Skip to content
Permalink
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
4341 lines (4065 sloc) 193 KB
;==================================================================================
; The updates to the original BASIC within this file are copyright Grant Searle
;
; You have permission to use this for NON COMMERCIAL USE ONLY
; If you wish to use it elsewhere, please include an acknowledgement to myself.
;
; http://searle.hostei.com/grant/index.html
;
; eMail: home.micros01@btinternet.com
;
; If the above don't work, please perform an Internet search to see if I have
; updated the web page hosting service.
;
;==================================================================================
; NASCOM ROM BASIC Ver 4.7, (C) 1978 Microsoft
; Scanned from source published in 80-BUS NEWS from Vol 2, Issue 3
; (May-June 1983) to Vol 3, Issue 3 (May-June 1984)
; Adapted for the freeware Zilog Macro Assembler 2.10 to produce
; the original ROM code (checksum A934H). PA
; GENERAL EQUATES
CTRLC .EQU 03H ; Control "C"
CTRLG .EQU 07H ; Control "G"
BKSP .EQU 08H ; Back space
LF .EQU 0AH ; Line feed
CS .EQU 0CH ; Clear screen
CR .EQU 0DH ; Carriage return
CTRLO .EQU 0FH ; Control "O"
CTRLQ .EQU 11H ; Control "Q"
CTRLR .EQU 12H ; Control "R"
CTRLS .EQU 13H ; Control "S"
CTRLU .EQU 15H ; Control "U"
ESC .EQU 1BH ; Escape
DEL .EQU 7FH ; Delete
; BASIC WORK SPACE LOCATIONS
WRKSPC .EQU 8220H ; <<<< BASIC Work space ** Rx buffer & Tx buffer located from 8100H **
USR .EQU WRKSPC+3H ; "USR (x)" jump
OUTSUB .EQU WRKSPC+6H ; "OUT p,n"
OTPORT .EQU WRKSPC+7H ; Port (p)
DIVSUP .EQU WRKSPC+9H ; Division support routine
DIV1 .EQU WRKSPC+0AH ; <- Values
DIV2 .EQU WRKSPC+0EH ; <- to
DIV3 .EQU WRKSPC+12H ; <- be
DIV4 .EQU WRKSPC+15H ; <-inserted
SEED .EQU WRKSPC+17H ; Random number seed
LSTRND .EQU WRKSPC+3AH ; Last random number
INPSUB .EQU WRKSPC+3EH ; #INP (x)" Routine
INPORT .EQU WRKSPC+3FH ; PORT (x)
NULLS .EQU WRKSPC+41H ; Number of nulls
LWIDTH .EQU WRKSPC+42H ; Terminal width
COMMAN .EQU WRKSPC+43H ; Width for commas
NULFLG .EQU WRKSPC+44H ; Null after input byte flag
CTLOFG .EQU WRKSPC+45H ; Control "O" flag
LINESC .EQU WRKSPC+46H ; Lines counter
LINESN .EQU WRKSPC+48H ; Lines number
CHKSUM .EQU WRKSPC+4AH ; Array load/save check sum
NMIFLG .EQU WRKSPC+4CH ; Flag for NMI break routine
BRKFLG .EQU WRKSPC+4DH ; Break flag
RINPUT .EQU WRKSPC+4EH ; Input reflection
POINT .EQU WRKSPC+51H ; "POINT" reflection (unused)
PSET .EQU WRKSPC+54H ; "SET" reflection
RESET .EQU WRKSPC+57H ; "RESET" reflection
STRSPC .EQU WRKSPC+5AH ; Bottom of string space
LINEAT .EQU WRKSPC+5CH ; Current line number
BASTXT .EQU WRKSPC+5EH ; Pointer to start of program
BUFFER .EQU WRKSPC+61H ; Input buffer
STACK .EQU WRKSPC+66H ; Initial stack
CURPOS .EQU WRKSPC+0ABH ; <<<< Character position on line ** Top of TEMPSTACK **
LCRFLG .EQU WRKSPC+0ACH ; Locate/Create flag
TYPE .EQU WRKSPC+0ADH ; Data type flag
DATFLG .EQU WRKSPC+0AEH ; Literal statement flag
LSTRAM .EQU WRKSPC+0AFH ; Last available RAM
TMSTPT .EQU WRKSPC+0B1H ; Temporary string pointer
TMSTPL .EQU WRKSPC+0B3H ; Temporary string pool
TMPSTR .EQU WRKSPC+0BFH ; Temporary string
STRBOT .EQU WRKSPC+0C3H ; Bottom of string space
CUROPR .EQU WRKSPC+0C5H ; Current operator in EVAL
LOOPST .EQU WRKSPC+0C7H ; First statement of loop
DATLIN .EQU WRKSPC+0C9H ; Line of current DATA item
FORFLG .EQU WRKSPC+0CBH ; "FOR" loop flag
LSTBIN .EQU WRKSPC+0CCH ; Last byte entered
READFG .EQU WRKSPC+0CDH ; Read/Input flag
BRKLIN .EQU WRKSPC+0CEH ; Line of break
NXTOPR .EQU WRKSPC+0D0H ; Next operator in EVAL
ERRLIN .EQU WRKSPC+0D2H ; Line of error
CONTAD .EQU WRKSPC+0D4H ; Where to CONTinue
PROGND .EQU WRKSPC+0D6H ; End of program
VAREND .EQU WRKSPC+0D8H ; End of variables
ARREND .EQU WRKSPC+0DAH ; End of arrays
NXTDAT .EQU WRKSPC+0DCH ; Next data item
FNRGNM .EQU WRKSPC+0DEH ; Name of FN argument
FNARG .EQU WRKSPC+0E0H ; FN argument value
FPREG .EQU WRKSPC+0E4H ; Floating point register
FPEXP .EQU FPREG+3 ; Floating point exponent
SGNRES .EQU WRKSPC+0E8H ; Sign of result
PBUFF .EQU WRKSPC+0E9H ; Number print buffer
MULVAL .EQU WRKSPC+0F6H ; Multiplier
PROGST .EQU WRKSPC+0F9H ; Start of program text area
STLOOK .EQU WRKSPC+15DH ; Start of memory test
; BASIC ERROR CODE VALUES
NF .EQU 00H ; NEXT without FOR
SN .EQU 02H ; Syntax error
RG .EQU 04H ; RETURN without GOSUB
OD .EQU 06H ; Out of DATA
FC .EQU 08H ; Function call error
OV .EQU 0AH ; Overflow
OM .EQU 0CH ; Out of memory
UL .EQU 0EH ; Undefined line number
BS .EQU 10H ; Bad subscript
DD .EQU 12H ; Re-DIMensioned array
DZ .EQU 14H ; Division by zero (/0)
ID .EQU 16H ; Illegal direct
TM .EQU 18H ; Type miss-match
OS .EQU 1AH ; Out of string space
LS .EQU 1CH ; String too long
ST .EQU 1EH ; String formula too complex
CN .EQU 20H ; Can't CONTinue
UF .EQU 22H ; UnDEFined FN function
MO .EQU 24H ; Missing operand
HX .EQU 26H ; HEX error
BN .EQU 28H ; BIN error
.ORG 0390H ; <<<< Modified to allow for Z80 Tx/Rx interrupt & HexLoadr
COLD: JP STARTB ; Jump in for cold start (0390H)
WARM: JP WARMST ; Jump in for warm start (0393H)
STARTB:
LD IX,0 ; Flag cold start
JP CSTART ; Jump to initialise
.WORD DEINT ; Get integer -32768 to 32767
.WORD ABPASS ; Return integer in AB
CSTART: LD HL,WRKSPC ; Start of workspace RAM
LD SP,HL ; Set up a temporary stack
JP INITST ; Go to initialise
INIT: LD DE,INITAB ; Initialise workspace
LD B,INITBE-INITAB+3; Bytes to copy
LD HL,WRKSPC ; Into workspace RAM
COPY: LD A,(DE) ; Get source
LD (HL),A ; To destination
INC HL ; Next destination
INC DE ; Next source
DEC B ; Count bytes
JP NZ,COPY ; More to move
LD SP,HL ; Temporary stack
CALL CLREG ; Clear registers and stack
CALL PRNTCRLF ; Output CRLF
LD (BUFFER+72+1),A ; Mark end of buffer
LD (PROGST),A ; Initialise program area
MSIZE: LD HL,MEMMSG ; Point to message
CALL PRS ; Output "Memory size"
CALL PROMPT ; Get input with '?'
CALL GETCHR ; Get next character
OR A ; Set flags
JP NZ,TSTMEM ; If number - Test if RAM there
LD HL,STLOOK ; Point to start of RAM
MLOOP: INC HL ; Next byte
LD A,H ; Above address FFFF ?
OR L
JP Z,SETTOP ; Yes - 64K RAM
LD A,(HL) ; Get contents
LD B,A ; Save it
CPL ; Flip all bits
LD (HL),A ; Put it back
CP (HL) ; RAM there if same
LD (HL),B ; Restore old contents
JP Z,MLOOP ; If RAM - test next byte
JP SETTOP ; Top of RAM found
TSTMEM: CALL ATOH ; Get high memory into DE
OR A ; Set flags on last byte
JP NZ,SNERR ; ?SN Error if bad character
EX DE,HL ; Address into HL
DEC HL ; Back one byte
LD A,11011001B ; Test byte
LD B,(HL) ; Get old contents
LD (HL),A ; Load test byte
CP (HL) ; RAM there if same
LD (HL),B ; Restore old contents
JP NZ,MSIZE ; Ask again if no RAM
SETTOP: DEC HL ; Back one byte
LD DE,STLOOK-1 ; See if enough RAM
CALL CPDEHL ; Compare DE with HL
JP C,MSIZE ; Ask again if not enough RAM
LD DE,0-50 ; 50 Bytes string space
LD (LSTRAM),HL ; Save last available RAM
ADD HL,DE ; Allocate string space
LD (STRSPC),HL ; Save string space
CALL CLRPTR ; Clear program area
LD HL,(STRSPC) ; Get end of memory
LD DE,0-17 ; Offset for free bytes
ADD HL,DE ; Adjust HL
LD DE,PROGST ; Start of program text
LD A,L ; Get LSB
SUB E ; Adjust it
LD L,A ; Re-save
LD A,H ; Get MSB
SBC A,D ; Adjust it
LD H,A ; Re-save
PUSH HL ; Save bytes free
LD HL,SIGNON ; Sign-on message
CALL PRS ; Output string
POP HL ; Get bytes free back
CALL PRNTHL ; Output amount of free memory
LD HL,BFREE ; " Bytes free" message
CALL PRS ; Output string
WARMST: LD SP,STACK ; Temporary stack
BRKRET: CALL CLREG ; Clear registers and stack
JP PRNTOK ; Go to get command line
BFREE: .BYTE " Bytes free",CR,LF,0,0
SIGNON: .BYTE "Z80 BASIC Ver 4.7b",CR,LF
.BYTE "Copyright ",40,"C",41
.BYTE " 1978 by Microsoft",CR,LF,0,0
MEMMSG: .BYTE "Memory top",0
; FUNCTION ADDRESS TABLE
FNCTAB: .WORD SGN
.WORD INT
.WORD ABS
.WORD USR
.WORD FRE
.WORD INP
.WORD POS
.WORD SQR
.WORD RND
.WORD LOG
.WORD EXP
.WORD COS
.WORD SIN
.WORD TAN
.WORD ATN
.WORD PEEK
.WORD DEEK
.WORD POINT
.WORD LEN
.WORD STR
.WORD VAL
.WORD ASC
.WORD CHR
.WORD HEX
.WORD BIN
.WORD LEFT
.WORD RIGHT
.WORD MID
; RESERVED WORD LIST
WORDS: .BYTE 'E'+80H,"ND"
.BYTE 'F'+80H,"OR"
.BYTE 'N'+80H,"EXT"
.BYTE 'D'+80H,"ATA"
.BYTE 'I'+80H,"NPUT"
.BYTE 'D'+80H,"IM"
.BYTE 'R'+80H,"EAD"
.BYTE 'L'+80H,"ET"
.BYTE 'G'+80H,"OTO"
.BYTE 'R'+80H,"UN"
.BYTE 'I'+80H,"F"
.BYTE 'R'+80H,"ESTORE"
.BYTE 'G'+80H,"OSUB"
.BYTE 'R'+80H,"ETURN"
.BYTE 'R'+80H,"EM"
.BYTE 'S'+80H,"TOP"
.BYTE 'O'+80H,"UT"
.BYTE 'O'+80H,"N"
.BYTE 'N'+80H,"ULL"
.BYTE 'W'+80H,"AIT"
.BYTE 'D'+80H,"EF"
.BYTE 'P'+80H,"OKE"
.BYTE 'D'+80H,"OKE"
.BYTE 'S'+80H,"CREEN"
.BYTE 'L'+80H,"INES"
.BYTE 'C'+80H,"LS"
.BYTE 'W'+80H,"IDTH"
.BYTE 'M'+80H,"ONITOR"
.BYTE 'S'+80H,"ET"
.BYTE 'R'+80H,"ESET"
.BYTE 'P'+80H,"RINT"
.BYTE 'C'+80H,"ONT"
.BYTE 'L'+80H,"IST"
.BYTE 'C'+80H,"LEAR"
.BYTE 'C'+80H,"LOAD"
.BYTE 'C'+80H,"SAVE"
.BYTE 'N'+80H,"EW"
.BYTE 'T'+80H,"AB("
.BYTE 'T'+80H,"O"
.BYTE 'F'+80H,"N"
.BYTE 'S'+80H,"PC("
.BYTE 'T'+80H,"HEN"
.BYTE 'N'+80H,"OT"
.BYTE 'S'+80H,"TEP"
.BYTE '+'+80H
.BYTE '-'+80H
.BYTE '*'+80H
.BYTE '/'+80H
.BYTE '^'+80H
.BYTE 'A'+80H,"ND"
.BYTE 'O'+80H,"R"
.BYTE '>'+80H
.BYTE '='+80H
.BYTE '<'+80H
.BYTE 'S'+80H,"GN"
.BYTE 'I'+80H,"NT"
.BYTE 'A'+80H,"BS"
.BYTE 'U'+80H,"SR"
.BYTE 'F'+80H,"RE"
.BYTE 'I'+80H,"NP"
.BYTE 'P'+80H,"OS"
.BYTE 'S'+80H,"QR"
.BYTE 'R'+80H,"ND"
.BYTE 'L'+80H,"OG"
.BYTE 'E'+80H,"XP"
.BYTE 'C'+80H,"OS"
.BYTE 'S'+80H,"IN"
.BYTE 'T'+80H,"AN"
.BYTE 'A'+80H,"TN"
.BYTE 'P'+80H,"EEK"
.BYTE 'D'+80H,"EEK"
.BYTE 'P'+80H,"OINT"
.BYTE 'L'+80H,"EN"
.BYTE 'S'+80H,"TR$"
.BYTE 'V'+80H,"AL"
.BYTE 'A'+80H,"SC"
.BYTE 'C'+80H,"HR$"
.BYTE 'H'+80H,"EX$"
.BYTE 'B'+80H,"IN$"
.BYTE 'L'+80H,"EFT$"
.BYTE 'R'+80H,"IGHT$"
.BYTE 'M'+80H,"ID$"
.BYTE 80H ; End of list marker
; KEYWORD ADDRESS TABLE
WORDTB: .WORD PEND
.WORD FOR
.WORD NEXT
.WORD DATA
.WORD INPUT
.WORD DIM
.WORD READ
.WORD LET
.WORD GOTO
.WORD RUN
.WORD IF
.WORD RESTOR
.WORD GOSUB
.WORD RETURN
.WORD REM
.WORD STOP
.WORD POUT
.WORD ON
.WORD NULL
.WORD WAIT
.WORD DEF
.WORD POKE
.WORD DOKE
.WORD REM
.WORD LINES
.WORD CLS
.WORD WIDTH
.WORD MONITR
.WORD PSET
.WORD RESET
.WORD PRINT
.WORD CONT
.WORD LIST
.WORD CLEAR
.WORD REM
.WORD REM
.WORD NEW
; RESERVED WORD TOKEN VALUES
ZEND .EQU 080H ; END
ZFOR .EQU 081H ; FOR
ZDATA .EQU 083H ; DATA
ZGOTO .EQU 088H ; GOTO
ZGOSUB .EQU 08CH ; GOSUB
ZREM .EQU 08EH ; REM
ZPRINT .EQU 09EH ; PRINT
ZNEW .EQU 0A4H ; NEW
ZTAB .EQU 0A5H ; TAB
ZTO .EQU 0A6H ; TO
ZFN .EQU 0A7H ; FN
ZSPC .EQU 0A8H ; SPC
ZTHEN .EQU 0A9H ; THEN
ZNOT .EQU 0AAH ; NOT
ZSTEP .EQU 0ABH ; STEP
ZPLUS .EQU 0ACH ; +
ZMINUS .EQU 0ADH ; -
ZTIMES .EQU 0AEH ; *
ZDIV .EQU 0AFH ; /
ZOR .EQU 0B2H ; OR
ZGTR .EQU 0B3H ; >
ZEQUAL .EQU 0B4H ; M
ZLTH .EQU 0B5H ; <
ZSGN .EQU 0B6H ; SGN
ZPOINT .EQU 0C7H ; POINT
ZLEFT .EQU 0CDH +2 ; LEFT$
; ARITHMETIC PRECEDENCE TABLE
PRITAB: .BYTE 79H ; Precedence value
.WORD PADD ; FPREG = <last> + FPREG
.BYTE 79H ; Precedence value
.WORD PSUB ; FPREG = <last> - FPREG
.BYTE 7CH ; Precedence value
.WORD MULT ; PPREG = <last> * FPREG
.BYTE 7CH ; Precedence value
.WORD DIV ; FPREG = <last> / FPREG
.BYTE 7FH ; Precedence value
.WORD POWER ; FPREG = <last> ^ FPREG
.BYTE 50H ; Precedence value
.WORD PAND ; FPREG = <last> AND FPREG
.BYTE 46H ; Precedence value
.WORD POR ; FPREG = <last> OR FPREG
; BASIC ERROR CODE LIST
ERRORS: .BYTE "NF" ; NEXT without FOR
.BYTE "SN" ; Syntax error
.BYTE "RG" ; RETURN without GOSUB
.BYTE "OD" ; Out of DATA
.BYTE "FC" ; Illegal function call
.BYTE "OV" ; Overflow error
.BYTE "OM" ; Out of memory
.BYTE "UL" ; Undefined line
.BYTE "BS" ; Bad subscript
.BYTE "DD" ; Re-DIMensioned array
.BYTE "/0" ; Division by zero
.BYTE "ID" ; Illegal direct
.BYTE "TM" ; Type mis-match
.BYTE "OS" ; Out of string space
.BYTE "LS" ; String too long
.BYTE "ST" ; String formula too complex
.BYTE "CN" ; Can't CONTinue
.BYTE "UF" ; Undefined FN function
.BYTE "MO" ; Missing operand
.BYTE "HX" ; HEX error
.BYTE "BN" ; BIN error
; INITIALISATION TABLE -------------------------------------------------------
INITAB: JP WARMST ; Warm start jump
JP FCERR ; "USR (X)" jump (Set to Error)
OUT (0),A ; "OUT p,n" skeleton
RET
SUB 0 ; Division support routine
LD L,A
LD A,H
SBC A,0
LD H,A
LD A,B
SBC A,0
LD B,A
LD A,0
RET
.BYTE 0,0,0 ; Random number seed table used by RND
.BYTE 035H,04AH,0CAH,099H ;-2.65145E+07
.BYTE 039H,01CH,076H,098H ; 1.61291E+07
.BYTE 022H,095H,0B3H,098H ;-1.17691E+07
.BYTE 00AH,0DDH,047H,098H ; 1.30983E+07
.BYTE 053H,0D1H,099H,099H ;-2-01612E+07
.BYTE 00AH,01AH,09FH,098H ;-1.04269E+07
.BYTE 065H,0BCH,0CDH,098H ;-1.34831E+07
.BYTE 0D6H,077H,03EH,098H ; 1.24825E+07
.BYTE 052H,0C7H,04FH,080H ; Last random number
IN A,(0) ; INP (x) skeleton
RET
.BYTE 1 ; POS (x) number (1)
.BYTE 255 ; Terminal width (255 = no auto CRLF)
.BYTE 28 ; Width for commas (3 columns)
.BYTE 0 ; No nulls after input bytes
.BYTE 0 ; Output enabled (^O off)
.WORD 20 ; Initial lines counter
.WORD 20 ; Initial lines number
.WORD 0 ; Array load/save check sum
.BYTE 0 ; Break not by NMI
.BYTE 0 ; Break flag
JP TTYLIN ; Input reflection (set to TTY)
JP $0000 ; POINT reflection unused
JP $0000 ; SET reflection
JP $0000 ; RESET reflection
.WORD STLOOK ; Temp string space
.WORD -2 ; Current line number (cold)
.WORD PROGST+1 ; Start of program text
INITBE:
; END OF INITIALISATION TABLE ---------------------------------------------------
ERRMSG: .BYTE " Error",0
INMSG: .BYTE " in ",0
ZERBYT .EQU $-1 ; A zero byte
OKMSG: .BYTE "Ok",CR,LF,0,0
BRKMSG: .BYTE "Break",0
BAKSTK: LD HL,4 ; Look for "FOR" block with
ADD HL,SP ; same index as specified
LOKFOR: LD A,(HL) ; Get block ID
INC HL ; Point to index address
CP ZFOR ; Is it a "FOR" token
RET NZ ; No - exit
LD C,(HL) ; BC = Address of "FOR" index
INC HL
LD B,(HL)
INC HL ; Point to sign of STEP
PUSH HL ; Save pointer to sign
LD L,C ; HL = address of "FOR" index
LD H,B
LD A,D ; See if an index was specified
OR E ; DE = 0 if no index specified
EX DE,HL ; Specified index into HL
JP Z,INDFND ; Skip if no index given
EX DE,HL ; Index back into DE
CALL CPDEHL ; Compare index with one given
INDFND: LD BC,16-3 ; Offset to next block
POP HL ; Restore pointer to sign
RET Z ; Return if block found
ADD HL,BC ; Point to next block
JP LOKFOR ; Keep on looking
MOVUP: CALL ENFMEM ; See if enough memory
MOVSTR: PUSH BC ; Save end of source
EX (SP),HL ; Swap source and dest" end
POP BC ; Get end of destination
MOVLP: CALL CPDEHL ; See if list moved
LD A,(HL) ; Get byte
LD (BC),A ; Move it
RET Z ; Exit if all done
DEC BC ; Next byte to move to
DEC HL ; Next byte to move
JP MOVLP ; Loop until all bytes moved
CHKSTK: PUSH HL ; Save code string address
LD HL,(ARREND) ; Lowest free memory
LD B,0 ; BC = Number of levels to test
ADD HL,BC ; 2 Bytes for each level
ADD HL,BC
.BYTE 3EH ; Skip "PUSH HL"
ENFMEM: PUSH HL ; Save code string address
LD A,0D0H ;LOW -48 ; 48 Bytes minimum RAM
SUB L
LD L,A
LD A,0FFH; HIGH (-48) ; 48 Bytes minimum RAM
SBC A,H
JP C,OMERR ; Not enough - ?OM Error
LD H,A
ADD HL,SP ; Test if stack is overflowed
POP HL ; Restore code string address
RET C ; Return if enough mmory
OMERR: LD E,OM ; ?OM Error
JP ERROR
DATSNR: LD HL,(DATLIN) ; Get line of current DATA item
LD (LINEAT),HL ; Save as current line
SNERR: LD E,SN ; ?SN Error
.BYTE 01H ; Skip "LD E,DZ"
DZERR: LD E,DZ ; ?/0 Error
.BYTE 01H ; Skip "LD E,NF"
NFERR: LD E,NF ; ?NF Error
.BYTE 01H ; Skip "LD E,DD"
DDERR: LD E,DD ; ?DD Error
.BYTE 01H ; Skip "LD E,UF"
UFERR: LD E,UF ; ?UF Error
.BYTE 01H ; Skip "LD E,OV
OVERR: LD E,OV ; ?OV Error
.BYTE 01H ; Skip "LD E,TM"
TMERR: LD E,TM ; ?TM Error
ERROR: CALL CLREG ; Clear registers and stack
LD (CTLOFG),A ; Enable output (A is 0)
CALL STTLIN ; Start new line
LD HL,ERRORS ; Point to error codes
LD D,A ; D = 0 (A is 0)
LD A,'?'
CALL OUTC ; Output '?'
ADD HL,DE ; Offset to correct error code
LD A,(HL) ; First character
CALL OUTC ; Output it
CALL GETCHR ; Get next character
CALL OUTC ; Output it
LD HL,ERRMSG ; "Error" message
ERRIN: CALL PRS ; Output message
LD HL,(LINEAT) ; Get line of error
LD DE,-2 ; Cold start error if -2
CALL CPDEHL ; See if cold start error
JP Z,CSTART ; Cold start error - Restart
LD A,H ; Was it a direct error?
AND L ; Line = -1 if direct error
INC A
CALL NZ,LINEIN ; No - output line of error
.BYTE 3EH ; Skip "POP BC"
POPNOK: POP BC ; Drop address in input buffer
PRNTOK: XOR A ; Output "Ok" and get command
LD (CTLOFG),A ; Enable output
CALL STTLIN ; Start new line
LD HL,OKMSG ; "Ok" message
CALL PRS ; Output "Ok"
GETCMD: LD HL,-1 ; Flag direct mode
LD (LINEAT),HL ; Save as current line
CALL GETLIN ; Get an input line
JP C,GETCMD ; Get line again if break
CALL GETCHR ; Get first character
INC A ; Test if end of line
DEC A ; Without affecting Carry
JP Z,GETCMD ; Nothing entered - Get another
PUSH AF ; Save Carry status
CALL ATOH ; Get line number into DE
PUSH DE ; Save line number
CALL CRUNCH ; Tokenise rest of line
LD B,A ; Length of tokenised line
POP DE ; Restore line number
POP AF ; Restore Carry
JP NC,EXCUTE ; No line number - Direct mode
PUSH DE ; Save line number
PUSH BC ; Save length of tokenised line
XOR A
LD (LSTBIN),A ; Clear last byte input
CALL GETCHR ; Get next character
OR A ; Set flags
PUSH AF ; And save them
CALL SRCHLN ; Search for line number in DE
JP C,LINFND ; Jump if line found
POP AF ; Get status
PUSH AF ; And re-save
JP Z,ULERR ; Nothing after number - Error
OR A ; Clear Carry
LINFND: PUSH BC ; Save address of line in prog
JP NC,INEWLN ; Line not found - Insert new
EX DE,HL ; Next line address in DE
LD HL,(PROGND) ; End of program
SFTPRG: LD A,(DE) ; Shift rest of program down
LD (BC),A
INC BC ; Next destination
INC DE ; Next source
CALL CPDEHL ; All done?
JP NZ,SFTPRG ; More to do
LD H,B ; HL - New end of program
LD L,C
LD (PROGND),HL ; Update end of program
INEWLN: POP DE ; Get address of line,
POP AF ; Get status
JP Z,SETPTR ; No text - Set up pointers
LD HL,(PROGND) ; Get end of program
EX (SP),HL ; Get length of input line
POP BC ; End of program to BC
ADD HL,BC ; Find new end
PUSH HL ; Save new end
CALL MOVUP ; Make space for line
POP HL ; Restore new end
LD (PROGND),HL ; Update end of program pointer
EX DE,HL ; Get line to move up in HL
LD (HL),H ; Save MSB
POP DE ; Get new line number
INC HL ; Skip pointer
INC HL
LD (HL),E ; Save LSB of line number
INC HL
LD (HL),D ; Save MSB of line number
INC HL ; To first byte in line
LD DE,BUFFER ; Copy buffer to program
MOVBUF: LD A,(DE) ; Get source
LD (HL),A ; Save destinations
INC HL ; Next source
INC DE ; Next destination
OR A ; Done?
JP NZ,MOVBUF ; No - Repeat
SETPTR: CALL RUNFST ; Set line pointers
INC HL ; To LSB of pointer
EX DE,HL ; Address to DE
PTRLP: LD H,D ; Address to HL
LD L,E
LD A,(HL) ; Get LSB of pointer
INC HL ; To MSB of pointer
OR (HL) ; Compare with MSB pointer
JP Z,GETCMD ; Get command line if end
INC HL ; To LSB of line number
INC HL ; Skip line number
INC HL ; Point to first byte in line
XOR A ; Looking for 00 byte
FNDEND: CP (HL) ; Found end of line?
INC HL ; Move to next byte
JP NZ,FNDEND ; No - Keep looking
EX DE,HL ; Next line address to HL
LD (HL),E ; Save LSB of pointer
INC HL
LD (HL),D ; Save MSB of pointer
JP PTRLP ; Do next line
SRCHLN: LD HL,(BASTXT) ; Start of program text
SRCHLP: LD B,H ; BC = Address to look at
LD C,L
LD A,(HL) ; Get address of next line
INC HL
OR (HL) ; End of program found?
DEC HL
RET Z ; Yes - Line not found
INC HL
INC HL
LD A,(HL) ; Get LSB of line number
INC HL
LD H,(HL) ; Get MSB of line number
LD L,A
CALL CPDEHL ; Compare with line in DE
LD H,B ; HL = Start of this line
LD L,C
LD A,(HL) ; Get LSB of next line address
INC HL
LD H,(HL) ; Get MSB of next line address
LD L,A ; Next line to HL
CCF
RET Z ; Lines found - Exit
CCF
RET NC ; Line not found,at line after
JP SRCHLP ; Keep looking
NEW: RET NZ ; Return if any more on line
CLRPTR: LD HL,(BASTXT) ; Point to start of program
XOR A ; Set program area to empty
LD (HL),A ; Save LSB = 00
INC HL
LD (HL),A ; Save MSB = 00
INC HL
LD (PROGND),HL ; Set program end
RUNFST: LD HL,(BASTXT) ; Clear all variables
DEC HL
INTVAR: LD (BRKLIN),HL ; Initialise RUN variables
LD HL,(LSTRAM) ; Get end of RAM
LD (STRBOT),HL ; Clear string space
XOR A
CALL RESTOR ; Reset DATA pointers
LD HL,(PROGND) ; Get end of program
LD (VAREND),HL ; Clear variables
LD (ARREND),HL ; Clear arrays
CLREG: POP BC ; Save return address
LD HL,(STRSPC) ; Get end of working RAN
LD SP,HL ; Set stack
LD HL,TMSTPL ; Temporary string pool
LD (TMSTPT),HL ; Reset temporary string ptr
XOR A ; A = 00
LD L,A ; HL = 0000
LD H,A
LD (CONTAD),HL ; No CONTinue
LD (FORFLG),A ; Clear FOR flag
LD (FNRGNM),HL ; Clear FN argument
PUSH HL ; HL = 0000
PUSH BC ; Put back return
DOAGN: LD HL,(BRKLIN) ; Get address of code to RUN
RET ; Return to execution driver
PROMPT: LD A,'?' ; '?'
CALL OUTC ; Output character
LD A,' ' ; Space
CALL OUTC ; Output character
JP RINPUT ; Get input line
CRUNCH: XOR A ; Tokenise line @ HL to BUFFER
LD (DATFLG),A ; Reset literal flag
LD C,2+3 ; 2 byte number and 3 nulls
LD DE,BUFFER ; Start of input buffer
CRNCLP: LD A,(HL) ; Get byte
CP ' ' ; Is it a space?
JP Z,MOVDIR ; Yes - Copy direct
LD B,A ; Save character
CP '"' ; Is it a quote?
JP Z,CPYLIT ; Yes - Copy literal string
OR A ; Is it end of buffer?
JP Z,ENDBUF ; Yes - End buffer
LD A,(DATFLG) ; Get data type
OR A ; Literal?
LD A,(HL) ; Get byte to copy
JP NZ,MOVDIR ; Literal - Copy direct
CP '?' ; Is it '?' short for PRINT
LD A,ZPRINT ; "PRINT" token
JP Z,MOVDIR ; Yes - replace it
LD A,(HL) ; Get byte again
CP '0' ; Is it less than '0'
JP C,FNDWRD ; Yes - Look for reserved words
CP 60; ";"+1 ; Is it "0123456789:;" ?
JP C,MOVDIR ; Yes - copy it direct
FNDWRD: PUSH DE ; Look for reserved words
LD DE,WORDS-1 ; Point to table
PUSH BC ; Save count
LD BC,RETNAD ; Where to return to
PUSH BC ; Save return address
LD B,ZEND-1 ; First token value -1
LD A,(HL) ; Get byte
CP 'a' ; Less than 'a' ?
JP C,SEARCH ; Yes - search for words
CP 'z'+1 ; Greater than 'z' ?
JP NC,SEARCH ; Yes - search for words
AND 01011111B ; Force upper case
LD (HL),A ; Replace byte
SEARCH: LD C,(HL) ; Search for a word
EX DE,HL
GETNXT: INC HL ; Get next reserved word
OR (HL) ; Start of word?
JP P,GETNXT ; No - move on
INC B ; Increment token value
LD A, (HL) ; Get byte from table
AND 01111111B ; Strip bit 7
RET Z ; Return if end of list
CP C ; Same character as in buffer?
JP NZ,GETNXT ; No - get next word
EX DE,HL
PUSH HL ; Save start of word
NXTBYT: INC DE ; Look through rest of word
LD A,(DE) ; Get byte from table
OR A ; End of word ?
JP M,MATCH ; Yes - Match found
LD C,A ; Save it
LD A,B ; Get token value
CP ZGOTO ; Is it "GOTO" token ?
JP NZ,NOSPC ; No - Don't allow spaces
CALL GETCHR ; Get next character
DEC HL ; Cancel increment from GETCHR
NOSPC: INC HL ; Next byte
LD A,(HL) ; Get byte
CP 'a' ; Less than 'a' ?
JP C,NOCHNG ; Yes - don't change
AND 01011111B ; Make upper case
NOCHNG: CP C ; Same as in buffer ?
JP Z,NXTBYT ; Yes - keep testing
POP HL ; Get back start of word
JP SEARCH ; Look at next word
MATCH: LD C,B ; Word found - Save token value
POP AF ; Throw away return
EX DE,HL
RET ; Return to "RETNAD"
RETNAD: EX DE,HL ; Get address in string
LD A,C ; Get token value
POP BC ; Restore buffer length
POP DE ; Get destination address
MOVDIR: INC HL ; Next source in buffer
LD (DE),A ; Put byte in buffer
INC DE ; Move up buffer
INC C ; Increment length of buffer
SUB ':' ; End of statement?
JP Z,SETLIT ; Jump if multi-statement line
CP ZDATA-3AH ; Is it DATA statement ?
JP NZ,TSTREM ; No - see if REM
SETLIT: LD (DATFLG),A ; Set literal flag
TSTREM: SUB ZREM-3AH ; Is it REM?
JP NZ,CRNCLP ; No - Leave flag
LD B,A ; Copy rest of buffer
NXTCHR: LD A,(HL) ; Get byte
OR A ; End of line ?
JP Z,ENDBUF ; Yes - Terminate buffer
CP B ; End of statement ?
JP Z,MOVDIR ; Yes - Get next one
CPYLIT: INC HL ; Move up source string
LD (DE),A ; Save in destination
INC C ; Increment length
INC DE ; Move up destination
JP NXTCHR ; Repeat
ENDBUF: LD HL,BUFFER-1 ; Point to start of buffer
LD (DE),A ; Mark end of buffer (A = 00)
INC DE
LD (DE),A ; A = 00
INC DE
LD (DE),A ; A = 00
RET
DODEL: LD A,(NULFLG) ; Get null flag status
OR A ; Is it zero?
LD A,0 ; Zero A - Leave flags
LD (NULFLG),A ; Zero null flag
JP NZ,ECHDEL ; Set - Echo it
DEC B ; Decrement length
JP Z,GETLIN ; Get line again if empty
CALL OUTC ; Output null character
.BYTE 3EH ; Skip "DEC B"
ECHDEL: DEC B ; Count bytes in buffer
DEC HL ; Back space buffer
JP Z,OTKLN ; No buffer - Try again
LD A,(HL) ; Get deleted byte
CALL OUTC ; Echo it
JP MORINP ; Get more input
DELCHR: DEC B ; Count bytes in buffer
DEC HL ; Back space buffer
CALL OUTC ; Output character in A
JP NZ,MORINP ; Not end - Get more
OTKLN: CALL OUTC ; Output character in A
KILIN: CALL PRNTCRLF ; Output CRLF
JP TTYLIN ; Get line again
GETLIN:
TTYLIN: LD HL,BUFFER ; Get a line by character
LD B,1 ; Set buffer as empty
XOR A
LD (NULFLG),A ; Clear null flag
MORINP: CALL CLOTST ; Get character and test ^O
LD C,A ; Save character in C
CP DEL ; Delete character?
JP Z,DODEL ; Yes - Process it
LD A,(NULFLG) ; Get null flag
OR A ; Test null flag status
JP Z,PROCES ; Reset - Process character
LD A,0 ; Set a null
CALL OUTC ; Output null
XOR A ; Clear A
LD (NULFLG),A ; Reset null flag
PROCES: LD A,C ; Get character
CP CTRLG ; Bell?
JP Z,PUTCTL ; Yes - Save it
CP CTRLC ; Is it control "C"?
CALL Z,PRNTCRLF ; Yes - Output CRLF
SCF ; Flag break
RET Z ; Return if control "C"
CP CR ; Is it enter?
JP Z,ENDINP ; Yes - Terminate input
CP CTRLU ; Is it control "U"?
JP Z,KILIN ; Yes - Get another line
CP '@' ; Is it "kill line"?
JP Z,OTKLN ; Yes - Kill line
CP '_' ; Is it delete?
JP Z,DELCHR ; Yes - Delete character
CP BKSP ; Is it backspace?
JP Z,DELCHR ; Yes - Delete character
CP CTRLR ; Is it control "R"?
JP NZ,PUTBUF ; No - Put in buffer
PUSH BC ; Save buffer length
PUSH DE ; Save DE
PUSH HL ; Save buffer address
LD (HL),0 ; Mark end of buffer
CALL OUTNCR ; Output and do CRLF
LD HL,BUFFER ; Point to buffer start
CALL PRS ; Output buffer
POP HL ; Restore buffer address
POP DE ; Restore DE
POP BC ; Restore buffer length
JP MORINP ; Get another character
PUTBUF: CP ' ' ; Is it a control code?
JP C,MORINP ; Yes - Ignore
PUTCTL: LD A,B ; Get number of bytes in buffer
CP 72+1 ; Test for line overflow
LD A,CTRLG ; Set a bell
JP NC,OUTNBS ; Ring bell if buffer full
LD A,C ; Get character
LD (HL),C ; Save in buffer
LD (LSTBIN),A ; Save last input byte
INC HL ; Move up buffer
INC B ; Increment length
OUTIT: CALL OUTC ; Output the character entered
JP MORINP ; Get another character
OUTNBS: CALL OUTC ; Output bell and back over it
LD A,BKSP ; Set back space
JP OUTIT ; Output it and get more
CPDEHL: LD A,H ; Get H
SUB D ; Compare with D
RET NZ ; Different - Exit
LD A,L ; Get L
SUB E ; Compare with E
RET ; Return status
CHKSYN: LD A,(HL) ; Check syntax of character
EX (SP),HL ; Address of test byte
CP (HL) ; Same as in code string?
INC HL ; Return address
EX (SP),HL ; Put it back
JP Z,GETCHR ; Yes - Get next character
JP SNERR ; Different - ?SN Error
OUTC: PUSH AF ; Save character
LD A,(CTLOFG) ; Get control "O" flag
OR A ; Is it set?
JP NZ,POPAF ; Yes - don't output
POP AF ; Restore character
PUSH BC ; Save buffer length
PUSH AF ; Save character
CP ' ' ; Is it a control code?
JP C,DINPOS ; Yes - Don't INC POS(X)
LD A,(LWIDTH) ; Get line width
LD B,A ; To B
LD A,(CURPOS) ; Get cursor position
INC B ; Width 255?
JP Z,INCLEN ; Yes - No width limit
DEC B ; Restore width
CP B ; At end of line?
CALL Z,PRNTCRLF ; Yes - output CRLF
INCLEN: INC A ; Move on one character
LD (CURPOS),A ; Save new position
DINPOS: POP AF ; Restore character
POP BC ; Restore buffer length
CALL MONOUT ; Send it
RET
CLOTST: CALL GETINP ; Get input character
AND 01111111B ; Strip bit 7
CP CTRLO ; Is it control "O"?
RET NZ ; No don't flip flag
LD A,(CTLOFG) ; Get flag
CPL ; Flip it
LD (CTLOFG),A ; Put it back
XOR A ; Null character
RET
LIST: CALL ATOH ; ASCII number to DE
RET NZ ; Return if anything extra
POP BC ; Rubbish - Not needed
CALL SRCHLN ; Search for line number in DE
PUSH BC ; Save address of line
CALL SETLIN ; Set up lines counter
LISTLP: POP HL ; Restore address of line
LD C,(HL) ; Get LSB of next line
INC HL
LD B,(HL) ; Get MSB of next line
INC HL
LD A,B ; BC = 0 (End of program)?
OR C
JP Z,PRNTOK ; Yes - Go to command mode
CALL COUNT ; Count lines
CALL TSTBRK ; Test for break key
PUSH BC ; Save address of next line
CALL PRNTCRLF ; Output CRLF
LD E,(HL) ; Get LSB of line number
INC HL
LD D,(HL) ; Get MSB of line number
INC HL
PUSH HL ; Save address of line start
EX DE,HL ; Line number to HL
CALL PRNTHL ; Output line number in decimal
LD A,' ' ; Space after line number
POP HL ; Restore start of line address
LSTLP2: CALL OUTC ; Output character in A
LSTLP3: LD A,(HL) ; Get next byte in line
OR A ; End of line?
INC HL ; To next byte in line
JP Z,LISTLP ; Yes - get next line
JP P,LSTLP2 ; No token - output it
SUB ZEND-1 ; Find and output word
LD C,A ; Token offset+1 to C
LD DE,WORDS ; Reserved word list
FNDTOK: LD A,(DE) ; Get character in list
INC DE ; Move on to next
OR A ; Is it start of word?
JP P,FNDTOK ; No - Keep looking for word
DEC C ; Count words
JP NZ,FNDTOK ; Not there - keep looking
OUTWRD: AND 01111111B ; Strip bit 7
CALL OUTC ; Output first character
LD A,(DE) ; Get next character
INC DE ; Move on to next
OR A ; Is it end of word?
JP P,OUTWRD ; No - output the rest
JP LSTLP3 ; Next byte in line
SETLIN: PUSH HL ; Set up LINES counter
LD HL,(LINESN) ; Get LINES number
LD (LINESC),HL ; Save in LINES counter
POP HL
RET
COUNT: PUSH HL ; Save code string address
PUSH DE
LD HL,(LINESC) ; Get LINES counter
LD DE,-1
ADC HL,DE ; Decrement
LD (LINESC),HL ; Put it back
POP DE
POP HL ; Restore code string address
RET P ; Return if more lines to go
PUSH HL ; Save code string address
LD HL,(LINESN) ; Get LINES number
LD (LINESC),HL ; Reset LINES counter
CALL GETINP ; Get input character
CP CTRLC ; Is it control "C"?
JP Z,RSLNBK ; Yes - Reset LINES and break
POP HL ; Restore code string address
JP COUNT ; Keep on counting
RSLNBK: LD HL,(LINESN) ; Get LINES number
LD (LINESC),HL ; Reset LINES counter
JP BRKRET ; Go and output "Break"
FOR: LD A,64H ; Flag "FOR" assignment
LD (FORFLG),A ; Save "FOR" flag
CALL LET ; Set up initial index
POP BC ; Drop RETurn address
PUSH HL ; Save code string address
CALL DATA ; Get next statement address
LD (LOOPST),HL ; Save it for start of loop
LD HL,2 ; Offset for "FOR" block
ADD HL,SP ; Point to it
FORSLP: CALL LOKFOR ; Look for existing "FOR" block
POP DE ; Get code string address
JP NZ,FORFND ; No nesting found
ADD HL,BC ; Move into "FOR" block
PUSH DE ; Save code string address
DEC HL
LD D,(HL) ; Get MSB of loop statement
DEC HL
LD E,(HL) ; Get LSB of loop statement
INC HL
INC HL
PUSH HL ; Save block address
LD HL,(LOOPST) ; Get address of loop statement
CALL CPDEHL ; Compare the FOR loops
POP HL ; Restore block address
JP NZ,FORSLP ; Different FORs - Find another
POP DE ; Restore code string address
LD SP,HL ; Remove all nested loops
FORFND: EX DE,HL ; Code string address to HL
LD C,8
CALL CHKSTK ; Check for 8 levels of stack
PUSH HL ; Save code string address
LD HL,(LOOPST) ; Get first statement of loop
EX (SP),HL ; Save and restore code string
PUSH HL ; Re-save code string address
LD HL,(LINEAT) ; Get current line number
EX (SP),HL ; Save and restore code string
CALL TSTNUM ; Make sure it's a number
CALL CHKSYN ; Make sure "TO" is next
.BYTE ZTO ; "TO" token
CALL GETNUM ; Get "TO" expression value
PUSH HL ; Save code string address
CALL BCDEFP ; Move "TO" value to BCDE
POP HL ; Restore code string address
PUSH BC ; Save "TO" value in block
PUSH DE
LD BC,8100H ; BCDE - 1 (default STEP)
LD D,C ; C=0
LD E,D ; D=0
LD A,(HL) ; Get next byte in code string
CP ZSTEP ; See if "STEP" is stated
LD A,1 ; Sign of step = 1
JP NZ,SAVSTP ; No STEP given - Default to 1
CALL GETCHR ; Jump over "STEP" token
CALL GETNUM ; Get step value
PUSH HL ; Save code string address
CALL BCDEFP ; Move STEP to BCDE
CALL TSTSGN ; Test sign of FPREG
POP HL ; Restore code string address
SAVSTP: PUSH BC ; Save the STEP value in block
PUSH DE
PUSH AF ; Save sign of STEP
INC SP ; Don't save flags
PUSH HL ; Save code string address
LD HL,(BRKLIN) ; Get address of index variable
EX (SP),HL ; Save and restore code string
PUTFID: LD B,ZFOR ; "FOR" block marker
PUSH BC ; Save it
INC SP ; Don't save C
RUNCNT: CALL TSTBRK ; Execution driver - Test break
LD (BRKLIN),HL ; Save code address for break
LD A,(HL) ; Get next byte in code string
CP ':' ; Multi statement line?
JP Z,EXCUTE ; Yes - Execute it
OR A ; End of line?
JP NZ,SNERR ; No - Syntax error
INC HL ; Point to address of next line
LD A,(HL) ; Get LSB of line pointer
INC HL
OR (HL) ; Is it zero (End of prog)?
JP Z,ENDPRG ; Yes - Terminate execution
INC HL ; Point to line number
LD E,(HL) ; Get LSB of line number
INC HL
LD D,(HL) ; Get MSB of line number
EX DE,HL ; Line number to HL
LD (LINEAT),HL ; Save as current line number
EX DE,HL ; Line number back to DE
EXCUTE: CALL GETCHR ; Get key word
LD DE,RUNCNT ; Where to RETurn to
PUSH DE ; Save for RETurn
IFJMP: RET Z ; Go to RUNCNT if end of STMT
ONJMP: SUB ZEND ; Is it a token?
JP C,LET ; No - try to assign it
CP ZNEW+1-ZEND ; END to NEW ?
JP NC,SNERR ; Not a key word - ?SN Error
RLCA ; Double it
LD C,A ; BC = Offset into table
LD B,0
EX DE,HL ; Save code string address
LD HL,WORDTB ; Keyword address table
ADD HL,BC ; Point to routine address
LD C,(HL) ; Get LSB of routine address
INC HL
LD B,(HL) ; Get MSB of routine address
PUSH BC ; Save routine address
EX DE,HL ; Restore code string address
GETCHR: INC HL ; Point to next character
LD A,(HL) ; Get next code string byte
CP ':' ; Z if ':'
RET NC ; NC if > "9"
CP ' '
JP Z,GETCHR ; Skip over spaces
CP '0'
CCF ; NC if < '0'
INC A ; Test for zero - Leave carry
DEC A ; Z if Null
RET
RESTOR: EX DE,HL ; Save code string address
LD HL,(BASTXT) ; Point to start of program
JP Z,RESTNL ; Just RESTORE - reset pointer
EX DE,HL ; Restore code string address
CALL ATOH ; Get line number to DE
PUSH HL ; Save code string address
CALL SRCHLN ; Search for line number in DE
LD H,B ; HL = Address of line
LD L,C
POP DE ; Restore code string address
JP NC,ULERR ; ?UL Error if not found
RESTNL: DEC HL ; Byte before DATA statement
UPDATA: LD (NXTDAT),HL ; Update DATA pointer
EX DE,HL ; Restore code string address
RET
TSTBRK: RST 18H ; Check input status
RET Z ; No key, go back
RST 10H ; Get the key into A
CP ESC ; Escape key?
JR Z,BRK ; Yes, break
CP CTRLC ; <Ctrl-C>
JR Z,BRK ; Yes, break
CP CTRLS ; Stop scrolling?
RET NZ ; Other key, ignore
STALL: RST 10H ; Wait for key
CP CTRLQ ; Resume scrolling?
RET Z ; Release the chokehold
CP CTRLC ; Second break?
JR Z,STOP ; Break during hold exits prog
JR STALL ; Loop until <Ctrl-Q> or <brk>
BRK LD A,$FF ; Set BRKFLG
LD (BRKFLG),A ; Store it
STOP: RET NZ ; Exit if anything else
.BYTE 0F6H ; Flag "STOP"
PEND: RET NZ ; Exit if anything else
LD (BRKLIN),HL ; Save point of break
.BYTE 21H ; Skip "OR 11111111B"
INPBRK: OR 11111111B ; Flag "Break" wanted
POP BC ; Return not needed and more
ENDPRG: LD HL,(LINEAT) ; Get current line number
PUSH AF ; Save STOP / END status
LD A,L ; Is it direct break?
AND H
INC A ; Line is -1 if direct break
JP Z,NOLIN ; Yes - No line number
LD (ERRLIN),HL ; Save line of break
LD HL,(BRKLIN) ; Get point of break
LD (CONTAD),HL ; Save point to CONTinue
NOLIN: XOR A
LD (CTLOFG),A ; Enable output
CALL STTLIN ; Start a new line
POP AF ; Restore STOP / END status
LD HL,BRKMSG ; "Break" message
JP NZ,ERRIN ; "in line" wanted?
JP PRNTOK ; Go to command mode
CONT: LD HL,(CONTAD) ; Get CONTinue address
LD A,H ; Is it zero?
OR L
LD E,CN ; ?CN Error
JP Z,ERROR ; Yes - output "?CN Error"
EX DE,HL ; Save code string address
LD HL,(ERRLIN) ; Get line of last break
LD (LINEAT),HL ; Set up current line number
EX DE,HL ; Restore code string address
RET ; CONTinue where left off
NULL: CALL GETINT ; Get integer 0-255
RET NZ ; Return if bad value
LD (NULLS),A ; Set nulls number
RET
ACCSUM: PUSH HL ; Save address in array
LD HL,(CHKSUM) ; Get check sum
LD B,0 ; BC - Value of byte
LD C,A
ADD HL,BC ; Add byte to check sum
LD (CHKSUM),HL ; Re-save check sum
POP HL ; Restore address in array
RET
CHKLTR: LD A,(HL) ; Get byte
CP 'A' ; < 'a' ?
RET C ; Carry set if not letter
CP 'Z'+1 ; > 'z' ?
CCF
RET ; Carry set if not letter
FPSINT: CALL GETCHR ; Get next character
POSINT: CALL GETNUM ; Get integer 0 to 32767
DEPINT: CALL TSTSGN ; Test sign of FPREG
JP M,FCERR ; Negative - ?FC Error
DEINT: LD A,(FPEXP) ; Get integer value to DE
CP 80H+16 ; Exponent in range (16 bits)?
JP C,FPINT ; Yes - convert it
LD BC,9080H ; BCDE = -32768
LD DE,0000
PUSH HL ; Save code string address
CALL CMPNUM ; Compare FPREG with BCDE
POP HL ; Restore code string address
LD D,C ; MSB to D
RET Z ; Return if in range
FCERR: LD E,FC ; ?FC Error
JP ERROR ; Output error-
ATOH: DEC HL ; ASCII number to DE binary
GETLN: LD DE,0 ; Get number to DE
GTLNLP: CALL GETCHR ; Get next character
RET NC ; Exit if not a digit
PUSH HL ; Save code string address
PUSH AF ; Save digit
LD HL,65529/10 ; Largest number 65529
CALL CPDEHL ; Number in range?
JP C,SNERR ; No - ?SN Error
LD H,D ; HL = Number
LD L,E
ADD HL,DE ; Times 2
ADD HL,HL ; Times 4
ADD HL,DE ; Times 5
ADD HL,HL ; Times 10
POP AF ; Restore digit
SUB '0' ; Make it 0 to 9
LD E,A ; DE = Value of digit
LD D,0
ADD HL,DE ; Add to number
EX DE,HL ; Number to DE
POP HL ; Restore code string address
JP GTLNLP ; Go to next character
CLEAR: JP Z,INTVAR ; Just "CLEAR" Keep parameters
CALL POSINT ; Get integer 0 to 32767 to DE
DEC HL ; Cancel increment
CALL GETCHR ; Get next character
PUSH HL ; Save code string address
LD HL,(LSTRAM) ; Get end of RAM
JP Z,STORED ; No value given - Use stored
POP HL ; Restore code string address
CALL CHKSYN ; Check for comma
.BYTE ','
PUSH DE ; Save number
CALL POSINT ; Get integer 0 to 32767
DEC HL ; Cancel increment
CALL GETCHR ; Get next character
JP NZ,SNERR ; ?SN Error if more on line
EX (SP),HL ; Save code string address
EX DE,HL ; Number to DE
STORED: LD A,L ; Get LSB of new RAM top
SUB E ; Subtract LSB of string space
LD E,A ; Save LSB
LD A,H ; Get MSB of new RAM top
SBC A,D ; Subtract MSB of string space
LD D,A ; Save MSB
JP C,OMERR ; ?OM Error if not enough mem
PUSH HL ; Save RAM top
LD HL,(PROGND) ; Get program end
LD BC,40 ; 40 Bytes minimum working RAM
ADD HL,BC ; Get lowest address
CALL CPDEHL ; Enough memory?
JP NC,OMERR ; No - ?OM Error
EX DE,HL ; RAM top to HL
LD (STRSPC),HL ; Set new string space
POP HL ; End of memory to use
LD (LSTRAM),HL ; Set new top of RAM
POP HL ; Restore code string address
JP INTVAR ; Initialise variables
RUN: JP Z,RUNFST ; RUN from start if just RUN
CALL INTVAR ; Initialise variables
LD BC,RUNCNT ; Execution driver loop
JP RUNLIN ; RUN from line number
GOSUB: LD C,3 ; 3 Levels of stack needed
CALL CHKSTK ; Check for 3 levels of stack
POP BC ; Get return address
PUSH HL ; Save code string for RETURN
PUSH HL ; And for GOSUB routine
LD HL,(LINEAT) ; Get current line
EX (SP),HL ; Into stack - Code string out
LD A,ZGOSUB ; "GOSUB" token
PUSH AF ; Save token
INC SP ; Don't save flags
RUNLIN: PUSH BC ; Save return address
GOTO: CALL ATOH ; ASCII number to DE binary
CALL REM ; Get end of line
PUSH HL ; Save end of line
LD HL,(LINEAT) ; Get current line
CALL CPDEHL ; Line after current?
POP HL ; Restore end of line
INC HL ; Start of next line
CALL C,SRCHLP ; Line is after current line
CALL NC,SRCHLN ; Line is before current line
LD H,B ; Set up code string address
LD L,C
DEC HL ; Incremented after
RET C ; Line found
ULERR: LD E,UL ; ?UL Error
JP ERROR ; Output error message
RETURN: RET NZ ; Return if not just RETURN
LD D,-1 ; Flag "GOSUB" search
CALL BAKSTK ; Look "GOSUB" block
LD SP,HL ; Kill all FORs in subroutine
CP ZGOSUB ; Test for "GOSUB" token
LD E,RG ; ?RG Error
JP NZ,ERROR ; Error if no "GOSUB" found
POP HL ; Get RETURN line number
LD (LINEAT),HL ; Save as current
INC HL ; Was it from direct statement?
LD A,H
OR L ; Return to line
JP NZ,RETLIN ; No - Return to line
LD A,(LSTBIN) ; Any INPUT in subroutine?
OR A ; If so buffer is corrupted
JP NZ,POPNOK ; Yes - Go to command mode
RETLIN: LD HL,RUNCNT ; Execution driver loop
EX (SP),HL ; Into stack - Code string out
.BYTE 3EH ; Skip "POP HL"
NXTDTA: POP HL ; Restore code string address
DATA: .BYTE 01H,3AH ; ':' End of statement
REM: LD C,0 ; 00 End of statement
LD B,0
NXTSTL: LD A,C ; Statement and byte
LD C,B
LD B,A ; Statement end byte
NXTSTT: LD A,(HL) ; Get byte
OR A ; End of line?
RET Z ; Yes - Exit
CP B ; End of statement?
RET Z ; Yes - Exit
INC HL ; Next byte
CP '"' ; Literal string?
JP Z,NXTSTL ; Yes - Look for another '"'
JP NXTSTT ; Keep looking
LET: CALL GETVAR ; Get variable name
CALL CHKSYN ; Make sure "=" follows
.BYTE ZEQUAL ; "=" token
PUSH DE ; Save address of variable
LD A,(TYPE) ; Get data type
PUSH AF ; Save type
CALL EVAL ; Evaluate expression
POP AF ; Restore type
EX (SP),HL ; Save code - Get var addr
LD (BRKLIN),HL ; Save address of variable
RRA ; Adjust type
CALL CHKTYP ; Check types are the same
JP Z,LETNUM ; Numeric - Move value
LETSTR: PUSH HL ; Save address of string var
LD HL,(FPREG) ; Pointer to string entry
PUSH HL ; Save it on stack
INC HL ; Skip over length
INC HL
LD E,(HL) ; LSB of string address
INC HL
LD D,(HL) ; MSB of string address
LD HL,(BASTXT) ; Point to start of program
CALL CPDEHL ; Is string before program?
JP NC,CRESTR ; Yes - Create string entry
LD HL,(STRSPC) ; Point to string space
CALL CPDEHL ; Is string literal in program?
POP DE ; Restore address of string
JP NC,MVSTPT ; Yes - Set up pointer
LD HL,TMPSTR ; Temporary string pool
CALL CPDEHL ; Is string in temporary pool?
JP NC,MVSTPT ; No - Set up pointer
.BYTE 3EH ; Skip "POP DE"
CRESTR: POP DE ; Restore address of string
CALL BAKTMP ; Back to last tmp-str entry
EX DE,HL ; Address of string entry
CALL SAVSTR ; Save string in string area
MVSTPT: CALL BAKTMP ; Back to last tmp-str entry
POP HL ; Get string pointer
CALL DETHL4 ; Move string pointer to var
POP HL ; Restore code string address
RET
LETNUM: PUSH HL ; Save address of variable
CALL FPTHL ; Move value to variable
POP DE ; Restore address of variable
POP HL ; Restore code string address
RET
ON: CALL GETINT ; Get integer 0-255
LD A,(HL) ; Get "GOTO" or "GOSUB" token
LD B,A ; Save in B
CP ZGOSUB ; "GOSUB" token?
JP Z,ONGO ; Yes - Find line number
CALL CHKSYN ; Make sure it's "GOTO"
.BYTE ZGOTO ; "GOTO" token
DEC HL ; Cancel increment
ONGO: LD C,E ; Integer of branch value
ONGOLP: DEC C ; Count branches
LD A,B ; Get "GOTO" or "GOSUB" token
JP Z,ONJMP ; Go to that line if right one
CALL GETLN ; Get line number to DE
CP ',' ; Another line number?
RET NZ ; No - Drop through
JP ONGOLP ; Yes - loop
IF: CALL EVAL ; Evaluate expression
LD A,(HL) ; Get token
CP ZGOTO ; "GOTO" token?
JP Z,IFGO ; Yes - Get line
CALL CHKSYN ; Make sure it's "THEN"
.BYTE ZTHEN ; "THEN" token
DEC HL ; Cancel increment
IFGO: CALL TSTNUM ; Make sure it's numeric
CALL TSTSGN ; Test state of expression
JP Z,REM ; False - Drop through
CALL GETCHR ; Get next character
JP C,GOTO ; Number - GOTO that line
JP IFJMP ; Otherwise do statement
MRPRNT: DEC HL ; DEC 'cos GETCHR INCs
CALL GETCHR ; Get next character
PRINT: JP Z,PRNTCRLF ; CRLF if just PRINT
PRNTLP: RET Z ; End of list - Exit
CP ZTAB ; "TAB(" token?
JP Z,DOTAB ; Yes - Do TAB routine
CP ZSPC ; "SPC(" token?
JP Z,DOTAB ; Yes - Do SPC routine
PUSH HL ; Save code string address
CP ',' ; Comma?
JP Z,DOCOM ; Yes - Move to next zone
CP 59 ;";" ; Semi-colon?
JP Z,NEXITM ; Do semi-colon routine
POP BC ; Code string address to BC
CALL EVAL ; Evaluate expression
PUSH HL ; Save code string address
LD A,(TYPE) ; Get variable type
OR A ; Is it a string variable?
JP NZ,PRNTST ; Yes - Output string contents
CALL NUMASC ; Convert number to text
CALL CRTST ; Create temporary string
LD (HL),' ' ; Followed by a space
LD HL,(FPREG) ; Get length of output
INC (HL) ; Plus 1 for the space
LD HL,(FPREG) ; < Not needed >
LD A,(LWIDTH) ; Get width of line
LD B,A ; To B
INC B ; Width 255 (No limit)?
JP Z,PRNTNB ; Yes - Output number string
INC B ; Adjust it
LD A,(CURPOS) ; Get cursor position
ADD A,(HL) ; Add length of string
DEC A ; Adjust it
CP B ; Will output fit on this line?
CALL NC,PRNTCRLF ; No - CRLF first
PRNTNB: CALL PRS1 ; Output string at (HL)
XOR A ; Skip CALL by setting 'z' flag
PRNTST: CALL NZ,PRS1 ; Output string at (HL)
POP HL ; Restore code string address
JP MRPRNT ; See if more to PRINT
STTLIN: LD A,(CURPOS) ; Make sure on new line
OR A ; Already at start?
RET Z ; Yes - Do nothing
JP PRNTCRLF ; Start a new line
ENDINP: LD (HL),0 ; Mark end of buffer
LD HL,BUFFER-1 ; Point to buffer
PRNTCRLF: LD A,CR ; Load a CR
CALL OUTC ; Output character
LD A,LF ; Load a LF
CALL OUTC ; Output character
DONULL: XOR A ; Set to position 0
LD (CURPOS),A ; Store it
LD A,(NULLS) ; Get number of nulls
NULLP: DEC A ; Count them
RET Z ; Return if done
PUSH AF ; Save count
XOR A ; Load a null
CALL OUTC ; Output it
POP AF ; Restore count
JP NULLP ; Keep counting
DOCOM: LD A,(COMMAN) ; Get comma width
LD B,A ; Save in B
LD A,(CURPOS) ; Get current position
CP B ; Within the limit?
CALL NC,PRNTCRLF ; No - output CRLF
JP NC,NEXITM ; Get next item
ZONELP: SUB 14 ; Next zone of 14 characters
JP NC,ZONELP ; Repeat if more zones
CPL ; Number of spaces to output
JP ASPCS ; Output them
DOTAB: PUSH AF ; Save token
CALL FNDNUM ; Evaluate expression
CALL CHKSYN ; Make sure ")" follows
.BYTE ")"
DEC HL ; Back space on to ")"
POP AF ; Restore token
SUB ZSPC ; Was it "SPC(" ?
PUSH HL ; Save code string address
JP Z,DOSPC ; Yes - Do 'E' spaces
LD A,(CURPOS) ; Get current position
DOSPC: CPL ; Number of spaces to print to
ADD A,E ; Total number to print
JP NC,NEXITM ; TAB < Current POS(X)
ASPCS: INC A ; Output A spaces
LD B,A ; Save number to print
LD A,' ' ; Space
SPCLP: CALL OUTC ; Output character in A
DEC B ; Count them
JP NZ,SPCLP ; Repeat if more
NEXITM: POP HL ; Restore code string address
CALL GETCHR ; Get next character
JP PRNTLP ; More to print
REDO: .BYTE "?Redo from start",CR,LF,0
BADINP: LD A,(READFG) ; READ or INPUT?
OR A
JP NZ,DATSNR ; READ - ?SN Error
POP BC ; Throw away code string addr
LD HL,REDO ; "Redo from start" message
CALL PRS ; Output string
JP DOAGN ; Do last INPUT again
INPUT: CALL IDTEST ; Test for illegal direct
LD A,(HL) ; Get character after "INPUT"
CP '"' ; Is there a prompt string?
LD A,0 ; Clear A and leave flags
LD (CTLOFG),A ; Enable output
JP NZ,NOPMPT ; No prompt - get input
CALL QTSTR ; Get string terminated by '"'
CALL CHKSYN ; Check for ';' after prompt
.BYTE ';'
PUSH HL ; Save code string address
CALL PRS1 ; Output prompt string
.BYTE 3EH ; Skip "PUSH HL"
NOPMPT: PUSH HL ; Save code string address
CALL PROMPT ; Get input with "? " prompt
POP BC ; Restore code string address
JP C,INPBRK ; Break pressed - Exit
INC HL ; Next byte
LD A,(HL) ; Get it
OR A ; End of line?
DEC HL ; Back again
PUSH BC ; Re-save code string address
JP Z,NXTDTA ; Yes - Find next DATA stmt
LD (HL),',' ; Store comma as separator
JP NXTITM ; Get next item
READ: PUSH HL ; Save code string address
LD HL,(NXTDAT) ; Next DATA statement
.BYTE 0F6H ; Flag "READ"
NXTITM: XOR A ; Flag "INPUT"
LD (READFG),A ; Save "READ"/"INPUT" flag
EX (SP),HL ; Get code str' , Save pointer
JP GTVLUS ; Get values
NEDMOR: CALL CHKSYN ; Check for comma between items
.BYTE ','
GTVLUS: CALL GETVAR ; Get variable name
EX (SP),HL ; Save code str" , Get pointer
PUSH DE ; Save variable address
LD A,(HL) ; Get next "INPUT"/"DATA" byte
CP ',' ; Comma?
JP Z,ANTVLU ; Yes - Get another value
LD A,(READFG) ; Is it READ?
OR A
JP NZ,FDTLP ; Yes - Find next DATA stmt
LD A,'?' ; More INPUT needed
CALL OUTC ; Output character
CALL PROMPT ; Get INPUT with prompt
POP DE ; Variable address
POP BC ; Code string address
JP C,INPBRK ; Break pressed
INC HL ; Point to next DATA byte
LD A,(HL) ; Get byte
OR A ; Is it zero (No input) ?
DEC HL ; Back space INPUT pointer
PUSH BC ; Save code string address
JP Z,NXTDTA ; Find end of buffer
PUSH DE ; Save variable address
ANTVLU: LD A,(TYPE) ; Check data type
OR A ; Is it numeric?
JP Z,INPBIN ; Yes - Convert to binary
CALL GETCHR ; Get next character
LD D,A ; Save input character
LD B,A ; Again
CP '"' ; Start of literal sting?
JP Z,STRENT ; Yes - Create string entry
LD A,(READFG) ; "READ" or "INPUT" ?
OR A
LD D,A ; Save 00 if "INPUT"
JP Z,ITMSEP ; "INPUT" - End with 00
LD D,':' ; "DATA" - End with 00 or ':'
ITMSEP: LD B,',' ; Item separator
DEC HL ; Back space for DTSTR
STRENT: CALL DTSTR ; Get string terminated by D
EX DE,HL ; String address to DE
LD HL,LTSTND ; Where to go after LETSTR
EX (SP),HL ; Save HL , get input pointer
PUSH DE ; Save address of string
JP LETSTR ; Assign string to variable
INPBIN: CALL GETCHR ; Get next character
CALL ASCTFP ; Convert ASCII to FP number
EX (SP),HL ; Save input ptr, Get var addr
CALL FPTHL ; Move FPREG to variable
POP HL ; Restore input pointer
LTSTND: DEC HL ; DEC 'cos GETCHR INCs
CALL GETCHR ; Get next character
JP Z,MORDT ; End of line - More needed?
CP ',' ; Another value?
JP NZ,BADINP ; No - Bad input
MORDT: EX (SP),HL ; Get code string address
DEC HL ; DEC 'cos GETCHR INCs
CALL GETCHR ; Get next character
JP NZ,NEDMOR ; More needed - Get it
POP DE ; Restore DATA pointer
LD A,(READFG) ; "READ" or "INPUT" ?
OR A
EX DE,HL ; DATA pointer to HL
JP NZ,UPDATA ; Update DATA pointer if "READ"
PUSH DE ; Save code string address
OR (HL) ; More input given?
LD HL,EXTIG ; "?Extra ignored" message
CALL NZ,PRS ; Output string if extra given
POP HL ; Restore code string address
RET
EXTIG: .BYTE "?Extra ignored",CR,LF,0
FDTLP: CALL DATA ; Get next statement
OR A ; End of line?
JP NZ,FANDT ; No - See if DATA statement
INC HL
LD A,(HL) ; End of program?
INC HL
OR (HL) ; 00 00 Ends program
LD E,OD ; ?OD Error
JP Z,ERROR ; Yes - Out of DATA
INC HL
LD E,(HL) ; LSB of line number
INC HL
LD D,(HL) ; MSB of line number
EX DE,HL
LD (DATLIN),HL ; Set line of current DATA item
EX DE,HL
FANDT: CALL GETCHR ; Get next character
CP ZDATA ; "DATA" token
JP NZ,FDTLP ; No "DATA" - Keep looking
JP ANTVLU ; Found - Convert input
NEXT: LD DE,0 ; In case no index given
NEXT1: CALL NZ,GETVAR ; Get index address
LD (BRKLIN),HL ; Save code string address
CALL BAKSTK ; Look for "FOR" block
JP NZ,NFERR ; No "FOR" - ?NF Error
LD SP,HL ; Clear nested loops
PUSH DE ; Save index address
LD A,(HL) ; Get sign of STEP
INC HL
PUSH AF ; Save sign of STEP
PUSH DE ; Save index address
CALL PHLTFP ; Move index value to FPREG
EX (SP),HL ; Save address of TO value
PUSH HL ; Save address of index
CALL ADDPHL ; Add STEP to index value
POP HL ; Restore address of index
CALL FPTHL ; Move value to index variable
POP HL ; Restore address of TO value
CALL LOADFP ; Move TO value to BCDE
PUSH HL ; Save address of line of FOR
CALL CMPNUM ; Compare index with TO value
POP HL ; Restore address of line num
POP BC ; Address of sign of STEP
SUB B ; Compare with expected sign
CALL LOADFP ; BC = Loop stmt,DE = Line num
JP Z,KILFOR ; Loop finished - Terminate it
EX DE,HL ; Loop statement line number
LD (LINEAT),HL ; Set loop line number
LD L,C ; Set code string to loop
LD H,B
JP PUTFID ; Put back "FOR" and continue
KILFOR: LD SP,HL ; Remove "FOR" block
LD HL,(BRKLIN) ; Code string after "NEXT"
LD A,(HL) ; Get next byte in code string
CP ',' ; More NEXTs ?
JP NZ,RUNCNT ; No - Do next statement
CALL GETCHR ; Position to index name
CALL NEXT1 ; Re-enter NEXT routine
; < will not RETurn to here , Exit to RUNCNT or Loop >
GETNUM: CALL EVAL ; Get a numeric expression
TSTNUM: .BYTE 0F6H ; Clear carry (numeric)
TSTSTR: SCF ; Set carry (string)
CHKTYP: LD A,(TYPE) ; Check types match
ADC A,A ; Expected + actual
OR A ; Clear carry , set parity
RET PE ; Even parity - Types match
JP TMERR ; Different types - Error
OPNPAR: CALL CHKSYN ; Make sure "(" follows
.BYTE "("
EVAL: DEC HL ; Evaluate expression & save
LD D,0 ; Precedence value
EVAL1: PUSH DE ; Save precedence
LD C,1
CALL CHKSTK ; Check for 1 level of stack
CALL OPRND ; Get next expression value
EVAL2: LD (NXTOPR),HL ; Save address of next operator
EVAL3: LD HL,(NXTOPR) ; Restore address of next opr
POP BC ; Precedence value and operator
LD A,B ; Get precedence value
CP 78H ; "AND" or "OR" ?
CALL NC,TSTNUM ; No - Make sure it's a number
LD A,(HL) ; Get next operator / function
LD D,0 ; Clear Last relation
RLTLP: SUB ZGTR ; ">" Token
JP C,FOPRND ; + - * / ^ AND OR - Test it
CP ZLTH+1-ZGTR ; < = >
JP NC,FOPRND ; Function - Call it
CP ZEQUAL-ZGTR ; "="
RLA ; <- Test for legal
XOR D ; <- combinations of < = >
CP D ; <- by combining last token
LD D,A ; <- with current one
JP C,SNERR ; Error if "<<' '==" or ">>"
LD (CUROPR),HL ; Save address of current token
CALL GETCHR ; Get next character
JP RLTLP ; Treat the two as one
FOPRND: LD A,D ; < = > found ?
OR A
JP NZ,TSTRED ; Yes - Test for reduction
LD A,(HL) ; Get operator token
LD (CUROPR),HL ; Save operator address
SUB ZPLUS ; Operator or function?
RET C ; Neither - Exit
CP ZOR+1-ZPLUS ; Is it + - * / ^ AND OR ?
RET NC ; No - Exit
LD E,A ; Coded operator
LD A,(TYPE) ; Get data type
DEC A ; FF = numeric , 00 = string
OR E ; Combine with coded operator
LD A,E ; Get coded operator
JP Z,CONCAT ; String concatenation
RLCA ; Times 2
ADD A,E ; Times 3
LD E,A ; To DE (D is 0)
LD HL,PRITAB ; Precedence table
ADD HL,DE ; To the operator concerned
LD A,B ; Last operator precedence
LD D,(HL) ; Get evaluation precedence
CP D ; Compare with eval precedence
RET NC ; Exit if higher precedence
INC HL ; Point to routine address
CALL TSTNUM ; Make sure it's a number
STKTHS: PUSH BC ; Save last precedence & token
LD BC,EVAL3 ; Where to go on prec' break
PUSH BC ; Save on stack for return
LD B,E ; Save operator
LD C,D ; Save precedence
CALL STAKFP ; Move value to stack
LD E,B ; Restore operator
LD D,C ; Restore precedence
LD C,(HL) ; Get LSB of routine address
INC HL
LD B,(HL) ; Get MSB of routine address
INC HL
PUSH BC ; Save routine address
LD HL,(CUROPR) ; Address of current operator
JP EVAL1 ; Loop until prec' break
OPRND: XOR A ; Get operand routine
LD (TYPE),A ; Set numeric expected
CALL GETCHR ; Get next character
LD E,MO ; ?MO Error
JP Z,ERROR ; No operand - Error
JP C,ASCTFP ; Number - Get value
CALL CHKLTR ; See if a letter
JP NC,CONVAR ; Letter - Find variable
CP '&' ; &H = HEX, &B = BINARY
JR NZ, NOTAMP
CALL GETCHR ; Get next character
CP 'H' ; Hex number indicated? [function added]
JP Z,HEXTFP ; Convert Hex to FPREG
CP 'B' ; Binary number indicated? [function added]
JP Z,BINTFP ; Convert Bin to FPREG
LD E,SN ; If neither then a ?SN Error
JP Z,ERROR ;
NOTAMP: CP ZPLUS ; '+' Token ?
JP Z,OPRND ; Yes - Look for operand
CP '.' ; '.' ?
JP Z,ASCTFP ; Yes - Create FP number
CP ZMINUS ; '-' Token ?
JP Z,MINUS ; Yes - Do minus
CP '"' ; Literal string ?
JP Z,QTSTR ; Get string terminated by '"'
CP ZNOT ; "NOT" Token ?
JP Z,EVNOT ; Yes - Eval NOT expression
CP ZFN ; "FN" Token ?
JP Z,DOFN ; Yes - Do FN routine
SUB ZSGN ; Is it a function?
JP NC,FNOFST ; Yes - Evaluate function
EVLPAR: CALL OPNPAR ; Evaluate expression in "()"
CALL CHKSYN ; Make sure ")" follows
.BYTE ")"
RET
MINUS: LD D,7DH ; '-' precedence
CALL EVAL1 ; Evaluate until prec' break
LD HL,(NXTOPR) ; Get next operator address
PUSH HL ; Save next operator address
CALL INVSGN ; Negate value
RETNUM: CALL TSTNUM ; Make sure it's a number
POP HL ; Restore next operator address
RET
CONVAR: CALL GETVAR ; Get variable address to DE
FRMEVL: PUSH HL ; Save code string address
EX DE,HL ; Variable address to HL
LD (FPREG),HL ; Save address of variable
LD A,(TYPE) ; Get type
OR A ; Numeric?
CALL Z,PHLTFP ; Yes - Move contents to FPREG
POP HL ; Restore code string address
RET
FNOFST: LD B,0 ; Get address of function
RLCA ; Double function offset
LD C,A ; BC = Offset in function table
PUSH BC ; Save adjusted token value
CALL GETCHR ; Get next character
LD A,C ; Get adjusted token value
CP 2*(ZLEFT-ZSGN)-1; Adj' LEFT$,RIGHT$ or MID$ ?
JP C,FNVAL ; No - Do function
CALL OPNPAR ; Evaluate expression (X,...
CALL CHKSYN ; Make sure ',' follows
.BYTE ','
CALL TSTSTR ; Make sure it's a string
EX DE,HL ; Save code string address
LD HL,(FPREG) ; Get address of string
EX (SP),HL ; Save address of string
PUSH HL ; Save adjusted token value
EX DE,HL ; Restore code string address
CALL GETINT ; Get integer 0-255
EX DE,HL ; Save code string address
EX (SP),HL ; Save integer,HL = adj' token
JP GOFUNC ; Jump to string function
FNVAL: CALL EVLPAR ; Evaluate expression
EX (SP),HL ; HL = Adjusted token value
LD DE,RETNUM ; Return number from function
PUSH DE ; Save on stack
GOFUNC: LD BC,FNCTAB ; Function routine addresses
ADD HL,BC ; Point to right address
LD C,(HL) ; Get LSB of address
INC HL ;
LD H,(HL) ; Get MSB of address
LD L,C ; Address to HL
JP (HL) ; Jump to function
SGNEXP: DEC D ; Dee to flag negative exponent
CP ZMINUS ; '-' token ?
RET Z ; Yes - Return
CP '-' ; '-' ASCII ?
RET Z ; Yes - Return
INC D ; Inc to flag positive exponent
CP '+' ; '+' ASCII ?
RET Z ; Yes - Return
CP ZPLUS ; '+' token ?
RET Z ; Yes - Return
DEC HL ; DEC 'cos GETCHR INCs
RET ; Return "NZ"
POR: .BYTE 0F6H ; Flag "OR"
PAND: XOR A ; Flag "AND"
PUSH AF ; Save "AND" / "OR" flag
CALL TSTNUM ; Make sure it's a number
CALL DEINT ; Get integer -32768 to 32767
POP AF ; Restore "AND" / "OR" flag
EX DE,HL ; <- Get last
POP BC ; <- value
EX (SP),HL ; <- from
EX DE,HL ; <- stack
CALL FPBCDE ; Move last value to FPREG
PUSH AF ; Save "AND" / "OR" flag
CALL DEINT ; Get integer -32768 to 32767
POP AF ; Restore "AND" / "OR" flag
POP BC ; Get value
LD A,C ; Get LSB
LD HL,ACPASS ; Address of save AC as current
JP NZ,POR1 ; Jump if OR
AND E ; "AND" LSBs
LD C,A ; Save LSB
LD A,B ; Get MBS
AND D ; "AND" MSBs
JP (HL) ; Save AC as current (ACPASS)
POR1: OR E ; "OR" LSBs
LD C,A ; Save LSB
LD A,B ; Get MSB
OR D ; "OR" MSBs
JP (HL) ; Save AC as current (ACPASS)
TSTRED: LD HL,CMPLOG ; Logical compare routine
LD A,(TYPE) ; Get data type
RRA ; Carry set = string
LD A,D ; Get last precedence value
RLA ; Times 2 plus carry
LD E,A ; To E
LD D,64H ; Relational precedence
LD A,B ; Get current precedence
CP D ; Compare with last
RET NC ; Eval if last was rel' or log'
JP STKTHS ; Stack this one and get next
CMPLOG: .WORD CMPLG1 ; Compare two values / strings
CMPLG1: LD A,C ; Get data type
OR A
RRA
POP BC ; Get last expression to BCDE
POP DE
PUSH AF ; Save status
CALL CHKTYP ; Check that types match
LD HL,CMPRES ; Result to comparison
PUSH HL ; Save for RETurn
JP Z,CMPNUM ; Compare values if numeric
XOR A ; Compare two strings
LD (TYPE),A ; Set type to numeric
PUSH DE ; Save string name
CALL GSTRCU ; Get current string
LD A,(HL) ; Get length of string
INC HL
INC HL
LD C,(HL) ; Get LSB of address
INC HL
LD B,(HL) ; Get MSB of address
POP DE ; Restore string name
PUSH BC ; Save address of string
PUSH AF ; Save length of string
CALL GSTRDE ; Get second string
CALL LOADFP ; Get address of second string
POP AF ; Restore length of string 1
LD D,A ; Length to D
POP HL ; Restore address of string 1
CMPSTR: LD A,E ; Bytes of string 2 to do
OR D ; Bytes of string 1 to do
RET Z ; Exit if all bytes compared
LD A,D ; Get bytes of string 1 to do
SUB 1
RET C ; Exit if end of string 1
XOR A
CP E ; Bytes of string 2 to do
INC A
RET NC ; Exit if end of string 2
DEC D ; Count bytes in string 1
DEC E ; Count bytes in string 2
LD A,(BC) ; Byte in string 2
CP (HL) ; Compare to byte in string 1
INC HL ; Move up string 1
INC BC ; Move up string 2
JP Z,CMPSTR ; Same - Try next bytes
CCF ; Flag difference (">" or "<")
JP FLGDIF ; "<" gives -1 , ">" gives +1
CMPRES: INC A ; Increment current value
ADC A,A ; Double plus carry
POP BC ; Get other value
AND B ; Combine them
ADD A,-1 ; Carry set if different
SBC A,A ; 00 - Equal , FF - Different
JP FLGREL ; Set current value & continue
EVNOT: LD D,5AH ; Precedence value for "NOT"
CALL EVAL1 ; Eval until precedence break
CALL TSTNUM ; Make sure it's a number
CALL DEINT ; Get integer -32768 - 32767
LD A,E ; Get LSB
CPL ; Invert LSB
LD C,A ; Save "NOT" of LSB
LD A,D ; Get MSB
CPL ; Invert MSB
CALL ACPASS ; Save AC as current
POP BC ; Clean up stack
JP EVAL3 ; Continue evaluation
DIMRET: DEC HL ; DEC 'cos GETCHR INCs
CALL GETCHR ; Get next character
RET Z ; End of DIM statement
CALL CHKSYN ; Make sure ',' follows
.BYTE ','
DIM: LD BC,DIMRET ; Return to "DIMRET"
PUSH BC ; Save on stack
.BYTE 0F6H ; Flag "Create" variable
GETVAR: XOR A ; Find variable address,to DE
LD (LCRFLG),A ; Set locate / create flag
LD B,(HL) ; Get First byte of name
GTFNAM: CALL CHKLTR ; See if a letter
JP C,SNERR ; ?SN Error if not a letter
XOR A
LD C,A ; Clear second byte of name
LD (TYPE),A ; Set type to numeric
CALL GETCHR ; Get next character
JP C,SVNAM2 ; Numeric - Save in name
CALL CHKLTR ; See if a letter
JP C,CHARTY ; Not a letter - Check type
SVNAM2: LD C,A ; Save second byte of name
ENDNAM: CALL GETCHR ; Get next character
JP C,ENDNAM ; Numeric - Get another
CALL CHKLTR ; See if a letter
JP NC,ENDNAM ; Letter - Get another
CHARTY: SUB '$' ; String variable?
JP NZ,NOTSTR ; No - Numeric variable
INC A ; A = 1 (string type)
LD (TYPE),A ; Set type to string
RRCA ; A = 80H , Flag for string
ADD A,C ; 2nd byte of name has bit 7 on
LD C,A ; Resave second byte on name
CALL GETCHR ; Get next character
NOTSTR: LD A,(FORFLG) ; Array name needed ?
DEC A
JP Z,ARLDSV ; Yes - Get array name
JP P,NSCFOR ; No array with "FOR" or "FN"
LD A,(HL) ; Get byte again
SUB '(' ; Subscripted variable?
JP Z,SBSCPT ; Yes - Sort out subscript
NSCFOR: XOR A ; Simple variable
LD (FORFLG),A ; Clear "FOR" flag
PUSH HL ; Save code string address
LD D,B ; DE = Variable name to find
LD E,C
LD HL,(FNRGNM) ; FN argument name
CALL CPDEHL ; Is it the FN argument?
LD DE,FNARG ; Point to argument value
JP Z,POPHRT ; Yes - Return FN argument value
LD HL,(VAREND) ; End of variables
EX DE,HL ; Address of end of search
LD HL,(PROGND) ; Start of variables address
FNDVAR: CALL CPDEHL ; End of variable list table?
JP Z,CFEVAL ; Yes - Called from EVAL?
LD A,C ; Get second byte of name
SUB (HL) ; Compare with name in list
INC HL ; Move on to first byte
JP NZ,FNTHR ; Different - Find another
LD A,B ; Get first byte of name
SUB (HL) ; Compare with name in list
FNTHR: INC HL ; Move on to LSB of value
JP Z,RETADR ; Found - Return address
INC HL ; <- Skip
INC HL ; <- over
INC HL ; <- F.P.
INC HL ; <- value
JP FNDVAR ; Keep looking
CFEVAL: POP HL ; Restore code string address
EX (SP),HL ; Get return address
PUSH DE ; Save address of variable
LD DE,FRMEVL ; Return address in EVAL
CALL CPDEHL ; Called from EVAL ?
POP DE ; Restore address of variable
JP Z,RETNUL ; Yes - Return null variable
EX (SP),HL ; Put back return
PUSH HL ; Save code string address
PUSH BC ; Save variable name
LD BC,6 ; 2 byte name plus 4 byte data
LD HL,(ARREND) ; End of arrays
PUSH HL ; Save end of arrays
ADD HL,BC ; Move up 6 bytes
POP BC ; Source address in BC
PUSH HL ; Save new end address
CALL MOVUP ; Move arrays up
POP HL ; Restore new end address
LD (ARREND),HL ; Set new end address
LD H,B ; End of variables to HL
LD L,C
LD (VAREND),HL ; Set new end address
ZEROLP: DEC HL ; Back through to zero variable
LD (HL),0 ; Zero byte in variable
CALL CPDEHL ; Done them all?
JP NZ,ZEROLP ; No - Keep on going
POP DE ; Get variable name
LD (HL),E ; Store second character
INC HL
LD (HL),D ; Store first character
INC HL
RETADR: EX DE,HL ; Address of variable in DE
POP HL ; Restore code string address
RET
RETNUL: LD (FPEXP),A ; Set result to zero
LD HL,ZERBYT ; Also set a null string
LD (FPREG),HL ; Save for EVAL
POP HL ; Restore code string address
RET
SBSCPT: PUSH HL ; Save code string address
LD HL,(LCRFLG) ; Locate/Create and Type
EX (SP),HL ; Save and get code string
LD D,A ; Zero number of dimensions
SCPTLP: PUSH DE ; Save number of dimensions
PUSH BC ; Save array name
CALL FPSINT ; Get subscript (0-32767)
POP BC ; Restore array name
POP AF ; Get number of dimensions
EX DE,HL
EX (SP),HL ; Save subscript value
PUSH HL ; Save LCRFLG and TYPE
EX DE,HL
INC A ; Count dimensions
LD D,A ; Save in D
LD A,(HL) ; Get next byte in code string
CP ',' ; Comma (more to come)?
JP Z,SCPTLP ; Yes - More subscripts
CALL CHKSYN ; Make sure ")" follows
.BYTE ")"
LD (NXTOPR),HL ; Save code string address
POP HL ; Get LCRFLG and TYPE
LD (LCRFLG),HL ; Restore Locate/create & type
LD E,0 ; Flag not CSAVE* or CLOAD*
PUSH DE ; Save number of dimensions (D)
.BYTE 11H ; Skip "PUSH HL" and "PUSH AF'
ARLDSV: PUSH HL ; Save code string address
PUSH AF ; A = 00 , Flags set = Z,N
LD HL,(VAREND) ; Start of arrays
.BYTE 3EH ; Skip "ADD HL,DE"
FNDARY: ADD HL,DE ; Move to next array start
EX DE,HL
LD HL,(ARREND) ; End of arrays
EX DE,HL ; Current array pointer
CALL CPDEHL ; End of arrays found?
JP Z,CREARY ; Yes - Create array
LD A,(HL) ; Get second byte of name
CP C ; Compare with name given
INC HL ; Move on
JP NZ,NXTARY ; Different - Find next array
LD A,(HL) ; Get first byte of name
CP B ; Compare with name given
NXTARY: INC HL ; Move on
LD E,(HL) ; Get LSB of next array address
INC HL
LD D,(HL) ; Get MSB of next array address
INC HL
JP NZ,FNDARY ; Not found - Keep looking
LD A,(LCRFLG) ; Found Locate or Create it?
OR A
JP NZ,DDERR ; Create - ?DD Error
POP AF ; Locate - Get number of dim'ns
LD B,H ; BC Points to array dim'ns
LD C,L
JP Z,POPHRT ; Jump if array load/save
SUB (HL) ; Same number of dimensions?
JP Z,FINDEL ; Yes - Find element
BSERR: LD E,BS ; ?BS Error
JP ERROR ; Output error
CREARY: LD DE,4 ; 4 Bytes per entry
POP AF ; Array to save or 0 dim'ns?
JP Z,FCERR ; Yes - ?FC Error
LD (HL),C ; Save second byte of name
INC HL
LD (HL),B ; Save first byte of name
INC HL
LD C,A ; Number of dimensions to C
CALL CHKSTK ; Check if enough memory
INC HL ; Point to number of dimensions
INC HL
LD (CUROPR),HL ; Save address of pointer
LD (HL),C ; Set number of dimensions
INC HL
LD A,(LCRFLG) ; Locate of Create?
RLA ; Carry set = Create
LD A,C ; Get number of dimensions
CRARLP: LD BC,10+1 ; Default dimension size 10
JP NC,DEFSIZ ; Locate - Set default size
POP BC ; Get specified dimension size
INC BC ; Include zero element
DEFSIZ: LD (HL),C ; Save LSB of dimension size
INC HL
LD (HL),B ; Save MSB of dimension size
INC HL
PUSH AF ; Save num' of dim'ns an status
PUSH HL ; Save address of dim'n size
CALL MLDEBC ; Multiply DE by BC to find
EX DE,HL ; amount of mem needed (to DE)
POP HL ; Restore address of dimension
POP AF ; Restore number of dimensions
DEC A ; Count them
JP NZ,CRARLP ; Do next dimension if more
PUSH AF ; Save locate/create flag
LD B,D ; MSB of memory needed
LD C,E ; LSB of memory needed
EX DE,HL
ADD HL,DE ; Add bytes to array start
JP C,OMERR ; Too big - Error
CALL ENFMEM ; See if enough memory
LD (ARREND),HL ; Save new end of array
ZERARY: DEC HL ; Back through array data
LD (HL),0 ; Set array element to zero
CALL CPDEHL ; All elements zeroed?
JP NZ,ZERARY ; No - Keep on going
INC BC ; Number of bytes + 1
LD D,A ; A=0
LD HL,(CUROPR) ; Get address of array
LD E,(HL) ; Number of dimensions
EX DE,HL ; To HL
ADD HL,HL ; Two bytes per dimension size
ADD HL,BC ; Add number of bytes
EX DE,HL ; Bytes needed to DE
DEC HL
DEC HL
LD (HL),E ; Save LSB of bytes needed
INC HL
LD (HL),D ; Save MSB of bytes needed
INC HL
POP AF ; Locate / Create?
JP C,ENDDIM ; A is 0 , End if create
FINDEL: LD B,A ; Find array element
LD C,A
LD A,(HL) ; Number of dimensions
INC HL
.BYTE 16H ; Skip "POP HL"
FNDELP: POP HL ; Address of next dim' size
LD E,(HL) ; Get LSB of dim'n size
INC HL
LD D,(HL) ; Get MSB of dim'n size
INC HL
EX (SP),HL ; Save address - Get index
PUSH AF ; Save number of dim'ns
CALL CPDEHL ; Dimension too large?
JP NC,BSERR ; Yes - ?BS Error
PUSH HL ; Save index
CALL MLDEBC ; Multiply previous by size
POP DE ; Index supplied to DE
ADD HL,DE ; Add index to pointer
POP AF ; Number of dimensions
DEC A ; Count them
LD B,H ; MSB of pointer
LD C,L ; LSB of pointer
JP NZ,FNDELP ; More - Keep going
ADD HL,HL ; 4 Bytes per element
ADD HL,HL
POP BC ; Start of array
ADD HL,BC ; Point to element
EX DE,HL ; Address of element to DE
ENDDIM: LD HL,(NXTOPR) ; Got code string address
RET
FRE: LD HL,(ARREND) ; Start of free memory
EX DE,HL ; To DE
LD HL,0 ; End of free memory
ADD HL,SP ; Current stack value
LD A,(TYPE) ; Dummy argument type
OR A
JP Z,FRENUM ; Numeric - Free variable space
CALL GSTRCU ; Current string to pool
CALL GARBGE ; Garbage collection
LD HL,(STRSPC) ; Bottom of string space in use
EX DE,HL ; To DE
LD HL,(STRBOT) ; Bottom of string space
FRENUM: LD A,L ; Get LSB of end
SUB E ; Subtract LSB of beginning
LD C,A ; Save difference if C
LD A,H ; Get MSB of end
SBC A,D ; Subtract MSB of beginning
ACPASS: LD B,C ; Return integer AC
ABPASS: LD D,B ; Return integer AB
LD E,0
LD HL,TYPE ; Point to type
LD (HL),E ; Set type to numeric
LD B,80H+16 ; 16 bit integer
JP RETINT ; Return the integr
POS: LD A,(CURPOS) ; Get cursor position
PASSA: LD B,A ; Put A into AB
XOR A ; Zero A
JP ABPASS ; Return integer AB
DEF: CALL CHEKFN ; Get "FN" and name
CALL IDTEST ; Test for illegal direct
LD BC,DATA ; To get next statement
PUSH BC ; Save address for RETurn
PUSH DE ; Save address of function ptr
CALL CHKSYN ; Make sure "(" follows
.BYTE "("
CALL GETVAR ; Get argument variable name
PUSH HL ; Save code string address
EX DE,HL ; Argument address to HL
DEC HL
LD D,(HL) ; Get first byte of arg name
DEC HL
LD E,(HL) ; Get second byte of arg name
POP HL ; Restore code string address
CALL TSTNUM ; Make sure numeric argument
CALL CHKSYN ; Make sure ")" follows
.BYTE ")"
CALL CHKSYN ; Make sure "=" follows
.BYTE ZEQUAL ; "=" token
LD B,H ; Code string address to BC
LD C,L
EX (SP),HL ; Save code str , Get FN ptr
LD (HL),C ; Save LSB of FN code string
INC HL
LD (HL),B ; Save MSB of FN code string
JP SVSTAD ; Save address and do function
DOFN: CALL CHEKFN ; Make sure FN follows
PUSH DE ; Save function pointer address
CALL EVLPAR ; Evaluate expression in "()"
CALL TSTNUM ; Make sure numeric result
EX (SP),HL ; Save code str , Get FN ptr
LD E,(HL) ; Get LSB of FN code string
INC HL
LD D,(HL) ; Get MSB of FN code string
INC HL
LD A,D ; And function DEFined?
OR E
JP Z,UFERR ; No - ?UF Error
LD A,(HL) ; Get LSB of argument address
INC HL
LD H,(HL) ; Get MSB of argument address
LD L,A ; HL = Arg variable address
PUSH HL ; Save it
LD HL,(FNRGNM) ; Get old argument name
EX (SP),HL ; ; Save old , Get new
LD (FNRGNM),HL ; Set new argument name
LD HL,(FNARG+2) ; Get LSB,NLSB of old arg value
PUSH HL ; Save it
LD HL,(FNARG) ; Get MSB,EXP of old arg value
PUSH HL ; Save it
LD HL,FNARG ; HL = Value of argument
PUSH DE ; Save FN code string address
CALL FPTHL ; Move FPREG to argument
POP HL ; Get FN code string address
CALL GETNUM ; Get value from function
DEC HL ; DEC 'cos GETCHR INCs
CALL GETCHR ; Get next character
JP NZ,SNERR ; Bad character in FN - Error
POP HL ; Get MSB,EXP of old arg
LD (FNARG),HL ; Restore it
POP HL ; Get LSB,NLSB of old arg
LD (FNARG+2),HL ; Restore it
POP HL ; Get name of old arg
LD (FNRGNM),HL ; Restore it
POP HL ; Restore code string address
RET
IDTEST: PUSH HL ; Save code string address
LD HL,(LINEAT) ; Get current line number
INC HL ; -1 means direct statement
LD A,H
OR L
POP HL ; Restore code string address
RET NZ ; Return if in program
LD E,ID ; ?ID Error
JP ERROR
CHEKFN: CALL CHKSYN ; Make sure FN follows
.BYTE ZFN ; "FN" token
LD A,80H
LD (FORFLG),A ; Flag FN name to find
OR (HL) ; FN name has bit 7 set
LD B,A ; in first byte of name
CALL GTFNAM ; Get FN name
JP TSTNUM ; Make sure numeric function
STR: CALL TSTNUM ; Make sure it's a number
CALL NUMASC ; Turn number into text
STR1: CALL CRTST ; Create string entry for it
CALL GSTRCU ; Current string to pool
LD BC,TOPOOL ; Save in string pool
PUSH BC ; Save address on stack
SAVSTR: LD A,(HL) ; Get string length
INC HL
INC HL
PUSH HL ; Save pointer to string
CALL TESTR ; See if enough string space
POP HL ; Restore pointer to string
LD C,(HL) ; Get LSB of address
INC HL
LD B,(HL) ; Get MSB of address
CALL CRTMST ; Create string entry
PUSH HL ; Save pointer to MSB of addr
LD L,A ; Length of string
CALL TOSTRA ; Move to string area
POP DE ; Restore pointer to MSB
RET
MKTMST: CALL TESTR ; See if enough string space
CRTMST: LD HL,TMPSTR ; Temporary string
PUSH HL ; Save it
LD (HL),A ; Save length of string
INC HL
SVSTAD: INC HL
LD (HL),E ; Save LSB of address
INC HL
LD (HL),D ; Save MSB of address
POP HL ; Restore pointer
RET
CRTST: DEC HL ; DEC - INCed after
QTSTR: LD B,'"' ; Terminating quote
LD D,B ; Quote to D
DTSTR: PUSH HL ; Save start
LD C,-1 ; Set counter to -1
QTSTLP: INC HL ; Move on
LD A,(HL) ; Get byte
INC C ; Count bytes
OR A ; End of line?
JP Z,CRTSTE ; Yes - Create string entry
CP D ; Terminator D found?
JP Z,CRTSTE ; Yes - Create string entry
CP B ; Terminator B found?
JP NZ,QTSTLP ; No - Keep looking
CRTSTE: CP '"' ; End with '"'?
CALL Z,GETCHR ; Yes - Get next character
EX (SP),HL ; Starting quote
INC HL ; First byte of string
EX DE,HL ; To DE
LD A,C ; Get length
CALL CRTMST ; Create string entry
TSTOPL: LD DE,TMPSTR ; Temporary string
LD HL,(TMSTPT) ; Temporary string pool pointer
LD (FPREG),HL ; Save address of string ptr
LD A,1
LD (TYPE),A ; Set type to string
CALL DETHL4 ; Move string to pool
CALL CPDEHL ; Out of string pool?
LD (TMSTPT),HL ; Save new pointer
POP HL ; Restore code string address
LD A,(HL) ; Get next code byte
RET NZ ; Return if pool OK
LD E,ST ; ?ST Error
JP ERROR ; String pool overflow
PRNUMS: INC HL ; Skip leading space
PRS: CALL CRTST ; Create string entry for it
PRS1: CALL GSTRCU ; Current string to pool
CALL LOADFP ; Move string block to BCDE
INC E ; Length + 1
PRSLP: DEC E ; Count characters
RET Z ; End of string
LD A,(BC) ; Get byte to output
CALL OUTC ; Output character in A
CP CR ; Return?
CALL Z,DONULL ; Yes - Do nulls
INC BC ; Next byte in string
JP PRSLP ; More characters to output
TESTR: OR A ; Test if enough room
.BYTE 0EH ; No garbage collection done
GRBDON: POP AF ; Garbage collection done
PUSH AF ; Save status
LD HL,(STRSPC) ; Bottom of string space in use
EX DE,HL ; To DE
LD HL,(STRBOT) ; Bottom of string area
CPL ; Negate length (Top down)
LD C,A ; -Length to BC
LD B,-1 ; BC = -ve length of string
ADD HL,BC ; Add to bottom of space in use
INC HL ; Plus one for 2's complement
CALL CPDEHL ; Below string RAM area?
JP C,TESTOS ; Tidy up if not done else err
LD (STRBOT),HL ; Save new bottom of area
INC HL ; Point to first byte of string
EX DE,HL ; Address to DE
POPAF: POP AF ; Throw away status push
RET
TESTOS: POP AF ; Garbage collect been done?
LD E,OS ; ?OS Error
JP Z,ERROR ; Yes - Not enough string apace
CP A ; Flag garbage collect done
PUSH AF ; Save status
LD BC,GRBDON ; Garbage collection done
PUSH BC ; Save for RETurn
GARBGE: LD HL,(LSTRAM) ; Get end of RAM pointer
GARBLP: LD (STRBOT),HL ; Reset string pointer
LD HL,0
PUSH HL ; Flag no string found
LD HL,(STRSPC) ; Get bottom of string space
PUSH HL ; Save bottom of string space
LD HL,TMSTPL ; Temporary string pool
GRBLP: EX DE,HL
LD HL,(TMSTPT) ; Temporary string pool pointer
EX DE,HL
CALL CPDEHL ; Temporary string pool done?
LD BC,GRBLP ; Loop until string pool done
JP NZ,STPOOL ; No - See if in string area
LD HL,(PROGND) ; Start of simple variables
SMPVAR: EX DE,HL
LD HL,(VAREND) ; End of simple variables
EX DE,HL
CALL CPDEHL ; All simple strings done?
JP Z,ARRLP ; Yes - Do string arrays
LD A,(HL) ; Get type of variable
INC HL
INC HL
OR A ; "S" flag set if string
CALL STRADD ; See if string in string area
JP SMPVAR ; Loop until simple ones done
GNXARY: POP BC ; Scrap address of this array
ARRLP: EX DE,HL
LD HL,(ARREND) ; End of string arrays
EX DE,HL
CALL CPDEHL ; All string arrays done?
JP Z,SCNEND ; Yes - Move string if found
CALL LOADFP ; Get array name to BCDE
LD A,E ; Get type of array
PUSH HL ; Save address of num of dim'ns
ADD HL,BC ; Start of next array
OR A ; Test type of array
JP P,GNXARY ; Numeric array - Ignore it
LD (CUROPR),HL ; Save address of next array
POP HL ; Get address of num of dim'ns
LD C,(HL) ; BC = Number of dimensions
LD B,0
ADD HL,BC ; Two bytes per dimension size
ADD HL,BC
INC HL ; Plus one for number of dim'ns
GRBARY: EX DE,HL
LD HL,(CUROPR) ; Get address of next array
EX DE,HL
CALL CPDEHL ; Is this array finished?
JP Z,ARRLP ; Yes - Get next one
LD BC,GRBARY ; Loop until array all done
STPOOL: PUSH BC ; Save return address
OR 80H ; Flag string type
STRADD: LD A,(HL) ; Get string length
INC HL
INC HL
LD E,(HL) ; Get LSB of string address
INC HL
LD D,(HL) ; Get MSB of string address
INC HL
RET P ; Not a string - Return
OR A ; Set flags on string length
RET Z ; Null string - Return
LD B,H ; Save variable pointer
LD C,L
LD HL,(STRBOT) ; Bottom of new area
CALL CPDEHL ; String been done?
LD H,B ; Restore variable pointer
LD L,C
RET C ; String done - Ignore
POP HL ; Return address
EX (SP),HL ; Lowest available string area
CALL CPDEHL ; String within string area?
EX (SP),HL ; Lowest available string area
PUSH HL ; Re-save return address
LD H,B ; Restore variable pointer
LD L,C
RET NC ; Outside string area - Ignore
POP BC ; Get return , Throw 2 away
POP AF ;
POP AF ;
PUSH HL ; Save variable pointer
PUSH DE ; Save address of current
PUSH BC ; Put back return address
RET ; Go to it
SCNEND: POP DE ; Addresses of strings
POP HL ;
LD A,L ; HL = 0 if no more to do
OR H
RET Z ; No more to do - Return
DEC HL
LD B,(HL) ; MSB of address of string
DEC HL
LD C,(HL) ; LSB of address of string
PUSH HL ; Save variable address
DEC HL
DEC HL
LD L,(HL) ; HL = Length of string
LD H,0
ADD HL,BC ; Address of end of string+1
LD D,B ; String address to DE
LD E,C
DEC HL ; Last byte in string
LD B,H ; Address to BC
LD C,L
LD HL,(STRBOT) ; Current bottom of string area
CALL MOVSTR ; Move string to new address
POP HL ; Restore variable address
LD (HL),C ; Save new LSB of address
INC HL
LD (HL),B ; Save new MSB of address
LD L,C ; Next string area+1 to HL
LD H,B
DEC HL ; Next string area address
JP GARBLP ; Look for more strings
CONCAT: PUSH BC ; Save prec' opr & code string
PUSH HL ;
LD HL,(FPREG) ; Get first string
EX (SP),HL ; Save first string
CALL OPRND ; Get second string
EX (SP),HL ; Restore first string
CALL TSTSTR ; Make sure it's a string
LD A,(HL) ; Get length of second string
PUSH HL ; Save first string
LD HL,(FPREG) ; Get second string
PUSH HL ; Save second string
ADD A,(HL) ; Add length of second string
LD E,LS ; ?LS Error
JP C,ERROR ; String too long - Error
CALL MKTMST ; Make temporary string
POP DE ; Get second string to DE
CALL GSTRDE ; Move to string pool if needed
EX (SP),HL ; Get first string
CALL GSTRHL ; Move to string pool if needed
PUSH HL ; Save first string
LD HL,(TMPSTR+2) ; Temporary string address
EX DE,HL ; To DE
CALL SSTSA ; First string to string area
CALL SSTSA ; Second string to string area
LD HL,EVAL2 ; Return to evaluation loop
EX (SP),HL ; Save return,get code string
PUSH HL ; Save code string address
JP TSTOPL ; To temporary string to pool
SSTSA: POP HL ; Return address
EX (SP),HL ; Get string block,save return
LD A,(HL) ; Get length of string
INC HL
INC HL
LD C,(HL) ; Get LSB of string address
INC HL
LD B,(HL) ; Get MSB of string address
LD L,A ; Length to L
TOSTRA: INC L ; INC - DECed after
TSALP: DEC L ; Count bytes moved
RET Z ; End of string - Return
LD A,(BC) ; Get source
LD (DE),A ; Save destination
INC BC ; Next source
INC DE ; Next destination
JP TSALP ; Loop until string moved
GETSTR: CALL TSTSTR ; Make sure it's a string
GSTRCU: LD HL,(FPREG) ; Get current string
GSTRHL: EX DE,HL ; Save DE
GSTRDE: CALL BAKTMP ; Was it last tmp-str?
EX DE,HL ; Restore DE
RET NZ ; No - Return
PUSH DE ; Save string
LD D,B ; String block address to DE
LD E,C
DEC DE ; Point to length
LD C,(HL) ; Get string length
LD HL,(STRBOT) ; Current bottom of string area
CALL CPDEHL ; Last one in string area?
JP NZ,POPHL ; No - Return
LD B,A ; Clear B (A=0)
ADD HL,BC ; Remove string from str' area
LD (STRBOT),HL ; Save new bottom of str' area
POPHL: POP HL ; Restore string
RET
BAKTMP: LD HL,(TMSTPT) ; Get temporary string pool top
DEC HL ; Back
LD B,(HL) ; Get MSB of address
DEC HL ; Back
LD C,(HL) ; Get LSB of address
DEC HL ; Back
DEC HL ; Back
CALL CPDEHL ; String last in string pool?
RET NZ ; Yes - Leave it
LD (TMSTPT),HL ; Save new string pool top
RET
LEN: LD BC,PASSA ; To return integer A
PUSH BC ; Save address
GETLEN: CALL GETSTR ; Get string and its length
XOR A
LD D,A ; Clear D
LD (TYPE),A ; Set type to numeric
LD A,(HL) ; Get length of string
OR A ; Set status flags
RET
ASC: LD BC,PASSA ; To return integer A
PUSH BC ; Save address
GTFLNM: CALL GETLEN ; Get length of string
JP Z,FCERR ; Null string - Error
INC HL
INC HL
LD E,(HL) ; Get LSB of address
INC HL
LD D,(HL) ; Get MSB of address
LD A,(DE) ; Get first byte of string
RET
CHR: LD A,1 ; One character string
CALL MKTMST ; Make a temporary string
CALL MAKINT ; Make it integer A
LD HL,(TMPSTR+2) ; Get address of string
LD (HL),E ; Save character
TOPOOL: POP BC ; Clean up stack
JP TSTOPL ; Temporary string to pool
LEFT: CALL LFRGNM ; Get number and ending ")"
XOR A ; Start at first byte in string
RIGHT1: EX (SP),HL ; Save code string,Get string
LD C,A ; Starting position in string
MID1: PUSH HL ; Save string block address
LD A,(HL) ; Get length of string
CP B ; Compare with number given
JP C,ALLFOL ; All following bytes required
LD A,B ; Get new length
.BYTE 11H ; Skip "LD C,0"
ALLFOL: LD C,0 ; First byte of string
PUSH BC ; Save position in string
CALL TESTR ; See if enough string space
POP BC ; Get position in string
POP HL ; Restore string block address
PUSH HL ; And re-save it
INC HL
INC HL
LD B,(HL) ; Get LSB of address
INC HL
LD H,(HL) ; Get MSB of address
LD L,B ; HL = address of string
LD B,0 ; BC = starting address
ADD HL,BC ; Point to that byte
LD B,H ; BC = source string
LD C,L
CALL CRTMST ; Create a string entry
LD L,A ; Length of new string
CALL TOSTRA ; Move string to string area
POP DE ; Clear stack
CALL GSTRDE ; Move to string pool if needed
JP TSTOPL ; Temporary string to pool
RIGHT: CALL LFRGNM ; Get number and ending ")"
POP DE ; Get string length
PUSH DE ; And re-save
LD A,(DE) ; Get length
SUB B ; Move back N bytes
JP RIGHT1 ; Go and get sub-string
MID: EX DE,HL ; Get code string address
LD A,(HL) ; Get next byte ',' or ")"
CALL MIDNUM ; Get number supplied
INC B ; Is it character zero?
DEC B
JP Z,FCERR ; Yes - Error
PUSH BC ; Save starting position
LD E,255 ; All of string
CP ')' ; Any length given?
JP Z,RSTSTR ; No - Rest of string
CALL CHKSYN ; Make sure ',' follows
.BYTE ','
CALL GETINT ; Get integer 0-255
RSTSTR: CALL CHKSYN ; Make sure ")" follows
.BYTE ")"
POP AF ; Restore starting position
EX (SP),HL ; Get string,8ave code string
LD BC,MID1 ; Continuation of MID$ routine
PUSH BC ; Save for return
DEC A ; Starting position-1
CP (HL) ; Compare with length
LD B,0 ; Zero bytes length
RET NC ; Null string if start past end
LD C,A ; Save starting position-1
LD A,(HL) ; Get length of string
SUB C ; Subtract start
CP E ; Enough string for it?
LD B,A ; Save maximum length available
RET C ; Truncate string if needed
LD B,E ; Set specified length
RET ; Go and create string
VAL: CALL GETLEN ; Get length of string
JP Z,RESZER ; Result zero
LD E,A ; Save length
INC HL
INC HL
LD A,(HL) ; Get LSB of address
INC HL
LD H,(HL) ; Get MSB of address
LD L,A ; HL = String address
PUSH HL ; Save string address
ADD HL,DE
LD B,(HL) ; Get end of string+1 byte
LD (HL),D ; Zero it to terminate
EX (SP),HL ; Save string end,get start
PUSH BC ; Save end+1 byte
LD A,(HL) ; Get starting byte
CP '$' ; Hex number indicated? [function added]
JP NZ,VAL1
CALL HEXTFP ; Convert Hex to FPREG
JR VAL3
VAL1: CP '%' ; Binary number indicated? [function added]
JP NZ,VAL2
CALL BINTFP ; Convert Bin to FPREG
JR VAL3
VAL2: CALL ASCTFP ; Convert ASCII string to FP
VAL3: POP BC ; Restore end+1 byte
POP HL ; Restore end+1 address
LD (HL),B ; Put back original byte
RET
LFRGNM: EX DE,HL ; Code string address to HL