10
20
30
40 :
50
60
70
80 :
90 A%=0:X%=1:os%=24:IF?&FFF4=&C3:os%=((USR&FFF4)AND&FF00)DIV256
100 d$=".":s$="/":IF(os%AND-24):d$="/":s$=".":IF(os%AND-32):d$="\"
110 :
120 start% =&D800 :
130 jsc% =FALSE :
140 znos% =TRUE :
150 bbc% =TRUE :
160 banner%=TRUE :
170 ver$ ="1.40"
180 fn$ ="SJCCP140"+s$+"SYS"
190 :
200 start%=&D800:jsc%=TRUE :znos%=TRUE :bbc%=TRUE :ver$="1.40":
210 start%=&D400:jsc%=FALSE:znos%=FALSE:bbc%=FALSE:ver$="1.40":
220 start%=&D400:jsc%=FALSE:znos%=FALSE:bbc%=TRUE :ver$="1.40":
230 optimise%=FALSE
240 :
250 DRIVE=4:BDOS=5:OSBYTE=&FFF4:OS_CLI=&FFF7:BRKV=&FFFA:FAULT=&FF82
260 :
270 DEFFNif(A%):IFA%:z%=-1:=opt% ELSE z%=P%:=opt%
280 DEFFNendif:IFz%=-1:=opt% ELSE z%=P%-z%:P%=P%-z%:O%=O%-z%:=opt%
290 DEFFNelse:IFz%=-1:z%=P%:=opt% ELSE z%=P%-z%:P%=P%-z%:O%=O%-z%:z%=-1:=opt%
300 :
310 p%=3:DIM mcode% &900
320 FOR P=0 TO 1:opt%=P*p%+4
330 O%=mcode%:P%=start%
340 [OPT P*p%+4
350 JP CCPStart :\ Execute any command in InputBuffer
360 JP CCPClear :\ Clear InputBuffer and start CCP
370 OPT FNif(jsc%)
380 ::JP ResetCCP :\ Standard CCP must have only two entries
390 OPT FNendif :\ Remove if not original version
400 .InputBuffer:DEFB CCPstack-InputText :\ Input buffer maximum size
410 .InputLength:DEFB &00 :\ Input buffer length, 0=empty
420 .InputText :DEFM STRING$(16," ")
430 DEFM "SJCCP version ":DEFM ver$:DEFB 13:DEFB 10
440 OPT FNif(jsc%)
450 ::DEFM "Another quality product from JSC wundersystems":DEFB 13:DEFB 10:DEFB 13:DEFB 10
460 OPT FNendif
470 DEFM "$"
480 DEFM "(C)SJ Research 1984."
490 :
500 DEFM STRING$(start%+&C1-LENver$-P%,CHR$0) :\ Tweekable space
510 :
520 .CCPstack :\ Top of internal stack
530 .LD8CD :DEFB &04 :\ Number of columns for DIR, 4 fits in 80 cols
540 .SEARCH:DEFB &01 :\ User/Drive to search if object not found
550 .LD8CF :DEFB &00 :\ Bad Filename flag in ReadFilename
560 .ESCFLG:DEFB &01 :\ Escape enabled
570 .ADDR :DEFW &00 :\ Address workspace
580 .CCPDRV:DEFB &00 :\ CCP's current search drive
590 :
600 \ --------------------------------------------
610 \ Restart CCP with current drive
620 \ If entered via *RUN, will have InputLength=0
630 \ If entered via RESET command, will have InputLength=0
640 \ So can optimise by falling through CCPClear
650 \ --------------------------------------------
660 .ResetCCP:.entry% :\ Enter here if *RUN
670 LD A,(DRIVE):LD C,A :\ Get current user+drive
680 : :\ Fall through to start
690 :
700 \ -------------------------------------
710 \ C=user+drive to start with
720 \ ZNOS BIOS Warm enters with C=&00
730 \ Acorn BIOS never enters via here
740 \ DRDOS BIOS never enters via here
750 \ No startup command executed
760 \ -------------------------------------
770 .CCPClear
780 SUB A:LD (InputLength),A :\ Clear input buffer
790 :
800 \ -------------------------------------
810 \ C=user+drive to start with
820 \ ZNOS BIOS Cold enters with C=&00
830 \ Acorn BIOS Cold+Warm enters with C=user+drive from (DRIVE)
840 \ Input buffer contains startup command
850 \ -------------------------------------
860 .CCPStart
870 LD SP,CCPstack :\ Set up stack and save startup flag
880 OPT FNif(bbc%)
890 ::LD HL,ErrorHandler
900 ::LD (BRKV),HL :\ Set up error handler
910 OPT FNendif
920 :
930 LD HL,DRIVE:LD (HL),C :\ Save entry user/drive
940 LD C,&0D:CALL callBDOS :\ Reset disk system and log into drive A:
950 OPT FNif(optimise%)
960 ::CALL SelectDriveUser :\ Select specified drive and user in (HL)
970 OPT FNelse
980 ::LD A,(HL):AND 15:LD E,A :\ Get entry drive
990 ::LD C,&0E:CALL callBDOS :\ Select this drive
1000 ::SUB A:RLD:LD E,A:RRD :\ Get user to E
1010 ::LD C,&20:CALL BDOS :\ Select this user
1020 OPT FNendif
1030 LD HL,(LF204):LD (ADDR),HL:\ Save BIOS warm start address
1040 LD HL,LD922:LD (LF204),HL :\ Redirect BIOS warm start
1050 LD C,&0F:CALL SubmitBDOS :\ Try to open '$$$.SUB' file
1060 INC A:LD (BATCH),A :\ Set batch file active/inactive
1070 :
1080 \ Redirected WARM returns here
1090 .LD922
1100 LD SP,CCPstack :\ Reset CCP stack
1110 LD HL,(ADDR):LD (LF204),HL:\ Restore BIOS warm start address
1120 LD A,(BATCH):OR A :\ Fetch again in case we lost it via WARM redirection
1130 JR NZ,LD92B :\ No title if batch file active
1140 CALL CRLF :\ Annoying, but BDOS ERROR and ^C leaves POS>0
1150 OPT FNif(banner%)
1160 ::CALL vers:CALL CRLF :\ Display CCP version
1170 OPT FNendif
1180 .LD92B
1190 CALL AddCR:JP ExecInput :\ Execute any command and enter command loop
1200 :
1210 .commands
1220 DEFM "DIR" :NOP:DEFW dir
1230 DEFM "TYPE" :NOP:DEFW type
1240 DEFM "ERA" :NOP:DEFW era
1250 DEFM "REN" :NOP:DEFW ren
1260 DEFM "SAVE" :NOP:DEFW save
1270 DEFM "USER" :NOP:DEFW user
1280 DEFM "LOAD" :NOP:DEFW load
1290 DEFM "GO" :NOP:DEFW go
1300 DEFM "VDU" :NOP:DEFW vdu
1310 DEFM "PRINT":NOP:DEFW print
1320 DEFM "OLD" :NOP:DEFW old
1330 DEFM "RUN" :NOP:DEFW run
1340 DEFM "RESET":NOP:DEFW ResetCCP
1350 DEFM "VERS" :NOP:DEFW vers
1360 NOP
1370 :
1380 \ ----------------------------------------
1390 \ VERS - Print CCP and ZNOS version string
1400 \ ----------------------------------------
1410 .title
1420 DEFM "SJCCP version ":DEFM ver$
1430 DEFM "$"
1440 :
1450 .vers
1460 LD DE,title:CALL PrMessage:\ Print out CCP title
1470 LD C,&4A:CALL BDOS :\ Get ZNOS version string
1480 LD A,H:OR L:RET Z :\ HL=0, no ZNOS
1490 EX DE,HL:JP PrMessage :\ Print out ZNOS version string and return
1500 :
1510 \ -------------
1520 \ Error handler
1530 \ -------------
1540 .ErrorHandler
1550 OPT FNif(bbc%)
1560 ::LD SP,CCPstack:CALL CRLF:\ Reset stack and print newline
1570 ::LD HL,(FAULT) :\ Get address of error block
1580 ::.err_lp
1590 ::INC HL:LD A,(HL) :\ Get character from error string
1600 ::OR A:CALL NZ,PrChar :\ Print if not zero
1610 ::JR NZ,err_lp:CALL CRLF :\ Loop until zero terminator
1620 OPT FNendif
1630 :
1640 .LD9D3
1650 OPT FNif(bbc%)
1660 ::LD A,&7E:CALL OSBYTE :\ Acknowledge any pending Escapes
1670 ::LD HL,(ESCFLG):LD H,0
1680 ::LD A,&E5:CALL OSBYTE :\ Restore Escape action
1690 ::JR MainLoop :\ Return to command loop
1700 OPT FNendif
1710 :
1720 .LD9E5
1730 CALL CRLF
1740 .LD9E8
1750 CALL LDAA9 :\ Delete any '$$$.SUB' file
1760 CALL abort:DEFM "* Aborted *":DEFM "$"
1770 :
1780 \ Print in-line message and abort
1790 \ -------------------------------
1800 .abort
1810 POP DE:CALL CRLF :\ Get address of message, print newline
1820 CALL PrMessage :\ Print message and newline
1830 :
1840 \ ------------------------
1850 \ Main command prompt loop
1860 \ ------------------------
1870 .MainLoop
1880 LD SP,CCPstack :\ Set up stack
1890 SUB A:LD (LD8CF),A :\ Clear 'Bad filename' flag
1900 OPT FNif(bbc%)
1910 ::LD HL,&FF00:LD A,&E5
1920 ::CALL OSBYTE:LD (ESCFLG),HL:\ Read escape enable
1930 OPT FNendif
1940 :
1950 OPT FNif(optimise%)
1960 ::LD HL,DRIVE
1970 ::CALL SelectDriveUser :\ Select specified drive and user
1980 ::LD A,(HL):AND 15:INC A :\ Returns HL=>DRIVE, E=USER
1990 ::LD (CCPDRV),A :\ Set CCP drive number
2000 ::ADD A,&40:CALL PrChar :\ Print drive letter
2010 ::LD A,E:CALL PrDec :\ Print user number
2020 OPT FNelse
2030 ::CALL ResetUser :\ Reset user, returns HL=>DRIVE
2040 ::LD A,(HL):AND 15:LD E,A :\ Get current drive
2050 ::LD C,&0E:CALL callBDOS :\ Select this drive
2060 ::LD A,E:INC A:LD (CCPDRV),A:\ Set CCP drive number
2070 ::ADD A,&40:CALL PrChar :\ Print drive letter
2080 ::LD E,&FF:CALL GetSetUser :\ Get user number
2090 ::CALL PrDec :\ Print user number
2100 OPT FNendif
2110 :
2120 LD C,&4A:CALL BDOS :\ Get ZNOS version string
2130 LD A,H:OR L:LD A,ASC">" :\ If ZNOS not present, use '>'
2140 JR Z,prompt:LD A,ASC"]" :\ ZNOS present, use ']'
2150 .prompt
2160 CALL PrChar :\ If ZNOS, print A], if not print A>
2170 CALL LDA5D:CALL CRLF :\ Read a line to InputBuffer
2180 :
2190 .ExecInput
2200 SUB A:LD (InputLength),A :\ Flag InputBuffer as empty
2210 CALL ResetDMA :\ Set DMA to &0080
2220 CALL ExecLine:JR MainLoop :\ Execute line and loop back
2230 :
2240 \ ---------------------------------------
2250 \ Delete $$$.SUB and read a line of input
2260 \ ---------------------------------------
2270 .LDA5A
2280 CALL LDAA9 :\ Delete any '$$$.SUB' file
2290 :
2300 \ -----------------------------------------------
2310 \ Read a line of input from console or batch file
2320 \ -----------------------------------------------
2330 \ Returns DE=>no longer needed
2340 .LDA5D
2350 LD DE,InputBuffer :\ Prepare to read to InputBuffer
2360 LD A,(BATCH) :\ Is there a batch file active?
2370 OR A:JR NZ,LDA78 :\ Jump to read a record from batch file
2380 LD C,&0A:CALL BDOS :\ Read a line of input from console
2390 :
2400 \ Returns DE=>start of input line
2410 \ -------------------------------
2420 .AddCR
2430 LD HL,InputLength :\ Point to line length
2440 LD E,(HL):LD D,0 :\ Get input line length
2450 INC HL:EX DE,HL :\ DE=>start of input line
2460 ADD HL,DE :\ HL=>end of input line
2470 LD (HL),13:RET :\ Put CR at end of text
2480 :
2490 \ Read a record from '$$$.SUB' batch file
2500 \ ---------------------------------------
2510 .LDA78
2520 INC DE :\ Point to InputLength
2530 CALL SetDMA :\ Set DMA address to InputBuffer contents
2540 LD A,(SUBFCB+15) :\ Get RecordCount
2550 DEC A:JP M,LDA5A :\ No more, delete $$$.SUB, read from console
2560 PUSH AF:LD (SUBFCB+32),A :\ Set record number to read
2570 LD C,&14:CALL SubmitBDOS :\ Read record
2580 CALL AddCR :\ Add CR and point DE to start of text
2590 .LDA98
2600 LD A,(DE) :\ Get character from buffer
2610 CP 13:CALL NZ,PrChar :\ If not <cr>, print it
2620 INC DE:JR NZ,LDA98 :\ Loop until <cr>
2630 CALL LDE19 :\ Check for keypress to abort
2640 POP AF:LD (SUBFCB+15),A :\ Set RecordCount for next call
2650 RET NZ :\ Return if not at end
2660 :
2670 \ Delete any batch file
2680 \ ---------------------
2690 .LDAA9
2700 LD A,(BATCH):OR A:RET Z :\ No batch file, just return
2710 LD C,&13:CALL SubmitBDOS :\ Delete '$$$.SUB'
2720 SUB A:LD (BATCH),A :\ Set 'no batch file active'
2730 RET
2740 :
2750 \ -----------------------------------
2760 \ Execute command line in InputBuffer
2770 \ -----------------------------------
2780 .ExecLine
2790 LD DE,InputText :\ Point to start of entered line
2800 CALL SkipSpace:LD (ADDR),DE :\ Save start of text
2810 CP ASC";":RET Z :\ Comment, exit
2820 CP 13:RET Z :\ Empty line, exit
2830 OPT FNif(bbc%)
2840 ::CP ASC"*":JR NZ,NotOscli :\ Jump past if not *command
2850 ::LD HL,0:LD A,&E5:CALL OSBYTE:\ Escape key sets Escape state
2860 ::EX DE,HL:CALL OS_CLI :\ Do *command
2870 ::JP LD9D3 :\ Restore Escape, and go back to command loop
2880 OPT FNendif
2890 :
2900 \ --------------------------
2910 \ Check for built-in command
2920 \ --------------------------
2930 .NotOscli
2940 LD HL,commands :\ Point to command table
2950 .comm_lp
2960 LD DE,(ADDR):LD A,(HL) :\ Get pointer to text, get byte from table
2970 OR A:JR Z,comm_end :\ If at end of table, try to run from disk
2980 .comm_lp2
2990 CALL GetCharNxt :\ Get upper case character from input line
3000 LD C,A:JR NZ,not_end :\ C=char, Z if end marker (<cr> = ,)
3010 SUB A :\ at end
3020 .not_end
3030 CP (HL):JR NZ,no_match :\ Doesn't match, try next command
3040 INC HL:OR A:JR NZ,comm_lp2:\ Check another character
3050 LD A,(HL):INC HL:LD H,(HL):\ Get command address
3060 LD L,A:LD A,C:JP (HL) :\ Enter with A=character
3070 .no_match
3080 LD A,(HL):OR A:INC HL :\ Find end of command text
3090 JR NZ,no_match :\ Loop until zero byte
3100 INC HL:INC HL:JR comm_lp :\ Step past address and check next command
3110 :
3120 \ ----------------------------
3130 \ Try to run command from disk
3140 \ ----------------------------
3150 .comm_end
3160 CALL read_filename :\ Parse filename to FCB1
3170 PUSH DE:LD DE,&65 :\ Point to extension in FCB1
3180 LD HL,com_txt:LD BC,3:LDIR:\ Force extension to '.COM'
3190 POP DE:LD A,(&5D) :\ Get first character of filename
3200 CP ASC" ":JP NZ,run_comm :\ If command there, run it
3210 :
3220 \ -----------------------------------------
3230 \ No filename, see if drive specifier given
3240 \ -----------------------------------------
3250 LD A,(&5C):DEC A:RET M :\ No drive given, exit
3260 .ResetDrive
3270 LD E,A:LD C,&E:CALL callBDOS :\ Set drive
3280 LD HL,DRIVE:LD A,(HL) :\ Get user from DRIVE
3290 AND &F0:OR E:LD (HL),A:RET :\ Merge with drive and return
3300 :
3310 OPT FNif(optimise%)
3320 ::.SelectDriveUser
3330 ::RET :\\\ TO DO \\\
3340 OPT FNendif
3350 :
3360 .com_txt
3370 DEFM "COM" :\ Extension for command files
3380 :
3390 \ Print message
3400 \ -------------
3410 .PrMessage
3420 CALL PrString
3430 :
3440 \ Print newline
3450 \ -------------
3460 .CRLF
3470 LD A,13:CALL PrChar
3480 LD A,10:JR PrChar
3490 :
3500 \ Print A in decimal
3510 \ ------------------
3520 .PrDec
3530 LD B,&FF
3540 .PrDecLp
3550 INC B:SUB 10:JR NC,PrDecLp
3560 LD C,A:LD A,B
3570 OR A:CALL NZ,PrDigit
3580 LD A,C:ADD A,10
3590 .PrDigit
3600 ADD A,ASC"0"
3610 :
3620 \ Print character in A, preserving all
3630 \ ------------------------------------
3640 \ Error reporting and SUBMIT echoing expects Z/NZ preserved
3650 .PrChar
3660 PUSH AF:PUSH BC:PUSH DE:PUSH HL
3670 LD E,A:LD C,&02:CALL BDOS
3680 POP HL:POP DE:POP BC:POP AF:RET
3690 :
3700 \ Parse and check for filename
3710 \ ----------------------------
3720 .LDB64
3730 LD HL,&5C :\ HL=>FCB1
3740 .LDB67
3750 PUSH HL:CALL read_filename2
3760 LD C,A:POP HL:INC HL :\ HL=>first character of FCB
3770 LD A,(HL):CP ASC" " :\ Check if no filename
3780 LD A,C:RET NZ :\ Ok if filename present
3790 .LDB73
3800 CALL abort:DEFM "Syntax error":DEFM "$"
3810 :
3820 \ Parse filename at DE to FCB1
3830 \ ----------------------------
3840 .read_filename
3850 LD HL,&5C :\ HL=>FCB1
3860 :
3870 \ Parse filename at DE to HL
3880 \ --------------------------
3890 \ On entry, DE=>text to scan
3900 \ HL=>FCB to fill
3910 \ On exit, DE=>terminating character
3920 \ A = terminating character
3930 \ Z = valid filename
3940 \ NZ= bad filename
3950 \ Filename terminated with <cr> <spc> ',' or '='
3960 .read_filename2
3970 PUSH HL:POP IX :\ IX=>FCB
3980 LD (IX+0),0:LD (IX+&20),0 :\ Drive=0, default
3990 LD B,11
4000 .LDB93
4010 LD (IX+1),ASC" " :\ Set filename+ext to spaces
4020 INC IX:DJNZ LDB93
4030 LD B,4
4040 .LDB9D
4050 LD (IX+1),0 :\ Set rest of FCB to zero
4060 INC IX:DJNZ LDB9D
4070 PUSH DE :\ Save line pointer
4080 CALL GetCharNxt:JR C,LDBD5:\ Error if control character
4090 LD C,A:CALL GetUpChar :\ Save in C in case drive character
4100 CP ASC":":JR NZ,LDBBA :\ Not drive specifier
4110 LD A,&3F:AND C:LD (HL),A :\ Convert to drive num or '?' and store
4120 INC SP:INC SP :\ Drop saved line pointer
4130 PUSH DE :\ Replace with new line pointer
4140 .LDBBA
4150 POP DE:INC HL:PUSH HL :\ DE=>line, HL=>FCB filename
4160 LD B,9 :\ Scan 9 characters (should this be 8?)
4170 .LDBBF
4180 CALL GetCharNxt:JR C,LDBD5:\ Error if control character
4190 JR NZ,LDBC8 :\ Skip if not at end
4200 POP HL:RET :\ Drop saved pointer and return
4210 .LDBC8
4220 CP ASC".":JR Z,LDBD8 :\ Jump if '.' for extension
4230 CP ASC"*":CALL Z,LDC07 :\ If '*', fill rest with '?'s
4240 LD (HL),A :\ Store character
4250 INC HL:DJNZ LDBBF :\ Step to next
4260 .LDBD5
4270 POP HL:JR LDBEE :\ Too many characters, bad filename
4280 .LDBD8
4290 POP HL :\ Get HL=>FCB
4300 LD BC,8:ADD HL,BC :\ Point to extension
4310 LD B,4 :\ Scan 4 characters (should this be 3?)
4320 .LDBDF
4330 CALL GetCharNxt:JR C,LDBEE:\ Error if illegal character
4340 RET Z :\ End character
4350 CP ASC"*":CALL Z,LDC07 :\ If '*', fill rest with '?'s
4360 LD (HL),A :\ Store character
4370 INC HL:DJNZ LDBDF :\ Step to next
4380 .LDBEE
4390 LD A,(LD8CF):OR A:RET NZ :\ If flag set, allow bad filename
4400 .LDBF3
4410 CALL abort:DEFM "Illegal filename":DEFM "$"
4420 :
4430 .LDC07
4440 LD A,ASC"?" :\ Fill with '?'
4450 DEC B:JR Z,LDC12 :\ Only one to do, exit to caller
4460 .LDC0C
4470 LD (HL),A:INC HL :\ Fill rest of FCB with '?'s
4480 DJNZ LDC0C
4490 DEC HL:INC B :\ Point to last character
4500 .LDC12
4510 INC B:RET :\ Returns B=1 or B=2
4520 :
4530 \ Get character and step to next
4540 \ ------------------------------
4550 \ On entry, DE=>current character
4560 \ On exit, A =upper case character
4570 \ DE=>next character if not <cr>
4580 .GetUpChar
4590 LD A,(DE):CP 13:RET Z
4600 AND &5F:CP ASC"A"
4610 JR C,LDC22
4620 CP ASC"[":JR C,LDC23 :\ 'a'-'z' becomes 'A'-'Z'
4630 .LDC22
4640 LD A,(DE)
4650 .LDC23
4660 INC DE:RET
4670 :
4680 \ Get next character and test it
4690 \ ------------------------------
4700 \ On entry, DE=>current character
4710 \ On exit, A =upper case character
4720 \ DE=>next character if not <cr>
4730 \ Z = terminator , = spc cr
4740 \ C = control character
4750 .GetCharNxt
4760 CALL GetUpChar :\ Get upper case character
4770 CP 13:RET Z :\ Exit with terminating character
4780 CP ASC",":RET Z
4790 CP ASC"=":RET Z
4800 CP ASC" ":RET NZ :\ Exit with non-terminator
4810 PUSH AF:CALL SkipSpace :\ Step past spaces
4820 POP AF:RET :\ And return with Z=<spc> found
4830 :
4840 .SkipSpace
4850 LD A,(DE)
4860 CP ASC" ":RET NZ
4870 INC DE:JR SkipSpace
4880 :
4890 \ -------------------------------
4900 \ DIR - List objects in catalogue
4910 \ -------------------------------
4920 .dir
4930 CALL read_filename :\ Parse filename to FCB1
4940 SUB A:LD (LDD06),A :\ Set 'drive not specified'
4950 LD HL,&5D:LD A,(HL) :\ Get first character from FCB1
4960 CP ASC" ":JR NZ,LDC76 :\ Jump as contains file to match
4970 LD B,11
4980 .LDC71
4990 LD (HL),ASC"?" :\ Set filename to '????????.???'
5000 INC HL:DJNZ LDC71
5010 .LDC76
5020 LD A,(&5C) :\ Get drive number from FCB1
5030 CP ASC"?":JR Z,LDC80 :\ If drive '?', use current drive
5040 OR A:JR NZ,LDC86 :\ If drive<>0, use specified drive
5050 .LDC80
5060 LD (LDD06),A :\ Set drive to &00 or '?'
5070 LD A,(CCPDRV) :\ Get current drive
5080 .LDC86
5090 ADD A,ASC"@":LD (LDD05),A :\ Convert to drive letter
5100 LD C,&11:CALL LDC50 :\ Search for first to FCB1
5110 INC A:RET Z :\ If nothing found, return
5120 LD C,1:PUSH BC :\ Start at "column zero"+1
5130 :
5140 .LDC96
5150 CALL LDE19 :\ Check for keypress interuption
5160 DEC A :\ A=index into current directory record
5170 RRCA:RRCA:SCF:RRA :\ A=&0080+index*32
5180 LD L,A:LD H,0 :\ HL points to this directory entry
5190 BIT 7,(HL):JR NZ,LDCF1 :\ If UserNum.b7=1, no entry or hidden, skip to next
5200 LD A,(LDD06) :\ Check if drive specified
5210 OR A:JR NZ,LDCB5 :\ If '?', skip check for "SYS" files
5220 PUSH HL:POP IX :\ IX points to directory entry
5230 BIT 7,(IX+10):JR NZ,LDCF1 :\ If "SYS" file, don't print, skip to next
5240 .LDCB5
5250 POP BC:DEC C :\ Decrement column number
5260 LD A,&20:JR NZ,LDCC5 :\ Jump to print space if between columns
5270 LD A,(LDD05) :\ Get drive letter
5280 LD BC,(LD8CD) :\ Get number of columns
5290 .LDCC5
5300 PUSH BC :\ Save column number
5310 CALL PrChar :\ Print drive letter or space
5320 LD A,ASC":":CALL PrChar :\ Print drive colon or column seperator
5330 LD A,(LDD06) :\ Check drive specified
5340 OR A:JR Z,LDCDD :\ If not '?', ignore user number
5350 LD A,(HL):CP 10 :\ Get user number from directory entry
5360 CALL C,PrSpace:CALL PrDec :\ Print space padded user number, corrupts A,B,C
5370 .LDCDD
5380 CALL PrSpace:LD B,11 :\ Prepare to print 11 characters
5390 .LDCE2
5400 INC HL:LD A,(HL) :\ Get character from filename
5410 AND &7F:CALL PrChar :\ Mask out bit7 and print character
5420 LD A,B:CP 4:CALL Z,PrSpace:\ Print space before extension
5430 DJNZ LDCE2 :\ Loop for 11 characters
5440 POP BC:PUSH BC :\ Get column number back again
5450 DEC C:CALL Z,CRLF :\ Print newline if needed
5460 :
5470 .LDCF1 :\ Step to next directory entry
5480 LD C,&12:CALL BDOS :\ Search for next to FCB use by SearchFirst
5490 INC A:JR NZ,LDC96 :\ Loop back if entry found
5500 POP BC:DEC C:JP NZ,CRLF :\ Final CRLF if middle column
5510 RET
5520 :
5530 .PrSpace
5540 PUSH AF:LD A,32
5550 CALL PrChar:POP AF:RET :\ Print space
5560 :
5570 .LDD05:DEFB &2B :\ Drive letter
5580 .LDD06:DEFB &CD :\ Drive 0=current, <>0=specified
5590 :
5600 \ --------------------------
5610 \ SAVE - Save memory to disk
5620 \ --------------------------
5630 .LDD07
5640 CALL abort:DEFM "Catalogue full":DEFM "$"
5650 :
5660 .save
5670 CALL ScanDec:PUSH BC :\ Scan number of 256-byte blocks
5680 CALL LDB64 :\ Parse filename to FCB1
5690 CALL ScanHex:PUSH HL :\ Scan start address, default to &100
5700 LD C,&13:CALL LDC41 :\ Delete any existing file
5710 LD C,&16:CALL LDC50 :\ Create file
5720 INC A:JR Z,LDD07 :\ Cat full
5730 POP DE:POP HL :\ DE=start, HL=length
5740 SUB A:LD H,A :\ Ensure HL=&00nn
5750 CP L:JR Z,LDD60 :\ Zero length, close and finish
5760 ADD HL,HL :\ HL=num of 128-byte blocks
5770 OPT FNif(znos%)
5780 ::LD A,(&5C) :\ Check returned drive from Create
5790 ::CP &10:JR Z,LDD65 :\ If &10, direct ZNOS saves available
5800 OPT FNendif
5810 :
5820 .LDD40
5830 PUSH HL :\ Save number of blocks
5840 LD (ADDR),DE:CALL SetDMA :\ Save current address and set DMA address
5850 LD C,&15:CALL LDC50 :\ Write 128 bytes from current DMA
5860 OR A:JR NZ,LDD75 :\ Disk full
5870 LD HL,(ADDR):LD DE,128 :\ Update to next 128-byte address
5880 ADD HL,DE:EX DE,HL
5890 POP HL:DEC HL :\ Decrement number of blocks to save
5900 LD A,H:OR L:JR NZ,LDD40 :\ Loop back if more to save
5910 :
5920 .LDD60
5930 LD C,&10:JP LDC50 :\ Close file and return
5940 :
5950 OPT FNif(znos%)
5960 ::.LDD65
5970 ::PUSH HL :\ Save number of 128-byte blocks
5980 ::CALL SetDMA :\ Set DMA address to start
5990 ::POP IX :\ Get save size back
6000 ::LD C,&59:CALL LDC50 :\ Save whole file, DMA=start, IX=size
6010 ::OR A:JR Z,LDD60 :\ Save ok, jump to close and return
6020 OPT FNendif
6030 :
6040 .LDD75
6050 CALL abort:DEFM "Disc full":DEFM "$"
6060 :
6070 \ -------------------------------------------
6080 \ Perform action if filename has no wildcards
6090 \ -------------------------------------------
6100 .LDC41
6110 PUSH BC:LD HL,&5C :\ Save call number, point to FCB1
6120 LD BC,12:LD A,ASC"?" :\ Search 12 bytes for '?'
6130 CPIR:POP BC:JP Z,LDBF3 :\ If found, jump to 'Illegal filename'
6140 .LDC50
6150 LD DE,&5C:JR JumpBDOS :\ Point to FCB1, call BDOS and return
6160 :
6170 .ResetDMA :LD DE,&80 :\ Set DMA to &0080
6180 .SetDMA :LD C,&1A:JR JumpBDOS :\ Set DMA to DE
6190 .SubmitBDOS:LD DE,SUBFCB:JR JumpBDOS :\ Call BDOS pointing to SUBFCB
6200 .PrString :LD C,9 :\ Print string at DE
6210 .JumpBDOS :JP BDOS :\ Call BDOS and return
6220 :
6230 \ ------------------
6240 \ Reset current User
6250 \ ------------------
6260 .ResetUser
6270 LD HL,DRIVE :\ Point to current User/Drive
6280 .SetUser
6290 XOR A:JR SetUser1 :\ Cy=0, use supplied User number
6300 :
6310 \ -----------------------
6320 \ USER - Select user area
6330 \ -----------------------
6340 .user
6350 CALL ScanDec:LD A,C :\ Read decimal value
6360 CP &10:JR NC,BadNumber :\ If >15, error
6370 LD HL,DRIVE :\ Cy=1, use drive in C
6380 .SetUser1
6390 RLD:JR NC,SetUser2:LD A,C :\ Merge user number from C
6400 .SetUser2
6410 LD E,A:RRD :\ Pass user number to E
6420 .GetSetUser:LD C,&20 :\ Set user number
6430 : :\ Fall through to call BDOS and return
6440 :
6450 \ Call BDOS, preserving registers
6460 \ -------------------------------
6470 .callBDOS
6480 PUSH DE:PUSH HL:CALL BDOS
6490 POP HL:POP DE:RET
6500 :
6510 \ ----------------------------------
6520 \ PRINT - Send characters to printer
6530 \ ----------------------------------
6540 .print
6550 LD L,5:JR vdu2 :\ LST output
6560 :
6570 \ --------------------------------
6580 \ VDU - Send characters to console
6590 \ --------------------------------
6600 .vdu
6610 LD L,6 :\ Direct CON output
6620 .vdu2
6630 CALL ScanDec:PUSH DE :\ Read decimal value
6640 LD E,C:LD C,L
6650 CALL callBDOS :\ Send to LST or CON
6660 POP DE:LD A,(DE) :\ Get line pointer back
6670 CP 13:JR NZ,vdu2 :\ Loop until end of line
6680 RET
6690 :
6700 \ Scan an 8-bit decimal number
6710 \ ----------------------------
6720 \ On entry, DE=>first character
6730 \ On exit, A = number
6740 \ DE=>first non-digit character
6750 .ScanDec
6760 SUB A :\ Accumulator=0
6770 .ScanDecLp
6780 LD C,A :\ C=accumulator
6790 CALL GetCharNxt:RET Z :\ Exit if terminator
6800 CP ASC":":JR NC,BadNumber :\ Non-digit, error
6810 SUB ASC"0":JR C,BadNumber :\ Non-digit, error
6820 LD B,10 :\ Multipy by 10
6830 .ScanDecAdd
6840 ADD A,C:JR C,BadNumber :\ Add 10*accumulator
6850 DJNZ ScanDecAdd
6860 JR ScanDecLp :\ Loop back for next digit
6870 .BadNumber
6880 CALL abort:DEFM "Bad number":DEFM "$"
6890 :
6900 \ ---------------------------
6910 \ TYPE - Type file to console
6920 \ ---------------------------
6930 .type
6940 CALL LDB64 :\ Parse filename to FCB1
6950 LD HL,&62:SET 7,(HL) :\ Set a flag in FCB1
6960 LD C,&F:CALL LDC50 :\ Open file
6970 INC A:JP Z,LDFCF :\ File not found
6980 XOR A:LD (ADDR),A :\ Clear CR/LF flag
6990 .LDDE8
7000 LD C,&14:CALL LDC50 :\ Read 128 bytes
7010 OR A:JP NZ,LDD60 :\ End of file, close and return
7020 LD B,128:LD HL,&80 :\ Prepare to type 128 bytes from &0080
7030 .type_lp
7040 LD A,(HL):LD C,A :\ Get a character
7050 \CP 32:\JR NC,type_char :\ Printable character
7060 CP &1A:JP Z,LDD60 :\ If EOF character, jump to close
7070 CP 13:JR Z,type_cr :\ Check if <cr> or <lf>
7080 CP 10:JR NZ,type_char :\ Not <cr> or <lf>, type character
7090 .type_cr
7100 LD A,(ADDR) :\ Check last character printed
7110 XOR 7:CP C:JR Z,type_skip :\ Different EOL character, skip
7120 CALL CRLF:JR type_last :\ Print newline
7130 .type_char
7140 LD A,C:CALL PrChar :\ Print character
7150 .type_last
7160 LD A,C:LD (ADDR),A :\ Set last chararacter
7170 .type_skip
7180 CALL LDE22 :\ Check for keypress
7190 PUSH AF:CALL NZ,LDD60 :\ Close file if key pressed
7200 POP AF:JP NZ,LD9E5 :\ Abort if key pressed
7210 INC HL:DJNZ type_lp :\ Point to next character and loop back
7220 JR LDDE8 :\ Loop for another 128 bytes
7230 :
7240 .LDE19
7250 PUSH AF:CALL LDE22 :\ Check for keypress
7260 JP NZ,LD9E5:POP AF:RET :\ Close batch file and abort
7270 .LDE22
7280 PUSH BC:PUSH DE:PUSH HL :\ Save registers
7290 LD C,&0B:CALL BDOS :\ Get Console Status
7300 OR A:JR Z,LDE37 :\ Nothing pending, exit
7310 LD C,&01:CALL BDOS :\ Get Console Input
7320 SUB A:DEC A :\ A=&FF for aborted
7330 .LDE37
7340 POP HL:POP DE:POP BC :\ Restore registers
7350 RET
7360 :
7370 \ -----------------
7380 \ ERA - Erase files
7390 \ -----------------
7400 .era_txt
7410 DEFM "Erase all files? (Y/N) ":DEFM "$"
7420 .era
7430 CALL LDB64 :\ Parse filename to FCB1
7440 LD A,ASC"?":LD B,11 :\ Check for *.*
7450 LD HL,&5C
7460 .LDE60
7470 INC HL:CP (HL) :\ Check character in FCB
7480 JR NZ,LDE79 :\ Not '?', continue to delete
7490 DJNZ LDE60 :\ Loop to check all characters
7500 LD DE,era_txt
7510 CALL PrString :\ Print confirm message
7520 CALL LDA5D :\ Read line of text from input
7530 LD DE,InputText
7540 CALL GetUpChar :\ Get first character from input line
7550 CP ASC"Y":JP NZ,LD9E8 :\ Not 'Y', abort
7560 CALL CRLF
7570 :
7580 .LDE79
7590 LD C,&13:CALL LDC50 :\ Erase the file(s)
7600 INC A:JP Z,LDFCF :\ File not found
7610 RET
7620 :
7630 \ -----------------
7640 \ REN - Rename file
7650 \ -----------------
7660 .ren
7670 LD HL,&6C:CALL LDB67 :\ Parse first filename
7680 PUSH AF:CALL LDB64:POP AF :\ Parse second filename
7690 CP ASC"=":JR Z,ren2 :\ REN newname=oldname
7700 CP ASC" ":JP NZ,LDB73 :\ Error if not REN oldname newname
7710 LD HL,&5C:LD DE,&6C:LD B,16 :\ Prepare to swap FCBs
7720 .ren1
7730 LD A,(DE):LD C,(HL) :\ Get bytes from FCB
7740 LD (HL),A:LD A,C:LD (DE),A:\ Swap them around
7750 INC HL:INC DE:DJNZ ren1 :\ Loop for all 16 bytes
7760 .ren2
7770 LD C,&11:LD DE,&6C:CALL BDOS:\ See if newname exits
7780 INC A:JR Z,LDEB3 :\ newname doesn't exist, go ahead
7790 CALL abort:DEFM "File already exists":DEFM "$"
7800 .LDEB3
7810 LD C,&17:CALL LDC41 :\ Do the rename
7820 INC A:JP Z,LDFCF:RET :\ Error if source not found
7830 :
7840 .txtNF
7850 DEFM " not found":DEFM "$"
7860 :
7870 \ -----------------------
7880 \ RUN - Run arbitary file
7890 \ -----------------------
7900 .run
7910 CALL read_filename :\ Read filename to FCB1
7920 LD A,(&5D) :\ Get first character of filename
7930 CP ASC" ":JR Z,old :\ No filename, enter current program
7940 :
7950 \ --------------------------------------
7960 \ Run a command file from command prompt
7970 \ --------------------------------------
7980 .run_comm
7990 PUSH DE:LD HL,&100
8000 CALL LDF3D:POP DE :\ Load file in FCB1 to &100
8010 :
8020 \ -----------------------------------------------
8030 \ OLD - Enter current program with new parameters
8040 \ -----------------------------------------------
8050 .old
8060 PUSH DE:CALL LDF16 :\ Close any batch file
8070 CALL ResetDMA:POP DE :\ Set DMA to &0080
8080 .LDEEA
8090 PUSH DE :\ Save address of command parameters
8100 LD A,&FF:LD (LD8CF),A :\ Prevent errors from ReadFilename
8110 CALL read_filename :\ Read first filename to FCB1
8120 LD HL,&6C :\ Point to FCB2
8130 CALL read_filename2 :\ Read second filename to FCB2
8140 POP DE :\ Get address of command parameters
8150 LD HL,&80:PUSH HL :\ Point to parameter buffer
8160 LD B,&FF:LD A,(DE) :\ Get first character from input text
8170 CP 13:JR Z,LDF06:DEC DE :\ Step back to copy space before parameter
8180 .LDF06
8190 \ Note, DRCCP doesn't force to upper case
8200 \ We do the same so, eg ECHO CamelCase works
8210 LD A,(DE):INC DE :\ Get a character from input line
8220 \CALL GetUpChar
8230 INC HL:LD (HL),A:INC B :\ Store in parameter buffer and inc count
8240 SUB &0D:JR NZ,LDF06 :\ Loop until <cr>
8250 LD (HL),A:POP HL :\ Store <00> at end of parameters
8260 LD (HL),B:JP &100 :\ Store parameter length and execute program
8270 :
8280 \ Close any batch file
8290 \ --------------------
8300 .LDF16
8310 LD A,(BATCH):OR A:RET Z :\ No batch file active, return
8320 PUSH DE:PUSH HL :\ Save registers
8330 LD HL,SUBFCB+14:RES 7,(HL):\ Reset b7 of S2
8340 LD C,&10:CALL SubmitBDOS :\ Close file
8350 POP HL:POP DE:RET :\ Restore registers and return
8360 :
8370 \ ---------------
8380 \ GO - Enter code
8390 \ ---------------
8400 .go
8410 CALL ReadHex :\ Read hex value, default to &100
8420 CALL LDF16:JP (HL) :\ Close any batch file and enter code
8430 :
8440 \ ------------------------------
8450 \ LOAD - Load a file into memory
8460 \ ------------------------------
8470 .load
8480 CALL LDB64 :\ Parse filename to FCB1
8490 CALL ScanHex :\ Scan load address, default to &100
8500 :
8510 \ Load a file
8520 \ -----------
8530 \ On entry, FCB1=filename
8540 \ HL =start address
8550 .LDF3D
8560 PUSH HL:EX DE,HL
8570 CALL SetDMA :\ Set DMA address
8580 LD HL,&62:SET 7,(HL) :\ Set F6 flag to open Read-Only
8590 .LDF49
8600 OPT FNif(znos%)
8610 ::LD C,&5A:CALL LDC50 :\ Attempt ZNOS direct load
8620 ::OR A:JR Z,LDF59 :\ Not supported, do manual load
8630 ::INC A:CALL Z,LDFB8 :\ Not found, try search drive
8640 ::JR Z,LDF49 :\ Jump back to try again
8650 ::POP HL:JR LDF83 :\ Reset User and return
8660 OPT FNendif
8670 :
8680 .LDF59
8690 LD C,&0F:CALL LDC50 :\ Open file in FCB1
8700 INC A:CALL Z,LDFB8 :\ If not found, try changing drive
8710 JR Z,LDF59:POP DE :\ Another drive found, jump back to try
8720 .LDF65
8730 LD (ADDR),DE:CALL SetDMA :\ Save current address and set DMA address
8740 LD C,&14:CALL LDC50 :\ Read a record to current address
8750 OR A:JR NZ,LDF80 :\ Jump to finish when at End Of File
8760 LD HL,(ADDR) :\ Get current address
8770 LD DE,&80:ADD HL,DE :\ Update to next 128-byte address
8780 EX DE,HL:JR LDF65 :\ Loop back for next record
8790 .LDF80
8800 CALL LDD60 :\ Close file
8810 .LDF83
8820 JP ResetUser :\ Reset User and return
8830 :
8840 .ReadHex
8850 \ Scan an 16-bit hex address, default to &100
8860 \ -------------------------------------------
8870 \ On entry, DE=>first character
8880 \ On exit, A = number
8890 \ DE=>first non-digit character
8900 .ScanHex
8910 LD HL,&100 :\ Default value
8920 LD A,(DE) :\ Get current character
8930 CP 13:CALL NZ,LDF94 :\ Not <cr>, scan hex number
8940 CP 13:RET Z :\ Nothing after, exit
8950 JP LDB73 :\ Abort with Syntax error
8960 :
8970 \ Scan an 16-bit hex address
8980 \ --------------------------
8990 .LDF94
9000 LD HL,0 :\ Accumulator=0
9010 .LDF97
9020 CALL GetCharNxt:RET Z :\ Exit if terminator
9030 SUB ASC"0" :\ Reduce to 0+digit
9040 .LDF9D
9050 JP C,BadNumber :\ <'0', error
9060 CP 10:JR C,LDFAB :\ '0'-'9', add to accumulator
9070 SUB 7 :\ Reduce 'A'-'F' to 10-15
9080 CP &10:JP NC,BadNumber :\ >'F', error
9090 .LDFAB
9100 PUSH BC:LD B,4 :\ Prepare to move up four bits
9110 .LDFAE
9120 ADD HL,HL:JR C,LDF9D :\ Multiply by two, four times
9130 DJNZ LDFAE
9140 POP BC:OR L:LD L,A :\ Add digit to accumulator
9150 JR LDF97 :\ Loop for next digit
9160 :
9170 \ Try changing search drive
9180 \ -------------------------
9190 .LDFB8
9200 LD HL,&5C:LD A,(HL) :\ Get drive from FCB1
9210 OR A:JR NZ,FileNotFound :\ If drive specified, print 'not found' and abort
9220 LD A,(CCPDRV):LD B,A :\ Get CCP current drive
9230 LD A,(SEARCH) :\ Get search drive
9240 OR A:JR Z,FileNotFound :\ No search drive, 'not found' and abort
9250 CP B:JR Z,FileNotFound :\ Same as current drive, 'not found' and abort
9260 LD (HL),A :\ Store drive in FCB1
9270 LD HL,SEARCH:CALL SetUser :\ Set user from SEARCH
9280 CP A:RET :\ Return with Z set
9290 :
9300 .FileNotFound
9310 .LDFCF
9320 CALL CRLF:CALL LDFDE :\ Print filename in FCB1
9330 LD DE,txtNF:CALL PrMessage:\ Print 'not found'
9340 JP MainLoop :\ Return to command loop
9350 :
9360 \ Print filename in FCB1
9370 \ ----------------------
9380 .LDFDE
9390 LD B,8 :\ Print up to first 8 characters
9400 LD HL,&5D:CALL LDFF0
9410 LD A,ASC".":CALL PrChar :\ Print dot before extension
9420 LD B,3:LD HL,&65 :\ Print up to remaining 3 characters
9430 :
9440 \ Print B characters
9450 \ ------------------
9460 .LDFF0
9470 LD A,(HL):AND &7F :\ Get character and mask out bit 7
9480 CP &20:RET Z :\ Unprintable, return early
9490 CALL PrChar :\ Print the character
9500 INC HL:DJNZ LDFF0 :\ Loop to do all characters
9510 RET
9520 :
9530 OPT FNif(NOT znos%)
9540 .BATCH :DEFB &00 :\ Batch file active flag
9550 .SUBFCB:DEFB &00 :\ Current drive to match SUBMIT.COM
9560 \ F241 :DEFM "$$$ SUB" :\ "$$$.SUB" filename
9570 \ F240 :DEFB &00 :\ EX
9580 \ F241 :DEFB &00 :\ S1
9590 \ F242 :DEFB &00 :\ S2
9600 \ F243 :DEFB &00 :\ RC
9610 DEFW 0:DEFW 0:DEFW 0:DEFW 0 :\ Alloc Vector
9620 DEFW 0:DEFW 0:DEFW 0:DEFW 0
9630 \ F254 :DEFB &00 :\ CR
9640 \ F255 :DEFW &0000:DEFB &00 :\ R0-R2
9650 OPT FNendif
9660 :
9670 .end%
9680 OPT FNif(P%<start%+&800)
9690 ::DEFM STRING$(start%+&800-P%,CHR$0)
9700 OPT FNendif
9710 ]
9720 BIOS_WARM=start%+&1603
9730 IFznos%:BIOS_WARM=&F203:BATCH=&F233
9740 LF204=BIOS_WARM+1:SUBFCB=BATCH+1
9750 NEXT
9760 :
9770 IFos%>31:CLS
9780 A%=CCPstack-InputText
9790 PRINT"Input buffer size/stack space:";SPC8;A%
9800 IF A%<127:PRINT"WARNING: Too small for SUBMIT"
9810 PRINT"Stack space during SUBMIT:";SPC12;A%-128
9820 A%=end%-start%
9830 IF A%<&801:PRINT"Spare code space:"SPC21;&800-A%
9840 IF A%>&800:PRINT"WARNING: Code too long by: ";SPC11;A%-&800
9850 :
9860 A$="SAVE "+fn$+" "+STR$~mcode%+"+800 "+LEFT$(STR$~entry%+" "+STR$~start%,os%<8)
9870 PRINTA$;:OSCLI A$:PRINT
9880 ON ERROR END
9890 IFos%<8:*Quit