butes2

.PAG 'BUTES2'
;  CBM 2001 DISK VERB PROCESSORS
;  AUTHOR RSR 7-24-79
;
;  TABFCB - TABLE OF FCB PROCESSING STRINGS.
;
TABFCB
TCLR=*-TABFCB
	.BYT <FCLRM1    ;CLEAR
TCAT=*-TABFCB
	.BYT FCAT-1     ;CATALOG
TOPN=*-TABFCB
	.BYT FOPN-1     ;DOPEN DSAVE DLOAD
TAPN=*-TABFCB
	.BYT FAPN-1     ;APPEND
THED=*-TABFCB
	.BYT FHED-1     ;HEADER
TCOLL=*-TABFCB
	.BYT FCOLL-1    ;COLLECT
TBAK=*-TABFCB
	.BYT FBAK-1     ;BACKUP
TCOPY=*-TABFCB
	.BYT FCOPY-1    ;COPY
TCONC=*-TABFCB
	.BYT FCONC-1    ;CONCAT
TREN=*-TABFCB
	.BYT FREN-1     ;RENAME
TSCR=*-TABFCB
	.BYT FSCR-1     ;SCRATCH
TREC=*-TABFCB
	.BYT FREC-1     ;RECORD
;
XSCA	=$C2            ;SEND DOSSCA
XID	=$D0            ;SENDS DISK ID
XD1	=$D1            ;SENDS DOSDS1
XD2	=$D2            ;SENDS DOSDS2
XREC	=$E0            ;SENDS S FOR SEQ OR DOSRCL
XWRT	=$E1            ;SENDS W OR L
XRCL	=$E2            ;SEND LOW ((POKER))
XFAT	=$F0            ;SENDS "@" IF SPECIFIED
XFN1	=$F1            ;SENDS FILENAME1
XFN2	=$F2            ;SENDS FILENAME2
;
;  TABLD - TOKEN TABLE DEFINITIONS
;
TABLD	;USED TO BUILD DISK COMMAND STRINGS
FCLR	=*-TABLD
FCLRM1	=FCLR-1
	.BYT 'I',XD1
FCAT	=*-TABLD
	.BYT '$',XD1,':',XFN1
;
FOPN	=*-TABLD
	.BYT XFAT,XD1,':',XFN1,',',XWRT,',',XREC
;
FCONC	=*-TABLD
	.BYT 'C',XD2,':',XFN2,'=',XD2,':',XFN2,','
FAPN	=*-TABLD
	.BYT XD1,':',XFN1,',','A'
;
FHED	=*-TABLD
	.BYT 'N',XD1,':',XFN1,',',XID
;
FCOLL	=*-TABLD
	.BYT 'V',XD1
;
FBAK	=*-TABLD
	.BYT 'D',XD2,'=',XD1
;
FCOPY	=*-TABLD
	.BYT 'C',XD2,':',XFN2,'=',XD1,':',XFN1
;
FREN	=*-TABLD
	.BYT 'R',XD1,':',XFN2,'=',XD1,':',XFN1
;
FSCR	=*-TABLD
	.BYT 'S',XD1,':',XFN1
;
FREC	=*-TABLD
	.BYT 'P',XSCA,XRCL,XREC
.PAG
;  SEND PARAMETERS TO DEVICE
;
;  ENTRY  A NUMBER OF BYTES IN FORMAT.
;  Y --> TABLD ENTRY.
SAV20	JSR     CHK2
	LDY     #TOPN   ;TABLE OFFSET
SAV21	LDA     #4      ;LENGTH
SENDP
	STA XCNT        ;SAVE NUMBER OF STRING BYTES
	LDA TABFCB,Y    ;GET POINTER INTO TABLD
	PHA
	JSR OLDCLR      ;CLEAR OLD STATUS
;
	LDX #0
