dos.parser

.PAG 'DOS PARSER'
;******* DOSPAR **************
;*
;*       -MGM 7/23/79-
;*
;* THIS IS THE PARSER ROUTINE
;* IT LOOKS AT LINES PASSED TO
;* IT AND MAKES SURE THAT THE
;* SYNTAX IS ALL PROPER.
;*
;* IT RETURNS WITH PARCHK
;* IN THE .ACC
;*
;* PARCHK IS THE
;*   "PARSING CHECK BYTE".
;* FLAGS ARE SET ACCORDINGLY
;* AS VALUES ARE PARSED  AND SET
;*
;* STRUCTURE OF PARCHK:
;*
;*I-I-I-I-I-I-I-I-I
;*I7+6+5+4+3+2+1+0I
;*I-I-I-I-I-I-I-I-I
;* ^ ^ ^ ^ ^ ^ ^ ^=> FN1:  THIS BIT
;* ! ! ! ! ! ! !   IS SET WHEN THE FIRST
;* ! ! ! ! ! ! !   FILENAME IS PARSED
;* ! ! ! ! ! ! !=> FN2: " FOR SECOND FILENAME
;* ! ! ! ! ! !=> LA: BIT SET WHEN #L IS PARSED
;* ! ! ! ! !=> FA: BIT SET WHEN UNIT# 1S PARSED
;* ! ! ! !=> D1: BIT SET WHEN DRIVE1 PARSED
;* ! ! !=> D2: DITTO - WHEN DRIVE2 PARSED
;* ! !=> LRECL: SET WHEN LRECL PARSED
;* !=> @RPL: SET ON REPLCMNT OPERATOR IN FN1
;*
;*  THE FOLLOWING ARE THE VALID BIT-
;*     PATTERNS FOR PARCHK AFTER PARSING
;*   FOR THE VARIOUS KEYWORDS:
;*
;*             PARCHK
;*          7 6 5 4   3 2 1 0
;*(FORMAT)
;* HEADER   0 0 0 1   * 0 0 1
;* COLECT   0 0 0 *   * 0 0 0
;* BACKUP   0 0 1 1   * 0 0 0
;* COPY     0 0 1 1   * 0 0 0
;*   OR..   0 0 * *   * 0 1 1
;* CONCAT   0 0 * *   * 0 1 1
;* DSAVE    * 0 0 *   * 0 0 1
;* DLOAD    0 0 0 *   * 0 0 l
;* CATLOG   0 0 0 *   * 0 0 0
;* RENAME   0 0 0 *   * 0 1 1
;* APPEND   0 0 0 *   * 1 0 1
;* SCRTCH   0 0 0 *   * 0 0 1
;* DOPEN    * * 0 *   * 1 0 1
;* DCLOSE   0 0 0 0   * * 0 0
;*          ^ ^ ^ ^   ^ ^ ^ ^
;*          @ L D D   F L F F
;*          R R 2 1   A A N N
;*          P E           2 1
;*          L L
;*   "1" BITS ARE REQ'D PARAMETERS
;*   "*" BITS ARE OPTIONAL PARMS
;************************************
;
DOSPAR	LDX #0
	STX PARCHK
	STX LA
	STX LRECL       ; INIT VARS
	STX DRIVE1
	STX DRIVE2
	STX FNLEN
	STX FNLEN2
	STX DISKID
	LDX #8
	STX FA
	JSR CHRGOT      ; GET CURRENT CHR
	BEQ DONE1       ; <CR> OR <:> => DONE
;
PARSEL	CMP #'#
	BEQ LOGADR
	CMP #'W
	BEQ RECLEN
	CMP #'L
	BEQ RECLEN
	CMP #'R
	BNE PARNXT
	JSR CHRGET      ;MOVE ON
	JMP DELIM1
PARNXT	CMP #'D
	BEQ DRV1
	CMP #ONTK       ;"ON" TOKEN
	BEQ ON1
	CMP #'U
	BEQ UNIT1
	CMP #'I
	BNE NEXT7
	JMP IDENT
NEXT7	CMP #'"
	BEQ NAME11
	CMP #'(
	BEQ NAME11
