REM > Harston.Patch/src
REM
REM Patch Spectrum ROM to fix bugs and provide extra features
REM 13-May-1985 JGH: Bug fixes and added features
REM 07-Jun-2003 JGH: Rewritten as source code, put in address order
REM 31-Oct-2003 JGH: Started on *command/RUNs$ from tape
REM 18-Nov-2003 JGH: Tokeniser checks for INKEY$ before INK and IN
REM 30-Aug-2004 JGH: Added Wearmouth DECtoFP bigfix, fixed RUN, "C" channel
REM 17-Sep-2004 JGH: Fixed "C" channel and OPEN, etc, some Wearmouth fixes
REM 25-Sep-2004 JGH: Run from mdrive
REM 27-Sep-2004 JGH: Run from tape is silent
ver$="0.74":vdate$="27-Sep-2004"
:
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:
P_FLAG=&5C91:T_ADDR=&5C74:E_LINE=&5C59:K_CUR=&5C5B:ERR_SP=&5C3D
FLAGS2=&5C6A:FLAGX=&5C71:CH_ADD=&5C5D:X_PTR=&5C5F:WORKSP=&5C61
P_RAMT=&5CB4:UDC=&5C7B:RAMTOP=&5CB2:RASP=&5C38:CHANS=&5C4F
:
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(&0013)
.PRHEX0      :LD D,ASC"0"    ; Print B with leading zero
.PRHEX       :JP PrHexByte   ; Print B with D=lead
OPT FNorg(&0025)
.SCANHEX     :JP ScanHexDE   ; Convert (CHADD) to hex in DE
OPT FNorg(&002B)
.PR2HEX0     :LD D,ASC"0"    ; Print BC with leading zeros
.PR2HEX      :JP PrHexLeading; Print BC with D=lead
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
; 4 spare bytes
;
;
OPT FNorg(&04AA)   ; 24 spare bytes at &04AA-&04C1
.Cat               ; Catalogue from tape
LD A,&02:CALL SYNTAX_Z
CALL NZ,&1601
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
;
;
; 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(&0A17)
DEFB &53           ; Extra CHR$12 routine
;
OPT FNorg(&0A32)   ; Fix CHR$8 bug
LD A,&19
;
OPT FNorg(&0A48)   ; Fix CHR$9 bug
CALL PO_ABLE       ; Print char, then PO_STORE
;
OPT FNorg(&0A69)
RET                ; Unprintable codes ignored
JP &0D6B           ; 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
NOP:NOP:NOP:NOP    ; BIT 1,(FLAGS)
NOP:NOP:NOP        ; JP NZ,COPY_BUFF
;
OPT FNorg(&0AA3)
NOP:NOP:NOP:NOP    ; BIT 1,(FLAGS)
NOP:NOP            ; JR NZ,PO_AT_SET
;
OPT FNorg(&0ADC)   ; PO_STORE
NOP:NOP:NOP:NOP    ; BIT 1,(FLAGS)
NOP:NOP            ; JR NZ,PO_ST_PR
;
OPT FNorg(&0AFC)
.SearchCheck
BIT 5,B:RET Z      ; Return if freely terminatable
LD A,(HL):CP ASC"A"; Check following char
RET                ; C=terminated ok
;
OPT FNorg(&0B03)   ; PO_FETCH
NOP:NOP:NOP:NOP    ; BIT 1,(FLAGS)
NOP: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
;
OPT FNorg(&0CB2)
NOP:CALL WaitKey   ; Fix 'scroll?' bug
NOP
;
OPT FNorg(&0D2B)
LD B,&17           ; Don't scroll into ROM
;
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 &0E:DEFB &0F: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
; =================
.ScanHex           ; Put ScanHex routine here
LD DE,&0000        ; Initialise DE for BIN and hex
CP &C4:SCF:RET Z   ; Ret with BIN, with C set
CP ASC"&":SCF:RET NZ; Ret if not "&"
.ScanHexDE
LD DE,&0000        ; Initialise DE for calling from zeropage
.ScanHexLoop
RST &20            ; NEXT_CHAR
CP ASC"0"  :CCF:RET NC
CP ASC"9"+1:JR C,ScanHexDigit
CP ASC"A"  :CCF:RET NC
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
;
OPT FNorg(&10D3)
.ExecBasic
LD (ERR_SP),SP     ; Set new error pointer
JP &1B8A           ; Execute BASIC line
; 1 spare byte at &10DA
;
OPT FNorg(&10E6)
CP 15              ; Don't go into E mode
;
; Print hexadecimal numbers
; =========================
; BUG-> D=0, BC=0 gives "" instead of "0"
;
OPT FNorg(&10FA)   ; 33 spare bytes at &10FA-&111A
.PrHexLeading      ; BC=value, D=0/48
CALL PrHexByte     ; Print top byte
LD B,C             ; Get bottom byte
.PrHexByte         ; Print byte in B
LD A,B:RRA:RRA:RRA:RRA
CALL PrHexDigit    ; Print top nybble
LD A,B             ; Print bottom nybble
.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
;
;
; 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,&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
LD HL,&5C3B        ; FLAGS
.WaitKeyLp
BIT 5,(HL):JR Z,WaitKeyLp
CALL &0D6E         ; Clear lower screen
.WaitGetKey
RES 5,(HL)         ; Clear keypress
LD A,(&5C08):RET   ; Get keypress
; 1 spare byte at &1554
;
;
; 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(&1631)
DEFB ASC"P":DEFB &31 ; Point to a RET
;
OPT FNorg(&1638)   ; Open channel 'K'
SET 3,(IY+1)       ; Set 'L' mode, also fixes INKEY#0 bug
;
OPT FNorg(&1646)   ; Open channel 'S' or 'K'
JP &0D4D           ; Exit via TEMPS
;
;
; Fix CLOSE# bug and restore #4 to "C" on closing
; ===============================================
.CloseC2
XOR ASC"C"
JP NZ,CloseC3      ; If not "C", return with zero
LD C,21:RET        ; Default entry for #4
; 1 spare byte at &1651
;
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,5             ; First four are short entries
.OpenLp
LD D,H:LD E,L
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
;
;
; Extend Basic to allow more commands
; ===================================
OPT FNorg(&1AAB)
DEFB &05           ; Parameters may follow
DEFW Run           ; RUN/RUN n/RUN s$
;
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
NOP:LD A,&FE
CALL NZ,&1601:NOP  ; Ensure "S" selected
OPT FNorg(&1CC3)
NOP:LD A,&FE
CALL NZ,&1601:NOP  ; Ensure "S" selected
;
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(&2244)
RET:NOP            ; Ignore colour out of range
;
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            ; Replace LD A,&FF
CALL HexOutputStr  ; Replace CALL CHAN_OPEN
CALL &2DE3         ; PRINT_FP
.StrDContinue
;
;
;
; 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 E,3
.CatPrAddrs        ; Print out addresses
LD A,ASC" ":RST &10
LD C,(IX+1):LD B,(IX+2)
CALL PR2HEX0
INC IX:INC IX
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             ; 17 spare bytes here
PUSH IX:LD DE,17
XOR A:SCF:CALL &0556 ; Load 17 bytes
POP IX:JR NC,WaitHdr ; Loop until loaded
RET
;
; Silently search for a tape file
; -------------------------------
.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
;
;
; 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
LD A,B:OR C        ; Bugfix:
LD A,ASC"0":JP Z,&10 ; If BC=0, print "0"
LD D,0:JP PrHexLeading
;
;
; 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
;
;
; Centronics printer text/raw output
; ==================================
.PrinterOut
BIT 1,(IY+1)
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+1)       ; 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
;
;
; Allow #4 to default to "C" on closing
; =====================================
.CheckStream4
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
PUSH HL:LD HL,(CHANS):DEC HL
ADD HL,BC:CALL &18BB ; Get channel char
POP HL:CP ASC"C"   ; Check if channel "C"
LD A,14:RET NZ     ; Not "C", return
LD BC,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
;
;
; 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               ; Causing errors
CALL PR_ST_END     ; End of statement?
JR Z,RunNull
CALL SCANNING
BIT 6,(IY+1)       ; 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:JP 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
LD A,2:CALL &1601  ; 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 200 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