SDP1
	PLA
	DEC XCNT
	BMI TRANR
	TAY
	INY             ;MOVE DOWN TABLE
	TYA
	PHA
	LDA TABLD,Y     ;GET NEXT ENTRY
	BPL SDP5        ;IF NOT ESCAPE CODE
	CMP #XSCA       ;IF NOT SECONDARY ADDRESS
	BEQ RSCA
	CMP #XID
	BEQ RID         ;IF DISK ID
	CMP #XRCL
	BEQ RDCN        ;IF RECORD NUMBER
	CMP #XWRT
	BEQ RWRT        ;IF W OR L
	CMP #XFAT
	BEQ RFAT        ;IF "@" SYMBOL REQUEST
	CMP #XFN1
	BEQ RSFN        ;IF FILENAME 1
	CMP #XFN2
	BEQ GORDFN      ;IF FILENAME 2
	CMP #XREC
	BNE SDP2        ;IF NOT RECORD TYPE
	LDA DOSRCL      ;GET REC #
	BNE SDP5        ;ALWAYS BRANCH
SDP2	CMP #XD1
	BNE SDP3        ;IF NOT DRIVE 1
	LDA DOSDS1
	BPL SDP4        ;ALWAYS BRANCH
SDP3	CMP #XD2
	BNE SDP1        ;IF NOT DRIVE 2, CONTINUE
	LDA DOSDS2
SDP4	ORA #'0         ;CHANGE # TO ASCII
;
SDP5	STA DOSSTR,X    ;ELSE INTO BUFFER
	INX
	BNE SDP1        ;ALWAYS
;
GORDFN
	BEQ RDFN
;
TRANR
	TXA             ;LENGTH TO A
	PHA
	LDX #<DOSSTR    ;SET FILENAME
	LDY #>DOSSTR
	STX HIGHDS      ; SET UP VECTOR FOR FILENAME
	STY HIGHDS+1
	LDY #SYSBNK     ;FILENAME IS IN SYSTEM BANK
	STY HIGHDS+2
	JSR SAV3
	PLA
	RTS
.SKI 4
RSCA	LDA DOSSA       ;SECONDARY ADDRESS (RECORD)
	BNE SDP5        ;ALWAYS
;
RFAT
	BIT PARSTS
	BMI RFATA
	BPL SDP1        ;IF @ NOT ENCOUNTERED
RFATA	LDA #'@
	BNE SDP5        ;ALWAYS
;
;  ID SUBROUTINE
RID
	LDA DOSDID      ;INCLUDE ID
	STA DOSSTR,X
	INX
	LDA DOSDID+1
	BNE SDP5        ;ALWAYS
;
RWRT
	LDA DOSRCL      ;CHK FOR L OR W
	BEQ RWRT1       ;ZERO THEN WRITE
	LDA #'L
	BNE SDP5        ;ALWAYS
;
RWRT1	LDA #'S         ;SEND W,S
	STA DOSRCL
	LDA #'W
	BNE SDP5        ;ALWAYS
;
;  MOVE RECORD NUMBER
RDCN
	LDA POKER
	STA DOSSTR,X
	LDA POKER+1
	INX
	BNE SDP5        ;ALWAYS
;
;  MOVE FILE NAMES.
RSFN
	LDA DOSF1A
	STA INDEX1
	LDA DOSF1A+1
	STA INDEX1+1
	LDA DOSF1B
	LDY DOSF1L
	BEQ RDRT0       ;IF NULL STRING
	BNE XRFN        ;ALWAYS
;
RDFN
	LDA DOSF2A
	STA INDEX1
	LDA DOSF2A+1
	STA INDEX1+1
	LDA DOSF2B
	LDY DOSF2L
	BEQ RDRT0       ;IF NULL STRING
;
XRFN
	STA I6509       ;SET INDIRECTION BANK
	STY COUNT
	LDY #0          ;MOVE NAME TO DOSSTR
RDMOV	LDA (INDEX1)Y
	STA DOSSTR,X
	INX
	INY
	CPY COUNT
	BNE RDMOV       ;IF MOVE NOT COMPLETE
	.BYTE $24       ;HOP