SNER1	JMP SNERR       ;SNYTAX ERROR
; OF THE ABOVE
;
;
LOGADR	LDA PARCHK      ;CHK SYNTAX
	AND #4
	BNE SNER1       ;ONLY ONE LA ALLOWED
	JSR GETVAL
	CPX #0
	BEQ QTYER2      ;ZERO NOT ALLOWED
	STX LA
	LDA PARCHK
	ORA #4          ;SET LA FLAG &
	STA PARCHK
	JMP DELIM1      ;CONTINUE
;
;
RECLEN	TAX             ;SAVE CHAR
	LDA PARCHK      ;CHK SYNTAX
	AND #$40
	BNE SNER1       ;ONLY 1 LRECL ALLOWED
	CPX #'W
	BNE RECOO
	JSR CHRGET
	JMP RECON       ;ONLY SET PARCHK
RECOO	JSR GETVAL
	CPX #0
	BEQ QTYER2      ;ZERO ILLEGAL. LRECL
	CPX #255
	BEQ QTYER2      ;ILLEGAL LRECL
	STX LRECL       ;STORE PARCEL
RECON	LDA PARCHK
	ORA #$40        ;SET LRECL FLAG &
	STA PARCHK
	JMP DELIM1      ; CONTINUE
;
DONE1	JMP DONE
;
NAME11	JMP NAME1
ON1	JSR ON
	JMP DELIM1
UNIT1	JSR UNIT        ;DO UNIT# PARSING
	JMP DELIM1
;
;
DRV1	LDA PARCHK
	AND #$10
	BNE SNER1       ;DRIVE1 ALLOWED ONCE
	JSR GETVAL
	CPX #2
	BCS QTYER2      ;ILLEGAL DRV# IF >1
	STX DRIVE1
	STX DRIVE2
	LDA PARCHK
	ORA #$10
	STA PARCHK      ;SET DRIVE1 FLAG &
	JMP DELIM1      ; CONTINUE
;
QTYER2	JMP QTYERR
;
IDENT	LDA DIDCHK
	AND #$FF
	BEQ IDCON       ;ONLY 1 DISKID ALLOWED
	JMP SNERR
IDCON	LDY #0
	LDX #0
NEXT3	INC TXTPTR
	BNE NEXT4
	INC TXTPTR+1
