REM > Harston.Patch/src
REM
REM Patch Spectrum ROM to fix bugs and provide extra features
REM 13-May-1985 Bug fixes and added features
REM 07-Jun-2003 Rewritten as source code, put in address order
REM 31-Oct-2003 Started on *command/RUNs$ from tape
REM 18-Nov-2003 Tokeniser checks for INKEY$ before INK and IN
REM 30-Aug-2004 Added Wearmouth DECtoFP bugfix, fixed RUN, "C" channel
REM 17-Sep-2004 Fixed "C" channel and OPEN, etc, some Wearmouth fixes
REM 25-Sep-2004 Run from mdrive
REM 27-Sep-2004 Run from tape is silent
REM 03-Oct-2004 CAT displays 'load+length extra', PrHex prints "0"
REM 11-Jun-2012 Fixed STR$/INKEY$ corrupting ATTR bug (Battle Bunny), better SCANHEX
REM 08-Feb-2015 Added CHR$10/CHR$11, colour items clear carry flag
ver$="0.77":vdate$="08-Feb-2015"
:
test%=FALSE
A%=0:X%=1:os%=(USR&FFF4 AND &FF00)DIV256:IFos%=6 AND PAGE>&8000:SYS "OS_GetEnv" TO A$:OSCLI"TextToBas "+MID$(A$,INSTR(A$," ",1+INSTR(A$," ")))+" "+LEFT$("-crunch",NOTtest%)+" *Z80":END
unix%=os%=8:quit%=?&80<>0:?&80=0
ON ERROR REPORT:PRINT" at line ";ERL:IFNOTquit%:END ELSE *Quit
:
IFtest%:DIM mcode% &400 ELSE DIM mcode% &4000:OS."Load ^.RomImages.48k "+STR$~mcode%
:
REM System variables:
ATTR_T=&5C8F:P_FLAG=&5C91:T_ADDR=&5C74:E_LINE=&5C59:K_CUR=&5C5B:DFSZ=&5C6B:oDFSZ=49
ERR_SP=&5C3D:FLAGS2=&5C6A:FLAGX=&5C71:CH_ADD=&5C5D:X_PTR=&5C5F:CURCHN=&5C51
WORKSP=&5C61:P_RAMT=&5CB4:UDC=&5C7B:RAMTOP=&5CB2:RASP=&5C38:CHANS=&5C4F:oFLAGS=1
FRAMES=&5C78:SPOSN=&5C88:DFCC=&5C84:oTVFLAG=2:SPOSNL=&5C8A:DFCCL=&5C86:ECHOE=&5C82
:
REM ROM Addresses:
PO_ABLE=&0AD9:EX_1NEXT=&1C81:EX_1NUM=&1C82:CHECK_END=&1BEE
FIND_INT2=&1E99:KEY_INPUT=&10A8:BREAK_KEY=&1F54:LD_BYTES=&0556
SCANNING=&24FB:SYNTAX_Z=&2530:UNSTACK_Z=&1FC3:EX_EXP=&1C8C
PR_ST_END=&2048:USE_ZERO=&1CE6:LD_LOOK_H=&0767:JumpHL=&006F
:
REM New Addresses:
NMIADD=&5C80:UKCMD=&5BFE:UKFNC=&5BFC:RSXADD=&5BFA:CMDADD=&5BF8
CURDRV=&5C7F:oCURDRV=CURDRV-&5C3A:TEMPSP=&5CB0
:
DEFFNorg(A%):P%=A%:O%=mcode%+(A%ANDNOTtest%):=P*3+4
DEFFNm(A$):=LEFT$(A$,LENA$-1)+CHR$(ASCRIGHT$(A$,1)OR&80)
FOR P=0 TO 1
[OPT 0
OPT FNorg(&0010)
.PRNTA1      :JP &15F1
.PRHEX0      :LD D,ASC"0"    ; Print B with leading zero
.PRHEX       :JP PrHexByte   ; Print B with D=lead
OPT FNorg(&0025)
.SCANHEX     :JP ScanHexInit ; Convert (DE) to hex in HL (((CHADD) to hex in DE))
OPT FNorg(&002B)
.PR2HEX0     :LD D,ASC"0"    ; Print BC with leading zeros
.PR2HEX      :JP PrHexWord   ; Print BC with D=lead
OPT FNorg(&003A)
LD HL,FRAMES:INC (HL)        ; Update FRAMES without depending on IY
JR NZ,KEYINT:INC HL:INC (HL)
JR NZ,KEYINT:INC HL:INC (HL)
NOP:NOP
.KEYINT
;
OPT FNorg(&005F)
OPT FNorg(&0060)
.SEARCH_TABLE:JP SearchTable ; Search table at DE for string at HL
.TKNISE      :JP Tokenise    ; Tokenise line at HL to DE
;
.NMI
PUSH AF:PUSH HL    ; Fix bug in NMI routine
LD HL,(NMIADD)     ; Old NMIADD at &5CB0 now used by Interface1
LD A,H:OR L        ; &5C80 used to be PR_CC
JR Z,&0070         ; Return if zero
;
;
; Shorten token strings
; =====================
; Remove spaces from tokens, allows tokeniser to work more effectively.
;
OPT FNorg(&0119)
DEFM FNm("DEFFN") :DEFM FNm("CAT")   :DEFM FNm("FORMAT"):DEFM FNm("MOVE")
DEFM FNm("ERASE") :DEFM FNm("OPEN#") :DEFM FNm("CLOSE#"):DEFM FNm("MERGE")
; Remove spaces from DEFFN, INPUT# and CLOSE#
DEFM FNm("VERIFY"):DEFM FNm("BEEP")  :DEFM FNm("CIRCLE"):DEFM FNm("INK")
DEFM FNm("PAPER") :DEFM FNm("FLASH") :DEFM FNm("BRIGHT"):DEFM FNm("INVERSE")
DEFM FNm("OVER")  :DEFM FNm("OUT")   :DEFM FNm("LPRINT"):DEFM FNm("LLIST")
DEFM FNm("STOP")  :DEFM FNm("READ")  :DEFM FNm("DATA")  :DEFM FNm("RESTORE")
DEFM FNm("NEW")   :DEFM FNm("BORDER"):DEFM FNm("CONTINUE"):DEFM FNm("DIM")
DEFM FNm("REM")   :DEFM FNm("FOR")   :DEFM FNm("GOTO")  :DEFM FNm("GOSUB")
; Remove spaces from GOTO and GOSUB
DEFM FNm("INPUT") :DEFM FNm("LOAD")  :DEFM FNm("LIST")  :DEFM FNm("LET")
DEFM FNm("PAUSE") :DEFM FNm("NEXT")  :DEFM FNm("POKE")  :DEFM FNm("PRINT")
DEFM FNm("PLOT")  :DEFM FNm("RUN")   :DEFM FNm("SAVE")  :DEFM FNm("RANDOMIZE")
DEFM FNm("IF")    :DEFM FNm("CLS")   :DEFM FNm("DRAW")  :DEFM FNm("CLEAR")
DEFM FNm("RETURN"):DEFM FNm("CALL")
; Replace 'COPY' with 'CALL'
;
;
; Part of new keyboard routines
OPT FNorg(&0200)   ; Space after Token table
.KeyScanAscii
LD E,A:LD D,&80    ; E=key, D=Ascii
CP A:RET           ; Set Z and return
;
;
; Search a token table
; ====================
; DE=table start (no prefix byte)
; HL=string to decode
; C=token value to start with. Stops when C=0
; B=flags, IgnoreCase/NoAbbrs/Termination/<tokeniser flags>
;
OPT FNorg(&022C)   ; This was extended mode table
.SearchTable
PUSH HL            ; Save pointer to input string
.SearchLoop
LD A,(DE)          ; Get character from table
AND &7F:CP (HL)    ; Lose terminator bit
JR Z,SearchMatch   ; Jump if characters match
BIT 7,B            ; Ignore case
JR Z,SearchTryDot  ; Case must match
XOR &20:CP (HL)    ; Change case and try again
JR Z,SearchMatch   ; Jump if characters match
.SearchTryDot
BIT 6,B            ; Abbreviations allowed?
JR NZ,SearchNext   ; Not allowed
LD A,(HL):CP ASC"."; Abbreviation?
INC HL:JR Z,SearchDot
;
.SearchNext        ; No match
LD A,(DE):INC DE   ; Look for token terminator
ADD A,A
JR NC,SearchNext   ; Loop until b7 set
POP HL             ; Retrieve input pointer
LD A,(DE):INC A    ; Test current byte
JR Z,SearchQuit    ; &00 is a terminator
INC C              ; Step to next token value
JR NZ,SearchTable  ; Loop if not come to end
.SearchQuit        ; Will always have Cy=set by here
LD A,(HL)          ; Run out of tokens, so fetch current byte
RET                ; Return, signalling no match
;
.SearchMatch       ; Current bytes match
LD A,(DE)          ; Get current byte
INC DE:INC HL      ; Point to next src & dst chars
ADD A,A            ; Was it a terminating char?
JR NC,SearchLoop   ; Look at more characters
CALL SearchCheck   ; Correctly teminated?
JR SearchContinue
;
;
; New symbol-shift table
; ----------------------
OPT FNorg(&026A)
DEFM "~*?\"+CHR$&C8 ; ABCDE
DEFM "{}^"+CHR$&7F  ; FGHI
DEFM "-+=.,;"""     ; JKLMNOP
DEFM CHR$&C7+"<|>]/"; QRSTUV
DEFM CHR$&C9+"`[:"  ; WXYZ
;
;
OPT FNorg(&0284)
.SearchContinue
JR NC,SearchNext   ; No, try for next token
.SearchDot
POP DE             ; Drop original input pointer
DEC HL             ; Point to last char
LD A,C             ; Pass token to A
AND A:RET          ; Return, signalling token found
; 3 spare bytes at &028B-&028D
;
;
; Replaced and extended keyboard routines
; =======================================
; There is no longer an 'E' mode. System will also
; take keypresses from an Ascii keyboard. Port 253
; should return the Ascii data and port 249 should
; return keyboard status, b0=shift, b1=control,
; b4=control codes need translating
;
; Scan Spectrum keyboard, then Ascii keyboard
; -------------------------------------------
OPT FNorg(&028E)   ; KEY_SCAN
LD L,&2F:JP KeyScanNew
.KeyScan2
;
; Test if keypress is valid
; -------------------------
OPT FNorg(&031E)   ; K_TEST
CALL KeyTestNew    ; Test the keypress
RET Z              ; Return if Ascii keypress
;
; Decode keypress
; ---------------
OPT FNorg(&0333)   ; K_DECODE
; D=FLAGS, C=MODE, 0=KLC, 1=E, 2=G
; B=Shift/etc, E=(keycode)AND 127
;  =%00xxxxxxx - Spectrum key, with shift key
;  =%111111111 - Spectrum key, no shifts pressed
;  =%1b0000000 - Ascii key, b=original bit7
;
CALL KeyDecodeAscii; Try to decode if Ascii
RET NC             ; Return if Ascii
DEC C:LD A,E:CP &3A; PreDEC C
JR C,KeyDigit
DEC C              ; Graphics mode?
JR NZ,KeyLetter    ; MODE<>2, jump forward
ADD A,&4F:RET      ; Return graphics code
.KeyLetter
LD HL,&0229        ; Symbol Shift table
BIT 0,B:JR NZ,KeyNoSymbol
.KeyLookup
LD D,0:ADD HL,DE
LD A,(HL):RET      ; Fetch code and return
.KeyNoSymbol
BIT 3,(IY+48):JR Z,KeyNoCaps
XOR &20            ; Make lower case if no CAPSLOCK
.KeyNoCaps
INC B:RET NZ       ; Return if CAPS not pressed
XOR &20            ; Change case, flip CAPSLOCK effect
RET
.KeyDigit
CP ASC"0":RET C    ; Return with Enter, Extend, Space
DEC C:JR Z,KeyDigitGraph
INC B:RET Z        ; No SHIFT pressed, return '0'-'9'
BIT 5,B:LD HL,&0230
JR NZ,KeyLookup    ; CAPS -> use Shift table
SUB &10            ; Convert '0'-'9' to ' ' to ')'
CP &22:JR Z,KeyAtChar
CP &20:RET NZ      ; Return with '1','#'-')'
LD A,&5F:RET       ; '0'->'_'
.KeyAtChar
LD A,&40:RET       ; '2'->'@'
.KeyDigitGraph
LD HL,&0230
CP &39:JR Z,KeyLookup; Graph-'9'
CP &30:JR Z,KeyLookup; Graph-'0'
AND 7:ADD A,&80    ; &80-&87
INC B:RET Z        ; Shift not pressed
XOR &0F:RET        ; &8F-&88
;
.KeyScanNew
LD DE,&FFFF
CALL KeyScan2:RET Z; Return if Spectrum key pressed
IN A,(253):CP 255  ; Fetch from Ascii keyboard
JP NZ,KeyScanAscii ; Jump if key pressed
AND A:RET          ; NZ=No key pressed
;
.KeyTestNew
LD B,D:LD D,0      ; B=shift/flag, preload D with 0 for lookup
                   ; SpecNoShift  SpecShift    Ascii
LD A,B             ; A=%11111111, %00xxxxxx, %10000000
INC A              ; A=%00000000, %00xxxxxx, %10000001
CP &80:LD A,E      ; A=key value
RET C              ; Return if Spectrum key, with NZ set
AND 127:SCF        ; Ensure b7=0, Cy=1
BIT 7,E:RET Z      ; Return if Ascii<&80, Z set
SET 6,B:CP A:RET   ; Remember old b7 and return, Z set
NOP:NOP:NOP:NOP    ; 4 spare bytes
;
;
OPT FNorg(&04AA)   ; 24 spare bytes at &04AA-&04C1
.Cat               ; Catalogue from tape
CALL SYNTAX_Z
CALL NZ,OpenS      ; Open 'S'
CALL CatRoutine    ; Should first do <cr> if needed
CALL &1BEE         ; This MUST be a CALL, otherwise crashes!
RET
.KeyNull
ADD A,A:AND &80:OR E; Retrieve bit7
LD E,A:LD A,&7F:RET ; A=Ascii key, Z=Copyright
NOP:NOP             ; 2 spare bytes
;
;
; Allow SAVE s$ CODE s,l,e,r,t
; ============================
OPT FNorg(&06F6)
CALL SaCodeExtra   ; Fetch length, look for extra, reload, type
;
OPT FNorg(&0981)   ; Fix WaitKey bug
CALL WaitKey
;
;
; Fix PRINTOUT bugs, and prevent colour errors
; ============================================
OPT FNorg(&0A11)
DEFB &51           ; CHR$6 skips superflous CALL
;
OPT FNorg(&0A15)
DEFB &43           ; CHR$10 does down
DEFB &42           ; CHR$11 does up
DEFB &53           ; CHR$12 does CLS
;
OPT FNorg(&0A32)   ; Fix CHR$8 bug
LD A,&19
;
OPT FNorg(&0A45)      ; Fix CHR$9 bug
LD A,&80:CALL PO_ABLE ; Print char, then PO_STORE
;
OPT FNorg(&0A69)
RET                ; Unprintable codes ignored
JP &0DAF           ; CHR$12->CLS
;
OPT FNorg(&0AAC)
RET C:NOP:NOP      ; Ignore AT out of range
OPT FNorg(&0ABC)
RET C:NOP:NOP      ; Ignore AT out of range
;
;
; Remove all references to ZX printer routines
; ============================================
OPT FNorg(&0A4F)   ; PO_ENTER
LD C,&21:CALL &0C55
DEC B:JP &0DD9
JP PO_UPDOWN       ; CHR$10,CHR$11
NOP:NOP:NOP:NOP    ; 7 spare bytes
NOP:NOP:NOP        ; Could use for CHR$14,15
;
OPT FNorg(&0AA3)
JR &0AA9           ; BIT 1,(FLAGS)
.Cls2              ; 4 spare bytes
LD A,12:RST &10:RET; JR NZ,PO_AT_SET
;
OPT FNorg(&0ADC)   ; PO_STORE
BIT 0,(IY+oTVFLAG)
JR NZ,PO_ST_E      ; Jump for lower screen
LD (SPOSN),BC:LD (DFCC),HL:RET
.PO_ST_E
LD (SPOSNL),BC:LD (ECHOE),BC:LD (DFCCL),HL:RET
;
.Cls
CALL OpenS:JR Cls2
;
.SearchCheck
BIT 5,B:RET Z      ; Return if freely terminatable
LD A,(HL):CP ASC"A"; Check following char
RET:NOP            ; C=terminated ok
;
OPT FNorg(&0B03)   ; PO_FETCH
LD BC,(SPOSN):LD HL,(DFCC)
BIT 0,(IY+oTVFLAG):RET Z
LD BC,(SPOSNL):LD HL,(DFCCL)
RET
.OpenS             ; Six spare bytes
LD A,2:JP &1601    ; BIT 1,(FLAGS)
NOP                ; JR NZ,PO_F_PR
;
OPT FNorg(&0B1D)
.HexAlphanum
CP ASC"&":SCF:RET Z; Return if "&"
JP &2C88           ; Continue into ALPHANUM
;
OPT FNorg(&0B87):JR &0B93
;
OPT FNorg(&0B89)   ; Finish Tape catalogue
.CatKeypress       ; Key pressed, quit catalogue
POP HL             ; Lose error trap address
.CatError          ; BREAK pressed, quit catalogue
POP HL
LD (ERR_SP),HL     ; Restore error handler
LD (IY+0),&FF      ; Clear any error
RET                ; Exit, workspace reclaimed by STMT_LOOP
;
OPT FNorg(&0BAB)
JR &0BB6
;
.PrinterWait       ; Wait for Centronics ready
CALL BreakCheck
IN A,(251):ADD A,A
JR NC,PrinterWait
RET
;
OPT FNorg(&0BBE):NOP:NOP
;
OPT FNorg(&0BD3)   ; Send to Centronics when ready
.PrinterRaw
PUSH AF:CALL PrinterWait
POP AF:OUT (251),A
RET
;
OPT FNorg(&0C55)   ; PO_SCR
NOP:NOP:NOP:NOP:NOP; No ZX printer
;
OPT FNorg(&0C93)
CALL PrintSave     ; Save ATTR/MASK/PFLAG
LD A,&FD:CALL &1601
XOR A:LD DE,&0CF8:CALL &0C0A
SET 5,(IY+oTVFLAG):LD HL,&5C3B
SET 3,(HL):RES 5,(HL)
CALL WaitKey       ; Fix 'scroll?' bug
CP &20:JR Z,&0D00
CP &E2:JR Z,&0D00
OR &20:CP &6E:JR Z,&0D00
CALL OpenS
CALL PrintRest:JR &0CD2
.StrFix            ; Use 12 spare bytes here
EX DE,HL:CALL PrintSave
EX DE,HL:CALL &1615; CHAN_FLAGS
CALL PrintRest:RET
;
OPT FNorg(&0D10)
CALL PrintSave     ; Save ATTR/MASK/PFLAG
CALL &0D4D:LD A,B
.POSCR4A
PUSH AF:LD HL,DFSZ:LD B,(HL)
LD A,B:INC A:LD (HL),A
LD HL,SPOSN+1:CP (HL):JR C,POSCR4B
INC (HL):LD B,&17  ; Don't scroll into ROM
.POSCR4B
CALL &0E00:POP AF:DEC A
JR NZ,POSCR4A:CALL PrintRest
LD BC,(SPOSN):RES 0,(IY+oTVFLAG)
CALL &0DD9:SET 0,(IY+oTVFLAG)
POP BC:RET
.PrintRest
POP HL:POP AF:LD (P_FLAG),A
EX (SP),HL:LD (ATTR_T),HL
RET
;
OPT FNorg(&0DD9)   ; CL_SET
JR &0DE2
.BreakCheck
CALL BREAK_KEY     ; Check BREAK key
JP NC,&1B7B:RET    ; Generate error if pressed
;
OPT FNorg(&0EAC)
.KeyDecodeAscii
LD A,B:INC A
CP &80:RET C       ; Return if Spectrum key
IN A,(249):LD D,A  ; Get keyboard status
LD A,B:CALL KeyNull; E=A=Ascii key
RET Z:LD A,E       ; &00->&7F Copyright
CP &7F:JR NC,KeyFunc ; &7F+function keys
CP &20:RET NC      ; Printable character
ADD A,143          ; Convert to graphics char
BIT 1,D:RET NZ     ; Return if Ctrl pressed
LD A,E             ; Retrieve key
BIT 4,D:RET Z      ; No translation required
CP &15:JR C,KeyCtrl
SUB 7
.KeyCtrl
LD HL,AsciiCodes-8 ; Index into control key translation
LD E,A:JP KeyLookup
.KeyFunc
LD A,12:RET Z      ; 127->12 Delete
LD A,E:AND &8F:LD E,A; E=&80+key offset
LD A,D:ADD A,A:ADD A,A
ADD A,A:ADD A,A    ; Move Ctrl/Shift into position
AND &30:OR E:RET   ; Form ascii value
.AsciiCodes
DEFB &0F:DEFB &0E:DEFB &06:DEFB &09  ; BS     TAB    LF ->
DEFB &1E:DEFB &0D:DEFB &08:DEFB &00  ; HOME   RETURN <- *
DEFB &00:DEFB &07:DEFB &0A:DEFB &0B  ; *      CLEAR  Dn Up
DEFB &1B                             ; ESCAPE
;
;
; Hexadecimal input
; =================
.ScanHexDE
LD (CH_ADD),DE     ; Point to input string
.ScanHex           ; Put ScanHex routine here
LD DE,&0000        ; Initialise DE for BIN and hex
CP &C4:SCF:RET Z   ; Ret with BIN, Cy=1, Z=1
CP ASC"&":SCF:RET NZ; Ret if not "&", Cy=1, Z=0
.ScanHexLoop
CALL &74:CALL &2D1B
JR NC,ScanHexDigit ; '0'-'9'
CP ASC"A":CCF:RET NC; Cy=0 - Done
AND &DF            ; Force to upper case
CP ASC"F"+1:RET NC
SUB 7              ; "A" -> "9"+1
.ScanHexDigit
SUB ASC"0"         ; "0".."F" -> &00..&0F
SLA E:RL D:SLA E:RL D
SLA E:RL D:SLA E:RL D ; DE=DE*16
OR E:LD E,A        ; Put bottom digit in
JR ScanHexLoop     ; NB No overflow check!
;
OPT FNorg(&0FA7)
DEFB &4B           ; Ignore Shift-Symbol in editing
;
OPT FNorg(&0FDB)   ; Wearmouth current line cursor bugfix
DEC (IY+16):CALL &1855:INC (IY+16)
;
OPT FNorg(&10CB)
JR NC,&111B
OPT FNorg(&10D1)
JR &111B
;
; Fix CLOSE# bug and restore #4 to "C" on closing
; ===============================================
OPT FNorg(&10D3)   ; 8 bytes here
.CloseC2
XOR ASC"C"
JP NZ,CloseC3      ; If not "C", return with zero
LD C,21:RET        ; Default entry for #4
;
OPT FNorg(&10E6)
CP 15              ; Don't go into E mode
;
;
; Silently search for a tape file
; ===============================
OPT FNorg(&10FA)   ; 33 spare bytes at &10FA-&111A
.TapeFind
LD DE,17:ADD IX,DE
.TapeLp1
CALL WaitHdr
LD BC,&0B00:PUSH IX
.TapeLp2
LD A,(IX+0):XOR (IX-17)
OR C:LD C,A
INC IX:DJNZ TapeLp2
POP IX
LD A,C:OR A:JR NZ,TapeLp1
RET
; 1 spare byte at &111A
;
;
; Change startup and main command loop
; ====================================
OPT FNorg(&11CC)
XOR A:OUT (&FE),A  ; Black border
LD A,&3F:LD I,A    ; Initialise I
LD H,D:LD L,E      ; HL=top of memory to clear
.RamFill
LD (HL),0:DEC HL
CP H:JR NZ,RamFill
EX DE,HL:EXX
LD (P_RAMT),BC
LD (RASP),DE
LD (UDC),HL:EXX    ; Saved values from NEW
INC B:JR Z,&1219
LD (P_RAMT),HL     ; Set top of accessible memory
LD DE,&3EAF
LD BC,&00A8
EX DE,HL:LDDR      ; Copy default UDC definitions
EX DE,HL:INC HL
LD (UDC),HL:DEC HL ; Set UDC address
LD BC,&0040        ;; B already 0, could use LD C,&40
LD (RASP),BC       ; Set default keyclicks
LD A,&7F:IN A,(&FE); Check SYMBOL key
XOR 2:RRCA:RRCA
JR C,&1219:LD B,A  ; Claim all memory if SYMBOL pressed
LD A,H:CP &F8
LD A,B:JR C,&1219  ; If RAMTOP<&F800, use it
LD HL,&F7FF        ; Otherwise, set RAMTOP=&F7FF
;
OPT FNorg(&1244)   ; Add "C" channel
ADD A,A:JR C,NoChanC ; SYMBOL not pressed
LD HL,ChannelC
LD C,12:DEC DE:LDIR; Copy to CHANS area
LD (IY-28),21      ; Attach stream 4 to "C"
.NoChanC
EX DE,HL:DEC HL
LD (&5C57),HL      ; Set DATADD, PROG, VARS
INC HL:LD (&5C53),HL
LD (&5C4B),HL
LD (HL),&80:INC HL
LD (&5C59),HL
LD A,&47           ; White on black
;
OPT FNorg(&1287)   ; Overwrite CALL CLEAR_PRB
SET 3,(IY+48)      ; Set CAPS LOCK
CALL FSInit        ; Set default drive, etc.
;
OPT FNorg(&12B1)   ; Main command prompt
CALL EnterTokens   ; Enter line and tokenise it
;
OPT FNorg(&1308)
NOP
LD A,(&5C3A):INC A ; Get ERR_NR
CP &1C:JR C,&1313  ; Error in range?
LD A,&14           ; Replace with 'Unknown command'
;
OPT FNorg(&1296)   ; New startup message
LD DE,MsgCopyright-1 ; Point to moved startup message
;
OPT FNorg(&134A)
LD DE,MsgComma-1   ; Point to moved ', ' message
;
;
; Alter error messages
; ====================
OPT FNorg(&140C)
DEFM FNm("STOP")            ; was "STOP statement"
DEFM FNm("Invalid argument")
DEFM FNm("Integer out of range")
DEFM FNm("Mistake")         ; Was "Nonsense in BASIC"
DEFM FNm("BREAK - CONT repeats")
DEFM FNm("Out of DATA")
DEFM FNm("Invalid filename")
DEFM FNm("No room for line")
DEFM FNm("STOP in INPUT")
DEFM FNm("FOR without NEXT")
DEFM FNm("Invalid I/O device")
DEFM FNm("Unknown command") ; Was "Invalid colour"
DEFM FNm("BREAK into program")
DEFM FNm("RAMTOP no good")
DEFM FNm("Statement lost")
DEFM FNm("Invalid stream")
DEFM FNm("FN without DEF")
DEFM FNm("Parameter error")
DEFM FNm("Tape loading error")
.MsgComma
DEFM FNm(", ")
.MsgCopyright
DEFB 127
DEFM FNm("1982 Sinclair Research Ltd, JGH")
;
;
; Wait for and return a keypress
; ==============================
.WaitKey
BIT 5,(IY+oFLAGS)
JR Z,WaitKey       ; Wait for a keypress
CALL &0D6E         ; Clear lower screen
.WaitGetKey
LD A,(&5C08)       ; Get keypress
JP &1F4F           ; Clear keypress
RET
;
;
; New Centronics printer output
; =============================
; Use port &FB directly as a Centronics port.
; OUT &FB,n writes data and strobes the port
; IN &FB returns a ready signal in bit 7.
; If b7=1, printer is ready. If b7=0, not ready.
; This also releases &5B00-&5BFF for other uses.
;
; Channel "P" (connected to stream 3) writes to
; the centronics port as text.
; Channel "C" (connected to stream 4) writes to
; the centronics port as raw data.
;
OPT FNorg(&15B6)   ; Allow INPUT from channel "S"
DEFW KEY_INPUT     ; Needs 'help' in INPUT routine
;
OPT FNorg(&15BE)   ; Redirect "P" to Centronics printer
DEFW PrinterOut    ; New printer channel
;
OPT FNorg(&15EF)
ADD A,ASC"0":SCF   ; Printout called with SCF
;
OPT FNorg(&1631)
DEFB ASC"P":DEFB &31 ; Point to a RET
;
OPT FNorg(&1638)   ; Open channel 'K'
SET 3,(IY+oFLAGS)  ; Set 'L' mode, also fixes INKEY#0 bug
;
OPT FNorg(&1646)   ; Open channel 'S' or 'K'
JP &0D4D           ; Exit via TEMPS
;
.PrintSave         ; 9 bytes at &1649
LD HL,(ATTR_T)     ; BIT 1,(FLAGS)
EX (SP),HL         ; JP NZ,COPY_BUFF
LD A,(P_FLAG)      ; Superflous CALL PO_FETCH
PUSH AF:JP (HL)
;
OPT FNorg(&16D4)   ; 7 spare bytes, code never called
.ExecBasic
LD (ERR_SP),SP     ; Set new error pointer
JP &1B8A           ; Execute BASIC line
;
OPT FNorg(&16EB)
CALL CloseC        ; Check for closing #4
;
OPT FNorg(&1708)
INC HL             ; Have to start here for Int#1
POP HL:RET         ; Don't bother even looking in close table
.CloseC
LD A,D
.CloseC3
LD BC,0:CP 14:RET NZ; Return with zero if not #4
PUSH HL:LD HL,(CHANS)
LD C,24:ADD HL,BC  ; Point to where "C" should be
LD A,(HL):POP HL   ; Get char from channel
JP CloseC2
;
OPT FNorg(&1733)
JP CheckStream4    ; Prevent Int#1 from deleting "C"
;
;
; Allow OPEN to select any non-extended channel
; =============================================
OPT FNorg(&173C)
PUSH HL            ; Save stream offset
LD HL,(CHANS):PUSH HL  ; Save CHANS start
LD A,B:OR C:JR Z,Open2 ; Stream closed, open it
ADD HL,BC:LD A,(HL); Get output high byte
AND A:JR Z,&1725   ; Invalid stream -> pass to Interface 1
.Open2
CALL &2BF1         ; Fetch channel string
LD A,B:OR A        ; Check string length
JR NZ,Report_F     ; String len>255
DEC C:JR Z,Open3   ; String len=1
.Report_F
RST &08:DEFB &0E   ; Invalid filename
.Open3
POP HL:PUSH HL     ; Get CHANS back
LD A,(DE)          ; Get channel character
AND &DF:LD C,A
LD B,4+1           ; First four are short entries
.OpenLp
LD D,H:LD E,L      ; DE=HL=>start of entry
LD A,(HL):CP &80   ; At end of CHANS?
JR Z,Report_F      ; No more channels, error
CALL &18BB:INC HL  ; Get channel char
CP C:JR Z,OpenFound; Matching character
DJNZ OpenLp        ; Step on for first four entries
INC B              ; Ensure loop returns here
CALL &18BB:INC HL  ; Get length low byte
LD H,(HL):LD L,A   ; Get channel length to HL
ADD HL,DE:JR OpenLp; Point to next channel
.OpenFound
POP HL:INC DE      ; Get CHANS, point to output high byte
LD A,(DE):AND A    ; Is this an Interface 1 channel?
JR Z,&1725         ; Don't open Interface 1 channel
EX DE,HL
SBC HL,DE:EX DE,HL ; DE=channel offset
POP HL:JP &0A83    ; Set stream offset
;
.ChannelC          ; Channel "C" data
DEFW PrinterRaw:DEFW &15C4
DEFB ASC"C"
DEFW &0000:DEFW &0000
DEFW &000B
DEFB &80
; 1 spare byte at &1792
;
;
OPT FNorg(&18F6)   ; Print cursor
SET 3,(HL)         ; Keep in 'L' mode
;
;
OPT FNorg(&1937)   ; OUT_CHAR no longer needed as
RST &10:RET        ; keyword entry removed (Wearmouth)
;
;
; Allow #4 to default to "C" on closing
; =====================================
.CheckStream4      ; 53 spare bytes at &1939-&196D
LD D,A:LD B,(HL)
DEC HL:CP 14:RET NZ; Not #4, return with offset
INC B:DEC B:RET NZ ; Offset not &00xx, return
LD A,C:CP 21       ; Offset not &0015, return
LD A,14:RET NZ     ; B is now &00
PUSH HL:LD HL,(CHANS)
ADD HL,BC:CALL &18BC ; Get channel char
POP HL:CP ASC"C"   ; Check if channel "C"
LD A,14:RET NZ     ; Not "C", return
LD C,0:RET         ; Return &0000 to stop overwriting
;
;
; Check for Interface 1 and set default drive
; ===========================================
.FSInit
LD (IY+oCURDRV),ASC"T" ; Default to "T"ape
LD BC,&FF00            ; Loop 255 times
.FSInitLp
IN A,(&F7):OR C:LD C,A ; See if Interface 1 responds
DJNZ FSInitLp
LD A,C:OR A:RET NZ     ; Return if not zero
LD (IY+oCURDRV),ASC"1" ; Set to drive 1
RET
;
;
; Extend Basic to allow more commands
; ===================================
OPT FNorg(&1AAB)
DEFB &05           ; Parameters may follow
DEFW Run           ; RUN/RUN n/RUN s$
;
OPT FNorg(&1ABE)
DEFB &00           ; No parameters
DEFW Cls           ; CLS
;
OPT FNorg(&1B14)
DEFB &05           ; Parameters may follow
DEFW Cat           ; Catalogue from tape
;
OPT FNorg(&1AD6)
DEFB &03           ; One numeric parameter
DEFW Call          ; Was COPY
;
OPT FNorg(&1B46)
JP C,UKCommand     ; Was JP C,REPORT_C
;
OPT FNorg(&1C9A)   ; Wearmouth colours bugfix
CALL NZ,OpenS      ; Ensure "S" selected
NOP:NOP:NOP:NOP
OPT FNorg(&1CC3)
CALL NZ,OpenS      ; Ensure "S" selected
NOP:NOP:NOP:NOP
;
OPT FNorg(&1F15)   ; Make out of memory use standard error call
RST &08:DEFB &03   ; Should stop Microdrive crashing with drive on
NOP:NOP:NOP
;
OPT FNorg(&202C)
CALL HexOutput     ; Check for PRINT ~
;
OPT FNorg(&208E)   ; Wearmouth bugfix for INPUT
CALL &0D6E
LD A,1:CALL &1601  ; Clear lower screen, then select #1
;
OPT FNorg(&2203)
CALL &1FC3:PUSH AF:CALL &1E94
LD D,A:POP AF:RST &10:LD A,D
RST &10:AND A:RET  ; Colour items return with Carry clear
;
OPT FNorg(&2244)
RET:NOP            ; Ignore colour out of range
;
OPT FNorg(&2297)
AND 15:XOR 8       ; Ignore border colour out of range, ensure bright
;
OPT FNorg(&257D)   ; Fix SCREEN$ bug
RET
; 2 spare bytes
;
;
; Allow &xxxx to enter hexadecimal numbers
; ========================================
OPT FNorg(&2684)   ; Line syntax checking
CALL HexAlphanum   ; Check if alphanum or "&"
;
OPT FNorg(&26EF)
JP C,UKFunction    ; Was JP C,REPORT_C
;
OPT FNorg(&2C9B)
CALL ScanHex       ; Try to read as hex
JR NC,&2CB3        ; Stack DE if hex
JR NZ,&2CB8        ; Try as decimal if not "BIN" and not "&"
;
;
; Fix truncate, STR$, -65536 and divide_bit34 bugs
; ================================================
OPT FNorg(&2CE3)   ; Wearmouth bugfix
DEFB &04           ; 10 instead of 1/10
DEFB &C0:DEFB &05  ; d/10 instead of d*(1/10)
;
OPT FNorg(&2E14)   ; Fix "x"+STR$y bug
AND A:JR NZ,PF_SAVE; A already holds D from INT_FETCH
OR E:JR Z,PF_SMALL ; Move following code back one byte
LD D,E:LD B,8
.PF_SAVE
PUSH DE:EXX:POP DE:EXX
JR &2E7B ; PF_BITS
.PF_SMALL
RST &28:DEFB 2     ; Squeeze the extra 'delete' in
;
OPT FNorg(&3032)   ; Fix -65536 bug in addition
CALL addCheckSmall
POP DE:RET
;
;
; CALL <addr> replaces COPY command
; =================================
.Call              ; Use these 5 spare locations
CALL FIND_INT2     ; Get the address
PUSH BC:RET        ; Jump to it
;
;
OPT FNorg(&3223)   ; Fix truncate bug
JR &323F
;
.addCheckSmall     ; This space now available
PUSH AF:INC A      ; for -65536 bugfix
OR E:OR D:JR NZ,ADD_STORE
POP AF:LD (HL),&80
DEC HL:LD (HL),&91
PUSH AF:INC HL     ; This is the error in CSRD
.ADD_STORE
POP AF:LD (HL),A
INC HL:LD (HL),E
INC HL:LD (HL),D
DEC HL:DEC HL
DEC HL:RET
; 2 spare bytes at &323D-&323E
;
OPT FNorg(&31FF)   ; Fix bit34 bug in divide
JR Z,&31DB
;
OPT FNorg(&33FB)   ; Stop SKIP_CONS from writing to ROM
NOP:NOP:NOP
;
;
; Allow STR$~ for conversion to hexadecimal
; =========================================
OPT FNorg(&2707)   ; Prepare calculator for STR$
CALL StrPreCheck   ; Check for STR$~
JR NC,S_PUSH_PO2   ; Next char already checked
NOP
.S_PUSH_PO
RST &20            ; Get next char
.S_PUSH_PO2
PUSH BC
;
OPT FNorg(&334F)   ; Change calcuator function &3C to STR$~
DEFW &361F         ; STR$~ - same as STR$
;
OPT FNorg(&362B)   ; STR$/STR$~
NOP:NOP            ; LD A,&FF
CALL HexOutputStr  ; CALL CHAN_OPEN
CALL &2DE3         ; PRINT_FP
.StrDContinue
POP HL:CALL StrFix ; Restore channel and flags
;
OPT FNorg(&364D)
CALL PrintSave     ; Save colours
LD HL,(CURCHN):PUSH HL
CALL InkFix:JR NC,RIStore
INC C:RST &30:LD (DE),A
.RIStore
CALL &2AB2
POP HL:CALL &1615  ; CHAN_FLAGS
CALL PrintRest     ; Restore colours
; &3666
;
; Use spare space at end of ROM for extra code
; ============================================
OPT FNorg(&386E)
;
; Extended SAVE/LOAD CODE
; =======================
.SaCodeExtra
CALL EX_1NUM       ; Fetch the 'length'
LD A,(T_ADDR)      ; Get token offset
CP 2:RET NC        ; Return if not SAVE or LOAD
POP BC             ; Lose return address
LD B,3             ; Maximum of three more parameters
.SaCodeLoop
RST &18:CP ASC","
JR NZ,SaCodeFound      ; No more parameters
PUSH BC:CALL EX_1NEXT
POP BC:DJNZ SaCodeLoop ; Loop for any more
.SaCodeFound
; B=0 - CODE s,l,e,r,t
; B=1 - CODE s,l,e,r
; B=2 - CODE s,l,e
; B=3 - CODE s,l
CALL CHECK_END     ; Must be end of statement
LD (IX+0),3        ; Assume 'CODE' - type &03
LD A,B:PUSH AF:AND A
JR NZ,SaCodeReLoad ; Use preset filetype
CALL FIND_INT2     ; Get 'filetype'
LD (IX+0),C        ; Store in header
.SaCodeReLoad
POP AF:PUSH AF     ; Get parameter count
CP 2:JR NC,SaCodeExec
CALL FIND_INT2     ; Get 'reload' into BC
LD (IX+13),C
LD (IX+14),B       ; Store in header
.SaCodeExec
POP AF:PUSH AF     ; Get parameter count
CP 3:JR NC,SaCodeLen
CALL FIND_INT2     ; Get 'extra'
LD (IX+15),C
LD (IX+16),B       ; Store in header
.SaCodeLen
CALL FIND_INT2     ; Get 'length'
LD (IX+11),C
LD (IX+12),B       ; Store in header
CALL FIND_INT2     ; Get 'start'
LD L,C:LD H,B      ; HL=start address
POP AF:CP 2
JR C,SaCodeDone    ; load & exec already set
JR Z,SaCodeLoad    ; exec already set
LD (IX+15),C
LD (IX+16),B       ; exec=start
.SaCodeLoad
LD (IX+13),C
LD (IX+14),B       ; load=start
.SaCodeDone
; HL=start, IX=>header, IX+0=type, IX+11/2=length, IX+13/14=start/reload, IX+15/16=extra
JP &075A           ; Continue at SA_ALL
;
;
; Tokenise entered command line
; =============================
.EnterTokens
LD (IY+0),&FF      ; Clear any errors
CALL &0F2C         ; Editor
LD HL,(E_LINE)     ; Point to command line
LD D,H:LD E,L      ; src=dest=E_LINE
LD A,(FLAGS2)      ; Default flags for tokeniser
AND &E0:LD B,A     ; Pass top three bits into B
;
.Tokenise
LD A,B:AND &E0:LD B,A; Clear tokeniser flags
; b4=within a statement
; b3=inside quotes
; b2=|name
; b1=REM or *command
; b0=spare
;
.TokenLoopZero
LD A,B:AND &E3:LD B,A; Clear in-line flags
.TokenLoop
PUSH DE            ; Save dest pointer
LD C,(HL)          ; Get current character
LD A,B             ; Get tokeniser flags
AND &0F:LD A,C     ; Are any 'skip' flags set?
JR NZ,TokenByte    ; Put the byte straight in
CP ASC"<"          ; A character that can start a token?
JR C,TokenByte     ; Chars<"<" not tokens
;BIT 4,B            ; Within a statement?
; Need to check for "INKEY$", then commands, then functions
;JR Z,TokenNotFunction; Look at all tokens
LD DE,&0099        ; Point to 'INKEY$'
LD C,255           ; Only check one token
CALL SearchTable   ; Try to decode it
LD A,&A6           ; INKEY$ token
JR NC,TokenByte    ; Matched, put it in
;.TokenNotFunction
LD DE,&0119        ; Point to start of command tokens
LD C,206           ; First token=CHR$206
CALL SearchTable   ; Try to decode it
JR NC,TokenByte    ; Enter token
.TokenFunction
LD DE,&0096        ; Point to start of function tokens
LD C,165           ; First token=CHR$165
CALL SearchTable   ; Try to decode it
.TokenByte
POP DE:LD (DE),A   ; Retrieve dest and store char or token
INC HL:INC DE      ; Increment source and dest pointers
;
CP 13:JR Z,TokenCR ; End of line reached
CP ASC""""         ; A quote?
JR NZ,TokenNotQuote
LD A,B:XOR 8:LD B,A; Flip quotes flag
JR TokenLoop       ; Go back for more
;
.TokenNotQuote
BIT 3,B            ; Inside quotes?
JR NZ,TokenLoop    ; Don't check if inside quotes
BIT 1,B            ; Stop tokenising?
JR NZ,TokenLoop    ; Don't check any more characters
;
CP ASC":"          ; A colon?
JR Z,TokenLoopZero ; Go back for more, resetting in-line flags
;
.TokenComma
CP ASC","          ; A comma?
JR NZ,TokenRem
RES 2,B            ; End of RSX name
JR TokenLoop       ; Go back for more
;
.TokenRem
CP 234             ; 'REM'?
JR NZ,TokenCommand
.TokenRem2
SET 1,B            ; Flag no more tokenising
JR TokenLoop       ; Go back for more
;
.TokenCommand
CP 206             ; A command token?
JR C,TokenRSX
SET 4,B            ; Flag within a statement
JR TokenLoop       ; Go back for more
;
.TokenRSX
BIT 4,B            ; At start of statement?
JR NZ,TokenLoop    ; Loop back if within a statement
CP ASC"*"          ; *command?
JR Z,TokenRem2     ; Treat as a REM
CP ASC"|"          ; Start of RSX command?
JR NZ,TokenLoop    ; No, loop back for more
SET 2,B            ; Set RSX name flag
JR TokenLoop       ; Go back for more
;
.TokenCR
LD HL,(K_CUR)
AND A:SBC HL,DE    ; Is K_CUR now past end of line?
JR C,TokenFinished
DEC DE:LD (K_CUR),DE ; Move K_CUR back to end of line
INC DE
.TokenFinished
EX DE,HL           ; Put dest pointer in HL
JP &16B9           ; Reset pointers
;
;
; Extra commands
; ==============
.CatRoutine
CALL &0D4D         ; Set PERM colours
RST &18:CALL &2070 ; STR_ALTER
CALL &1FC3         ; Return if checking syntax
RST &18:CALL PR_ST_END
RET NZ             ; Return if not end of statement
LD BC,17:RST &30   ; Create 17 bytes in the workspace
PUSH DE:POP IX     ; Pass its address to IX
LD HL,(ERR_SP)
PUSH HL            ; Save old error return
LD HL,CatError
PUSH HL
LD (ERR_SP),SP     ; Set up error trap
.CatLoop           ; Allow error from LD_BYTES to end catalogue
CALL WaitHdr:;JR Z,CatLoop
PUSH IX            ; Save pointer to header
LD B,(IX+0)
CALL PRHEX0        ; Print filetype
LD A,ASC" ":RST &10
LD B,10
.CatPrName         ; Print out filename
LD A,(IX+1):RST &10
INC IX:DJNZ CatPrName
LD A,ASC" ":RST &10
LD C,(IX+3):LD B,(IX+4)
CALL PR2HEX0       ; Print start address
LD A,ASC"+":LD E,2
.CatPrAddrs        ; Print out addresses
RST &10            ; Print '+' or ' '
LD C,(IX+1):LD B,(IX+2)
CALL PR2HEX0       ; Print length or extra
LD BC,4:ADD IX,BC  ; Move from length to extra
LD A,ASC" "        ; Print space next time around
DEC E:JR NZ,CatPrAddrs
LD A,13:RST &10    ; Print newline
POP IX:JR CatLoop  ; Loop back for another
;
; Wait for a tape header
; ----------------------
.WaitHdr
PUSH IX:LD DE,17
XOR A:SCF:CALL &0556 ; Load 17 bytes
POP IX:JR NC,WaitHdr ; Loop until loaded
RET
;
;
; Print hexadecimal numbers
; =========================
.HexOutput
CP ASC"~"          ; Is current char '~'?
JP NZ,SCANNING     ; Jump if not to do as decimal
POP AF             ; Lose return address
CALL EX_1NEXT      ; Scan next as numeric
CALL UNSTACK_Z     ; Return if syntax checking
.HexOutput2        ; Fetch number and print as hex
CALL FIND_INT2     ; Get number to BC
LD D,0             ; Print with no leading zeros
;
;
; Print hexadecimal numbers
; =========================
.PrHexWord         ; BC=value, D=0/48
CALL PrHexTop      ; Print top nybble
CALL PrHexByte2    ; Print second nybble
LD B,C             ; Copy bottom byte to B
:
.PrHexByte         ; B=value, D=0/48
CALL PrHexTop      ; Print top nybble
LD D,ASC"0"        ; Ensure zero printed
.PrHexByte2
LD A,B:JR PrHexDigit ; Print bottom nybble
:
.PrHexTop
LD A,B:RRA:RRA:RRA:RRA
.PrHexDigit
AND 15:JR NZ,PrHexDigitOk
OR D:RET Z         ; Leading zero
.PrHexDigitOk
LD D,ASC"0":OR D
CP ASC"9"+1:JR C,PrHexDigitOk2
ADD A,7
.PrHexDigitOk2
RST &10:RET        ; Print digit
;
;
; Conversion to hexadecimal
; =========================
.StrPreCheck       ; Check for STR$/STR$~
CP &EE:RET C       ; Return if <"STR$"
RES 7,C:SCF:RET NZ ; Set 'returns string', return if not "STR$"
RST &20:CP ASC"~"  ; Followed by '~'?
JR Z,StrPreHex
AND A:RET          ; Decimal, return with next char fetched
.StrPreHex
LD C,&7C:SCF:RET   ; Change function to 'STR$~' and return
;
.HexOutputStr      ; Do STR$/STR$~
PUSH AF            ; A=&2E*2 or &3C*2 for STR$ or STR$~
LD A,&FF:CALL &1601; Select 'R' stream
POP AF:CP &78:RET C; Return to do decimal if STR$
POP AF             ; lose return address
CALL HexOutput2    ; Fetch and print
JP StrDContinue    ; Finish STR$ function
;
;
; Scan hexadecimal number in string
; =================================
.ScanHexInit
LD HL,(CH_ADD):PUSH HL ; Save current CH_ADD
LD A,ASC"&"            ; Prepare for scanning hex
DEC DE:CALL ScanHexDE  ; Scan string at DE
PUSH DE:POP HL         ; HL=result
LD DE,(CH_ADD)         ; DE=>after string
EX (SP),HL:LD (CH_ADD),HL ; Restore CH_ADD
POP HL:RET
; HL=result, DE=>after hex string, A=terminating character
;
;
; Bugfix for INKEY$#n
; ===================
.InkFix
LD A,C:CALL &1601
CALL &15E6:LD BC,0:RET
;
;
; Implement CHR$10, CHR$11
; ========================
.PO_UPDOWN
ADD A,A:AND 2:DEC A    ; Offset to new row
ADD A,B:CP 25:RET NC   ; Off top of screen, ignore
LD B,A:PUSH BC
CALL &0C55:POP BC      ; Check for scrolling
BIT 0,(IY+oTVFLAG)
JR NZ,PO_UPDOWN2       ; Jump for lower screen
LD A,(DFSZ):CP B
JR NZ,PO_UPDOWN2:INC B ; Adjust if scrolled
.PO_UPDOWN2
JP &0DD9               ; Calculate DFCC and store
;
;
; Centronics printer text/raw output
; ==================================
.PrinterOut
BIT 1,(IY+oFLAGS)
JR NZ,PrintOutRaw  ; Print raw characters if FLAGS.b1 set
CP &A5             ; Is it a token?
JR C,PrintOutText  ; No, print a text character
SUB &A5:JP &0C10   ; Print tokens
.PrintOutText
CP 32:JR NZ,PrintOutChar
SET 0,(IY+oFLAGS)  ; Set 'leading space'
.PrintOutChar
JR NC,PrintOutRaw  ; Send printable chars
CP 13:RET NZ       ; Ignore all but <cr>
CALL PrinterRaw
LD A,10            ; Add a <lf>
.PrintOutRaw
JP PrinterRaw
;
;
; Unrecognised command
; ==============================================
; Check for *command, |command, then UKCmd chain
;
.UKCommand
CP ASC"*"-&CE+256:JP NZ,CheckRSX
CALL SYNTAX_Z      ; Deal with *command
JP Z,&1BB2         ; During syntax, treat as a REM
RST &18:CALL Oscli ; GET_CHAR, HL=>command
JP &1BB2           ; Skip line to adjust CH_ADD
;
;
; Allow RUN s$ to call OSCLI
; ==========================
.RunNull
CALL USE_ZERO      ; Use zero if no parameters
.RunNumber
CALL CHECK_END     ; Exit during syntax check
JP &1EA1           ; RUN
;
.Run
CALL PR_ST_END     ; End of statement?
JR Z,RunNull
CALL SCANNING
BIT 6,(IY+oFLAGS)  ; FLAGS
JR NZ,RunNumber    
CALL CHECK_END     ; Exit during syntax check
CALL &2BF1         ; Get string parameters
; DE=string start
; BC=string length
PUSH DE            ; Save string start
INC BC:RST &30     ; Reserve space for string+CR
; DE=reserved space
; BC=length reserved
POP HL:PUSH DE     ; HL=string start, save DE
LDIR:LD A,13       ; Copy string to space
DEC DE:LD (DE),A   ; Put terminating CR in place
POP HL             ; Get start of CR-string
;CALL Oscli
;RET
;
;
; OSCLI - *commands to run code
; =============================
.Oscli             ; Skip any '*'s or ' 's
LD A,(HL):INC HL
CP ASC"*":JR Z,Oscli
CP ASC" ":JR Z,Oscli
CP ASC"/":JR Z,OscSlash
DEC HL
.OscSlash          ; HL=>name
LD A,(HL)
CP ASC"|":RET Z    ; Comment
CP ASC" ":RET C    ; Null string
;
LD B,A             ; In case this is a driver spec
INC HL:LD A,(HL)
CP ASC":"          ; Look for "d<colon>xxx..."
JR NZ,OscNotDrive1 ; No drive specifier
BIT 6,B:JR Z,OscDrive
RES 5,B            ; Ensure upper case
.OscDrive
INC HL             ; Move past drive spec
LD A,(HL):CP ASC"!"; *d<colon> or *d<colon>name ?
JR NC,OscNotDrive2 ; Following filename
LD (IY+oCURDRV),B  ; Set current drive
RET
;
.OscNotDrive1
DEC HL             ; Point to filename start
LD B,(IY+oCURDRV)  ; Use current drive
.OscNotDrive2
PUSH BC            ; Save drive spec
LD (X_PTR),HL      ; Save pointer, in case RESERVE moves it
LD A,B             ; Check drive
CP ASC"T":JR Z,OscValid   ; NC=Tape
CP ASC"1":JR C,OscInvalid
CP ASC"8"+1:JR C,OscMValid
.OscInvalid
RST &08:DEFB &17   ; Invalid I/O device
.OscMValid
RST &08:DEFB &31   ; Ensure Int#1 initialised
SCF                ; C=MDrive
.OscValid
PUSH AF            ; Save Tape/MDrive flag
LD BC,34:RST &30   ; Reserve 34 bytes
LD HL,(X_PTR)      ; Get pointer back
POP AF:POP BC      ; Get flags, drive spec back
PUSH DE:POP IX     ; DE=IX=header area, HL=>command, B=drive
JP C,OscMDrive
;
.OscTape           ; Run a command from tape
LD B,10:LD A,ASC" "; Blank out ten characters
.OscHdrBlank1
INC DE:LD (DE),A
DJNZ OscHdrBlank1
LD B,6:XOR A       ; Blank out three words
.OscHdrBlank2
INC DE:LD (DE),A
DJNZ OscHdrBlank2
INC A:LD (T_ADDR),A; T_ADDR=1 = LOAD
PUSH IX:POP DE     ; Get header address back
CALL OscFilename
PUSH HL            ; Pointer to parameters
LD (IX+0),3        ; Looking for CODE
CALL TapeFind      ; Look for the specified file
CALL OpenS         ; Open 'S'
POP BC             ; Get =>parameters
LD HL,0:ADD HL,SP  ; Save old SP
LD SP,TEMPSP       ; Temporary stack in calculator area (15 deep)
PUSH HL:PUSH BC    ; Save old SP, =>parameters
LD L,(IX+15)
LD H,(IX+16)       ; Get exec address
PUSH HL            ; If zero, should load to stack (or RST &30 space?)
LD HL,0:CALL &07CB ; Load the data block
HALT:DI:POP BC     ; Get entry address
POP DE             ; =>Parameters
POP HL:LD SP,HL    ; Restore stack, avoiding any writing to stack
JR OscEnter        ; BC=entry address
;
.OscMDrive
PUSH HL:PUSH BC        ; Save filename pointer, drive
LD HL,MDHdr:LD BC,12
LDIR:POP BC:LD (IX+8),B; Set drive
POP HL:DEC DE:CALL OscFilename
PUSH HL                ; Save parameter pointer
EX DE,HL:LD (HL),&22   ; Closing quote
INC HL:LD (HL),&AF     ; CODE
INC HL:LD (HL),&0D     ; <cr>
INC HL:LD (HL),&80     ; Terminator
INC HL:EX DE,HL
;
LD HL,(&5C55):PUSH HL  ; Save current BASIC context
LD HL,(E_LINE):PUSH HL:LD HL,(WORKSP):PUSH HL
LD HL,(CH_ADD):PUSH HL:LD HL,(ERR_SP):PUSH HL
LD (E_LINE),IX         ; Point to BASIC command
LD (WORKSP),DE         ; Move workspace up
LD (IY+10),1           ; Set to statement 1
CALL ExecBasic         ; Execute line
POP HL:LD (ERR_SP),HL  ; Restore BASIC context
POP HL:LD (CH_ADD),HL:POP HL:LD (WORKSP),HL
POP HL:LD (E_LINE),HL:POP HL:LD (&5C55),HL
POP DE                 ; Get parameter address
LD HL,(&5CE9)          ; Get load address
LD BC,(&5CEB)          ; Get exec address
INC BC:LD A,B:OR C     ; Check if exec=&FFFF
DEC BC:JR NZ,OscEnter  ; exec<>&FFFF - enter here
LD C,L:LD B,H          ; exec=&FFFF - use load address
.OscEnter
LD L,C:LD H,B
SCF:EI:JP (HL)         ; Enter code, BC=address, DE=>parameters
;
.MDHdr
DEFB &EF:DEFM "*":DEFB &22:DEFM "m"  ; LOAD*"m
DEFB &22:DEFM ";":DEFB &B0:DEFB &22  ; ";VAL"
DEFM "1":DEFB &22:DEFM ";":DEFB &22  ; 1";"
;
.OscFilename
LD B,10            ; Up to ten characters
.OscNameLp
INC DE:LD A,(HL):CP ASC"!"
JR C,OscNameSpc    ; End with SPC or CR
INC HL:LD (DE),A
DJNZ OscNameLp     ; Loop for up to ten characters
.OscNameSpc
LD A,(HL):INC HL   ; Skip spaces
CP ASC" ":JR Z,OscNameSpc
DEC HL:RET
;
;
; Check for resident system extensions
; ====================================
; NB, unimplemented
;
.CheckRSX
;CP ASC"|"-&CE+256:;JR Z,RSXCommand
.RSXCommand
.UKFunction
RST &08:DEFB &0B:NOP   ; 'Mistake' error
;
;
; End of finished code
; ====================
DEFM "v"+ver$+" ("+vdate$+")":DEFB 0
;
; ROM ends at &3CFF - about 250 bytes left
;
]:NEXT:IFtest%:END
REM Use replacement font
REM NB: This LOAD overwrites all variables, other than mcode% and quit%
OS."Load ^.Fonts.Master    "+STR$~(mcode%+&3D00)
REM OS."Load ^.Fonts.Pound     "+STR$~(mcode%+&3F00)
OS."Load ^.Fonts.Copyright "+STR$~(mcode%+&3FF8)
:
OS."Save JGH/ROM "+STR$~mcode%+"+4000 FFFF0000 FFF70000"
OS."Stamp JGH/ROM"
mcode%?&56C=&DD:mcode%?&56D=&DD
OS."Save JGHSpec "+STR$~mcode%+"+4000 FFFF0000 FFF70000"
OS."Stamp JGHSpec"
IFquit%:*Quit