diff --git a/Source/HBIOS/tastybasic.asm b/Source/HBIOS/tastybasic.asm
index b38b87e2..3366737b 100644
--- a/Source/HBIOS/tastybasic.asm
+++ b/Source/HBIOS/tastybasic.asm
@@ -1,1795 +1,1901 @@
-
-; -----------------------------------------------------------------------------
-; Copyright 2018 Dimitri Theulings
-;
-; This file is part of Tasty Basic.
-;
-; Tasty Basic is free software: you can redistribute it and/or modify
-; it under the terms of the GNU General Public License as published by
-; the Free Software Foundation, either version 3 of the License, or
-; (at your option) any later version.
-;
-; Tasty Basic is distributed in the hope that it will be useful,
-; but WITHOUT ANY WARRANTY; without even the implied warranty of
-; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-; GNU General Public License for more details.
-;
-; You should have received a copy of the GNU General Public License
-; along with Tasty Basic. If not, see .
-; -----------------------------------------------------------------------------
-; Tasty Basic is derived from earlier works by Li-Chen Wang, Peter Rauskolb,
-; and Doug Gabbard. Refer to the enclosed README.md file for details.
-; -----------------------------------------------------------------------------
-
-#INCLUDE "std.asm"
-
-ctrlc .equ 03h
-bs .equ 08h
-lf .equ 0ah
-cr .equ 0dh
-ctrlo .equ 0fh
-ctrlu .equ 15h
-
-#define dwa(addr) .db (addr >> 8) + 080h\ .db addr & 0ffh
-
- .org TBC_LOC
-start:
- ld sp,stack ; ** Cold Start **
- ld a,0ffh
- jp init
-testc:
- ex (sp),hl ; ** TestC **
- call skipspace ; ignore spaces
- cp (hl) ; test character
- inc hl ; compare the byte that follows the
- jr z,tc1 ; call instruction with the text pointer
- push bc
- ld c,(hl) ; if not equal, ad the seond byte
- ld b, 0h ; that follows the call to the old pc
- add hl,bc
- pop bc
- dec de
-tc1:
- inc de ; if equal, skip those bytes
- inc hl ; and continue
- ex (sp),hl
- ret
-
-skipspace:
- ld a,(de) ; ** SkipSpace **
- cp ' ' ; ignore spaces
- ret nz ; in text (where de points)
- inc de ; and return the first non-blank
- jp skipspace ; character in A
-
-expr:
- call expr2 ; ** Expr **
- push hl ; evaluate expression
- jp expr1
-
-comp:
- ld a,h ; ** Compare **
- cp d ; compare hl with de
- ret nz ; return c and z flags
- ld a,l ; old a is lost
- cp e
- ret
-
-finish:
- pop af ; ** Finish **
- call fin ; check end of command
- jp qwhat
-
-;*************************************************************
-;
-; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
-;
-; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
-; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
-;
-; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
-; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
-; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
-; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
-; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
-; EXECUTION CONTINUES AT THE NEXT LINE.
-;
-; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
-; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
-; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
-; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
-; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
-; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
-; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
-; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
-; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
-; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
-;
-; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
-; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
-; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
-; THIS IS HANDLED IN 'INPERR'.
-;
-; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
-; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
-; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
-; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
-; THIS IS DONE BY 'DEFLT'.
-;*************************************************************
-rem:
- ld hl,0000h ; ** Rem **
- jr if1 ; this is like 'IF 0'
-iff:
- call expr ; ** If **
-if1:
- ld a,h ; is the expr = 0?
- or l
- jp nz,runsml ; no, continue
- call findskip ; yes, skip rest of line
- jp nc,runtsl ; and run the next line
- jp rstart ; if no, restart
-inputerror:
- ld hl,(stkinp) ; ** InputError **
- ld sp,hl ; restore old sp and old current
- pop hl
- ld (current),hl
- pop de ; and old text pointer
- pop de ; redo curret
-input:
- push de ; ** Input **
- call qtstg ; is next item a string?
- jp ip2 ; no
- call testvar ; yes and followed by a variable?
- jp c,ip4 ; no
- jp ip3 ; yes, input variable
-ip2:
- push de ; save for printstr
- call testvar ; must be variable
- jp c,qwhat ; no, what?
- ld a,(de) ; prepare for printstr
- ld c,a
- sub a
- ld (de),a
- pop de
- call printstr ; print string as prompt
- ld a,c ; restore text
- dec de
- ld (de),a
-ip3:
- push de ; save text pointer
- ex de,hl
- ld hl,(current) ; also save current
- push hl
- ld hl,input
- ld (current),hl
- ld hl,0000h
- add hl,sp
- ld (stkinp),hl
- push de
- ld a,':'
- call getline
- ld de,buffer
- call expr
- nop ; ** TODO: check? **
- nop
- nop
- pop de
- ex de,hl
- ld (hl),e
- inc hl
- ld (hl),d
- pop hl
- ld (current),hl
- pop de
-ip4:
- pop af ; purge stack
- call testc ; is next character ','?
- .db ','
- .db ip5-$-1
- jr input ; yes, more items
-ip5:
- call finish
-deflt:
- ld a,(de) ; ** DEFLT **
- cp cr ; empty line is fine
- jr z,lt1 ; else it's 'LET'
-let:
- call setval ; ** Let **
- call testc ; set value to var
- .db ','
- .db lt1-$-1
- jr let ; item by item
-lt1:
- call finish
-
-;*************************************************************
-;
-; *** PEEK *** POKE *** IN *** & OUT ***
-;
-; 'PEEK()' RETURNS THE VALUE OF THE BYTE AT THE GIVEN
-; ADDRESS.
-; 'POKE ,' SETS BYTE AT ADDRESS TO
-; VALUE
-;
-;*************************************************************
-peek:
- call parn ; ** Peek(expr) **
- ld a,h ; expression must be positive
- or a
- jp m,qhow
- ld a,(hl)
- ld h,0
- ld l,a
- ret
-poke:
- call expr ; ** Poke **
- ld a,h ; address must be positive
- or a
- jp m,qhow
- push hl
- call testc ; is next char a comma?
- .db ','
- .db pk1-$-1 ; what, no?
- call expr ; get value to store
- ld a,0 ; is it > 255?
- cp h
- jp z,pk2 ; no, all good
- pop hl
- jp m,qhow
-pk2:
- ld a,l ; save value
- pop hl
- ld (hl),a
- call finish
-pk1:
- pop hl
- jp qwhat
-usrexec:
- call parn ; ** Usr(expr) **
- push de
- ex de,hl
- ld hl,ue1
- push hl
- ld ix,(usrvector)
- jp (ix)
-ue1:
- ex de,hl
- pop de
- ret
-;*************************************************************
-;
-; *** EXPR ***
-;
-; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
-; ::
-;
-; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE
-; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
-; ::=(+ OR -)(+ OR -)(....)
-; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
-; ::=(* OR />)(....)
-; ::=
-;
-; ()
-; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN
-; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND
-; CAN BE AN IN PARANTHESE.
-;*************************************************************
-
-expr1:
- ld hl,tab8-1 ; look up rel.op
- jp exec ; go do it
-xp11:
- call xp18 ; rel.op.'>='
- ret c ; no, return hl=0
- ld l,a ; yes, return hl=1
- ret
-xp12:
- call xp18 ; rel.op.'#'
- ret z ; no, return hl=0
- ld l,a ; yes, return hl=1
- ret
-xp13:
- call xp18 ; rel.op.'>'
- ret z ; no
- ret c ; also, no
- ld l,a ; yes, return hl=1
- ret
-xp14:
- call xp18 ; rel.op.'<='
- ld l,a ; set hl=1
- ret z ; yes, return hl=1
- ret c
- ld l,h ; else set hl=0
- ret
-xp15:
- call xp18 ; rel.op.'='
- ret nz ; no, return hl=0
- ld l,a ; else hl=1
- ret
-xp16:
- call xp18 ; rel.op.'<'
- ret nc ; no, return hl=0
- ld l,a ; else hl=1
- ret
-xp17:
- pop hl ; not rel.op
- ret ; return hl=
-xp18:
- ld a,c ; routine for all rel.ops
- pop hl
- pop bc
- push hl
- push bc ; reverse top of stack
- ld c,a
- call expr2 ; get second
- ex de,hl ; value now in de
- ex (sp),hl ; first in hl
- call ckhlde ; compare them
- pop de ; restore text pointer
- ld hl,0000h ; set hl=0, a=1
- ld a,1
- ret
-expr2:
- call testc ; is it minus sign?
- .db '-'
- .db xp21-$-1
- ld hl,0000h ; yes, fake 0 -
- jr xp26 ; treat like subtract
-xp21:
- call testc ; is it plus sign?
- .db '+'
- .db xp22-$-1
-xp22:
- call expr3 ; first
-xp23:
- call testc ; addition?
- .db '+'
- .db xp25-$-1
- push hl ; yes, save value
- call expr3 ; get second
-xp24:
- ex de,hl ; 2nd in de
- ex (sp),hl ; 1st in hl
- ld a,h ; compare sign
- xor d
- ld a,d
- add hl,de
- pop de ; restore text pointer
- jp m,xp23 ; first and second sign differ
- xor h ; first and second sign are equal
- jp p,xp23 ; so is the result
- jp qhow ; else we have overflow
-xp25:
- call testc ; subtract?
- .db '-'
- .db xp42-$-1
-xp26:
- push hl ; yes, save first
- call expr3 ; get second
- call changesign ; negate
- jr xp24 ; and add them
-expr3:
- call expr4 ; get first expr4
-xp31:
- call testc ; multiply?
- .db '*'
- .db xp34-$-1
- push hl ; yes, save first and get second
- call expr4 ;
- ld b,0 ; clear b for sign
- call checksign
- ex (sp),hl ; first in hl
- call checksign ; check sign of first
- ex de,hl
- ex (sp),hl
- ld a,h ; is hl > 255?
- or a
- jr z,xp32 ; no
- ld a,d ; yes, what about de
- or d
- ex de,hl
- jp nz,ahow
-xp32:
- ld a,l
- ld hl,0000h
- or a
- jr z,xp35
-xp33:
- add hl,de
- jp c,ahow
- dec a
- jr nz,xp33
- jr xp35
-xp34:
- call testc ; divide
- .db '/'
- .db xp42-$-1
- push hl ; yes, save first
- call expr4 ; and get the second one
- ld b,0h ; clear b for sign
- call checksign ; check sign of the second
- ex (sp),hl ; get the first in hl
- call checksign ; check sign of first
- ex de,hl
- ex (sp),hl
- ex de,hl
- ld a,d ; divide by 0?
- or e
- jp z,ahow ; err...how?
- push bc ; else save sign
- call divide
- ld h,b
- ld l,c
- pop bc ; retrieve sign
-xp35:
- pop de ; and text pointer
- ld a,h ; hl must be positive
- or a
- jp m,qhow ; else it's overflow
- ld a,b
- or a
- call m,changesign ; change sign if needed
- jp xp31 ; look for more terms
-expr4:
- ld hl,tab4-1 ; find function in tab4
- jp exec ; and execute it
-xp40:
- call testvar
- jr c,xp41 ; nor a variable
- ld a,(hl)
- inc hl
- ld h,(hl) ; value in hl
- ld l,a
- ret
-xp41:
- call testnum ; or is it a number
- ld a,b ; number of digits
- or a
- ret nz ; ok
-
-parn:
- call testc
- .db '('
- .db xp43-$-1
- call expr ; "(expr)"
- call testc
- .db ')'
- .db xp43-$-1
-xp42:
- ret
-xp43:
- jp qwhat ; what?
-rnd:
- call parn ; ** Rnd(expr) **
- ld a,h ; expression must be positive
- or a
- jp m,qhow
- or l ; and non-zero
- jp z,qhow
- push de ; save de and hl
- push hl
- ld hl,(rndptr) ; get memory as random number
- ld de,lstrom
- call comp
- jr c,ra1 ; wrap around if last
- ld hl,start
-ra1:
- ld e,(hl)
- inc hl
- ld d,(hl)
- ld (rndptr),hl
- pop hl
- ex de,hl
- push bc
- call divide ; rnd(n)=mod(m,n)+1
- pop bc
- pop de
- inc hl
- ret
-abs:
- call parn ; ** Abs (expr) **
- dec de
- call checksign
- inc de
- ret
-size:
- ld hl,(textunfilled) ; ** Size **
- push de ; get the number of free bytes between
- ex de,hl ; and varbegin
- ld hl,varbegin
- call subde
- pop de
- ret
-
-;*************************************************************
-;
-; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
-;
-; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
-;
-; 'SUBDE' SUBSTRACTS DE FROM HL
-;
-; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
-; SIGN AND FLIP SIGN OF B.
-;
-; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
-;
-; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
-; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
-; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
-;*************************************************************
-divide:
- push hl ; ** Divide **
- ld l,h ; divide h by de
- ld h,0h
- call dv1
- ld b,c ; save result in b
- ld a,l ; (remainder + l) / de
- pop hl
- ld h,a
-dv1:
- ld c,0ffh ; result in c
-dv2:
- inc c ; dumb routine
- call subde ; divide using subtract and count
- jr nc,dv2
- add hl,de
- ret
-subde:
- ld a,l ; ** subde **
- sub e ; subtract de from hl
- ld l,a
- ld a,h
- sbc a,d
- ld h,a
- ret
-
-checksign:
- ld a,h ; ** CheckSign **
- or a ; check sign of hl
- ret p
-changesign:
- ld a,h ; ** ChangeSign **
- push af
- cpl ; change sign of hl
- ld h,a
- ld a,l
- cpl
- ld l,a
- inc hl
- pop af
- xor h
- jp p,qhow
- ld a,b ; and also flip b
- xor 80h
- ld b,a
- ret
-ckhlde:
- ld a,h ; same sign?
- xor d ; yes, compare
- jp p,ck1 ; no, exchange and compare
- ex de,hl
-ck1:
- call comp
- ret
-
-;*************************************************************
-;
-; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
-;
-; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
-; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
-; TO THAT VALUE.
-;
-; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ";",
-; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
-; NEXT LINE AND CONTINUE FROM THERE.
-;
-; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
-; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
-;
-; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
-; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
-; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
-; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
-; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
-; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
-; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
-; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
-; NOT TERMINATED BUT CONTINUED AT 'INPERR'.
-;
-; RELATED TO 'ERROR' ARE THE FOLLOWING:
-; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
-; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
-; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
-; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
-;*************************************************************
-setval:
- call testvar ; ** SetVal **
- jp c,qwhat ; no variable
- push hl ; save address of var
- call testc ; do we have =?
- .db '='
- .db sv1-$-1
- call expr ; evaluate expression
- ld b,h ; value is in bc now
- ld c,l
- pop hl ; get address
- ld (hl),c ; save value
- inc hl
- ld (hl),b
- ret
-sv1:
- jp qwhat
-fin:
- call testc ; test for ';'
- .db ';'
- .db fi1 - $ - 1
- pop af ; yes, purge return address
- jp runsml ; continue on same line
-fi1:
- call testc ; not ';', is it cr
- .db cr
- .db fi2 - $ - 1
- pop af ; yes, purge return address
- jp runnxl ; run next line
-fi2:
- ret ; else return to caller
-endchk:
- call skipspace ; ** EndChk **
- cp cr ; ends with cr?
- ret z ; ok, otherwise say 'what?'
-qwhat:
- push de ; ** QWhat **
-awhat:
- ld de,what ; ** AWhat **
-handleerror:
- sub a ; ** Error **
- call printstr ; print error message
- pop de
- ld a,(de) ; save the character
- push af ; at where old de points
- sub a ; and put a 0 (zero) there
- ld (de),a
- ld hl,(current) ; get the current line number
- push hl
- ld a,(hl) ; check the value
- inc hl
- or (hl)
- pop de
- jp z,rstart ; if zero, just rerstart
- ld a,(hl) ; if negative
- or a
- jp m,inputerror ; then redo input
- call printline ; else print the line
- dec de ; up to where the 0 is
- pop af ; restore the character
- ld (de),a
- ld a,'?' ; print a ?
- call outc
- sub a ; and the rest of the line
- call printstr
- jp rstart
-qsorry:
- push de ; ** Sorry **
-asorry:
- ld de,sorry
- jr handleerror
-
-;*************************************************************
-;
-; *** GETLN *** FNDLN (& FRIENDS) ***
-;
-; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
-; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
-; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
-; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
-; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
-; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
-; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
-;
-; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
-; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
-; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
-; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
-; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
-; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
-; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
-; LINE, FLAGS ARE C & NZ.
-; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
-; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
-; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
-; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
-; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
-; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
-;*************************************************************
-getline:
- call outc ; ** GetLine **
- ld de,buffer ; prompt and initalise pointer
-gl1:
- call chkio ; check keyboard
- jr z,gl1 ; no input, so wait
- cp bs ; erase last character?
- jr z,gl3 ; yes
- call outc ; echo character
- cp lf ; ignore lf
- jr z,gl1
- or a ; ignore null
- jr z,gl1
- cp ctrlu ; erase the whole line?
- jr z,gl4 ; yes
- ld (de),a ; save the input
- inc de ; and increment pointer
- cp cr ; was it cr?
- ret z ; yes, end of line
- ld a,e ; any free space left?
- cp bufend & 0ffh
- jr nz,gl1 ; yes, get next char
-gl3:
- ld a,e ; delete last character
- cp buffer & 0ffh ; if there are any?
- jr z,gl4 ; no, redo whole line
- dec de ; yes, back pointer
- ld a,bs ; and echo a backslash 5ch **
- call outc
- jr gl1 ; and get next character
-gl4:
- call crlf ; redo entire line
- ld a,'>' ; 5eh **
- jr getline
-findline:
- ld a,h ; ** FindLine **
- or a ; check the sign of hl
- jp m,qhow ; it cannot be negative
- ld de,textbegin ; initialise the text pointer
-findlineptr:
-fl1:
- push hl ; save line number
- ld hl,(textunfilled) ; check if we passed end
- dec hl
- call comp
- pop hl ; retrieve line number
- ret c ; c,nz passed end
- ld a,(de) ; we didn't; get first byte
- sub l ; is this the line?
- ld b,a ; compare low order
- inc de
- ld a,(de) ; get second byte
- sbc a,h ; compare high order
- jr c,fl2 ; no, not there yet
- dec de ; else we either found it
- or b ; or it's not there
- ret ; nc,z:found; nc,nz:no
-findnext:
- inc de ; find next line
-fl2:
- inc de ; just passed first and second byte
-findskip:
- ld a,(de) ; ** FindSkip **
- cp cr ; try to find cr
- jr nz,fl2 ; keep looking
- inc de ; found cr, skip over
- jr fl1 ; check if end of text
-
-;*************************************************************
-;
-; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
-;
-; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
-; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
-; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
-; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
-;
-; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
-; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
-; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
-; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
-; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
-; OVER (USUALLY A JUMP INSTRUCTION.
-;
-; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
-; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
-; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
-; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
-; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
-;
-; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
-;*************************************************************
-printstr:
- ld b,a
-ps1:
- ld a,(de) ; get a character
- inc de ; bump pointer
- cp b ; same as old A?
- ret z ; yes, return
- call outc ; no, show character
- cp cr ; was it a cr?
- jr nz,ps1 ; no, next character
- ret ; yes, returns
-qtstg:
- call testc ; ** Qtstg **
- .db 22h ; is it a double quote
- .db qt3-$-1
- ld a,22h
-qt1:
- call printstr ; print until another
- cp cr
- pop hl
- jp z,runnxl
-qt2:
- inc hl ; skip 3 bytes on return
- inc hl
- inc hl
- jp (hl) ; return
-qt3:
- call testc ; is it a single quote
- .db 27h
- .db qt4-$-1
- ld a,27h
- jr qt1
-qt4:
- call testc ; is it back-arrow
- .db '_'
- .db qt5-$-1
- ld a,8dh ; yes, cr without lf
- call outc
- call outc
- pop hl ; return address
- jr qt2
-qt5:
- ret ; none of the above
-
-printnum:
- ld b,0h ; ** PrintNum **
- call checksign ; check sign
- jp p,pn1 ; no sign
- ld b,'-'
- dec c
-pn1:
- push de ; save
- ld de, 000ah ; decimal
- push de ; save as flag
- dec c ; c=spaces
- push bc ; save sign & space
-pn2:
- call divide ; divide hl by 10
- ld a,b ; result 0?
- or c
- jr z,pn3 ; yes, we got all
- ex (sp),hl ; no, save remainder
- dec l ; and count space
- push hl ; hl is old bc
- ld h,b ; mobed result to bc
- ld l,c
- jr pn2 ; and divide by 10
-pn3:
- pop bc ; we got all digits
-pn4:
- dec c
- ld a,c ; look at space count
- or a
- jp m,pn5 ; no leading spaces
- ld a,' ' ; print a leading space
- call outc
- jr pn4 ; any more?
-pn5:
- ld a,b ; print sign
- or a
- call nz,outc
- ld e,l ; last remainder in e
-pn6:
- ld a,e ; check digit in e
- cp lf ; lf is flag for no more
- pop de
- ret z ; if yes, return
- add a,30h ; else convert to ascii
- call outc ; and print the digit
- jr pn6 ; next digit
-
-printline:
- ld a,(de) ; ** PrintLine **
- ld l,a ; low order line number
- inc de
- ld a,(de) ; high order
- ld h,a
- inc de
- ld c,04h ; print 4 digit line number
- call printnum
- ld a,' ' ; followed by a space
- call outc
- sub a ; and the the rest
- call printstr
- ret
-
-;*************************************************************
-;
-; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
-;
-; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
-; DE = HL
-;
-; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
-; UNTIL DE = BC
-;
-; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
-; STACK
-;
-; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
-; STACK
-;*************************************************************
-mvup:
- call comp ; ** mvup **
- ret z ; de = hl, return
- ld a,(de) ; get one byte
- ld (bc),a ; then copy it
- inc de ; increase both pointers
- inc bc
- jr mvup ; until done
-mvdown:
- ld a,b ; ** mvdown **
- sub d ; check if de = bc
- jp nz,md1 ; no, go move
- ld a,c ; maybe, other byte
- sub e
- ret z ; yes, return
-md1:
- dec de ; else move a byte
- dec hl ; but first decrease both pointers
- ld a,(de) ; and then do it
- ld (hl),a
- jr mvdown ; loop back
-popa:
- pop bc ; bc = return address
- pop hl ; restore loopvar
- ld (loopvar),hl
- ld a,h
- or l
- jr z,pp1 ; all done, so return
- pop hl
- ld (loopinc),hl
- pop hl
- ld (looplmt),hl
- pop hl
- ld (loopln),hl
- pop hl
- ld (loopptr),hl
-pp1:
- push bc ; bc = return address
- ret
-pusha:
- ld hl,stacklimit ; ** PushA **
- call changesign
- pop bc ; bc = return address
- add hl,sp ; is stack near the top?
- jp nc,qsorry ; yes, sorry
- ld hl,(loopvar) ; else save loop variables
- ld a,h
- or l
- jr z,pu1 ; only when loopvar not 0
- ld hl,(loopptr)
- push hl
- ld hl,(loopln)
- push hl
- ld hl,(looplmt)
- push hl
- ld hl,(loopinc)
- push hl
- ld hl,(loopvar)
-pu1:
- push hl
- push bc ; bc = return address
- ret
-
-testvar:
- call skipspace ; ** testvar **
- sub '@' ; test variables
- ret c ; not a variable
- jr nz,tv1 ; not @ array
- inc de ; is is the @ array
- call parn ; @ should be followed by (expr)
- add hl,hl ; as its index
- jr c,qhow ; is index too big?
- push de ; will it override text?
- ex de,hl
- call size ; find the size of free
- call comp
- jp c,asorry ; yes, sorry
- ld hl,varbegin ; no, get address of @(expr) and
- call subde ; put it in hl
- pop de
- ret
-tv1:
- cp 1bh ; not @, is it A to Z
- ccf
- ret c
- inc de ; if A trhough Z
- ld hl,varbegin ; calculate address of that variable
- rlca ; and return it in hl
- add a,l ; with the c flag cleared
- ld l,a
- ld a,0
- adc a,h
- ld h,a
- ret
-
-testnum:
- ld hl,0000h ; ** TestNum **
- ld b,h ; test if the text is a number
- call skipspace
-tn1:
- cp '0' ; if not,return 0 in b and hl
- ret c
- cp ':' ; if a digit, convert to binary in
- ret nc ; b and hl
- ld a,0f0h ; set b to number of digits
- and h ; if h>255, there is no room for
- jr nz,qhow ; next digit
- inc b ; b counts number of digits
- push bc
- ld b,h ; hl=10*hl+(new digit)
- ld c,l
- add hl,hl ; where 10* is done by shift and add
- add hl,hl
- add hl,bc
- add hl,hl
- ld a,(de) ; and (digit) is by stripping the
- inc de ; ascii code
- and 0fh
- add a,l
- ld l,a
- ld a,0
- adc a,h
- ld h,a
- pop bc
- ld a,(de)
- jp p,tn1
-qhow:
- push de ; ** Error How? **
-ahow:
- ld de,how
- jp handleerror
-
-msg1 .db "TASTY BASIC",cr
-how .db "HOW?",cr
-ok .db "OK",cr
-what .db "WHAT?",cr
-sorry .db "SORRY",cr
-
-;*************************************************************
-;
-; *** MAIN ***
-;
-; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
-; AND STORES IT IN THE MEMORY.
-;
-; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
-; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
-; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
-; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
-; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
-; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
-; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
-; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
-; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
-;
-; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
-; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
-; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
-; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
-;
-; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
-; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
-; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
-; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
-;
-; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
-; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
-; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
-; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
-;*************************************************************
-rstart:
- ld sp,stack
-st1:
- call crlf
- sub a ; a=0
- ld de,ok ; print ok
- call printstr
- ld hl,st2 + 1 ; literal zero
- ld (current),hl ; reset current line pointer
-st2:
- ld hl,0000h
- ld (loopvar),hl
- ld (stkgos),hl
-st3:
- ld a,'>' ; initialise prompt
- call getline
- push de ; de points to end of line
- ld de,buffer ; point de to beginning of line
- call testnum ; check if it is a number
- call skipspace
- ld a,h ; hl = value of the number, or
- or l ; 0 if no number was found
- pop bc ; bc points to end of line
- jp z,direct
- dec de ; back up de and save the value of
- ld a,h ; the value of the line number there
- ld (de),a
- dec de
- ld a,l
- ld (de),a
- push bc ; bc,de point to begin,end
- push de
- ld a,c
- sub e
-
- push af ; a = number of bytes in line
- call findline ; find this line in save area
- push de ; de points to save area
- jr nz,st4 ; nz: line not found
- push de ; z: found, delete it
- call findnext ; find next line
- ; de -> next line
- pop bc ; bc -> line to be deleted
- ld hl,(textunfilled) ; hl -> unfilled text area
- call mvup ; move up to delete
- ld h,b ; txtunf -> unfilled area
- ld l,c
- ld (textunfilled),hl
-st4:
- pop bc ; get ready to insert
- ld hl,(textunfilled) ; but first check if the length
- pop af ; of new line is 3 (line# and cr)
- push hl
- cp 3h ; if so, do not insert
- jr z,rstart ; must clear the stack
- add a,l ; calculate new txtunf
- ld l,a
- ld a,0
- adc a,h
- ld h,a ; hl -> new unfilled area
- ld de,textend ; check to see if there is space
- call comp
- jp nc,qsorry ; no, sorry
- ld (textunfilled),hl ; ok, update textunfilled
- pop de ; de -> old unfilled area
- call mvdown
- pop de ; de,hl -> begin,end
- pop hl
- call mvup ; copy new line to save area
- jr st3
-
-;*************************************************************
-;
-; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
-; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
-; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
-; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
-; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
-;
-; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
-; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
-; GO BACK TO 'RSTART'.
-; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
-; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
-; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
-; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
-;*************************************************************
-;
-; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO ***
-;
-; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
-;
-; 'END(CR)' GOES BACK TO 'RSTART'
-;
-; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
-; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
-; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
-;
-; THERE ARE 3 MORE ENTRIES IN 'RUN':
-; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
-; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
-; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
-;
-; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
-; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
-;*************************************************************
-
-new:
- call endchk ; ** New **
- ld hl,textbegin
- ld (textunfilled),hl
-endd:
- call endchk ; ** End **
- jp rstart
-
-bye: call endchk ; ** Reboot **
- LD A,BID_BOOT ; BOOT BANK
- LD HL,0 ; ADDRESS ZERO
- CALL HB_BNKCALL ; DOES NOT RETURN
- HALT
-run:
- call endchk ; ** Run **
- ld de,textbegin
-runnxl:
- ld hl,0h ; ** Run Next Line **
- call findlineptr
- jp c,rstart
-runtsl:
- ex de,hl ; ** Run Tsl
- ld (current),hl ; set current -> line #
- ex de,hl
- inc de
- inc de
-runsml:
- call chkio ; ** Run Same Line **
- ld hl, tab2-1 ; find the command in table 2
- jp exec ; and execute it
-goto:
- call expr
- push de ; save for error routine
- call endchk ; must find a cr
- call findline ; find the target line
- jp nz, ahow ; no such line #
- pop af ; clear the pushed de
- jr runtsl ; go do it
-
-;*************************************************************
-;
-; *** LIST *** & PRINT ***
-;
-; LIST HAS TWO FORMS:
-; 'LIST(CR)' LISTS ALL SAVED LINES
-; 'LIST #(CR)' START LIST AT THIS LINE #
-; YOU CAN STOP THE LISTING BY CONTROL C KEY
-;
-; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
-; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
-; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
-;
-; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
-; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
-; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
-; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
-; SPECIFIED, 6 POSITIONS WILL BE USED.
-;
-; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
-; DOUBLE QUOTES.
-;
-; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
-;
-; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
-; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
-; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
-;*************************************************************
-list:
- call testnum ; check if there is a number
- call endchk ; if no number we get a 0
- call findline ; find this or next line
-ls1:
- jp c,rstart
- call printline ; print the line
- call chkio ; stop on ctrl-c
- call findlineptr ; find the next line
- jr ls1 ; and loop back
-
-print:
- ld c,6 ; c = number of spaces
- call testc ; is it a semicolon?
- .db ';'
- .db pr2-$-1
- call crlf
- jr runsml
-pr2:
- call testc ; is it a cr?
- .db cr
- .db pr0-$-1
- call crlf
- jr runnxl
-pr0:
- call testc ; is it format?
- .db '#'
- .db pr1-$-1
- call expr
- ld c,l
- jr pr3
-pr1:
- call qtstg ; is it a string?
- jr pr8
-pr3:
- call testc ; is it a comma?
- .db ','
- .db pr6-$-1
- call fin
- jr pr0
-pr6:
- call crlf ; list ends
- call finish
-pr8:
- call expr ; evaluate the expression
- push bc
- call printnum
- pop bc
- jr pr3
-
-;*************************************************************
-;
-; *** GOSUB *** & RETURN ***
-;
-; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
-; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
-; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
-; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
-; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
-; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
-; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
-; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
-; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
-;
-; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
-; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
-; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
-; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
-;*************************************************************
-gosub:
- call pusha ; ** Gosub **
- call expr ; save the current "FOR" params
- push de ; and text pointer
- call findline ; find the target line
- jp nz,ahow ; how? because it doesn't exist
- ld hl,(current) ; found it, save old 'current'
- push hl
- ld hl,(stkgos) ; and 'stkgos'
- push hl
- ld hl,0000h ; and load new ones
- ld (loopvar),hl
- add hl,sp
- ld (stkgos),hl
- jp runtsl ; and run the line
-return:
- call endchk ; there must be a cr
- ld hl,(stkgos) ; check old stack pointer
- ld a,h ;
- or l
- jp z,what ; what? not found
- ld sp,hl ; otherwise restore it
- pop hl
- ld (stkgos),hl
- pop hl
- ld (current),hl ; and old 'current'
- pop de ; and old text pointer
- call popa ; and old 'FOR' params
- call finish ; and we're back
-
-;*************************************************************
-;
-; *** FOR *** & NEXT ***
-;
-; 'FOR' HAS TWO FORMS:
-; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
-; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
-; EXP3=1. (I.E., WITH A STEP OF +1.)
-; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
-; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
-; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
-; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
-; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
-; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
-; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
-; BEFORE THE NEW ONE OVERWRITES IT.
-; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
-; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
-; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
-; (PURGED FROM THE STACK..)
-;
-; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
-; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
-; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
-; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
-; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
-; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
-; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
-; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
-; IS PURGED AND EXECUTION CONTINUES.
-;*************************************************************
-
-for:
- call pusha ; save old save area
- call setval ; set the control variable
- dec hl ; its address is hl
- ld (loopvar),hl ; save that
- ld hl,tab5-1 ; use 'exec' to find 'TO'
- jp exec
-fr1:
- call expr ; evaluate the limit
- ld (looplmt),hl ; and save it
- ld hl,tab6-1 ; use 'exec' to find 'STEP'
- jp exec
-fr2:
- call expr ; found 'STEP'
- jr fr4
-fr3:
- ld hl,0001h ; no 'STEP' so set to 1
-fr4:
- ld (loopinc),hl ; and save that too
-fr5:
- ld hl,(current) ; save current line number
- ld (loopln),hl
- ex de,hl ; and text pointer
- ld (loopptr),hl
- ld bc,0ah ; dig into stack to find loopvar
- ld hl,(loopvar)
- ex de,hl
- ld h,b
- ld l,b
- add hl,sp
- .db 3eh
-fr7:
- add hl,bc
- ld a,(hl)
- inc hl
- or (hl)
- jr z,fr8
- ld a,(hl)
- dec hl
- cp d
- jr nz,fr7
- ld a,(hl)
- cp e
- jr nz,fr7
- ex de,hl
- ld hl,0000h
- add hl,sp
- ld b,h
- ld c,l
- ld hl,000ah
- add hl,de
- call mvdown
- ld sp,hl
-fr8:
- ld hl,(loopptr) ; all done
- ex de,hl
- call finish
-next:
- call testvar ; get address of variable
- jp c,qwhat ; what, no variable
- ld (varnext),hl ; yes, save it
-nx0:
- push de ; save the text pointer
- ex de,hl
- ld hl,(loopvar) ; get the variable in 'FOR'
- ld a,h
- or l ; if 0, there never was one
- jp z,awhat
- call comp ; else check them
- jr z,nx3 ; yes, they agree
- pop de ; no, complete current loop
- call popa
- ld hl,(varnext) ; and pop one level
- jr nx0 ; go check again
-nx3:
- ld e,(hl)
- inc hl
- ld d,(hl) ; de = value of variable
- ld hl,(loopinc)
- push hl
- ld a,h
- xor d
- ld a,d
- add hl,de
- jp m,nx4
- xor h
- jp m,nx5
-nx4:
- ex de,hl
- ld hl,(loopvar)
- ld (hl),e
- inc hl
- ld (hl),d
- ld hl,(looplmt)
- pop af
- or a
- jp p,nx1 ; step > 0
- ex de,hl ; step < 0
-nx1:
- call ckhlde ; compare with limit
- pop de ; restore the text pointer
- jr c,nx2 ; over the limit
- ld hl,(loopln) ; within the limit
- ld (current),hl
- ld hl,(loopptr)
- ex de,hl
- call finish
-nx5:
- pop hl
- pop de
-nx2:
- call popa ; purge this loop
- call finish ;
-
-
-init:
- ld (ocsw),a ; enable output control switch
- ld d,19h ; clear the screen
-patloop:
- call crlf ; by outputting 25 clear lines
- dec d
- jr nz,patloop
- ld de,msg1 ; then output welcome message
- call printstr
- ld hl,start ; initialise random pointer
- ld (rndptr),hl
- ld hl,textbegin ; initialise text area pointers
- ld (textunfilled),hl
- jp rstart
-
-chkio:
- ; SAVE INCOMING REGISTERS (AF IS OUTPUT)
- PUSH BC
- PUSH DE
- PUSH HL
- ; GET CONSOLE INPUT STATUS VIA HBIOS
- LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
- LD B,BF_CIOIST ; HBIOS FUNC: INPUT STATUS
- RST 08 ; HBIOS RETURNS STATUS IN A
-
- ; RESTORE REGISTERS (AF IS OUTPUT)
-
-
- POP HL
- POP DE
- POP BC
- RET Z ; no, return
- PUSH BC
- PUSH DE
- PUSH HL
- ; INPUT CHARACTER FROM CONSOLE VIA HBIOS
- LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
- LD B,BF_CIOIN ; HBIOS FUNC: INPUT CHAR
- RST 08 ; HBIOS READS CHARACTDR
- LD A,E ; MOVE CHARACTER TO A FOR RETURN
- ; RESTORE REGISTERS (AF IS OUTPUT)
- POP HL
- POP DE
- POP BC
-
- push bc ; is it a lf?
- ld b,a
- sub lf
- jr z,io1 ; yes, ignore an return
- ld a,b ; no, restore a and bc
- pop bc
- cp ctrlo ; is it ctrl-o?
- jr nz,io2 ; no, done
- ld a,(ocsw) ; toggle output control switch
- cpl
- ld (ocsw),a
- jr chkio ; get next character
-io1:
- ld a,0h ; clear
- or a ; set the z-flag
- pop bc ; restore bc
- ret ; return with z set
-io2:
- cp 60h ; is it lower case?
- jp c,io3 ; no
- and 0dfh ; yes, make upper case
-io3:
- cp ctrlc ; is it ctrl-c?
- ret nz ; no
- jp rstart ; yes, restart tasty basic
-crlf:
- ld a,cr ; outc will alway output a lf after a cr
-outc: ; using a recursice call
- push af
- ld a,(ocsw) ; check output control switch
- or a
- jr nz,outen ; output is enabled
- pop af ; output is disabled
- ret
-
-outen: ;call canoutc ;
- pop af ; recover character to output
- push af
- PUSH BC
- PUSH DE
- PUSH HL
- ; OUTPUT CHARACTER TO CONSOLE VIA HBIOS
- LD E,A ; OUTPUT CHAR TO E
- LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
- LD B,BF_CIOOUT ; HBIOS FUNC: OUTPUT CHAR
- RST 08 ; HBIOS OUTPUTS CHARACTER
- POP HL
- POP DE
- POP BC
- POP AF
- cp cr ; was it a cr?
- ret nz ; no, return
- ld a,lf ; send a lf
- call outc
- ld a,cr ; restore register
- RET
-
-;canoutc:
-; push af
-;uart_tx_ready_loop:
-; LD C,CIODEV_CONSOLE; CONSOLE UNIT TO C
-; LD B,BF_CIOOST ; HBIOS FUNC: CHAR OUTPUT STATUS
-; RST 08 ; HBIOS CHECK STATUS
-; OR A
-; bit tx_empty,a
-; jp z,uart_tx_ready_loop
-; pop af
-; ret
-
-
-;*************************************************************
-;
-; *** TABLES *** DIRECT *** & EXEC ***
-;
-; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
-; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
-; OF CODE ACCORDING TO THE TABLE.
-;
-; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
-; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
-; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
-; ALL DIRECT AND STATEMENT COMMANDS.
-;
-; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
-; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
-; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
-;
-; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
-; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
-; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
-; BYTE SET TO 1.
-;
-; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
-; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
-; MATCH THIS NULL ITEM AS DEFAULT.
-;*************************************************************
-tab1: ; direct commands
- .db "LIST"
- dwa(list)
- .db "RUN"
- dwa(run)
- .db "NEW"
- dwa(new)
-tab2: ; direct/statement
- .db "NEXT"
- dwa(next)
- .db "LET"
- dwa(let)
- .db "IF"
- dwa(iff)
- .db "GOTO"
- dwa(goto)
- .db "GOSUB"
- dwa(gosub)
- .db "RETURN"
- dwa(return)
- .db "REM"
- dwa(rem)
- .db "FOR"
- dwa(for)
- .db "INPUT"
- dwa(input)
- .db "PRINT"
- dwa(print)
- .db "POKE"
- dwa(poke)
- .db "END"
- dwa(endd)
- .db "BYE"
- dwa(bye)
- dwa(deflt)
-tab4: ; functions
- .db "PEEK"
- dwa(peek)
- .db "RND"
- dwa(rnd)
- .db "ABS"
- dwa(abs)
- .db "USR"
- dwa(usrexec)
- .db "SIZE"
- dwa(size)
- dwa(xp40)
-tab5: ; 'TO' in 'FOR'
- .db "TO"
- dwa(fr1)
-tab6: ; 'STEP' in 'FOR'
- .db "STEP"
- dwa(fr2)
- dwa(fr3)
-tab8: ; relational operators
- .db ">="
- dwa(xp11)
- .db "#"
- dwa(xp12)
- .db ">"
- dwa(xp13)
- .db "="
- dwa(xp15)
- .db "<="
- dwa(xp14)
- .db "<"
- dwa(xp16)
- dwa(xp17)
-
-direct:
- ld hl,tab1-1 ; ** Direct **
-exec:
- call skipspace ; ** Exec **
- push de
-ex1:
- ld a,(de)
- inc de
- cp '.'
- jr z,ex3
- inc hl
- cp (hl)
- jr z,ex1
- ld a,7fh
- dec de
- cp (hl)
- jr c,ex5
-ex2:
- inc hl
- cp (hl)
- jr nc,ex2
- inc hl
- pop de
- jr exec
-ex3:
- ld a,7fh
-ex4:
- inc hl
- cp (hl)
- jr nc,ex4
-ex5:
- ld a,(hl)
- inc hl
- ld l,(hl)
- and 7fh
- ld h,a
- pop af
- jp (hl)
-usrfunc: jp qhow ; default user defined function
-;-------------------------------------------------------------------------------
-usrvector: .db usrfunc & 0ffh ; location of user defined
- .db (usrfunc >> 8) & 0ffh ; function
-ocsw .db 0ffh ; output control switch
-lstrom: .equ $
-current .DS 2 ; points to current line
-stkgos .DS 2 ; saves sp in 'GOSUB'
-varnext .ds 2 ; temp storage
-stkinp .ds 2 ; save sp in 'INPUT'
-loopvar .ds 2 ; 'FOR' loop save area
-loopinc .ds 2 ; loop increment
-looplmt .ds 2 ; loop limit
-loopln .ds 2 ; loop line number
-loopptr .ds 2 ; loop text pointer
-rndptr .ds 2 ; random number pointer
-textunfilled .ds 2 ; -> unfilled text area
-textbegin .ds 2 ; start of text save area
-
- .org 0fcffh
-textend .ds 1
-varbegin .ds 55 ; variable @(0)
-buffer .ds 72 ; input buffer
-bufend .ds 1
-stacklimit .ds 1
-
- .org 0fdffh
-stack .equ $
-
-SLACK .EQU (TBC_END - lstrom)
- .FILL SLACK,'t'
-;
- .ECHO "TASTYBASIC space remaining: "
- .ECHO SLACK
- .ECHO " bytes.\n"
-
- .end
\ No newline at end of file
+
+; -----------------------------------------------------------------------------
+; Copyright 2018 Dimitri Theulings
+;
+; This file is part of Tasty Basic.
+;
+; Tasty Basic is free software: you can redistribute it and/or modify
+; it under the terms of the GNU General Public License as published by
+; the Free Software Foundation, either version 3 of the License, or
+; (at your option) any later version.
+;
+; Tasty Basic is distributed in the hope that it will be useful,
+; but WITHOUT ANY WARRANTY; without even the implied warranty of
+; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+; GNU General Public License for more details.
+;
+; You should have received a copy of the GNU General Public License
+; along with Tasty Basic. If not, see .
+; -----------------------------------------------------------------------------
+; Tasty Basic is derived from earlier works by Li-Chen Wang, Peter Rauskolb,
+; and Doug Gabbard. Refer to the source code repository for details
+; .
+; -----------------------------------------------------------------------------
+
+#define dwa(addr) .db (addr >> 8) + 080h\ .db addr & 0ffh
+
+ctrlc .equ 03h
+bs .equ 08h
+lf .equ 0ah
+cr .equ 0dh
+ctrlo .equ 0fh
+ctrlu .equ 15h
+
+#ifdef ZEMU ; Z80 Emulator
+tty_data .equ 7ch
+tty_status .equ 7dh
+rx_full .equ 1
+tx_empty .equ 0
+TBC_LOC .equ 0
+#else ; RomWBW
+#include "std.asm"
+#endif
+ .org TBC_LOC
+start:
+ ld sp,stack ; ** Cold Start **
+ ld a,0ffh
+ jp init
+testc:
+ ex (sp),hl ; ** TestC **
+ call skipspace ; ignore spaces
+ cp (hl) ; test character
+ inc hl ; compare the byte that follows the
+ jr z,tc1 ; call instruction with the text pointer
+ push bc
+ ld c,(hl) ; if not equal, ad the seond byte
+ ld b, 0h ; that follows the call to the old pc
+ add hl,bc
+ pop bc
+ dec de
+tc1:
+ inc de ; if equal, skip those bytes
+ inc hl ; and continue
+ ex (sp),hl
+ ret
+
+skipspace:
+ ld a,(de) ; ** SkipSpace **
+ cp ' ' ; ignore spaces
+ ret nz ; in text (where de points)
+ inc de ; and return the first non-blank
+ jp skipspace ; character in A
+
+expr:
+ call expr2 ; ** Expr **
+ push hl ; evaluate expression
+ jp expr1
+
+comp:
+ ld a,h ; ** Compare **
+ cp d ; compare hl with de
+ ret nz ; return c and z flags
+ ld a,l ; old a is lost
+ cp e
+ ret
+
+finish:
+ pop af ; ** Finish **
+ call fin ; check end of command
+ jp qwhat
+
+;*************************************************************
+;
+; *** REM *** IF *** INPUT *** & LET (& DEFLT) ***
+;
+; 'REM' CAN BE FOLLOWED BY ANYTHING AND IS IGNORED BY TBI.
+; TBI TREATS IT LIKE AN 'IF' WITH A FALSE CONDITION.
+;
+; 'IF' IS FOLLOWED BY AN EXPR. AS A CONDITION AND ONE OR MORE
+; COMMANDS (INCLUDING OTHER 'IF'S) SEPERATED BY SEMI-COLONS.
+; NOTE THAT THE WORD 'THEN' IS NOT USED. TBI EVALUATES THE
+; EXPR. IF IT IS NON-ZERO, EXECUTION CONTINUES. IF THE
+; EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
+; EXECUTION CONTINUES AT THE NEXT LINE.
+;
+; 'INPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
+; BY A LIST OF ITEMS. IF THE ITEM IS A STRING IN SINGLE OR
+; DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
+; IN 'PRINT'. IF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS
+; PRINTED OUT FOLLOWED BY A COLON. THEN TBI WAITS FOR AN
+; EXPR. TO BE TYPED IN. THE VARIABLE IS THEN SET TO THE
+; VALUE OF THIS EXPR. IF THE VARIABLE IS PROCEDED BY A STRING
+; (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE
+; PRINTED FOLLOWED BY A COLON. TBI THEN WAITS FOR INPUT EXPR.
+; AND SET THE VARIABLE TO THE VALUE OF THE EXPR.
+;
+; IF THE INPUT EXPR. IS INVALID, TBI WILL PRINT "WHAT?",
+; "HOW?" OR "SORRY" AND REPRINT THE PROMPT AND REDO THE INPUT.
+; THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.
+; THIS IS HANDLED IN 'INPERR'.
+;
+; 'LET' IS FOLLOWED BY A LIST OF ITEMS SEPERATED BY COMMAS.
+; EACH ITEM CONSISTS OF A VARIABLE, AN EQUAL SIGN, AND AN EXPR.
+; TBI EVALUATES THE EXPR. AND SET THE VARIABLE TO THAT VALUE.
+; TBI WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
+; THIS IS DONE BY 'DEFLT'.
+;*************************************************************
+rem:
+ ld hl,0000h ; ** Rem **
+ jr if1 ; this is like 'IF 0'
+iff:
+ call expr ; ** If **
+if1:
+ ld a,h ; is the expr = 0?
+ or l
+ jp nz,runsml ; no, continue
+ call findskip ; yes, skip rest of line
+ jp nc,runtsl ; and run the next line
+ jp rstart ; if no, restart
+inputerror:
+ ld hl,(stkinp) ; ** InputError **
+ ld sp,hl ; restore old sp and old current
+ pop hl
+ ld (current),hl
+ pop de ; and old text pointer
+ pop de ; redo current
+input:
+ push de ; ** Input **
+ call qtstg ; is next item a string?
+ jp ip2 ; no
+ call testvar ; yes and followed by a variable?
+ jp c,ip4 ; no
+ jp ip3 ; yes, input variable
+ip2:
+ push de ; save for printstr
+ call testvar ; must be variable
+ jp c,qwhat ; no, what?
+ ld a,(de) ; prepare for printstr
+ ld c,a
+ sub a
+ ld (de),a
+ pop de
+ call printstr ; print string as prompt
+ ld a,c ; restore text
+ dec de
+ ld (de),a
+ip3:
+ push de ; save text pointer
+ ex de,hl
+ ld hl,(current) ; also save current
+ push hl
+ ld hl,input
+ ld (current),hl
+ ld hl,0000h
+ add hl,sp
+ ld (stkinp),hl
+ push de
+ ld a,':'
+ call getline
+ ld de,buffer
+ call expr
+ nop
+ nop
+ nop
+ pop de
+ ex de,hl
+ ld (hl),e
+ inc hl
+ ld (hl),d
+ pop hl
+ ld (current),hl
+ pop de
+ip4:
+ pop af ; purge stack
+ call testc ; is next character ','?
+ .db ','
+ .db ip5-$-1
+ jr input ; yes, more items
+ip5:
+ call finish
+deflt:
+ ld a,(de) ; ** DEFLT **
+ cp cr ; empty line is fine
+ jr z,lt1 ; else it's 'LET'
+let:
+ call setval ; ** Let **
+ call testc ; set value to var
+ .db ','
+ .db lt1-$-1
+ jr let ; item by item
+lt1:
+ call finish
+
+;*************************************************************
+;
+; *** PEEK *** POKE *** IN *** & OUT ***
+;
+; 'PEEK()' RETURNS THE VALUE OF THE BYTE AT THE GIVEN
+; ADDRESS.
+; 'POKE ,' SETS BYTE AT ADDRESS TO
+; VALUE
+;
+;*************************************************************
+peek:
+ call parn ; ** Peek(expr) **
+ ld a,h ; expression must be positive
+ or a
+ jp m,qhow
+ ld a,(hl)
+ ld h,0
+ ld l,a
+ ret
+poke:
+ call expr ; ** Poke **
+ ld a,h ; address must be positive
+ or a
+ jp m,qhow
+ push hl
+ call testc ; is next char a comma?
+ .db ','
+ .db pk1-$-1 ; what, no?
+ call expr ; get value to store
+ ld a,0 ; is it > 255?
+ cp h
+ jp z,pk2 ; no, all good
+ pop hl
+ jp m,qhow
+pk2:
+ ld a,l ; save value
+ pop hl
+ ld (hl),a
+ call finish
+pk1:
+ pop hl
+ jp qwhat
+usrexec:
+ call parn ; ** Usr(expr) **
+ push de
+ ex de,hl
+ ld hl,ue1
+ push hl
+ ld ix,(usrptr)
+ jp (ix)
+ue1:
+ ex de,hl
+ pop de
+ ret
+;*************************************************************
+;
+; *** EXPR ***
+;
+; 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
+; ::
+;
+; WHERE IS ONE OF THE OPERATORS IN TAB8 AND THE
+; RESULT OF THESE OPERATIONS IS 1 IF TRUE AND 0 IF FALSE.
+; ::=(+ OR -)(+ OR -)(....)
+; WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
+; ::=(* OR />)(....)
+; ::=
+;
+; ()
+; IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN
+; AS INDEX, FUNCTIONS CAN HAVE AN AS ARGUMENTS, AND
+; CAN BE AN IN PARANTHESE.
+;*************************************************************
+
+expr1:
+ ld hl,tab8-1 ; look up rel.op
+ jp exec ; go do it
+xp11:
+ call xp18 ; rel.op.'>='
+ ret c ; no, return hl=0
+ ld l,a ; yes, return hl=1
+ ret
+xp12:
+ call xp18 ; rel.op.'#'
+ ret z ; no, return hl=0
+ ld l,a ; yes, return hl=1
+ ret
+xp13:
+ call xp18 ; rel.op.'>'
+ ret z ; no
+ ret c ; also, no
+ ld l,a ; yes, return hl=1
+ ret
+xp14:
+ call xp18 ; rel.op.'<='
+ ld l,a ; set hl=1
+ ret z ; yes, return hl=1
+ ret c
+ ld l,h ; else set hl=0
+ ret
+xp15:
+ call xp18 ; rel.op.'='
+ ret nz ; no, return hl=0
+ ld l,a ; else hl=1
+ ret
+xp16:
+ call xp18 ; rel.op.'<'
+ ret nc ; no, return hl=0
+ ld l,a ; else hl=1
+ ret
+xp17:
+ pop hl ; not rel.op
+ ret ; return hl=
+xp18:
+ ld a,c ; routine for all rel.ops
+ pop hl
+ pop bc
+ push hl
+ push bc ; reverse top of stack
+ ld c,a
+ call expr2 ; get second
+ ex de,hl ; value now in de
+ ex (sp),hl ; first in hl
+ call ckhlde ; compare them
+ pop de ; restore text pointer
+ ld hl,0000h ; set hl=0, a=1
+ ld a,1
+ ret
+expr2:
+ call testc ; is it minus sign?
+ .db '-'
+ .db xp21-$-1
+ ld hl,0000h ; yes, fake 0 -
+ jr xp26 ; treat like subtract
+xp21:
+ call testc ; is it plus sign?
+ .db '+'
+ .db xp22-$-1
+xp22:
+ call expr3 ; first
+xp23:
+ call testc ; addition?
+ .db '+'
+ .db xp25-$-1
+ push hl ; yes, save value
+ call expr3 ; get second
+xp24:
+ ex de,hl ; 2nd in de
+ ex (sp),hl ; 1st in hl
+ ld a,h ; compare sign
+ xor d
+ ld a,d
+ add hl,de
+ pop de ; restore text pointer
+ jp m,xp23 ; first and second sign differ
+ xor h ; first and second sign are equal
+ jp p,xp23 ; so is the result
+ jp qhow ; else we have overflow
+xp25:
+ call testc ; subtract?
+ .db '-'
+ .db xp42-$-1
+xp26:
+ push hl ; yes, save first
+ call expr3 ; get second
+ call changesign ; negate
+ jr xp24 ; and add them
+expr3:
+ call expr4 ; get first expr4
+xp31:
+ call testc ; multiply?
+ .db '*'
+ .db xp34-$-1
+ push hl ; yes, save first and get second
+ call expr4 ;
+ ld b,0 ; clear b for sign
+ call checksign
+ ex (sp),hl ; first in hl
+ call checksign ; check sign of first
+ ex de,hl
+ ex (sp),hl
+ ld a,h ; is hl > 255?
+ or a
+ jr z,xp32 ; no
+ ld a,d ; yes, what about de
+ or d
+ ex de,hl
+ jp nz,ahow
+xp32:
+ ld a,l
+ ld hl,0000h
+ or a
+ jr z,xp35
+xp33:
+ add hl,de
+ jp c,ahow
+ dec a
+ jr nz,xp33
+ jr xp35
+xp34:
+ call testc ; divide
+ .db '/'
+ .db xp42-$-1
+ push hl ; yes, save first
+ call expr4 ; and get the second one
+ ld b,0h ; clear b for sign
+ call checksign ; check sign of the second
+ ex (sp),hl ; get the first in hl
+ call checksign ; check sign of first
+ ex de,hl
+ ex (sp),hl
+ ex de,hl
+ ld a,d ; divide by 0?
+ or e
+ jp z,ahow ; err...how?
+ push bc ; else save sign
+ call divide
+ ld h,b
+ ld l,c
+ pop bc ; retrieve sign
+xp35:
+ pop de ; and text pointer
+ ld a,h ; hl must be positive
+ or a
+ jp m,qhow ; else it's overflow
+ ld a,b
+ or a
+ call m,changesign ; change sign if needed
+ jp xp31 ; look for more terms
+expr4:
+ ld hl,tab4-1 ; find function in tab4
+ jp exec ; and execute it
+xp40:
+ call testvar
+ jr c,xp41 ; nor a variable
+ ld a,(hl)
+ inc hl
+ ld h,(hl) ; value in hl
+ ld l,a
+ ret
+xp41:
+ call testnum ; or is it a number
+ ld a,b ; number of digits
+ or a
+ ret nz ; ok
+
+parn:
+ call testc
+ .db '('
+ .db xp43-$-1
+ call expr ; "(expr)"
+ call testc
+ .db ')'
+ .db xp43-$-1
+xp42:
+ ret
+xp43:
+ jp qwhat ; what?
+rnd:
+ call parn ; ** Rnd(expr) **
+ ld a,h ; expression must be positive
+ or a
+ jp m,qhow
+ or l ; and non-zero
+ jp z,qhow
+ push de ; save de and hl
+ push hl
+ ld hl,(rndptr) ; get memory as random number
+ ld de,LST_ROM
+ call comp
+ jr c,ra1 ; wrap around if last
+ ld hl,start
+ra1:
+ ld e,(hl)
+ inc hl
+ ld d,(hl)
+ ld (rndptr),hl
+ pop hl
+ ex de,hl
+ push bc
+ call divide ; rnd(n)=mod(m,n)+1
+ pop bc
+ pop de
+ inc hl
+ ret
+abs:
+ call parn ; ** Abs (expr) **
+ dec de
+ call checksign
+ inc de
+ ret
+size:
+ ld hl,(textunfilled) ; ** Size **
+ push de ; get the number of free bytes between
+ ex de,hl ; and varbegin
+ ld hl,varbegin
+ call subde
+ pop de
+ ret
+clrvars:
+ ld hl,(textunfilled) ; ** ClearVars**
+ push de ; get the number of bytes available
+ ex de,hl ; for variable storge
+ ld hl,varend
+ call subde
+ ld b,h ; and save in bc
+ ld c,l
+ ld hl,(textunfilled) ; clear the first byte
+ ld d,h
+ ld e,l
+ inc de
+ ld (hl),0h
+ ldir ; and repeat for all the others
+ pop de
+ ret
+
+;*************************************************************
+;
+; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
+;
+; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
+;
+; 'SUBDE' SUBSTRACTS DE FROM HL
+;
+; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE
+; SIGN AND FLIP SIGN OF B.
+;
+; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY.
+;
+; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE
+; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER
+; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
+;*************************************************************
+divide:
+ push hl ; ** Divide **
+ ld l,h ; divide h by de
+ ld h,0h
+ call dv1
+ ld b,c ; save result in b
+ ld a,l ; (remainder + l) / de
+ pop hl
+ ld h,a
+dv1:
+ ld c,0ffh ; result in c
+dv2:
+ inc c ; dumb routine
+ call subde ; divide using subtract and count
+ jr nc,dv2
+ add hl,de
+ ret
+subde:
+ ld a,l ; ** subde **
+ sub e ; subtract de from hl
+ ld l,a
+ ld a,h
+ sbc a,d
+ ld h,a
+ ret
+
+checksign:
+ ld a,h ; ** CheckSign **
+ or a ; check sign of hl
+ ret p
+changesign:
+ ld a,h ; ** ChangeSign **
+ or l ; check if hl is zero
+ jp nz,cs1 ; no, try to change sign
+ ret ; yes, return
+cs1:
+ ld a,h ; change sign of hl
+ push af
+ cpl
+ ld h,a
+ ld a,l
+ cpl
+ ld l,a
+ inc hl
+ pop af
+ xor h
+ jp p,qhow
+ ld a,b ; and also flip b
+ xor 80h
+ ld b,a
+ ret
+ckhlde:
+ ld a,h ; same sign?
+ xor d ; yes, compare
+ jp p,ck1 ; no, exchange and compare
+ ex de,hl
+ck1:
+ call comp
+ ret
+
+;*************************************************************
+;
+; *** SETVAL *** FIN *** ENDCHK *** & ERROR (& FRIENDS) ***
+;
+; "SETVAL" EXPECTS A VARIABLE, FOLLOWED BY AN EQUAL SIGN AND
+; THEN AN EXPR. IT EVALUATES THE EXPR. AND SET THE VARIABLE
+; TO THAT VALUE.
+;
+; "FIN" CHECKS THE END OF A COMMAND. IF IT ENDED WITH ":",
+; EXECUTION CONTINUES. IF IT ENDED WITH A CR, IT FINDS THE
+; NEXT LINE AND CONTINUE FROM THERE.
+;
+; "ENDCHK" CHECKS IF A COMMAND IS ENDED WITH CR. THIS IS
+; REQUIRED IN CERTAIN COMMANDS. (GOTO, RETURN, AND STOP ETC.)
+;
+; "ERROR" PRINTS THE STRING POINTED BY DE (AND ENDS WITH CR).
+; IT THEN PRINTS THE LINE POINTED BY 'CURRNT' WITH A "?"
+; INSERTED AT WHERE THE OLD TEXT POINTER (SHOULD BE ON TOP
+; OF THE STACK) POINTS TO. EXECUTION OF TB IS STOPPED
+; AND TBI IS RESTARTED. HOWEVER, IF 'CURRNT' -> ZERO
+; (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
+; PRINTED. AND IF 'CURRNT' -> NEGATIVE # (INDICATING 'INPUT'
+; COMMAND), THE INPUT LINE IS NOT PRINTED AND EXECUTION IS
+; NOT TERMINATED BUT CONTINUED AT 'INPERR'.
+;
+; RELATED TO 'ERROR' ARE THE FOLLOWING:
+; 'QWHAT' SAVES TEXT POINTER IN STACK AND GET MESSAGE "WHAT?"
+; 'AWHAT' JUST GET MESSAGE "WHAT?" AND JUMP TO 'ERROR'.
+; 'QSORRY' AND 'ASORRY' DO SAME KIND OF THING.
+; 'AHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS.
+;*************************************************************
+setval:
+ call testvar ; ** SetVal **
+ jp c,qwhat ; no variable
+ push hl ; save address of var
+ call testc ; do we have =?
+ .db '='
+ .db sv1-$-1
+ call expr ; evaluate expression
+ ld b,h ; value is in bc now
+ ld c,l
+ pop hl ; get address
+ ld (hl),c ; save value
+ inc hl
+ ld (hl),b
+ ret
+sv1:
+ jp qwhat
+fin:
+ call testc ; test for ':'
+ .db ':'
+ .db fi1 - $ - 1
+ pop af ; yes, purge return address
+ jp runsml ; continue on same line
+fi1:
+ call testc ; not ':', is it cr
+ .db cr
+ .db fi2 - $ - 1
+ pop af ; yes, purge return address
+ jp runnxl ; run next line
+fi2:
+ ret ; else return to caller
+endchk:
+ call skipspace ; ** EndChk **
+ cp cr ; ends with cr?
+ ret z ; ok, otherwise say 'what?'
+qwhat:
+ push de ; ** QWhat **
+awhat:
+ ld de,what ; ** AWhat **
+handleerror:
+ sub a ; ** Error **
+ call printstr ; print error message
+ pop de
+ ld a,(de) ; save the character
+ push af ; at where old de points
+ sub a ; and put a 0 (zero) there
+ ld (de),a
+ ld hl,(current) ; get the current line number
+ push hl
+ ld a,(hl) ; check the value
+ inc hl
+ or (hl)
+ pop de
+ jp z,rstart ; if zero, just rerstart
+ ld a,(hl) ; if negative
+ or a
+ jp m,inputerror ; then redo input
+ call printline ; else print the line
+ dec de ; up to where the 0 is
+ pop af ; restore the character
+ ld (de),a
+ ld a,'?' ; print a ?
+ call outc
+ sub a ; and the rest of the line
+ call printstr
+ jp rstart
+qsorry:
+ push de ; ** Sorry **
+asorry:
+ ld de,sorry
+ jr handleerror
+
+;*************************************************************
+;
+; *** GETLN *** FNDLN (& FRIENDS) ***
+;
+; 'GETLN' READS A INPUT LINE INTO 'BUFFER'. IT FIRST PROMPT
+; THE CHARACTER IN A (GIVEN BY THE CALLER), THEN IT FILLS
+; THE BUFFER AND ECHOS. IT IGNORES LF'S AND NULLS, BUT STILL
+; ECHOS THEM BACK. RUB-OUT IS USED TO CAUSE IT TO DELETE
+; THE LAST CHARACTER (IF THERE IS ONE), AND ALT-MOD IS USED TO
+; CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
+; CR SIGNALS THE END OF A LINE, AND CAUSE 'GETLN' TO RETURN.
+;
+; 'FNDLN' FINDS A LINE WITH A GIVEN LINE # (IN HL) IN THE
+; TEXT SAVE AREA. DE IS USED AS THE TEXT POINTER. IF THE
+; LINE IS FOUND, DE WILL POINT TO THE BEGINNING OF THAT LINE
+; (I.E., THE LOW BYTE OF THE LINE #), AND FLAGS ARE NC & Z.
+; IF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
+; IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ. IF
+; WE REACHED THE END OF TEXT SAVE AREA AND CANNOT FIND THE
+; LINE, FLAGS ARE C & NZ.
+; 'FNDLN' WILL INITIALIZE DE TO THE BEGINNING OF THE TEXT SAVE
+; AREA TO START THE SEARCH. SOME OTHER ENTRIES OF THIS
+; ROUTINE WILL NOT INITIALIZE DE AND DO THE SEARCH.
+; 'FNDLNP' WILL START WITH DE AND SEARCH FOR THE LINE #.
+; 'FNDNXT' WILL BUMP DE BY 2, FIND A CR AND THEN START SEARCH.
+; 'FNDSKP' USE DE TO FIND A CR, AND THEN START SEARCH.
+;*************************************************************
+getline:
+ call outc ; ** GetLine **
+ ld de,buffer ; prompt and initalise pointer
+gl1:
+ call chkio ; check keyboard
+ jr z,gl1 ; no input, so wait
+ cp bs ; erase last character?
+ jr z,gl3 ; yes
+ call outc ; echo character
+ cp lf ; ignore lf
+ jr z,gl1
+ or a ; ignore null
+ jr z,gl1
+ cp ctrlu ; erase the whole line?
+ jr z,gl4 ; yes
+ ld (de),a ; save the input
+ inc de ; and increment pointer
+ cp cr ; was it cr?
+ ret z ; yes, end of line
+ ld a,e ; any free space left?
+ cp bufend & 0ffh
+ jr nz,gl1 ; yes, get next char
+gl3:
+ ld a,e ; delete last character
+ cp buffer & 0ffh ; if there are any?
+ jr z,gl4 ; no, redo whole line
+ dec de ; yes, back pointer
+ ld a,08h ; and echo a backspace
+ call outc
+ jr gl1 ; and get next character
+gl4:
+ call crlf ; redo entire line
+ ld a,'>'
+ jr getline
+findline:
+ ld a,h ; ** FindLine **
+ or a ; check the sign of hl
+ jp m,qhow ; it cannot be negative
+ ld de,textbegin ; initialise the text pointer
+findlineptr:
+fl1:
+ push hl ; save line number
+ ld hl,(textunfilled) ; check if we passed end
+ dec hl
+ call comp
+ pop hl ; retrieve line number
+ ret c ; c,nz passed end
+ ld a,(de) ; we didn't; get first byte
+ sub l ; is this the line?
+ ld b,a ; compare low order
+ inc de
+ ld a,(de) ; get second byte
+ sbc a,h ; compare high order
+ jr c,fl2 ; no, not there yet
+ dec de ; else we either found it
+ or b ; or it's not there
+ ret ; nc,z:found; nc,nz:no
+findnext:
+ inc de ; find next line
+fl2:
+ inc de ; just passed first and second byte
+findskip:
+ ld a,(de) ; ** FindSkip **
+ cp cr ; try to find cr
+ jr nz,fl2 ; keep looking
+ inc de ; found cr, skip over
+ jr fl1 ; check if end of text
+
+;*************************************************************
+;
+; *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
+;
+; 'PRTSTG' PRINTS A STRING POINTED BY DE. IT STOPS PRINTING
+; AND RETURNS TO CALLER WHEN EITHER A CR IS PRINTED OR WHEN
+; THE NEXT BYTE IS THE SAME AS WHAT WAS IN A (GIVEN BY THE
+; CALLER). OLD A IS STORED IN B, OLD B IS LOST.
+;
+; 'QTSTG' LOOKS FOR A BACK-ARROW, SINGLE QUOTE, OR DOUBLE
+; QUOTE. IF NONE OF THESE, RETURN TO CALLER. IF BACK-ARROW,
+; OUTPUT A CR WITHOUT A LF. IF SINGLE OR DOUBLE QUOTE, PRINT
+; THE STRING IN THE QUOTE AND DEMANDS A MATCHING UNQUOTE.
+; AFTER THE PRINTING THE NEXT 3 BYTES OF THE CALLER IS SKIPPED
+; OVER (USUALLY A JUMP INSTRUCTION.
+;
+; 'PRTNUM' PRINTS THE NUMBER IN HL. LEADING BLANKS ARE ADDED
+; IF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
+; HOWEVER, IF THE NUMBER OF DIGITS IS LARGER THAN THE # IN
+; C, ALL DIGITS ARE PRINTED ANYWAY. NEGATIVE SIGN IS ALSO
+; PRINTED AND COUNTED IN, POSITIVE SIGN IS NOT.
+;
+; 'PRTLN' PRINTS A SAVED TEXT LINE WITH LINE # AND ALL.
+;*************************************************************
+printstr:
+ ld b,a
+ps1:
+ ld a,(de) ; get a character
+ inc de ; bump pointer
+ cp b ; same as old A?
+ ret z ; yes, return
+ call outc ; no, show character
+ cp cr ; was it a cr?
+ jr nz,ps1 ; no, next character
+ ret ; yes, returns
+qtstg:
+ call testc ; ** Qtstg **
+ .db 22h ; is it a double quote
+ .db qt3-$-1
+ ld a,22h
+qt1:
+ call printstr ; print until another
+ cp cr
+ pop hl
+ jp z,runnxl
+qt2:
+ inc hl ; skip 3 bytes on return
+ inc hl
+ inc hl
+ jp (hl) ; return
+qt3:
+ call testc ; is it a single quote
+ .db 27h
+ .db qt4-$-1
+ ld a,27h
+ jr qt1
+qt4:
+ call testc ; is it back-arrow
+ .db '_'
+ .db qt5-$-1
+ ld a,8dh ; yes, cr without lf
+ call outc
+ call outc
+ pop hl ; return address
+ jr qt2
+qt5:
+ ret ; none of the above
+
+printnum:
+ ld b,0h ; ** PrintNum **
+ call checksign ; check sign
+ jp p,pn1 ; no sign
+ ld b,'-'
+ dec c
+pn1:
+ push de ; save
+ ld de, 000ah ; decimal
+ push de ; save as flag
+ dec c ; c=spaces
+ push bc ; save sign & space
+pn2:
+ call divide ; divide hl by 10
+ ld a,b ; result 0?
+ or c
+ jr z,pn3 ; yes, we got all
+ ex (sp),hl ; no, save remainder
+ dec l ; and count space
+ push hl ; hl is old bc
+ ld h,b ; moved result to bc
+ ld l,c
+ jr pn2 ; and divide by 10
+pn3:
+ pop bc ; we got all digits
+pn4:
+ dec c
+ ld a,c ; look at space count
+ or a
+ jp m,pn5 ; no leading spaces
+ ld a,' ' ; print a leading space
+ call outc
+ jr pn4 ; any more?
+pn5:
+ ld a,b ; print sign
+ or a
+ call nz,outc
+ ld e,l ; last remainder in e
+pn6:
+ ld a,e ; check digit in e
+ cp lf ; lf is flag for no more
+ pop de
+ ret z ; if yes, return
+ add a,30h ; else convert to ascii
+ call outc ; and print the digit
+ jr pn6 ; next digit
+printhex:
+ ld c,h ; ** PrintHex **
+ call ph1 ; first hex byte
+printhex8:
+ ld c,l ; then second
+ph1:
+ ld a,c ; get left nibble into position
+ rra
+ rra
+ rra
+ rra
+ call ph2 ; and turn into hex digit
+ ld a,c ; then convert right nibble
+ph2:
+ and 0fh ; mask right nibble
+ add a,90h ; and convert to ascii character
+ daa
+ adc a,40h
+ daa
+ call outc ; print character
+ ret
+printline:
+ ld a,(de) ; ** PrintLine **
+ ld l,a ; low order line number
+ inc de
+ ld a,(de) ; high order
+ ld h,a
+ inc de
+ ld c,04h ; print 4 digit line number
+ call printnum
+ ld a,' ' ; followed by a space
+ call outc
+ sub a ; and the the rest
+ call printstr
+ ret
+
+;*************************************************************
+;
+; *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
+;
+; 'MVUP' MOVES A BLOCK UP FROM WHERE DE-> TO WHERE BC-> UNTIL
+; DE = HL
+;
+; 'MVDOWN' MOVES A BLOCK DOWN FROM WHERE DE-> TO WHERE HL->
+; UNTIL DE = BC
+;
+; 'POPA' RESTORES THE 'FOR' LOOP VARIABLE SAVE AREA FROM THE
+; STACK
+;
+; 'PUSHA' STACKS THE 'FOR' LOOP VARIABLE SAVE AREA INTO THE
+; STACK
+;*************************************************************
+mvup:
+ call comp ; ** mvup **
+ ret z ; de = hl, return
+ ld a,(de) ; get one byte
+ ld (bc),a ; then copy it
+ inc de ; increase both pointers
+ inc bc
+ jr mvup ; until done
+mvdown:
+ ld a,b ; ** mvdown **
+ sub d ; check if de = bc
+ jp nz,md1 ; no, go move
+ ld a,c ; maybe, other byte
+ sub e
+ ret z ; yes, return
+md1:
+ dec de ; else move a byte
+ dec hl ; but first decrease both pointers
+ ld a,(de) ; and then do it
+ ld (hl),a
+ jr mvdown ; loop back
+popa:
+ pop bc ; bc = return address
+ pop hl ; restore loopvar
+ ld (loopvar),hl
+ ld a,h
+ or l
+ jr z,pp1 ; all done, so return
+ pop hl
+ ld (loopinc),hl
+ pop hl
+ ld (looplmt),hl
+ pop hl
+ ld (loopln),hl
+ pop hl
+ ld (loopptr),hl
+pp1:
+ push bc ; bc = return address
+ ret
+pusha:
+ ld hl,stacklimit ; ** PushA **
+ call changesign
+ pop bc ; bc = return address
+ add hl,sp ; is stack near the top?
+ jp nc,qsorry ; yes, sorry
+ ld hl,(loopvar) ; else save loop variables
+ ld a,h
+ or l
+ jr z,pu1 ; only when loopvar not 0
+ ld hl,(loopptr)
+ push hl
+ ld hl,(loopln)
+ push hl
+ ld hl,(looplmt)
+ push hl
+ ld hl,(loopinc)
+ push hl
+ ld hl,(loopvar)
+pu1:
+ push hl
+ push bc ; bc = return address
+ ret
+
+testvar:
+ call skipspace ; ** testvar **
+ sub '@' ; test variables
+ ret c ; not a variable
+ jr nz,tv1 ; not @ array
+ inc de ; is is the @ array
+ call parn ; @ should be followed by (expr)
+ add hl,hl ; as its index
+ jr c,qhow ; is index too big?
+ push de ; will it override text?
+ ex de,hl
+ call size ; find the size of free
+ call comp
+ jp c,asorry ; yes, sorry
+ ld hl,varbegin ; no, get address of @(expr) and
+ call subde ; put it in hl
+ pop de
+ ret
+tv1:
+ cp 1bh ; not @, is it A to Z
+ ccf
+ ret c
+ inc de ; if A trhough Z
+ ld hl,varbegin ; calculate address of that variable
+ rlca ; and return it in hl
+ add a,l ; with the c flag cleared
+ ld l,a
+ ld a,0
+ adc a,h
+ ld h,a
+ ret
+
+testnum:
+ ld hl,0000h ; ** TestNum **
+ ld b,h ; test if the text is a number
+ call skipspace
+tn1:
+ cp '0' ; if not,return 0 in b and hl
+ ret c
+ cp ':' ; if a digit, convert to binary in
+ ret nc ; b and hl
+ ld a,0f0h ; set b to number of digits
+ and h ; if h>255, there is no room for
+ jr nz,qhow ; next digit
+ inc b ; b counts number of digits
+ push bc
+ ld b,h ; hl=10*hl+(new digit)
+ ld c,l
+ add hl,hl ; where 10* is done by shift and add
+ add hl,hl
+ add hl,bc
+ add hl,hl
+ ld a,(de) ; and (digit) is by stripping the
+ inc de ; ascii code
+ and 0fh
+ add a,l
+ ld l,a
+ ld a,0
+ adc a,h
+ ld h,a
+ pop bc
+ ld a,(de)
+ jp p,tn1
+qhow:
+ push de ; ** Error How? **
+ahow:
+ ld de,how
+ jp handleerror
+
+msg1 .db "TASTY BASIC",cr
+msg2 .db " BYTES FREE",cr
+how .db "HOW?",cr
+ok .db "OK",cr
+what .db "WHAT?",cr
+sorry .db "SORRY",cr
+
+;*************************************************************
+;
+; *** MAIN ***
+;
+; THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM
+; AND STORES IT IN THE MEMORY.
+;
+; AT START, IT PRINTS OUT "(CR)OK(CR)", AND INITIALIZES THE
+; STACK AND SOME OTHER INTERNAL VARIABLES. THEN IT PROMPTS
+; ">" AND READS A LINE. IF THE LINE STARTS WITH A NON-ZERO
+; NUMBER, THIS NUMBER IS THE LINE NUMBER. THE LINE NUMBER
+; (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)
+; IS STORED IN THE MEMORY. IF A LINE WITH THE SAME LINE
+; NUMBER IS ALREADY THERE, IT IS REPLACED BY THE NEW ONE. IF
+; THE REST OF THE LINE CONSISTS OF A CR ONLY, IT IS NOT STORED
+; AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
+;
+; AFTER A LINE IS INSERTED, REPLACED, OR DELETED, THE PROGRAM
+; LOOPS BACK AND ASKS FOR ANOTHER LINE. THIS LOOP WILL BE
+; TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
+; NUMBER; AND CONTROL IS TRANSFERED TO "DIRECT".
+;
+; TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
+; LABELED "TXTBGN" AND ENDS AT "TXTEND". WE ALWAYS FILL THIS
+; AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED
+; BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".
+;
+; THE MEMORY LOCATION "CURRNT" POINTS TO THE LINE NUMBER
+; THAT IS CURRENTLY BEING INTERPRETED. WHILE WE ARE IN
+; THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND
+; (SEE NEXT SECTION). "CURRNT" SHOULD POINT TO A 0.
+;*************************************************************
+rstart:
+ ld sp,stack
+st1:
+ call crlf
+ sub a ; a=0
+ ld de,ok ; print ok
+ call printstr
+ ld hl,st2 + 1 ; literal zero
+ ld (current),hl ; reset current line pointer
+st2:
+ ld hl,0000h
+ ld (loopvar),hl
+ ld (stkgos),hl
+st3:
+ ld a,'>' ; initialise prompt
+ call getline
+ push de ; de points to end of line
+ ld de,buffer ; point de to beginning of line
+ call testnum ; check if it is a number
+ call skipspace
+ ld a,h ; hl = value of the number, or
+ or l ; 0 if no number was found
+ pop bc ; bc points to end of line
+ jp z,direct
+ dec de ; back up de and save the value of
+ ld a,h ; the value of the line number there
+ ld (de),a
+ dec de
+ ld a,l
+ ld (de),a
+ push bc ; bc,de point to begin,end
+ push de
+ ld a,c
+ sub e
+
+ push af ; a = number of bytes in line
+ call findline ; find this line in save area
+ push de ; de points to save area
+ jr nz,st4 ; nz: line not found
+ push de ; z: found, delete it
+ call findnext ; find next line
+ ; de -> next line
+ pop bc ; bc -> line to be deleted
+ ld hl,(textunfilled) ; hl -> unfilled text area
+ call mvup ; move up to delete
+ ld h,b ; txtunf -> unfilled area
+ ld l,c
+ ld (textunfilled),hl
+st4:
+ pop bc ; get ready to insert
+ ld hl,(textunfilled) ; but first check if the length
+ pop af ; of new line is 3 (line# and cr)
+ push hl
+ cp 3h ; if so, do not insert
+ jr z,rstart ; must clear the stack
+ add a,l ; calculate new txtunf
+ ld l,a
+ ld a,0
+ adc a,h
+ ld h,a ; hl -> new unfilled area
+ ld de,textend ; check to see if there is space
+ call comp
+ jp nc,qsorry ; no, sorry
+ ld (textunfilled),hl ; ok, update textunfilled
+ pop de ; de -> old unfilled area
+ call mvdown
+ pop de ; de,hl -> begin,end
+ pop hl
+ call mvup ; copy new line to save area
+ jr st3
+
+;*************************************************************
+;
+; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT
+; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE
+; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST
+; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS
+; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS:
+;
+; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
+; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE
+; GO BACK TO 'RSTART'.
+; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.
+; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.
+; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE
+; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.)
+;*************************************************************
+;
+; *** NEW *** CLEAR *** STOP *** RUN (& FRIENDS) *** GOTO ***
+;
+; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'
+;
+; 'CLEAR(CR)' CLEARS ALL VARIABLES
+;
+; 'END(CR)' GOES BACK TO 'RSTART'
+;
+; 'RUN(CR)' FINDS THE FIRST STORED LINE, STORE ITS ADDRESS (IN
+; 'CURRENT'), AND START EXECUTE IT. NOTE THAT ONLY THOSE
+; COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.
+;
+; THERE ARE 3 MORE ENTRIES IN 'RUN':
+; 'RUNNXL' FINDS NEXT LINE, STORES ITS ADDR. AND EXECUTES IT.
+; 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.
+; 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.
+;
+; 'GOTO EXPR(CR)' EVALUATES THE EXPRESSION, FIND THE TARGET
+; LINE, AND JUMP TO 'RUNTSL' TO DO IT.
+;*************************************************************
+#ifndef ZEMU
+bye:
+ call endchk ; ** Reboot **
+ LD A,BID_BOOT ; BOOT BANK
+ LD HL,0 ; ADDRESS ZERO
+ CALL HB_BNKCALL ; DOES NOT RETURN
+ HALT
+#endif
+new:
+ call endchk ; ** New **
+ ld hl,textbegin
+ ld (textunfilled),hl
+clear:
+ call clrvars ; ** Clear **
+ jp rstart
+endd:
+ call endchk ; ** End **
+ jp rstart
+run:
+ call endchk ; ** Run **
+ ld de,textbegin
+runnxl:
+ ld hl,0h ; ** Run Next Line **
+ call findlineptr
+ jp c,rstart
+runtsl:
+ ex de,hl ; ** Run Tsl
+ ld (current),hl ; set current -> line #
+ ex de,hl
+ inc de
+ inc de
+runsml:
+ call chkio ; ** Run Same Line **
+ ld hl, tab2-1 ; find the command in table 2
+ jp exec ; and execute it
+goto:
+ call expr
+ push de ; save for error routine
+ call endchk ; must find a cr
+ call findline ; find the target line
+ jp nz, ahow ; no such line #
+ pop af ; clear the pushed de
+ jr runtsl ; go do it
+
+;*************************************************************
+;
+; *** LIST *** & PRINT ***
+;
+; LIST HAS TWO FORMS:
+; 'LIST(CR)' LISTS ALL SAVED LINES
+; 'LIST #(CR)' START LIST AT THIS LINE #
+; YOU CAN STOP THE LISTING BY CONTROL C KEY
+;
+; PRINT COMMAND IS 'PRINT ....;' OR 'PRINT ....(CR)'
+; WHERE '....' IS A LIST OF EXPRESIONS, FORMATS, BACK-
+; ARROWS, AND STRINGS. THESE ITEMS ARE SEPERATED BY COMMAS.
+;
+; A FORMAT IS A POUND SIGN FOLLOWED BY A NUMBER. IT CONTROLS
+; THE NUMBER OF SPACES THE VALUE OF A EXPRESION IS GOING TO
+; BE PRINTED. IT STAYS EFFECTIVE FOR THE REST OF THE PRINT
+; COMMAND UNLESS CHANGED BY ANOTHER FORMAT. IF NO FORMAT IS
+; SPECIFIED, 6 POSITIONS WILL BE USED.
+;
+; A STRING IS QUOTED IN A PAIR OF SINGLE QUOTES OR A PAIR OF
+; DOUBLE QUOTES.
+;
+; A BACK-ARROW MEANS GENERATE A (CR) WITHOUT (LF)
+;
+; A (CRLF) IS GENERATED AFTER THE ENTIRE LIST HAS BEEN
+; PRINTED OR IF THE LIST IS A NULL LIST. HOWEVER IF THE LIST
+; ENDED WITH A COMMA, NO (CRLF) IS GENERATED.
+;*************************************************************
+list:
+ call testnum ; check if there is a number
+ call endchk ; if no number we get a 0
+ call findline ; find this or next line
+ls1:
+ jp c,rstart
+ call printline ; print the line
+ call chkio ; stop on ctrl-c
+ call findlineptr ; find the next line
+ jr ls1 ; and loop back
+
+print:
+ ld c,6 ; c = number of spaces
+ call testc ; is it a semicolon?
+ .db ':'
+ .db pr2-$-1
+ call crlf
+ jr runsml
+pr2:
+ call testc ; is it a cr?
+ .db cr
+ .db pr0-$-1
+ call crlf
+ jr runnxl
+pr0:
+ call testc ; is it format?
+ .db '#'
+ .db pr1-$-1
+ call expr
+ ld c,l
+ jr pr3
+pr1:
+ call testc ; is it a dollar?
+ .db '$'
+ .db pr4-$-1
+ call expr
+ ld c,l
+ call testc ; do we have a comma?
+ .db ','
+ .db pr6-$-1
+ push bc
+ call expr
+ pop bc
+ ld a,8 ; 8 bits?
+ cp c
+ jp nz,pr9 ; no, try 16
+ call printhex8 ; yes, print a single hex byte
+ jp pr3
+pr9:
+ ld a,10h ; 16 bits?
+ cp c
+ jp nz,qhow ; no, show error message
+ call printhex ; yes, print two hex bytes
+ jp pr3
+pr4:
+ call qtstg ; is it a string?
+ jr pr8
+pr3:
+ call testc ; is it a comma?
+ .db ','
+ .db pr6-$-1
+ call fin
+ jr pr0
+pr6:
+ call crlf ; list ends
+ call finish
+pr8:
+ call expr ; evaluate the expression
+ push bc
+ call printnum
+ pop bc
+ jr pr3
+
+;*************************************************************
+;
+; *** GOSUB *** & RETURN ***
+;
+; 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'
+; COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER
+; ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE
+; SUBROUTINE 'RETURN'. IN ORDER THAT 'GOSUB' CAN BE NESTED
+; (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.
+; THE STACK POINTER IS SAVED IN 'STKGOS', THE OLD 'STKGOS' IS
+; SAVED IN THE STACK. IF WE ARE IN THE MAIN ROUTINE, 'STKGOS'
+; IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),
+; BUT WE STILL SAVE IT AS A FLAG FOR NO FURTHER 'RETURN'S.
+;
+; 'RETURN(CR)' UNDOS EVERYTHING THAT 'GOSUB' DID, AND THUS
+; RETURN THE EXECUTION TO THE COMMAND AFTER THE MOST RECENT
+; 'GOSUB'. IF 'STKGOS' IS ZERO, IT INDICATES THAT WE
+; NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
+;*************************************************************
+gosub:
+ call pusha ; ** Gosub **
+ call expr ; save the current "FOR" params
+ push de ; and text pointer
+ call findline ; find the target line
+ jp nz,ahow ; how? because it doesn't exist
+ ld hl,(current) ; found it, save old 'current'
+ push hl
+ ld hl,(stkgos) ; and 'stkgos'
+ push hl
+ ld hl,0000h ; and load new ones
+ ld (loopvar),hl
+ add hl,sp
+ ld (stkgos),hl
+ jp runtsl ; and run the line
+return:
+ call endchk ; there must be a cr
+ ld hl,(stkgos) ; check old stack pointer
+ ld a,h ;
+ or l
+ jp z,what ; what? not found
+ ld sp,hl ; otherwise restore it
+ pop hl
+ ld (stkgos),hl
+ pop hl
+ ld (current),hl ; and old 'current'
+ pop de ; and old text pointer
+ call popa ; and old 'FOR' params
+ call finish ; and we're back
+
+;*************************************************************
+;
+; *** FOR *** & NEXT ***
+;
+; 'FOR' HAS TWO FORMS:
+; 'FOR VAR=EXP1 TO EXP2 STEP EXP3' AND 'FOR VAR=EXP1 TO EXP2'
+; THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
+; EXP3=1. (I.E., WITH A STEP OF +1.)
+; TBI WILL FIND THE VARIABLE VAR, AND SET ITS VALUE TO THE
+; CURRENT VALUE OF EXP1. IT ALSO EVALUATES EXP2 AND EXP3
+; AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTER ETC. IN
+; THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
+; 'LOPLMT', 'LOPLN', AND 'LOPPT'. IF THERE IS ALREADY SOME-
+; THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO
+; 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK
+; BEFORE THE NEW ONE OVERWRITES IT.
+; TBI WILL THEN DIG IN THE STACK AND FIND OUT IF THIS SAME
+; VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
+; IF THAT IS THE CASE, THEN THE OLD 'FOR' LOOP IS DEACTIVATED.
+; (PURGED FROM THE STACK..)
+;
+; 'NEXT VAR' SERVES AS THE LOGICAL (NOT NECESSARILLY PHYSICAL)
+; END OF THE 'FOR' LOOP. THE CONTROL VARIABLE VAR. IS CHECKED
+; WITH THE 'LOPVAR'. IF THEY ARE NOT THE SAME, TBI DIGS IN
+; THE STACK TO FIND THE RIGHT ONE AND PURGES ALL THOSE THAT
+; DID NOT MATCH. EITHER WAY, TBI THEN ADDS THE 'STEP' TO
+; THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT. IF IT
+; IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
+; FOLLOWING THE 'FOR'. IF OUTSIDE THE LIMIT, THE SAVE AREA
+; IS PURGED AND EXECUTION CONTINUES.
+;*************************************************************
+
+for:
+ call pusha ; save old save area
+ call setval ; set the control variable
+ dec hl ; its address is hl
+ ld (loopvar),hl ; save that
+ ld hl,tab5-1 ; use 'exec' to find 'TO'
+ jp exec
+fr1:
+ call expr ; evaluate the limit
+ ld (looplmt),hl ; and save it
+ ld hl,tab6-1 ; use 'exec' to find 'STEP'
+ jp exec
+fr2:
+ call expr ; found 'STEP'
+ jr fr4
+fr3:
+ ld hl,0001h ; no 'STEP' so set to 1
+fr4:
+ ld (loopinc),hl ; and save that too
+fr5:
+ ld hl,(current) ; save current line number
+ ld (loopln),hl
+ ex de,hl ; and text pointer
+ ld (loopptr),hl
+ ld bc,0ah ; dig into stack to find loopvar
+ ld hl,(loopvar)
+ ex de,hl
+ ld h,b
+ ld l,b
+ add hl,sp
+ .db 3eh
+fr7:
+ add hl,bc
+ ld a,(hl)
+ inc hl
+ or (hl)
+ jr z,fr8
+ ld a,(hl)
+ dec hl
+ cp d
+ jr nz,fr7
+ ld a,(hl)
+ cp e
+ jr nz,fr7
+ ex de,hl
+ ld hl,0000h
+ add hl,sp
+ ld b,h
+ ld c,l
+ ld hl,000ah
+ add hl,de
+ call mvdown
+ ld sp,hl
+fr8:
+ ld hl,(loopptr) ; all done
+ ex de,hl
+ call finish
+next:
+ call testvar ; get address of variable
+ jp c,qwhat ; what, no variable
+ ld (varnext),hl ; yes, save it
+nx0:
+ push de ; save the text pointer
+ ex de,hl
+ ld hl,(loopvar) ; get the variable in 'FOR'
+ ld a,h
+ or l ; if 0, there never was one
+ jp z,awhat
+ call comp ; else check them
+ jr z,nx3 ; yes, they agree
+ pop de ; no, complete current loop
+ call popa
+ ld hl,(varnext) ; and pop one level
+ jr nx0 ; go check again
+nx3:
+ ld e,(hl)
+ inc hl
+ ld d,(hl) ; de = value of variable
+ ld hl,(loopinc)
+ push hl
+ ld a,h
+ xor d
+ ld a,d
+ add hl,de
+ jp m,nx4
+ xor h
+ jp m,nx5
+nx4:
+ ex de,hl
+ ld hl,(loopvar)
+ ld (hl),e
+ inc hl
+ ld (hl),d
+ ld hl,(looplmt)
+ pop af
+ or a
+ jp p,nx1 ; step > 0
+ ex de,hl ; step < 0
+nx1:
+ call ckhlde ; compare with limit
+ pop de ; restore the text pointer
+ jr c,nx2 ; over the limit
+ ld hl,(loopln) ; within the limit
+ ld (current),hl
+ ld hl,(loopptr)
+ ex de,hl
+ call finish
+nx5:
+ pop hl
+ pop de
+nx2:
+ call popa ; purge this loop
+ call finish ;
+
+init:
+ ld hl,start ; initialise random pointer
+ ld (rndptr),hl
+ ld hl,usrfunc ; initialise user defined function
+ ld (usrptr),hl
+ ld a,0c3h
+ ld (usrfunc),a ; initiase default USR() behaviour
+ ld hl,qhow ; (i.e. HOW? error)
+ ld (usrfunc+1),hl
+ ld hl,textbegin ; initialise text area pointers
+ ld (textunfilled),hl
+ ld (ocsw),a ; enable output control switch
+ call clrvars ; clear variables
+ call crlf
+ ld de,msg1 ; output welcome message
+ call printstr
+ call crlf
+ call size ; output free size message
+ call printnum
+ ld de,msg2
+ call printstr
+ jp rstart
+
+chkio:
+ call haschar ; check if character available
+ ret z ; no, return
+ call getchar ; get the character
+ push bc ; is it a lf?
+ ld b,a
+ sub lf
+ jr z,io1 ; yes, ignore an return
+ ld a,b ; no, restore a and bc
+ pop bc
+ cp ctrlo ; is it ctrl-o?
+ jr nz,io2 ; no, done
+ ld a,(ocsw) ; toggle output control switch
+ cpl
+ ld (ocsw),a
+ jr chkio ; get next character
+io1:
+ ld a,0h ; clear
+ or a ; set the z-flag
+ pop bc ; restore bc
+ ret ; return with z set
+io2:
+ cp 60h ; is it lower case?
+ jp c,io3 ; no
+ and 0dfh ; yes, make upper case
+io3:
+ cp ctrlc ; is it ctrl-c?
+ ret nz ; no
+ jp rstart ; yes, restart tasty basic
+crlf:
+ ld a,cr
+outc:
+ push af
+ ld a,(ocsw) ; check output control switch
+ or a
+ jr nz,oc1 ; output is enabled
+ pop af ; output is disabled
+ ret ; so return
+oc1:
+ pop af
+ call putchar
+ cp cr ; was it a cr?
+ ret nz ; no, return
+ ld a,lf ; send a lf
+ call outc
+ ld a,cr ; restore register
+ ret ; and return
+putchar:
+#ifdef ZEMU
+ call uart_tx_ready ; see if transmit is available
+ out (tty_data),a ; and send it
+ ret
+uart_tx_ready:
+ push af
+uart_tx_ready_loop:
+ in a,(tty_status)
+ bit tx_empty,a
+ jp z,uart_tx_ready_loop
+ pop af
+#else
+ PUSH AF
+ PUSH BC
+ PUSH DE
+ PUSH HL
+ ; OUTPUT CHARACTER TO CONSOLE VIA HBIOS
+ LD E,A ; OUTPUT CHAR TO E
+ LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
+ LD B,BF_CIOOUT ; HBIOS FUNC: OUTPUT CHAR
+ RST 08 ; HBIOS OUTPUTS CHARACTER
+ POP HL
+ POP DE
+ POP BC
+ POP AF
+#endif
+ ret
+haschar:
+#ifdef ZEMU
+ in a,(tty_status) ; check if character available
+ bit rx_full,a
+#else
+ PUSH BC
+ PUSH DE
+ PUSH HL
+ ; GET CONSOLE INPUT STATUS VIA HBIOS
+ LD C,CIODEV_CONSOLE; CONSOLE UNIT TO C
+ LD B,BF_CIOIST ; HBIOS FUNC: INPUT STATUS
+ RST 08 ; HBIOS RETURNS STATUS IN A
+ POP HL
+ POP DE
+ POP BC
+#endif
+ ret
+
+getchar:
+#ifdef ZEMU
+ in a,(tty_data) ; get the character
+#else
+ PUSH BC
+ PUSH DE
+ PUSH HL
+ ; INPUT CHARACTER FROM CONSOLE VIA HBIOS
+ LD C,CIODEV_CONSOLE ; CONSOLE UNIT TO C
+ LD B,BF_CIOIN ; HBIOS FUNC: INPUT CHAR
+ RST 08 ; HBIOS READS CHARACTDR
+ LD A,E ; MOVE CHARACTER TO A FOR RETURN
+ ; RESTORE REGISTERS (AF IS OUTPUT)
+ POP HL
+ POP DE
+ POP BC
+#endif
+ ret
+
+;*************************************************************
+;
+; *** TABLES *** DIRECT *** & EXEC ***
+;
+; THIS SECTION OF THE CODE TESTS A STRING AGAINST A TABLE.
+; WHEN A MATCH IS FOUND, CONTROL IS TRANSFERED TO THE SECTION
+; OF CODE ACCORDING TO THE TABLE.
+;
+; AT 'EXEC', DE SHOULD POINT TO THE STRING AND HL SHOULD POINT
+; TO THE TABLE-1. AT 'DIRECT', DE SHOULD POINT TO THE STRING.
+; HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF
+; ALL DIRECT AND STATEMENT COMMANDS.
+;
+; A '.' IN THE STRING WILL TERMINATE THE TEST AND THE PARTIAL
+; MATCH WILL BE CONSIDERED AS A MATCH. E.G., 'P.', 'PR.',
+; 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.
+;
+; THE TABLE CONSISTS OF ANY NUMBER OF ITEMS. EACH ITEM
+; IS A STRING OF CHARACTERS WITH BIT 7 SET TO 0 AND
+; A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH
+; BYTE SET TO 1.
+;
+; END OF TABLE IS AN ITEM WITH A JUMP ADDRESS ONLY. IF THE
+; STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
+; MATCH THIS NULL ITEM AS DEFAULT.
+;*************************************************************
+tab1: ; direct commands
+ .db "LIST"
+ dwa(list)
+ .db "RUN"
+ dwa(run)
+ .db "NEW"
+ dwa(new)
+ .db "CLEAR"
+ dwa(clear)
+#ifndef ZEMU
+ .db "BYE"
+ dwa(bye)
+#endif
+tab2: ; direct/statement
+ .db "NEXT"
+ dwa(next)
+ .db "LET"
+ dwa(let)
+ .db "IF"
+ dwa(iff)
+ .db "GOTO"
+ dwa(goto)
+ .db "GOSUB"
+ dwa(gosub)
+ .db "RETURN"
+ dwa(return)
+ .db "REM"
+ dwa(rem)
+ .db "FOR"
+ dwa(for)
+ .db "INPUT"
+ dwa(input)
+ .db "PRINT"
+ dwa(print)
+ .db "POKE"
+ dwa(poke)
+ .db "END"
+ dwa(endd)
+ dwa(deflt)
+tab4: ; functions
+ .db "PEEK"
+ dwa(peek)
+ .db "RND"
+ dwa(rnd)
+ .db "ABS"
+ dwa(abs)
+ .db "USR"
+ dwa(usrexec)
+ .db "SIZE"
+ dwa(size)
+ dwa(xp40)
+tab5: ; 'TO' in 'FOR'
+ .db "TO"
+ dwa(fr1)
+tab6: ; 'STEP' in 'FOR'
+ .db "STEP"
+ dwa(fr2)
+ dwa(fr3)
+tab8: ; relational operators
+ .db ">="
+ dwa(xp11)
+ .db "#"
+ dwa(xp12)
+ .db ">"
+ dwa(xp13)
+ .db "="
+ dwa(xp15)
+ .db "<="
+ dwa(xp14)
+ .db "<"
+ dwa(xp16)
+ dwa(xp17)
+
+direct:
+ ld hl,tab1-1 ; ** Direct **
+exec:
+ call skipspace ; ** Exec **
+ push de
+ex1:
+ ld a,(de)
+ inc de
+ cp '.'
+ jr z,ex3
+ inc hl
+ cp (hl)
+ jr z,ex1
+ ld a,7fh
+ dec de
+ cp (hl)
+ jr c,ex5
+ex2:
+ inc hl
+ cp (hl)
+ jr nc,ex2
+ inc hl
+ pop de
+ jr exec
+ex3:
+ ld a,7fh
+ex4:
+ inc hl
+ cp (hl)
+ jr nc,ex4
+ex5:
+ ld a,(hl)
+ inc hl
+ ld l,(hl)
+ and 7fh
+ ld h,a
+ pop af
+ jp (hl)
+
+;-------------------------------------------------------------------------------
+LST_ROM: ; all the above _can_ be in rom
+ ; all following *must* be in ram
+ .org (TBC_LOC + 09feh)
+usrptr: .ds 2 ; -> user defined function area
+ .org (TBC_LOC + 0a00h)
+usrfunc .ds 2 ; start of user defined function area
+ .org (TBC_LOC + 0c00h) ; start of state
+ocsw .ds 1 ; output control switch
+current .ds 2 ; points to current line
+stkgos .ds 2 ; saves sp in 'GOSUB'
+varnext .ds 2 ; temp storage
+stkinp .ds 2 ; save sp in 'INPUT'
+loopvar .ds 2 ; 'FOR' loop save area
+loopinc .ds 2 ; loop increment
+looplmt .ds 2 ; loop limit
+loopln .ds 2 ; loop line number
+loopptr .ds 2 ; loop text pointer
+rndptr .ds 2 ; random number pointer
+textunfilled .ds 2 ; -> unfilled text area
+textbegin .ds 2 ; start of text save area
+ .org (TBC_LOC + 07dffh)
+textend .ds 0 ; end of text area
+varbegin .ds 55 ; variable @(0)
+varend .ds 0 ; end of variable area
+buffer .ds 72 ; input buffer
+bufend .ds 1
+stacklimit .ds 1
+ .org (TBC_LOC + 07fffh)
+stack .equ $
+
+#ifndef ZEMU
+SLACK .EQU (TBC_END - LST_ROM)
+ .FILL SLACK,'t'
+
+ .ECHO "TASTYBASIC space remaining: "
+ .ECHO SLACK
+ .ECHO " bytes.\n"
+#endif
+ .end