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