S-C ProDOS Interface 3.0 -- SCI/SC.COMMAND.PAR
1000 *SAVE SC.COMMAND.PAR
1010 *--------------------------------
1020 .DA COMMAND.TABLE needed for HELP command
1030 *--------------------------------
1040 * PARSE COMMAND LINE
1050 *--------------------------------
1060 PARSE.COMMAND
1070 JSR SCAN.COMMAND.TABLE
1080 BCS SYNERR2 ...SYNTAX ERROR
1090 LDA #0
1100 STA FBITS
1110 STA FBITS+1
1120 STA PATHNAME.TWO.BUFFER
1130 STA PATHNAME.ONE.BUFFER+1
1140 LDA D.SLOT
1150 STA VAL.S
1160 LDA D.DRIV
1170 STA VAL.D
1180 *---Handle special cases---------
1190 BIT PBITS Check for PR# or IN#
1200 BVS PARSE.INPR PR# & IN# commands
1210 BPL .1 ...not CAT(ALOG) or PREFIX
1220 JSR MLI.C7 ...CAT, CATALOG, or PREFIX
1230 *---TEST CHAR AFTER COMMAND------
1240 .1 JSR GET.NEXT.NONBLANK
1250 BNE .2 ...not comma or
1260 BCC .5 ... already
1270 JMP GET.ANOTHER.PARM
1280 *---Get a pathname---------------
1290 .2 CMP #'/' MUST START WITH "/" OR LETTER
1300 BEQ .3
1310 CMP #'A'
1320 BCC SYNERR2 ...SYNTAX ERROR
1330 .3 DEX RE-SCAN THE FIRST CHAR OF PATH
1340 LDY #0
1350 .4 JSR GET.NEXT.CHAR.FROM.WBUF
1360 STA PATHNAME.ONE.BUFFER+1,Y
1370 JSR STORE.PATH.TWO.AND.TEST
1380 BCC .4
1390 DEY
1400 STY PATHNAME.ONE.BUFFER
1410 STY PATHNAME.TWO.BUFFER
1420 LDA #$01 TELL THE WORLD ABOUT IT
1430 STA FBITS
1440 *--------------------------------
1450 DEX RE-SCAN CHAR AFTER PATHNAME
1460 JSR GET.NEXT.NONBLANK
1470 BNE SYNERR2 ...NOT COMMA OR
1480 BCS MORE.PARMS ...COMMA
1490 .5 JMP NO.MORE.PARMS ...
1500 SYNERR2
1510 JMP ERR.SYNTAX
1520 *--------------------------------
1530 * PR# or IN# commands
1540 *--------------------------------
1550 PARSE.INPR
1560 JSR GET.NEXT.NONBLANK CHAR AFTER COMMAND
1570 BEQ SYNERR2 ...comma or
1580 DEX ...IN CASE IT IS "Axxx"
1590 CMP #'A'
1600 BEQ GET.ANOTHER.PARM ...HANDLE PR#Axxx or IN#Axxx
1610 INX RESTORE X
1620 JSR ZERO.ACCUM
1630 STY PARM.LENM1 Y=0, 1 BYTE PARM
1640 LDY #VAL.LB-VAL.A PARM OFFSET FROM VAL.A
1650 STY PARM.OFFSET
1660 LDY #$40
1670 STY FBITS
1680 JSR CONVERT.DECIMAL.NUMBER
1690 BCS RTS4
1700 LDA VAL.LB
1710 CMP #$08
1720 BCC TEST.IF.MORE.PARMS
1730 ERR.RANGE
1740 LDA #$02
1750 SEC
1760 RTS4 RTS
1770 *--------------------------------
1780 MORE.PARMS
1790 LDA PBITS
1800 LSR TEST BIT 0
1810 BCC SYNERR2 ...NO PATHNAME EXPECTED
1820 LSR TEST BIT 1
1830 BCC GET.ANOTHER.PARM ...NO PATH-TWO EXPECTED
1840 *---Get second pathname----------
1850 JSR GET.NEXT.NONBLANK
1860 BEQ SYNERR2 ...COMMA OR
1870 DEX RE-SCAN FIRST CHAR OF PATHNAME
1880 LDY #0
1890 .1 JSR GET.NEXT.CHAR.FROM.WBUF
1900 JSR STORE.PATH.TWO.AND.TEST
1910 BCC .1
1920 DEY
1930 STY PATHNAME.TWO.BUFFER
1940 LDA #$03 WE GOT TWO PATHNAMES, SO
1950 STA FBITS MARK THE BITS
1960 DEX RE-SCAN TERM. CHAR
1970 *--------------------------------
1980 TEST.IF.MORE.PARMS
1990 JSR GET.NEXT.NONBLANK
2000 BNE SYNERR2
2010 BCC NO.MORE.PARMS
2020 GET.ANOTHER.PARM
2030 JSR GET.NEXT.NONBLANK
2040 BEQ SYNERR2 ...NULL PARAMETER
2050 JSR PARSE.PARAMETER
2060 BCC TEST.IF.MORE.PARMS
2070 RTS ...error return
2080 *--------------------------------
2090 NO.MORE.PARMS
2100 LDA VAL.S CHECK RANGE OF S AND D
2110 BEQ ERR.RANGE
2120 CMP #$08
2130 BCS ERR.RANGE
2140 LDA VAL.D
2150 BEQ ERR.RANGE
2160 CMP #$03
2170 BCS ERR.RANGE
2180 *---CHECK IF DEFERRED COMMAND----
2190 LDA PBITS (only OPEN and WRITE are deferred)
2200 AND #$21
2210 LSR
2220 BEQ .1 ...NOT DEFERRED
2230 LDA STATE ...ARE WE IN DIRECT MODE?
2240 BEQ .6 ...YES, DEFERRED IS ILLEGAL
2250 *---CHECK PATHNAME---------------
2260 .1 BCC .5 ...NO PATH PERMITTED
2270 LDA PBITS+1
2280 AND #$04 S OR D OK?
2290 BEQ .5 ...NO
2300 LDA FBITS
2310 LSR HAVE WE A PATHNAME?
2320 BCS .2 ...YES
2330 LDA PBITS ...NO, IS PATH NEEDED
2340 AND #$90
2350 BEQ ERR.SYNTAX ...YES
2360 BPL .5
2370 *---NEED PREFIX OR S,D-----------
2380 .2 LDA PATHNAME.ONE.BUFFER+1
2390 EOR #'/' SLASH
2400 BEQ .3 ...EXPLICIT PREFIX
2410 LDA PREFIX.FLAG MLI's flag
2420 BEQ .4 ...NO PREFIX IS SET
2430 .3 LDA FBITS+1 DID WE GET S,D?
2440 AND #$04
2450 BEQ .5 ...NO
2460 BCS .4 ...YES, AND THERE IS A PATHNAME
2470 LDA #0 ...YES, BUT NO PATHNAME
2480 STA PATHNAME.ONE.BUFFER
2490 STA PATHNAME.ONE.BUFFER+1
2500 LDA #$01 SIGNAL WE GOT PATHNAME AFTER ALL
2510 ORA FBITS
2520 STA FBITS
2530 .4 JSR INSERT.VOLUME.NAME
2540 BCS .7
2550 *---BRANCH TO COMMAND------------
2560 .5 CLC SIGNAL NO ERROR
2570 LDA COMMAND.NUMBER
2580 BEQ EXTERNAL ...USER'S COMMAND
2590 EOR #CN.PREFIX
2600 BEQ INTERNAL ...PREFIX COMMAND
2610 LDA PBITS+1 ARE S/D VALID?
2620 AND #$04
2630 BEQ INTERNAL ...NO
2640 LDA FBITS ANY PATHNAME SPECIFIED?
2650 LSR
2660 BCC INTERNAL ...NO
2670 JSR GET.FILE.INFO ...YES
2680 BCC INTERNAL ...NO ERROR
2690 ORA #0 ...ERROR, WAS IT "FILE NOT FOUND"?
2700 BPL .7 ...NO, REAL ERROR
2710 LDA PBITS OKAY TO CREATE PATHNAME?
2720 AND #$08
2730 BNE INTERNAL ...YES
2740 LDA #$06 "PATH NOT FOUND"
2750 .HS 2C
2760 .6 LDA #$0F "NOT DIRECT COMMAND"
2770 SEC
2780 .7 RTS
2790 *--------------------------------
2800 INTERNAL JMP (COMMAND.ADDR)
2810 EXTERNAL JMP (EXTERNAL.COMMAND.HANDLER)
2820 *--------------------------------
2830 ERR.SYNTAX
2840 LDA #$10 SYNTAX ERROR
2850 ERRR SEC
2860 RTS
2870 *--------------------------------
2880 * INSERT PREFIX BEFORE PATHNAME
2890 *--------------------------------
2900 INSERT.VOLUME.NAME
2910 LDA VAL.S BUILD UNIT # FROM SLOT,DRIVE
2920 TAY SAVE VAL.S
2930 LSR 0000.00SS S
2940 ROR S000.000S S
2950 ROR SS00.0000 S
2960 ROR SSS0.0000 0
2970 LDX VAL.D
2980 CPX #2 .CS. if 2, .CC. if 1
2990 ROR DSSS.0000
3000 STA MISC.PARMS+1
3010 LDA #WBUF+1
3020 STA MISC.PARMS+2
3030 LDA /WBUF+1
3040 STA MISC.PARMS+3
3050 JSR MLI.C5 ONLINE -- READ VOLUME NAME
3060 BCS .4 NO SUCH SLOT AND DRIVE
3070 STX D.DRIV UPDATE DEFAULT S AND D
3080 STY D.SLOT
3090 *--------------------------------
3100 LDA PATHNAME.ONE.BUFFER+1
3110 EOR #'/' ALREADY HAVE VOLUME NAME?
3120 BEQ .4 ...YES, DON'T NEED ANOTHER
3130 *---ISOLATE VOLNAME LENGTH-------
3140 LDA WBUF+1 DSSSLLLL
3150 AND #$0F 0000LLLL
3160 STA WBUF+1
3170 *---MOVE PATHNAMES OVER L+2------
3180 LDY #62
3190 TYA
3200 SEC
3210 SBC WBUF+1
3220 TAX
3230 .1 LDA PATHNAME.ONE.BUFFER,X
3240 STA PATHNAME.ONE.BUFFER+2,Y
3250 LDA PATHNAME.TWO.BUFFER,X
3260 STA PATHNAME.TWO.BUFFER+2,Y
3270 DEY
3280 DEX
3290 BNE .1
3300 *---INSERT VOLUME SLASHES--------
3310 LDA #'/'
3320 STA PATHNAME.ONE.BUFFER+2,Y
3330 STA PATHNAME.ONE.BUFFER+1
3340 STA PATHNAME.TWO.BUFFER+2,Y
3350 STA PATHNAME.TWO.BUFFER+1
3360 *---COPY VOLUME NAME-------------
3370 .2 LDA WBUF+1,Y
3380 STA PATHNAME.ONE.BUFFER+1,Y
3390 STA PATHNAME.TWO.BUFFER+1,Y
3400 DEY
3410 BNE .2
3420 *---UPDATE PATH LENGTHS----------
3430 CLC
3440 LDA WBUF+1
3450 ADC #2 INCLUDE SLASHES
3460 TAY
3470 ADC PATHNAME.ONE.BUFFER
3480 CMP #64
3490 .3 BCS ERR.SYNTAX
3500 STA PATHNAME.ONE.BUFFER
3510 TYA
3520 ADC PATHNAME.TWO.BUFFER
3530 STA PATHNAME.TWO.BUFFER
3540 CMP #64
3550 BCS .3 ...BRIDGE TO SYNTAX ERROR
3560 *--------------------------------
3570 .4 RTS
3580 *--------------------------------
3590 SCAN.COMMAND.TABLE
3600 LDY #0 PNTR INTO COMMAND TABLE
3610 STY COMMAND.NUMBER
3620 DEY
3630 *---COMPARE COMMAND NAME---------
3640 .1 INC COMMAND.NUMBER
3650 LDX #0 PNTR INTO WBUF
3660 .2 INY next byte in command table
3670 JSR GET.NEXT.NONBLANK
3680 BEQ .4 ...end of WBUF contents
3690 EOR COMMAND.TABLE,Y
3700 BEQ .2 ...same so far
3710 ASL Might be last char
3720 BNE .4 ...No, try next command
3730 *---We found the command---------
3740 LDA COMMAND.TABLE+1,Y
3750 STA COMMAND.ADDR
3760 LDA COMMAND.TABLE+2,Y
3770 STA COMMAND.ADDR+1
3780 LDA COMMAND.TABLE+3,Y
3790 STA PBITS
3800 LDA COMMAND.TABLE+4,Y
3810 STA PBITS+1
3820 CLC
3830 RTS
3840 *---SKIP TO NEXT COMMAND---------
3850 .3 INY
3860 .4 LDA COMMAND.TABLE,Y
3870 BPL .3 ...NOT LAST CHAR YET
3880 INY SKIP OVER ADDRESS
3890 INY
3900 INY SKIP OVER PBITS
3910 INY
3920 LDA COMMAND.TABLE+1,Y
3930 BNE .1 ...more commands in table
3940 *---TRY EXTERNAL COMMAND---------
3950 LDA #$FF
3960 STA COMMAND.NUMBER
3970 SEC
3980 JMP USER.CMD
3990 *--------------------------------
4000 SYNERR1 JMP ERR.SYNTAX
4010 *--------------------------------
4020 PARSE.PARAMETER
4030 JSR ZERO.ACCUM
4040 LDY #NO.PARM.NAMES-1
4050 .1 CMP PARM.NAMES,Y
4060 BEQ FOUND.PARM
4070 DEY
4080 BPL .1
4090 CMP #'T'
4100 BNE SYNERR1 ...SYNTAX ERROR
4110 *---PARSE T PARAMETER------------
4120 LDA #$04
4130 AND PBITS
4140 BEQ ERR.BADPARM
4150 ORA FBITS
4160 STA FBITS
4170 LDA #0 SINGLE BLYTE
4180 STA PARM.LENM1
4190 LDA #VAL.T-VAL.A PARM OFFSET FROM VAL.A
4200 STA PARM.OFFSET
4210 JSR GET.NEXT.NONBLANK
4220 BEQ SYNERR1
4230 CMP #'$'
4240 BEQ CONVERT.HEX.NUMBER
4250 CMP #'A'
4260 BCC CONVERT.DECIMAL.NUMBER
4270 JMP CONVERT.FILE.TYPE
4280 *--------------------------------
4290 ERR.BADPARM
4300 SEC "INVALID PARAMETER"
4310 LDA #$0B
4320 RTS
4330 *--------------------------------
4340 FOUND.PARM
4350 LDA PARM.MASKS,Y
4360 BEQ .2
4370 AND PBITS+1
4380 BEQ ERR.BADPARM
4390 CMP #$04 IS IT S OR D
4400 BNE .1 ...NO
4410 AND FBITS+1 ...YES, DID WE ALREADY HAVE S OR D
4420 BNE .2 ...YES
4430 LDA #1 ...NO, SET D=1
4440 STA VAL.D
4450 LDA #$04
4460 .1 ORA FBITS+1
4470 STA FBITS+1
4480 .2 LDA PARM.VARIABLES,Y
4490 AND #$03
4500 STA PARM.LENM1
4510 LDA PARM.VARIABLES,Y
4520 LSR
4530 LSR
4540 STA PARM.OFFSET
4550 JSR GET.NEXT.NONBLANK
4560 BEQ GO.ERR.SYNTAX.1
4570 CMP #'$'
4580 BEQ CONVERT.HEX.NUMBER
4590 *--------------------------------
4600 CONVERT.DECIMAL.NUMBER
4610 STX COMMAND.LINE.LENGTH
4620 JSR ACCUMULATE.DECIMAL.DIGIT
4630 BCC .1
4640 BMI GO.ERR.RANGE.1
4650 BCS GO.ERR.SYNTAX.1
4660 .1 LDX COMMAND.LINE.LENGTH
4670 JSR GET.NEXT.NONBLANK
4680 BNE CONVERT.DECIMAL.NUMBER
4690 BEQ CHECK.PARAMETER.RANGE
4700 *--------------------------------
4710 CONVERT.HEX.NUMBER
4720 JSR GET.NEXT.NONBLANK
4730 BEQ GO.ERR.SYNTAX.1
4740 .1 STX COMMAND.LINE.LENGTH
4750 JSR ACCUMULATE.HEX.DIGIT
4760 BCC .2
4770 BMI GO.ERR.RANGE.1
4780 BCS GO.ERR.SYNTAX.1
4790 .2 LDX COMMAND.LINE.LENGTH
4800 JSR GET.NEXT.NONBLANK
4810 BNE .1
4820 *--------------------------------
4830 CHECK.PARAMETER.RANGE
4840 LDX #$02
4850 .1 CPX PARM.LENM1
4860 BEQ .2
4870 LDA ACCUM,X
4880 BNE GO.ERR.RANGE.1
4890 DEX
4900 BNE .1
4910 .2 LDY PARM.OFFSET
4920 .3 LDA ACCUM,X
4930 STA VAL.A,Y
4940 DEY
4950 DEX
4960 BPL .3
4970 LDX COMMAND.LINE.LENGTH
4980 CLC
4990 RTS
5000 *--------------------------------
5010 GO.ERR.SYNTAX.1 JMP ERR.SYNTAX
5020 *--------------------------------
5030 GO.ERR.RANGE.1 JMP ERR.RANGE
5040 *--------------------------------
5050 CONVERT.FILE.TYPE
5060 STA ACCUM+2 1ST LETTER
5070 LDY #2 GET 2ND AND 3RD
5080 .1 JSR GET.NEXT.NONBLANK
5090 BEQ GO.ERR.SYNTAX.1
5100 STA ACCUM-1,Y STORE THEM BACKWARDS
5110 DEY
5120 BNE .1 ...UNTIL Y=0
5130 STX COMMAND.LINE.LENGTH SAVE X-REG
5140 .2 LDX #2 COMPARE NEXT ENTRY
5150 .3 LDA ACCUM,X
5160 EOR FILE.TYPES,Y
5170 INY
5180 ASL IGNORE BIT 7
5190 BNE .4 ...NOT THE SAME
5200 DEX NEXT CHAR
5210 BPL .3
5220 LDA FILE.TYPES,Y
5230 STA VAL.T
5240 LDX COMMAND.LINE.LENGTH RESTORE X-REG
5250 CLC
5260 RTS
5270 .4 INY
5280 DEX
5290 BPL .4
5300 CPY #LAST.FILE.TYPE
5310 BCC .2
5320 BCS GO.ERR.SYNTAX.1
5330 *--------------------------------
5340 * GET NEXT NON-BLANK CHAR FROM WBUF
5350 * CHAR Z C
5360 * YES CLR
5370 * COMMA YES SET
5380 * OTHER NO ?
5390 *--------------------------------
5400 GET.NEXT.NONBLANK
5410 .1 JSR GET.NEXT.CHAR.FROM.WBUF
5420 CMP #' '
5430 BEQ .1 IGNORE BLANKS
5440 CMP #','
5450 BEQ .2 .CS. and .EQ.
5460 CMP #$0D .EQ. if
5470 CLC .CC.
5480 .2 RTS
5490 *--------------------------------
5500 GET.NEXT.CHAR.FROM.WBUF
5510 LDA WBUF,X
5520 BNE .1 MAKE 00==8D
5530 LDA #$0D
5540 .1 AND #$7F
5550 CMP #$60 CONVERT LOWER CASE TO UPPER
5560 BCC .2
5570 AND #$5F
5580 .2 INX
5590 RTS
5600 *--------------------------------
5610 ACCUMULATE.DECIMAL.DIGIT
5620 CMP #$30
5630 BCC .1
5640 CMP #$3A
5650 BCC .2
5660 .1 SEC
5670 ORA #0
5680 RTS
5690 *--------------------------------
5700 .2 AND #$0F
5710 PHA
5720 LDA ACCUM+2
5730 CMP #$1A
5740 BCS .5
5750 LDX #$02
5760 .3 LDA ACCUM,X
5770 PHA
5780 DEX
5790 BPL .3
5800 JSR SHIFT.ACCUM.LEFT
5810 JSR SHIFT.ACCUM.LEFT
5820 LDX #0
5830 CLC
5840 .4 PLA
5850 ADC ACCUM,X
5860 STA ACCUM,X
5870 INX
5880 TXA
5890 EOR #$03
5900 BNE .4
5910 JSR SHIFT.ACCUM.LEFT
5920 .5 PLA
5930 BCS TOOBIG
5940 ADC ACCUM
5950 STA ACCUM
5960 BCC RTS1
5970 CLC
5980 INC ACCUM+1
5990 BNE RTS1
6000 INC ACCUM+2
6010 BNE RTS1
6020 TOOBIG LDA #$FF
6030 SEC
6040 RTS1 RTS
6050 *--------------------------------
6060 ACCUMULATE.HEX.DIGIT
6070 CMP #'0'
6080 BCC .1
6090 CMP #'9'+1
6100 BCC .3
6110 CMP #'A'
6120 BCC .1
6130 CMP #'F'+1
6140 BCC .2
6150 .1 SEC
6160 ORA #0
6170 RTS
6180 .2 SBC #$06
6190 .3 AND #$0F
6200 LDX #$03
6210 .4 JSR SHIFT.ACCUM.LEFT
6220 BCS TOOBIG
6230 DEX
6240 BPL .4
6250 ORA ACCUM
6260 STA ACCUM
6270 RTS
6280 *--------------------------------
6290 SHIFT.ACCUM.LEFT
6300 ASL ACCUM
6310 ROL ACCUM+1
6320 ROL ACCUM+2
6330 RTS
6340 *--------------------------------
6350 ZERO.ACCUM
6360 LDY #0
6370 STY ACCUM
6380 STY ACCUM+1
6390 STY ACCUM+2
6400 RTS
6410 *--------------------------------
6420 * RETURN .CC. IF NOT END OF PATHNAME YET
6430 * ELSE .CS.
6440 *--------------------------------
6450 STORE.PATH.TWO.AND.TEST
6460 STA PATHNAME.TWO.BUFFER+1,Y
6470 INY
6480 CMP #','
6490 BEQ .1
6500 CMP #' '
6510 BEQ .1
6520 CMP #$0D
6530 BEQ .1
6540 CPY #65
6550 .1 RTS
6560 *--------------------------------