RDRT0	DEX             ;CASE CDD=SD
RDRT1
	JSR MAPTXT      ;RESTORE INDIR BANK
	JMP SDP1        ;GET NEXT SYMBOL
.PAG
;  SYNTAX CHECKER
;  ROUTINES FOR DOS.WRITE
CHK1
	AND #$E6        ;FOR HEADER,DLOAD,SCRTCH
	BEQ CHK2        ;CHK OPT PARMS
CHKER1	JMP SNERR
;
CHK2
	LDA PARSTS      ;FOR DSAVE
	AND #1
	CMP #1          ;CHK REQ'D PARMS
	BNE CHKER1      ;ERROR IF 1 MISSING
	LDA PARSTS      ;RELOAD FOR RETURN
	RTS
;
CHK3	AND #$E7        ;FOR COLECT
	BNE CHKER1      ;CHK OPT PARMS
	RTS
;
CHK4	AND #$C4        ;FOR COPY,CONCAT
	BNE CHKER1      ;CHK OPT PARMS
	LDA PARSTS
CHK5	AND #3          ;FOR RENAME
	CMP #3          ;CHK REQ'D PARMS
	BNE CHKER1
	LDA PARSTS      ;RELOAD FOR RETURN
	RTS
;
CHK6	AND #5          ;FOR APPEND,DOPEN
	CMP #5          ;CHK REQ'D PARMS
	BNE CHKER1
	LDA PARSTS      ;RELOAD FOR RTS
	RTS
.PAG
;  ERROR ON CHANNEL READ
ERRCHL
	LDA #0          ;NO FILENAME
	JSR SETNAM
	LDY #$6F        ;.Y=SA
	JSR OCHANL      ;OPEN SPECIAL CHANNEL
	LDX #DOSLFN     ;MAKE IT THE INPUT CHANNEL
	JSR CHKIN
	LDY #$FF        ;FOR OFFSET
	JSR MAPSTR
;
LOOP1	INY
	JSR BASIN
	CMP #CR         ;CHECK FOR END
	BEQ ERREND
	STA (DSDESC+1)Y
	CPY #39
	BNE LOOP1
ERREND	LDA #00
	STA (DSDESC+1)Y
	LDA #40         ;GET 40 CHAR STR
	STA DSDESC      ;WE HAVE 40 CHRS
	JSR MAPTXT
	JSR CLRCH
	LDA #DOSLFN     ;CLOSE CHANNEL AND RESTORE DEFAULT CHNLS
	CLC
	JSR TCLOSE
	JMP DCAT0       ;RESTORE DEFAULT CHANNEL ...
.SKI 4
;R-U-SURE SUBROUTINE
RUSURE	JSR TSTDIR      ;CHK FOR DIRECT
	BNE ANSYES      ;Z CLR=NOT DIRECT
	LDX #MSG30
	JSR MSG         ;PROMPT USER
	JSR CLRCH       ;CLEAR CHANNEL FOR BASIN
	JSR BASIN       ;NEXT CHAR
	CMP #'Y
	BNE ANSNO       ;IF 1ST <> 'Y'
	JSR BASIN       ;NEXT CHR
	CMP #CR
	BEQ ANSYES      ;IF SHORT FORM OF YES (Y,CR)
	CMP #'E
	BNE ANSNO       ;IF NOT 'E'
	JSR BASIN
	CMP #'S
	BNE ANSNO       ;IF NOT 'S'
	JSR BASIN
	CMP #CR
	BEQ ANSYES      ;IF 'YES',CR
;
;  IF NOT YES, INPUT UNTIL CR RECEIVED
ANSNO	CMP #CR
	SEC             ;CARRY SET =NO&DIRECT
	BEQ ANSBYE      ;IF CR RECEIVED, EXIT
	JSR BASIN
	BNE ANSNO       ;CONTINUE TO IGNORE