NEXT4	LDA (TXTPTR),Y
	STA DISKID,X    ;M(TXTPTR => DISKID
	INX
	CPX #2
	BCC NEXT3
	LDA #$FF
	STA DIDCHK      ;SET DISKID FLAG &
	JSR CHRGET      ;CONTINUE
	JMP DELIM1
;
;
NAME1	LDA PARCHK
	AND #1          ;NAMEL ALLWD ONLY ONCE
	JSR NEWNAM      ;DO NAME PARSING
	STA FNLEN
	STA COUNT       ;SAVE TEMP VALUE
	LDA #<TBUF2
	STA FNADR
	LDA #>TBUF2
	STA FNADR+1;RESET FNADR VALUE
	LDY #0
LOOP6	LDA (INDEX1)Y   ;TBUF2 XFER LOOP
	CPY #0
	BNE NAMCON
	CMP #'@
	BNE NAMCON
	INC FNADR       ;AND ERASE IT
	DEC FNLEN
NAMCON	STA TBUF2,Y
	INY
	CPY COUNT
	BCC LOOP6
	LDA PARCHK
	ORA #1          ;SET NAPIE1 FLAG
	STA PARCHK
;
DELIM1	JSR CHRGOT
	BNE NXXX
	JMP DONE1       ;<CR>/<:> => DONE
NXXX	CMP #',
	BNE NEXT6
	JSR CHRGET
	JMP PARSEL
NEXT6	CMP #ONTK
	BNE NEXT6A
	JMP ON1
NEXT6A	CMP #TOTK       ;"TO" TOKEN
	BEQ PARSE2
SNER8	JMP SNERR       ;SNTAX ERROR
;
;
PARSE2	JSR CHRGET
	CMP #'D
	BEQ DRV2
	CMP #ONTK       ;"ON" TOKEN
	BEQ ON2
	CMP #'U
	BEQ UNIT2
	CMP #'"
	BEQ NAME2
	CMP #'(
	BEQ NAME2
SNER2	JMP SNERR        ;ERROR
;
;
DRV2	LDA PARCHK
	AND #$20
	BNE SNER2       ;ONLY ONE DRIVE2 ALLWD
	JSR GETVAL
	CPX #2
	BCS QTYERR      ;ILLEGAL DRIVE #
	STX DRIVE2
	LDA PARCHK
	ORA #$20
	STA PARCHK      ;GET DRIVE2 FLAG &
	JMP DELIM2
;
;
ON2	JSR ON
	JMP DELIM2
UNIT2	JSR UNIT         ;DO UNIT# PARSING
	JMP DELIM2
;
;
NAME2	LDA PARCHK
	AND #2          ;NAME2 ALLOWED ONLY ONCE
	JSR NEWNAM
	STA FNLEN2
	STX FNADR2
	STY FNADR2+1
	LDA PARCHK
	ORA #2          ;SET FILENAME2 FLAG &
	STA PARCHK
;CONTINUE
;
DELIM2	JSR CHRGOT
	BEQ DONE        ;DONE ON <CR>/<:>
	CMP #',
	BEQ PARSE2
	CMP #ONTK       ;"ON" TOKEN
	BEQ ON2
	CMP #'U
	BEQ UNIT2
SNER3	JMP SNERR        ;ERROR
;
;
DONE	LDA PARCHK       ;LOAD PARSER CHK
	RTS             ;BYTE FOR CALLING PROG TO CHECK
;
;***************************************
;* DOSPAR SUPPORT ROUTINES             *
;***************************************
;
;
QTYERR	LDX #ERRFC
	JMP ERROR; "ILLEGAL QUANTITY"
;
;
ON	JSR CHRGET
	CMP #'U
	BNE SNER3       ;NXT CHR MUST BE "U"
UNIT	JSR GETVAL
	CPX #32
	BCS QTYERR      ;ERROR IF >31
	CPX #3
	BCC QTYERR      ;ERROR IF <3
	STX FA
	LDA PARCHK
	ORA #8
	STA PARCHK      ;SET UNIT# FLAG
	RTS
;
;
NEWNAM	BNE SNER3
	JSR FRMEVL
	JSR FRESTR
	TAX             ;SAVE LENGTH IN .X
	CMP #0
	BEQ QTYERR      ;0 LENGTH NOT ALLOWED
	CMP #18
	BCS ERRLEN
	LDY #0
	LDA (INDEX1)Y
	CMP #'@
	BNE LENCHK
	LDA PARCHK
	AND #$80        ;IF T => SNERR
	BEQ NXXT5
	JMP SNERR
LENCHK	TXA
	CMP #17         ;"STRING TOO LONG ?
	BCS ERRLEN
	JMP NXX5
ERRLEN	LDX #ERRLS
	JMP ERROR       ;"STRING TOO LONG"
NXXT5	LDA PARCHK
	ORA #$80        ;SET "@" FLAG
	STA PARCHK
NEXT5	TXA              ;.A = FNLEN NOW
NXX5	LDX INDEX1
	LDY INDEX1+1
	RTS
;
;
GETVAL	;GET NEXTVALUE ROUTINE
	JSR CHRGET      ;GET NXT CHR
GTVL2	BNE CONT
	JMP SNERR       ;CANT BE <CR>/<:>
CONT	BCC NUMERC       ;CAN BE NUMERIC
	JSR CHKOPN      ;OR A "("
	JSR GETBYT      ;ANYTHING ELSE IS AN ERROR
	JMP CHKCLS      ;NEED CLOSING ")"
NUMERC	JMP GETBYT       ;EVALUATE IT
;
CKSUMD	.BYT 0           ; D-PAGE CHECKSUM BYT
;
PATCH5	STA SATUS
	STA (DSDESC+1)Y
	DEY
	RTS
;
SIGNON	.BYT '*** COMMODORE BASIC 4.0 ***'
	.BYT 13,13,0
;
.FILE OA1SRC