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