;
;  HERE IF ANSWER 'YES'
ANSYES	CLC             ;CARRY CLR =NOT DIRECT
ANSBYE	RTS
.SKI 4
;OLDCLR SUBROUTINE
;    CLEARS DS$: SET STRING LENGTH TO ZERO.
;    CLEARS ST
;
OLDCLR
	LDA #0
	STA DSDESC      ;KILL DS$
	CLC
	JMP STORST      ;KILL ST
.SKI 3
SAV77
	JSR SAV13
	STA DOSF1L
	LDA INDEX1      ;SAVE ADDRESS OF STRING
	LDY INDEX1+1
	STA DOSF1A
	STY DOSF1A+1
	LDY INDEX1+2    ; ...AND ITS BANK#
	STY DOSF1B
	RTS
.PAG
;  PARSER FOR LOAD,SAVE AND VERIFY VERBS
; (FILE NAME OPTION)
; (OPT DEVICE #) DFLT=1
; (EOT CMD) DFLT=0=NO
PLSV
	LDX #0
	STX DOSF1L      ;SET FILE NAME LENGTH TO ZERO
	STX DOSSA       ;SET SECONDARY ADDRESS TO ZERO
	STX DOSLA       ;CLEAR LOGICAL ADDRESS
	LDX #1          ;DEFAULT DEVICE
	STX DOSFA       ;SET PHYSICAL ADDRESS TO 8 (DISK)
;
	JSR CHRGOT
	BEQ PLSVX       ;IF NO PARAMTERS
	JSR SAV77
;
	JSR PLSV27
	STX DOSFA       ;SAVE DEVICE CHANNEL
;
	JSR PLSV27
	STX DOSSA       ;SET SECONDARY ADDRESS
;
PLSVX
	LDA DOSF1A
	LDX DOSF1A+1
	LDY DOSF1B
	STA HIGHDS      ;SET UP VECTOR TO FILENAME
	STX HIGHDS+1
	STY HIGHDS+2
	LDA DOSF1L      ;.A=FILENAME LENGTH
SAV3	LDX #<HIGHDS    ;PAGE 0 ADDR OF VECTOR
	JSR SETNAM
	LDA DOSLA       ;SET LOGICAL FILE INFO
	LDX DOSFA
	LDY DOSSA
	JMP SETLFS
;
PLSV27
	JSR CHRGOT
	BEQ PLSVX
	JMP COPG
;
PLSV30	JSR CHKCOM
PLSV32	JSR CHRGOT
	BNE PLSRTS      ;IF NOT END OF STATEMENT
	JMP SNERR
.SKI 4
;  ROUTINE TO TEST IF VARIABLE IS IN BASIC.
;  ENTRY  (FACMO) = ADDRESS OF VARIABLE.
;  EXIT  CARRY CLEAR IF VARIABLE IS IN BASIC.
;  CARRY SET IF VARIABLE NOT IN BASIC.
TSTROM
	LDA FACMO+2     ;CHECK BANK#S
	CMP #SYSBNK
	BNE XIT         ;NOT IN BASIC...
	CLC
	LDA #<BENTRY    ;BENTRY-PTR-1<=0?
	SBC FACMO
	LDA #>BENTRY
	SBC FACMO+1
PLSRTS	RTS
;
XIT	SEC
	RTS
.SKI 4
FLPINT
	JSR AYINT
	LDA FACMO
	LDY FACLO
	RTS
.PAG     'CHRGET ROUTINE'
;  CHRGET IS CALLED TO GET THE NEXT CHARACTER FROM THE
;  TEXT BUFFER POINTED TO BY TXTPTR WHICH IS INCREMENTED
;  BEFORE THE ACCESS IS MADE.
;
;  CHRGOT IS CALLED TO GET THE CURRENT CHARACTER FROM
;  THE BUFFER POINTED TO BY TXTPTR.
;
;  QNUM IS CALLED TO TEST FOR A ASCII NUMERIC CHARACTER.
;
;  ENTRY  TXTPTR POINTS TO THE BUFFER.
;
;  EXIT  .A = CHARACTER FROM BUFFER.
;        .Y = 0
;  TXTPTR IS UPDATED (CHRGET).
;  C BIT = 0, CHARACTER IN .A IS NUMERIC.
;   = 1, CHARACTER IN .A IS NON-NUMERIC.
;  Z BIT = 0, THE NOT END OF STATEMENT.
;   = 1, END OF STATEMENT "" OR END OF LINE.
;
CHRGET	JMP (ICHRGE)
CHRGOT	JMP (ICHRGO)
.SKI 2
	.IFN CC1 <
NCHRGE
	INC TXTPTR      ;INCREMENT TEXT POINTER
	BNE NCHRGO      ;IF NO CARRY INTO MSB
	INC TXTPTR+1
;
NCHRGO
	LDY #0
	LDA (TXTPTR)Y
	CMP #$20        ;SPAN BLANKS
	BEQ CHRGET      ;IF BLANK CHARACTER
;
;  IF THE CHARACTER IN .A IS NUMERIC THEN
;  THE FOLLOWING CODE CLEARS THE CARRY BIT.
QNUM
	CMP #':
	BCS QNRTS
	SBC #$2F        ;'0'-1
	SEC
	SBC #$D0        ;$100-'0'
QNRTS	RTS
>
	.IFE CC1 <
NCHRGO	JSR CHRMAP
	JMP CHRG20
NCHRGE
	JSR CHRMAP
CHRG10
	INC TXTPTR      ;INCREMENT TEXT POINTER
	BNE CHRG20      ;IF NO CARRY INTO MSB
	INC TXTPTR+1
;
CHRG20	LDY #0
	LDA (TXTPTR)Y
	CMP #$20        ;SPAN BLANKS
	BEQ CHRG10      ;IF BLANK CHARACTER
	JSR QNUM
	PHP
	PHA
	LDA TTTEMP
	STA I6509
	PLA
	PLP
	RTS
;  IF THE CHARACTER IN .A IS NUMERIC THEN
;  THE FOLLOWING CODE CLEARS THE CARRY BIT.
QNUM
	CMP #':
	BCS QNRTS
	SBC #$2F        ;'0'-1
	SEC
	SBC #$D0        ;$100-'0'
QNRTS	RTS
.SKIP 2
CHRMAP
	LDA I6509
	STA TTTEMP
	LDA TXTPTR+2    ;CAN'T ALWAYS ASSUME TXT BANK
	STA I6509
	RTS
>
.PAGE   'INDIRECT REGISTER ROUTINES'
;   LOAD INDIRECT THROUGH .Y, USING INDEX1 OR INDEX2
;   AS POINTER. USED TO READ FROM SYSTEM MEMORY BANK
;   EXIT:    .A
;
LDI1Y	LDA #0
	ORA (INDEX1),Y
	RTS
.SKIP 3
;      BANK MAPPING ROUTINES
;
MAPDST	PHA             ;I6509:=DSCTMP+3
	LDA DSCTMP+3
	BPL MAP001      ; ALWAYS
;
MAPDSP	PHA             ;I6509:=DSCPNT+2
	LDA DSCPNT+2
	BPL MAP001
;
MAPINX	PHA             ;I6509:=INDEX+2
	LDA INDEX+2
	BPL MAP001
;
MAPSYS	PHA             ;I6509:=SYSTEM BANK
	LDA #SYSBNK
	BPL MAP001
;
MAPSTR	PHA             ;I6509:=STRING BANK
	LDA #STRBNK
	BPL MAP001
;
MAPARY	PHA             ;I6509:=ARRAY BANK
	LDA #ARYBNK
	BPL MAP001
;
MAPVAR	PHA             ;I6509:=SIMP VAR BANK
	LDA #VARBNK
	BPL MAP001
;
MAPUSR
MAPTXT	PHA             ;I6509:=TEXT BANK
	LDA #TXTBNK
MAP001	STA I6509
	PLA
	RTS
.END