diff --git a/Source/BuildShared.cmd b/Source/BuildShared.cmd index df961d93..ea9a7b10 100644 --- a/Source/BuildShared.cmd +++ b/Source/BuildShared.cmd @@ -11,5 +11,6 @@ pushd CPM3 && call Build || exit /b & popd pushd ZPM3 && call Build || exit /b & popd pushd Apps && call Build || exit /b & popd pushd Forth && call Build || exit /b & popd +pushd TastyBasic && call Build || exit /b & popd pushd Fonts && call Build || exit /b & popd pushd RomDsk && call Build || exit /b & popd diff --git a/Source/Clean.cmd b/Source/Clean.cmd index 3507fcb2..1af0deff 100644 --- a/Source/Clean.cmd +++ b/Source/Clean.cmd @@ -11,6 +11,7 @@ pushd CBIOS && call Clean.cmd & popd pushd CPM3 && call Clean.cmd & popd pushd ZPM3 && call Clean.cmd & popd pushd Forth && call Clean.cmd & popd +pushd TastyBasic && call Clean & popd pushd Fonts && call Clean.cmd & popd pushd BPBIOS && call Clean.cmd & popd pushd HBIOS && call Clean.cmd & popd @@ -18,4 +19,3 @@ pushd Images && call Clean & popd pushd Prop && call Clean & popd pushd RomDsk && call Clean & popd pushd Doc && call Clean & popd - diff --git a/Source/HBIOS/Build.cmd b/Source/HBIOS/Build.cmd index b5967ec5..c0a9fe0f 100644 --- a/Source/HBIOS/Build.cmd +++ b/Source/HBIOS/Build.cmd @@ -70,7 +70,7 @@ call :asm romldr || exit /b call :asm eastaegg || exit /b call :asm nascom || exit /b -call :asm tastybasic || exit /b +:: call :asm tastybasic || exit /b call :asm game || exit /b call :asm usrrom || exit /b call :asm updater || exit /b @@ -84,7 +84,7 @@ call :asm imgpad2 || exit /b :: copy /b romldr.bin + dbgmon.bin + ..\zsdos\zsys_wbw.bin + ..\cpm22\cpm_wbw.bin osimg.bin || exit /b -copy /b ..\Forth\camel80.bin + nascom.bin + tastybasic.bin + game.bin + eastaegg.bin + netboot.mod + updater.bin + usrrom.bin osimg1.bin || exit /b +copy /b ..\Forth\camel80.bin + nascom.bin + ..\tastybasic\src\tastybasic.bin + game.bin + eastaegg.bin + netboot.mod + updater.bin + usrrom.bin osimg1.bin || exit /b copy /b imgpad2.bin osimg2.bin || exit /b copy /b romldr.bin + dbgmon.bin + ..\zsdos\zsys_wbw.bin osimg_small.bin || exit /b diff --git a/Source/HBIOS/Makefile b/Source/HBIOS/Makefile index cc7a94be..b1dc4abf 100644 --- a/Source/HBIOS/Makefile +++ b/Source/HBIOS/Makefile @@ -70,13 +70,16 @@ $(ROMNAME).rom $(ROMNAME).com $(ROMNAME).img &: $(ROMDEPS) cat hbios_app.bin osimg_small.bin > $(ROMNAME).com ; \ fi -prereq: $(FONTS) camel80.bin +prereq: $(FONTS) camel80.bin tastybasic.bin font%.asm: cp ../Fonts/$@ . camel80.bin: cp ../Forth/$@ . + +tastybasic.bin: + cp ../TastyBasic/src/$@ . hbios_rom.bin: hbios.asm build.inc $(DEPS) $(TASM) -dROMBOOT hbios.asm hbios_rom.bin hbios_rom.lst diff --git a/Source/HBIOS/std.asm b/Source/HBIOS/std.asm index 82a3be91..5630860c 100644 --- a/Source/HBIOS/std.asm +++ b/Source/HBIOS/std.asm @@ -592,7 +592,7 @@ BAS_END .EQU BAS_LOC + BAS_SIZ BAS_IMGLOC .EQU FTH_IMGLOC + FTH_SIZ TBC_LOC .EQU $0A00 ; TASTYBASIC -TBC_SIZ .EQU $0900 +TBC_SIZ .EQU $0A00 TBC_END .EQU TBC_LOC + TBC_SIZ TBC_IMGLOC .EQU BAS_IMGLOC + BAS_SIZ diff --git a/Source/HBIOS/tastybasic.asm b/Source/HBIOS/tastybasic.asm deleted file mode 100644 index 75162e67..00000000 --- a/Source/HBIOS/tastybasic.asm +++ /dev/null @@ -1,1905 +0,0 @@ - -; ----------------------------------------------------------------------------- -; 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 - LD B,BF_SYSRESET ; SYSTEM RESTART - LD C,BF_SYSRES_WARM ; WARM START - CALL $FFF0 ; CALL HBIOS - 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,CIO_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,CIO_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,CIO_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 diff --git a/Source/Images/d_cpm22.txt b/Source/Images/d_cpm22.txt index 8e4245a9..0be74e3d 100644 --- a/Source/Images/d_cpm22.txt +++ b/Source/Images/d_cpm22.txt @@ -17,6 +17,7 @@ d_cpm22/ReadMe.txt 0: ../../Binary/Apps/syscopy.com 0: ../../Binary/Apps/sysgen.com 0: ../../Binary/Apps/talk.com 0: +../../Binary/Apps/tbasic.com 0: ../../Binary/Apps/timer.com 0: ../../Binary/Apps/tune.com 0: ../../Binary/Apps/xm.com 0: diff --git a/Source/Images/d_zsdos.txt b/Source/Images/d_zsdos.txt index a691c5df..72106517 100644 --- a/Source/Images/d_zsdos.txt +++ b/Source/Images/d_zsdos.txt @@ -30,6 +30,7 @@ d_cpm22/u0/XSUB.COM 0: ../../Binary/Apps/syscopy.com 0: ../../Binary/Apps/sysgen.com 0: ../../Binary/Apps/talk.com 0: +../../Binary/Apps/tbasic.com 0: ../../Binary/Apps/timer.com 0: ../../Binary/Apps/tune.com 0: ../../Binary/Apps/xm.com 0: diff --git a/Source/Makefile b/Source/Makefile index 056fbcb8..d0dc7de1 100644 --- a/Source/Makefile +++ b/Source/Makefile @@ -6,6 +6,7 @@ SUBDIRS += Prop SUBDIRS += Apps SUBDIRS += CBIOS SUBDIRS += Forth +SUBDIRS += TastyBasic SUBDIRS += Fonts SUBDIRS += CPM22 ZCPR ZCPR-DJ ZSDOS CPM3 ZPM3 #SUBDIRS += BPBIOS diff --git a/Source/TastyBasic/Build.cmd b/Source/TastyBasic/Build.cmd new file mode 100644 index 00000000..d8138be3 --- /dev/null +++ b/Source/TastyBasic/Build.cmd @@ -0,0 +1,4 @@ +@echo off +setlocal + +pushd src && call Build || exit /b & popd diff --git a/Source/TastyBasic/Clean.cmd b/Source/TastyBasic/Clean.cmd new file mode 100644 index 00000000..ffdfa66c --- /dev/null +++ b/Source/TastyBasic/Clean.cmd @@ -0,0 +1,4 @@ +@echo off +setlocal + +pushd src && call Clean & popd diff --git a/Source/TastyBasic/LICENSE b/Source/TastyBasic/LICENSE new file mode 100644 index 00000000..3877ae0a --- /dev/null +++ b/Source/TastyBasic/LICENSE @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program 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. + + This program 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 this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/Source/TastyBasic/Makefile b/Source/TastyBasic/Makefile new file mode 100644 index 00000000..267ad065 --- /dev/null +++ b/Source/TastyBasic/Makefile @@ -0,0 +1,9 @@ +SUBDIRS := src +TARGETS := all clobber clean + +$(TARGETS): $(SUBDIRS) + +$(SUBDIRS): + $(MAKE) -C $@ $(MAKECMDGOALS) + +.PHONY: $(TARGETS) $(SUBDIRS) diff --git a/Source/TastyBasic/README.md b/Source/TastyBasic/README.md new file mode 100644 index 00000000..07e4a38b --- /dev/null +++ b/Source/TastyBasic/README.md @@ -0,0 +1,163 @@ +# Tasty Basic + +## Introduction +Tasty Basic is a basic interpreter for CP/M and RomWBW ([Warthen, 2021](##References)), based on +the Z80 port of Palo Alto Tiny Basic ([Gabbard, 2017; Rauskolb, 1976; Wang, 1976](##References)). + +## Tasty Basic Language +The Tasty Basic language is based on Palo Alto Tiny Basic, as described in the December 1976 +issue of Interface Age ([Rauskolb, 1976](##References)). As such, Tasty Basic shares many of the +same limitations as Palo Alto Basic. All numbers are integers and must be less than or +equal to 32767, and Tasty Basic supports only 26 variables denoted by letters A through Z. + +In addition to Tiny Basic's `ABS(n)`, `RND(n)` and `SIZE` functions, Tasty Basic also provides +statements and functions to read and write memory locations, and allows interaction with I/O ports. + +### Statements +Tasty Basic provides two statements to write to memory and I/O ports: + +`POKE m,n` Writes the value _n_ to address location _m_ + +`OUT m,n` Sends the value n to I/O port _m_ + +Additionally there are statements to define and read constant values: + +`DATA m[,n[,...]]` Used to store constant values in the program code. Each DATA statement can define one or more numeric constants separated by commas. `DATA` statements may appear anywhere in the program. + +`READ m` Reads the next available data value and assigns it to variable _m_, starting with the first item in the first `DATA` statement. + +`RESTORE` Resets the `READ` pointer to the first item of the data list, allowing `DATA` values to be re-read. + +#### CP/M Specific Statements +The CP/M version includes two additional statements that allow Tasty Basic programs to be saved +to, and loaded from, disk: + +`LOAD "filename"` Loads the Tasty Basic (`.TBA`) file with the given _filename_ from the current disk drive into memory. Any existing programs and variables are cleared before the program is loaded. + +`SAVE "filename"` Persists the program currently in memory in a file with the given _filename_ on the current disk drive. + +Refer to [Tasty Basic files](examples/README.md) for details of the `.TBA` file format. + +### Functions +Tasty Basic provides the following functions to read from and write to memory locations and I/O ports: + +`IN(m)` Returns the byte value read from I/O port _m_ + +`PEEK(m)` Returns the byte value of address location _m_ + +`USR(i)` Accepts a numeric expression _i_ , calls a user-defined machine language routine, and returns the resulting value. + +### User defined machine language routines +The `USR(i)` function enables interaction with user defined machine routines. +The entry point for these routines is specified using a platform specific vector +pointing to a default location as shown below. User defined code may be +placed elsewhere in memory by updating the vector values. +The value _i_ is passed to the routine in the `DE` register, which must also +contain the result on return. + +| Platform | Vector location | Default value | +| --- | --- | --- | +| CP/M | $0BFE/$0BFF | $0C00 | +| RomWBW | $13FE/$13FF | $1400 | + +### Example +The following example shows the bit summation for a given value: + +``` + 0000 #IFDEF CPM + 0C00 .ORG $0C00 ; ie. 3072 dec + 0C00~ #ELSE + 0C00~ .ORG $1400 ; ie. 5120 dec + 0C00 #ENDIF + 0C00 + 0C00 06 00 LD B,0 + 0C02 7A LD A,D + 0C03 CD 0E 0C CALL COUNT + 0C06 7B LD A,E + 0C07 CD 0E 0C CALL COUNT + 0C0A 58 LD E,B + 0C0B 16 00 LD D,0 + 0C0D C9 RET + 0C0E COUNT: + 0C0E B7 OR A + 0C0F C8 RET Z + 0C10 CB 47 BIT 0,A + 0C12 28 01 JR Z,NEXT + 0C14 04 INC B + 0C15 NEXT: + 0C15 CB 3F SRL A + 0C17 18 F5 JR COUNT + 0C19 + 0C19 .END +``` + +``` +10 REM -- CP/M VERSION +20 REM -- SEE EXAMPLES DIRECTORY FOR OTHER PLATFORMS +30 FOR I=0 TO 24 +40 READ A +50 POKE 3072+I,A +60 NEXT I +70 INPUT P +80 LET Q=USR(P) +90 PRINT "THE BIT SUMMATION OF ",#5,P," IS ",#2,Q +100 GOTO 70 +110 DATA 6,0,122,205,14,12,123,205,14,12,88,22,0,201 +120 DATA 183,200,203,71,40,1,4,203,63,24,245 +``` + +Note that the Tasty Basic program above is CP/M specific. Examples for other platforms can be found +in the `examples` directory. + +## Building Tasty Basic +Building Tasty Basic requires the `uz80as` Z80 assembler v1.12 or later ([Giner, 2021](##References)). +Alternatively, Windows users can use TASM (Telemark Assembler) ([Anderson, 1998](##References)). + +### RomWBW version +Tasty Basic is part of the SBCv2 RomWBW distribution. Please refer to the +[RomWBW github repository](https://github.com/wwarthen/RomWBW) for details. + +### CP/M version +The CP/M version of Tasty Basic can be built using the `-dCPM` flag: + +```uz80as -dCPM tastybasic.asm tbasic.com``` + +The resulting `tbasic.com` command file can be run in CP/M. For example: + +``` +B>TBASIC ↵ + +CP/M TASTY BASIC +28902 BYTES FREE + +OK +>10 PRINT "HELLO WORLD ", ↵ +>RUN ↵ +HELLO WORLD + +OK +>BYE ↵ + +B> +``` + +## Example BASIC programs + +A small number of example Tasty Basic programs are included in the `examples` directory. +Most of these programs are from _BASIC COMPUTER GAMES_ ([Ahl, 1978](##References)), and +have been modified as required to make them work with Tasty Basic. + +## License +In line with Wang's (1976) original Tiny Basic source listing and later derived works +by Rauskolb (1976) and Gabbard (2017), Tasty Basic is licensed under GPL v3. +For license details refer to the enclosed [LICENSE](../master/LICENSE) file. + +## References +Ahl, D. H. (Ed.).(1978). _BASIC COMPUTER GAMES_. New York, NY: Workman Publishing +Anderson, T. N. (1998). _The Telemark Assembler (TASM) User's Manual, Version 3.1._ Issaquah, WA: Squak Valley Software +b1ackmai1er (2018). _SBC V2_. Retrieved October 6, 2018, from [https://www.retrobrewcomputers.org/doku.php?id=boards:sbc:sbc_v2:start](https://www.retrobrewcomputers.org/doku.php?id=boards:sbc:sbc_v2:start) +Gabbard, D. (2017, October 10). _TinyBASIC for the z80 – TinyBASIC 2.0g._ Retrieved September 29, 2108, from [http://retrodepot.net/?p=274](http://retrodepot.net/?p=274) +Giner, J. (2021, August 1). _Micro Z80 assembler - uz80as._ Retrieved September 19, 2021, from [https://jorgicor.niobe.org/uz80as/](https://jorgicor.niobe.org/uz80as/) +Rauskolb, P. (1976, December). _DR. WANG'S PALO ALTO TINY BASIC._ Interface Age, (2)1, 92-108. Retrieved from [https://archive.org/stream/InterfaceAge197612/Interface%20Age%201976-12#page/n93/mode/1up](https://archive.org/stream/InterfaceAge197612/Interface%20Age%201976-12#page/n93/mode/1up) +Wang, L-C. (1976). _Palo Alto Tiny BASIC._ In J. C. Warren Jr. (Ed.), _Dr. Dobb's Journal of COMPUTER Calisthenics & Orthodontia_ (pp. 129-142). Menlo Park, CA: People's Computer Company +Warthen, W. (2021). _RomWBW, Z80/Z180 System Software._ Retrieved Octover 5, 2021, from [https://github.com/wwarthen/RomWBW](https://github.com/wwarthen/RomWBW) \ No newline at end of file diff --git a/Source/TastyBasic/examples/BATNUM.BAS b/Source/TastyBasic/examples/BATNUM.BAS new file mode 100644 index 00000000..13a3fdb8 --- /dev/null +++ b/Source/TastyBasic/examples/BATNUM.BAS @@ -0,0 +1,86 @@ +10 PRINT "BATNUM" +20 PRINT "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +30 PRINT +110 PRINT "THIS PROGRAM IS A 'BATTLE OF NUMBERS' GAME, WHERE THE" +120 PRINT "COMPUTER IS YOUR OPPONENT." +130 PRINT +140 PRINT "THE GAME STARTS WITH AN ASSUMED PILE OF OBJECTS. YOU" +150 PRINT "AND YOUR OPPONENT ALTERNATELY REMOVE OBJECTS FROM THE PILE." +160 PRINT "WINNING IS DEFINED IN ADVANCE AS TAKING THE LAST OBJECT OR" +170 PRINT "NOT. YOU CAN ALSO SPECIFY SOME OTHER BEGINNING CONDITIONS." +180 PRINT "DON'T USE ZERO, HOWEVER, IN PLAYING THE GAME." +190 PRINT "ENTER A NEGATIVE NUMBER FOR NEW PILE SIZE TO STOP PLAYING." +200 PRINT +210 GOTO 330 +220 FOR I=1 TO 10 +230 PRINT +240 NEXT I +330 INPUT "ENTER PILE SIZE"N +340 IF N<0 GOTO 1080 +350 IF N>=1 GOTO 390 +360 GOTO 330 +390 INPUT "ENTER WIN OPTION - 1 TO TAKE LAST, 2 TO AVOID LAST"M +410 IF M=1 GOTO 430 +420 IF M#2 GOTO 390 +430 INPUT "ENTER MIN PER TURN"A,"AND MAX"B +450 IF A>B GOTO 430 +460 IF A<1 GOTO 430 +490 INPUT "ENTER START OPTION - 1 COMPUTER FIRST, 2 YOU FIRST"S +500 PRINT +510 IF S=1 GOTO 530 +520 IF S#2 GOTO 490 +530 C=A+B +540 IF S=2 GOTO 570 +550 GOSUB 600 +560 IF W=1 GOTO 220 +570 GOSUB 810 +580 IF W=1 GOTO 220 +590 GOTO 550 +600 Q=N +610 IF M=1 GOTO 630 +620 Q=Q-1 +630 IF M=1 GOTO 680 +640 IF N>A GOTO 720 +650 W=1 +660 PRINT "COMPUTER TAKES",N," AND LOSES." +670 RETURN +680 IF N>B GOTO 720 +690 W=1 +700 PRINT "COMPUTER TAKES",N," AND WINS." +710 RETURN +720 P=Q-C*(Q/C) +730 IF P>=A GOTO 750 +740 P=A +750 IF P<=B GOTO 770 +760 P=B +770 N=N-P +780 PRINT "COMPUTER TAKES",P," AND LEAVES",N +790 W=0 +800 RETURN +810 PRINT +820 INPUT "YOUR MOVE"P +830 IF P#0 GOTO 880 +840 PRINT "I TOLD YOU NOT TO USE ZERO! COMPUTER WINS BY FORFEIT." +850 W=1 +860 RETURN +880 IF P>=A GOTO 910 +890 IF P=N GOTO 960 +900 GOTO 920 +910 IF P<=B GOTO 940 +920 PRINT "ILLEGAL MOVE, REENTER IT!" +930 GOTO 820 +940 N=N-P +950 IF N#0 GOTO 1030 +960 IF M=1 GOTO 1000 +970 PRINT "TOUGH LUCK, YOU LOSE." +980 W=1 +990 RETURN +1000 PRINT "CONGRATULATIONS, YOU WIN." +1010 W=1 +1020 RETURN +1030 IF N>=0 GOTO 1060 +1040 N=N+P +1050 GOTO 920 +1060 W=0 +1070 RETURN +1080 END diff --git a/Source/TastyBasic/examples/DUMP.BAS b/Source/TastyBasic/examples/DUMP.BAS new file mode 100644 index 00000000..db91aca3 --- /dev/null +++ b/Source/TastyBasic/examples/DUMP.BAS @@ -0,0 +1,16 @@ +10 INPUT "ADDRESS"A +20 FOR I=0 TO 15 +30 P=A+I*16 +40 PRINT $16,P, +50 FOR J=0 TO 15 +60 PRINT " ",$8,PEEK(P+J), +70 NEXT J +80 PRINT +90 NEXT I +100 INPUT ""Q +110 IF Q<0 GOTO 160 +120 A=A+256 +130 IF Q=0 GOTO 20 +140 A=Q +150 GOTO 20 +160 END diff --git a/Source/TastyBasic/examples/README.md b/Source/TastyBasic/examples/README.md new file mode 100644 index 00000000..270e33a0 --- /dev/null +++ b/Source/TastyBasic/examples/README.md @@ -0,0 +1,25 @@ +# Tasty Basic Files + +## Introduction +The CP/M version of Tasty Basic allows programs to be saved to and loaded from disk. This +document describes the Tasty Basic `.TBA` file format. + +## .TBA File format +Tasty Basic `.TBA` files are direct reflections of Tasty Basic programs as held in memory. Thus, +each line of code starts with a 16 bit, LSB first, line number and ends with a carriage return +character (0xD). An EOF marker (0x1A) indicates the end of the file. Any trailing NUL characters +(0x0) are ignored. + +### Example +Following is an example Tasty Basic program: +``` +10 PRINT "HELLO WORLD" +20 GOTO 10 +``` +And its `.TBA` file representation: +``` +0A 00 50 52 49 4E 54 20 22 48 45 4C 4C 4F 20 57 +4F 52 4C 44 22 0D 14 00 47 4F 54 4F 20 31 30 0D +1A 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 +``` + diff --git a/Source/TastyBasic/examples/REVERSE.BAS b/Source/TastyBasic/examples/REVERSE.BAS new file mode 100644 index 00000000..e8c235c7 --- /dev/null +++ b/Source/TastyBasic/examples/REVERSE.BAS @@ -0,0 +1,74 @@ +10 PRINT "REVERSE" +30 PRINT "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +100 PRINT "REVERSE -- A GAME OF SKILL" +140 REM *** N=NUMBER OF NUMBERS +150 N=9 +160 INPUT "DO YOU WANT THE RULES (0=NO,1=YES)"A +180 IF A=0 GOTO 210 +190 GOSUB 710 +200 REM *** MAKE A RANDOM LIST @(1) TO @(N) +210 @(1)=RND(N-1)+1 +220 FOR K=2 TO N +230 @(K)=RND(N) +240 FOR J=1 TO K-1 +250 IF @(K)=@(J) GOTO 230 +260 NEXT J +270 NEXT K +280 REM *** PRINT ORIGINAL LIST AND START GAME +290 PRINT +300 PRINT "HERE WE GO ... THE LIST IS:" +310 T=0 +320 GOSUB 610 +330 INPUT "HOW MANY SHALL I REVERSE"R +350 IF R=0 GOTO 520 +360 IF R<=N GOTO 390 +370 PRINT "OOPS! TOO MANY! I CAN REVERSE AT MOST ",#2,N +380 GOTO 330 +390 T=T+1 +400 REM *** REVERSE R NUMBERS AND PRINT NEW LIST +410 FOR K=1 TO R/2 +420 Z=@(K) +430 @(K)=@(R-K+1) +440 @(R-K+1)=Z +450 NEXT K +460 GOSUB 610 +470 REM *** CHECK FOR A WIN +480 FOR K=1 TO N +490 IF @(K)#K GOTO 330 +500 NEXT K +510 PRINT "YOU WON IT IN",T," MOVES!!!" +520 PRINT +530 INPUT "TRY AGAIN (1=YES, 0=NO)"A +550 IF A=1 GOTO 210 +560 PRINT +565 PRINT "O.K. HOPE YOU HAD FUN!!" +570 GOTO 999 +600 REM *** SUBROUTINE TO PRINT LIST +610 PRINT +620 FOR K=1 TO N +630 PRINT #2,@(K), +640 NEXT K +650 PRINT +660 RETURN +700 REM *** SUBROUTINE TO PRINT THE RULES +710 PRINT "THIS IS THE GAME OF 'REVERSE'. TO WIN, ALL YOU HAVE" +720 PRINT "TO DO IS ARRANGE A LIST OF NUMBERS (1 THROUGH ",#2,N,")" +730 PRINT "IN NUMERICAL ORDER FROM LEFT TO RIGHT. TO MOVE, YOU" +740 PRINT "TELL ME HOW MANY NUMBERS (COUNTING FROM THE LEFT) TO" +750 PRINT "REVERSE. FOR EXAMPLE, IF THE CURRENT LIST IS:" +755 PRINT +760 PRINT " 2 3 4 5 1 6 7 8 9" +765 PRINT +770 PRINT "AND YOU REVERSE 4, THE RESULT WILL BE:" +775 PRINT +780 PRINT " 5 4 3 2 1 6 7 8 9" +785 PRINT +790 PRINT "NOW IF YOU REVERSE 5, YOU WIN!" +795 PRINT +800 PRINT " 1 2 3 4 5 6 7 8 9" +805 PRINT +810 PRINT "NO DOUBT YOU WILL LIKE THIS GAME, BUT" +820 PRINT "IF YOU WANT TO QUIT, REVERSE 0 (ZERO)." +830 PRINT +840 RETURN +999 END diff --git a/Source/TastyBasic/examples/SBCRTC.BAS b/Source/TastyBasic/examples/SBCRTC.BAS new file mode 100644 index 00000000..ba8bc2c4 --- /dev/null +++ b/Source/TastyBasic/examples/SBCRTC.BAS @@ -0,0 +1,30 @@ +100 REM -- ADJUST USR FUNCTION POINTER +110 POKE 5118,6 +120 POKE 5119,20 +200 REM -- RTC BUFFER AT 5120-5125 +210 FOR I=0 TO 14 +220 READ A +230 POKE 5126+I,A +240 NEXT I +250 DATA 6,32,123,178,40,1,4,33,0,20,207,17,0,0,201 +300 INPUT "GET OR SET TIME (GET=0,SET=1)"P +310 IF P=0 GOTO 400 +320 A=5120:INPUT "YEAR"Q:GOSUB 500 +330 A=5121:INPUT "MONTH"Q:GOSUB 500 +340 A=5122:INPUT "DAY"Q:GOSUB 500 +350 A=5123:INPUT "HOURS"Q:GOSUB 500 +360 A=5124:INPUT "MINS"Q:GOSUB 500 +370 A=5125:INPUT "SECS"Q:GOSUB 500 +400 Q=USR(P) +410 PRINT $8,PEEK(5120),"-", +420 PRINT $8,PEEK(5121),"-", +430 PRINT $8,PEEK(5122)," ", +440 PRINT $8,PEEK(5123),":", +450 PRINT $8,PEEK(5124),":", +460 PRINT $8,PEEK(5125) +470 GOTO 300 +500 T=Q/10 +510 U=Q-10*T +520 B=T*16+U +530 POKE A,B +540 RETURN diff --git a/Source/TastyBasic/examples/TICTAC.BAS b/Source/TastyBasic/examples/TICTAC.BAS new file mode 100644 index 00000000..e6c9258a --- /dev/null +++ b/Source/TastyBasic/examples/TICTAC.BAS @@ -0,0 +1,117 @@ +2 PRINT "TIC-TAC-TOE" +4 PRINT "CREATIVE COMPUTING MORRISTOWN, NEW JERSEY" +6 PRINT +8 PRINT "THE BOARD IS NUMBERED:" +10 PRINT " 1 2 3" +12 PRINT " 4 5 6" +14 PRINT " 7 8 9" +16 PRINT +20 FOR I=1 TO 9:@(I)=0:NEXT I +50 INPUT"DO YOU WANT 'X' OR 'O' (X=1,O=0)"C +55 IF C=1 GOTO 475 +60 P=0,Q=1 +100 G=-1,H=1:IF @(5)#0 GOTO 103 +102 @(5)=-1:GOTO 195 +103 IF @(5)#1 GOTO 106 +104 IF @(1)#0 GOTO 110 +105 @(1)=-1:GOTO 195 +106 IF (@(2)=1)*(@(1)=0) GOTO 181 +107 IF (@(4)=1)*(@(1)=0) GOTO 181 +108 IF (@(6)=1)*(@(9)=0) GOTO 189 +109 IF (@(8)=1)*(@(9)=0) GOTO 189 +110 IF G=1 GOTO 112 +111 GOTO 118 +112 J=3*(M-1)/3+1 +113 IF J=M LET K=1 +114 IF J+1=M LET K=2 +115 IF J+2=M LET K=3 +116 GOTO 120 +118 FOR J=1 TO 7 STEP 3:FOR K=1 TO 3 +120 IF @(J)#G GOTO 130 +122 IF @(J+2)#G GOTO 135 +126 IF @(J+1)#0 GOTO 150 +128 @(J+1)=-1:GOTO 195 +130 IF @(J)=H GOTO 150 +131 IF @(J+2)#G GOTO 150 +132 IF @(J+1)#G GOTO 150 +133 @(J)=-1:GOTO 195 +135 IF @(J+2)#0 GOTO 150 +136 IF @(J+1)#G GOTO 150 +138 @(J+2)=-1:GOTO 195 +150 IF @(K)#G GOTO 160 +152 IF @(K+6)#G GOTO 165 +156 IF @(K+3)#0 GOTO 170 +158 @(K+3)=-1:GOTO 195 +160 IF @(K)=H GOTO 170 +161 IF @(K+6)#G GOTO 170 +162 IF @(K+3)#G GOTO 170 +163 @(K)=-1:GOTO 195 +165 IF @(K+6)#0 GOTO 170 +166 IF @(K+3)#G GOTO 170 +168 @(K+6)=-1:GOTO 195 +170 GOTO 450 +171 IF (@(3)=G)*(@(7)=0) GOTO 187 +172 IF (@(9)=G)*(@(1)=0) GOTO 181 +173 IF (@(7)=G)*(@(3)=0) GOTO 183 +174 IF (@(9)=0)*(@(1)=G) GOTO 189 +175 IF G=-1 LET G=1,H=-1:GOTO 110 +176 IF (@(9)=1)*(@(3)=0) GOTO 182 +177 FOR I=2 TO 9:IF @(I)#0 GOTO 179 +178 @(I)=-1:GOTO 195 +179 NEXT I +181 @(1)=-1:GOTO 195 +182 IF @(1)=1 GOTO 177 +183 @(3)=-1:GOTO 195 +187 @(7)=-1:GOTO 195 +189 @(9)=-1 +195 PRINT"THE COMPUTER MOVES TO..." +202 GOSUB 1000 +205 GOTO 500 +450 IF G=1 GOTO 465 +455 IF (J=7)*(K=3) GOTO 465 +460 NEXT K:NEXT J +465 IF @(5)=G GOTO 171 +467 GOTO 175 +475 P=1,Q=0 +500 INPUT"WHERE DO YOU MOVE"M +502 IF M=0 PRINT"THANKS FOR THE GAME.":GOTO 2000 +503 IF M>9 GOTO 506 +505 IF @(M)=0 GOTO 510 +506 PRINT"THAT SQUARE IS OCCUPIED.":GOTO 500 +510 G=1,@(M)=1 +520 GOSUB 1000 +530 GOTO 100 +1000 FOR I=1 TO 9:PRINT" ",:IF @(I)#-1 GOTO 1014 +1011 IF Q=1 PRINT "X ", +1012 IF Q=0 PRINT "O ", +1013 GOTO 1020 +1014 IF @(I)#0 GOTO 1016 +1015 PRINT" ",:GOTO 1020 +1016 IF P=1 PRINT "X ", +1017 IF P=0 PRINT "O ", +1020 IF (I#3)*(I#6) GOTO 1050 +1030 PRINT"":PRINT"---+---+---" +1040 GOTO 1080 +1050 IF I=9 GOTO 1080 +1060 PRINT"!", +1080 NEXT I:PRINT +1095 FOR I=1 TO 7 STEP 3 +1100 IF @(I)#@(I+1) GOTO 1115 +1105 IF @(I)#@(I+2) GOTO 1115 +1110 IF @(I)=-1 GOTO 1350 +1112 IF @(I)=1 GOTO 1200 +1115 NEXT I:FOR I=1 TO 3:IF @(I)#@(I+3) GOTO 1150 +1130 IF @(I)#@(I+6) GOTO 1150 +1135 IF @(I)=-1 GOTO 1350 +1137 IF @(I)=1 GOTO 1200 +1150 NEXT I:FOR I=1 TO 9:IF @(I)=0 GOTO 1155 +1152 NEXT I:GOTO 1400 +1155 IF @(5)#G GOTO 1170 +1160 IF (@(1)=G)*(@(9)=G) GOTO 1180 +1165 IF (@(3)=G)*(@(7)=G) GOTO 1180 +1170 RETURN +1180 IF G=-1 GOTO 1350 +1200 PRINT"YOU BEAT ME!! GOOD GAME.":GOTO 2000 +1350 PRINT"I WIN, TURKEY!!!":GOTO 2000 +1400 PRINT"IT'S A DRAW. THANK YOU." +2000 END diff --git a/Source/TastyBasic/examples/bitsum.asm b/Source/TastyBasic/examples/bitsum.asm new file mode 100644 index 00000000..bcb8cfa4 --- /dev/null +++ b/Source/TastyBasic/examples/bitsum.asm @@ -0,0 +1,48 @@ +; ----------------------------------------------------------------------------- +; Copyright 2021 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 +; . +; ----------------------------------------------------------------------------- + +#IFDEF CPM + .ORG $0C00 ; ie. 3072 dec +#ELSE + .ORG $1400 ; ie. 5120 dec +#ENDIF + + LD B,0 + LD A,D + CALL COUNT + LD A,E + CALL COUNT + LD E,B + LD D,0 + RET +COUNT: + OR A + RET Z + BIT 0,A + JR Z,NEXT + INC B +NEXT: + SRL A + JR COUNT + + .END \ No newline at end of file diff --git a/Source/TastyBasic/examples/bitsum.tba b/Source/TastyBasic/examples/bitsum.tba new file mode 100644 index 00000000..83b3046e Binary files /dev/null and b/Source/TastyBasic/examples/bitsum.tba differ diff --git a/Source/TastyBasic/examples/tictac.tba b/Source/TastyBasic/examples/tictac.tba new file mode 100644 index 00000000..a88534d2 Binary files /dev/null and b/Source/TastyBasic/examples/tictac.tba differ diff --git a/Source/TastyBasic/src/Build.cmd b/Source/TastyBasic/src/Build.cmd new file mode 100644 index 00000000..9ee76528 --- /dev/null +++ b/Source/TastyBasic/src/Build.cmd @@ -0,0 +1,13 @@ +@echo off +setlocal + +set TOOLS=..\..\..\Tools + +set PATH=%TOOLS%\tasm32;%PATH% + +set TASMTABS=%TOOLS%\tasm32 + +tasm -80 -g3 -fFF -dROMWBW tastybasic.asm tastybasic.bin tastybasic.bin.lst +tasm -80 -g3 -fFF -dCPM tastybasic.asm tastybasic.com tastybasic.com.lst + +copy /b /v tastybasic.com ..\..\..\Binary\Apps\tbasic.com diff --git a/Source/TastyBasic/src/Clean.cmd b/Source/TastyBasic/src/Clean.cmd new file mode 100644 index 00000000..420369b5 --- /dev/null +++ b/Source/TastyBasic/src/Clean.cmd @@ -0,0 +1,10 @@ +@echo off +setlocal + +if exist *.bin del *.bin +if exist *.lst del *.lst +if exist *.prn del *.prn +if exist *.hex del *.hex +if exist *.rel del *.rel +if exist *.sym del *.sym +if exist *.com del *.com diff --git a/Source/TastyBasic/src/Makefile b/Source/TastyBasic/src/Makefile new file mode 100644 index 00000000..dbe3fae8 --- /dev/null +++ b/Source/TastyBasic/src/Makefile @@ -0,0 +1,36 @@ +UNAME := $(shell uname) +# VER := $(shell git describe --tags --abbrev=0) +APPDIR := $(wildcard ../../../Binary/Apps) +BINDIR := ../../../Tools/$(UNAME) + +ROMIMAGE := tastybasic.bin +ROMDEPS := tastybasic.asm romwbwio.asm +CPMCMD := tastybasic.com +CPMDEPS := tastybasic.asm cpmio.asm +CPMAPP := $(APPDIR)/tbasic.com +CPMIMAGE := tastybasic.img + +export PATH := $(BINDIR):${PATH} + +all: $(ROMIMAGE) $(CPMCMD) | $(APPDIR) + +clean: + @rm -f *.lst *.img *.com *.bin + +clobber: clean + @rm -f $(CPMAPP) + +$(ROMIMAGE): $(ROMDEPS) + @uz80as -dROMWBW tastybasic.asm tastybasic.bin tastybasic.bin.lst + +$(CPMIMAGE): $(CPMCMD) + @mkfs.cpm -f wbw_fd144 tastybasic.img + @cpmcp -f wbw_fd144 tastybasic.img tastybasic.com 0:tbasic.com + +$(CPMCMD): $(CPMDEPS) + @uz80as -dCPM tastybasic.asm tastybasic.com tastybasic.com.lst + +$(APPDIR): $(CPMCMD) + @cat $(CPMCMD) > $(CPMAPP) + +.PHONY: clean clobber $(APPDIR) diff --git a/Source/TastyBasic/src/cpmio.asm b/Source/TastyBasic/src/cpmio.asm new file mode 100644 index 00000000..fdef0bef --- /dev/null +++ b/Source/TastyBasic/src/cpmio.asm @@ -0,0 +1,207 @@ +; ----------------------------------------------------------------------------- +; Copyright 2021 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 +; . +; ----------------------------------------------------------------------------- + +USRPTR_OFFSET .equ 0afeh +INTERNAL_OFFSET .equ 0c00h +TEXTEND_OFFSET .equ 07cffh +STACK_OFFSET .equ 07effh + +BDOS .equ 05h ; standard cp/m entry +DCONIO .equ 06h ; direct console I/O +INPREQ .equ 0ffh ; console input request +TERMCPM .equ 0 +OPENF .equ 0fh ; file open +CLOSEF .equ 10h ; file close +DELETEF .equ 13h ; file delete +READF .equ 14h ; read file record +WRITEF .equ 15h ; write file record +MAKEF .equ 16h ; make new file +SETDMA .equ 1ah ; set DMA address +EOF .equ 1ah ; EOF marker +DMAOFF .equ 1ah ; set DMA address pointer +FCB .equ 5ch ; file control block address +DMA .equ 80h ; disk buffer address +BUFSIZE .equ 80h ; disk buffer size + +; FILE CONTROL BLOCK DEFINITIONS +FCBDN .equ FCB+0 ; disk name +FCBFN .equ FCB+1 ; file name +FCBFT .equ FCB+9 ; disk file type (3 chars) +FCBRL .equ FCB+12 ; file's current reel number +FCBRC .equ FCB+15 ; file's record count (0 to 128) +FCBCR .equ FCB+32 ; current (next) record +FCBLN .equ FCB+33 ; FCB length +FTYPE .db "TBA" ; tasty basic file type + +haschar: + push bc + push de + ld c,DCONIO ; direct console i/o + ld e,INPREQ ; input request + call BDOS ; any chr typed? + pop de ; if yes, (a)<--char + pop bc ; else (a)<--00h (ignore chr) + or a + ret +; +putchar: + push bc + push de + push af + push hl + ld c,DCONIO ; direct console i/o + ld e,a ; output char (a) + call BDOS + pop hl + pop af + pop de + pop bc + ret +load: + ld hl,textbegin ; ** load ** + ld (textunfilled),hl ; clear program text area + call clrvars ; and variables + call fname ; get filename + call fopen ; and open file for reading + ld de,DMA + ld c,SETDMA ; point dma to default + call BDOS + +lo1: + ld de,FCB ; and read record + ld c,READF + call BDOS + or a ; are we at EOF? + jr nz,lo3 ; yes, all done + ld b,BUFSIZE ; no, copy from io buffer + ld de,DMA ; to text buffer + ld hl,(textunfilled) +lo2: + ld a,(de) ; get char from buffer + cp 1ah ; is it EOF? + jr z,lo3 ; yes, all done + ld (hl),a ; copy char to text area + inc hl ; and update pointers + inc de + ld (textunfilled),hl + dec b ; end of record? + jr z,lo1 ; yes, so try next record + jr lo2 ; no, copy next char +lo3: + jp rstart +save: + call fname ; ** save ** + ld de,textbegin ; check there is a program + ld hl,(textunfilled) ; in memory + sbc hl,de + jr nz,sa1 ; yes, try to save it + jp qhow ; no, nothing to be done +sa1: + call fdel ; remove any existing file + call fmake ; open new file for writing + ld de,textbegin ; initialise text ptr +sa2: + push de ; save current text ptr + ld hl,(textunfilled) + ld (hl),EOF ; set EOF marker + sbc hl,de ; are we done? + jr c,sa4 + ld c,SETDMA ; point dma to text + call BDOS + ld de,FCB ; write record + ld c,WRITEF + call BDOS + or a ; all good? + jr z,sa3 ; yes, try next + jp qsorry ; no, something bad happened +sa3: + pop hl ; update text ptr + ld de,BUFSIZE + add hl,de + ex de,hl + jr sa2 +sa4: + call fclose ; and close file jp rstart + jp rstart +fname: + call testc ; check filename + .db 22h ; is first char a double quote + .db fn4-$-1 ; no, so fail + ld hl,FCBFN ; start configuring fcb + ld b,22h + ld c,8 ; max filename length +fn1: + ld a,(de) + inc de ; bump pointer + cp b ; double quote? + jr z,fn2 + ld (hl),a ; copy into fcb + inc hl + dec c ; check filename length + jp z,qhow ; too long + jr fn1 +fn2: + call endchk + ld a,20h ; clear any remaining chars + ld (hl),a ; in filename + inc hl + dec c + jr nz,fn2 + ld b,3 ; set file type + ld hl,FTYPE + ld de,FCBFT +fn3: + ld a,(hl) + ld (de),a + inc hl + inc de + dec b + jr nz,fn3 + xor a + ld (FCBCR),a ; clear current record + ret +fn4: + jp qwhat +fopen: + ld de,FCB ; open file + ld c,OPENF + jr fexec +fclose: + ld de,FCB ; close file + ld c,CLOSEF + jr fexec +fmake: + ld de,FCB ; create new file + ld c,MAKEF +fexec: + call BDOS + inc a ; did operation fail? + ret nz ; no, all good + jp qhow ; something bad happened +fdel: + ld de,FCB ; delete file + ld c,DELETEF + jp BDOS ; ignore any errors +bye: + ld c,TERMCPM ; does not return! + jp BDOS \ No newline at end of file diff --git a/Source/TastyBasic/src/romwbwio.asm b/Source/TastyBasic/src/romwbwio.asm new file mode 100644 index 00000000..0f4a5cbd --- /dev/null +++ b/Source/TastyBasic/src/romwbwio.asm @@ -0,0 +1,100 @@ + +; ----------------------------------------------------------------------------- +; Copyright 2021 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 +; . +; ----------------------------------------------------------------------------- + +CIODEV_CONSOLE .equ 0d0h +BF_CIOIN .equ 00h ; character input +BF_CIOOUT .equ 01h ; character output +BF_CIOIST .equ 02h ; character input status +BF_SYSRESET .equ 0f0h ; restart system +BF_SYSRES_WARM .equ 01h ; warm start + +;************************************************************* +; +; THE FOLLOWING NEED MUST BE SYNCED WITH STD.ASM SO ROMLDR +; KNOWS WHERE THIS EXECUTES AT +; +;************************************************************* +; +#ifndef PLATFORM +TBC_LOC .equ $0a00 +#endif +TBC_SIZ .equ $0a00 +TBC_END .equ TBC_LOC + TBC_SIZ +; +;************************************************************* + +USRPTR_OFFSET .equ 09feh +INTERNAL_OFFSET .equ 0c00h +TEXTEND_OFFSET .equ 07dffh +STACK_OFFSET .equ 07fffh + +bye: + call endchk ; ** Reboot ** + ld b,BF_SYSRESET ; system restart + ld c,BF_SYSRES_WARM ; warm start + jp 0fff0h ; does not return! +putchar: + 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 08h ; hbios outputs character + + pop hl + pop de + pop bc + pop af + ret +haschar: + 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 08h ; hbios returns status in a + + pop hl + pop de + pop bc + ret + +getchar: + 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 08h ; hbios reads charactdr + ld a,e ; move character to a for return + ; restore registers (af is output) + pop hl + pop de + pop bc + ret diff --git a/Source/TastyBasic/src/tastybasic.asm b/Source/TastyBasic/src/tastybasic.asm new file mode 100644 index 00000000..e564c3c8 --- /dev/null +++ b/Source/TastyBasic/src/tastybasic.asm @@ -0,0 +1,2017 @@ + +; ----------------------------------------------------------------------------- +; 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 CPM +#define PLATFORM "CP/M" +TBC_LOC .equ 0100h +#endif + +#ifdef ROMWBW +#define PLATFORM "ROMWBW" +TBC_LOC .equ 0a00h +#endif + +#ifndef PLATFORM +TBC_LOC .equ 0 +#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) ** DATA ** READ ** +; +; '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'. +; +; 'DATA' ALLOWS CONSTANT VALUES TO BE STORED IN CODE. TREATED +; AS A REMARK ('REM') WHEN PROGRAM IS EXECUTED. +; +; 'READ' ASSIGNS THE NEXT AVAILABLE DATA VALUE TO A VARIABLE. +;************************************************************* +rem: +data: + ld hl,0 ; ** Rem ** Data ** + 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,0 + 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 +restore: call rstreadptr + call finish +rstreadptr: + ld hl,0 + ld (readptr),hl + ret +read: + push de ; ** Read ** + ld hl,(readptr) ; has read pointer been initialised? + ld a,h + or a + jr nz,rd2 ; yes, find next data value + call findline ; no, find first line + jr nc,rd1 ; found first line + pop de ; nothing found, so how? + jp qhow +rd1: + call finddata + jr rd4 +rd2: + ex de,hl + call skipspace ; skip over spaces + call testc ; have we hit a comma? + .db ',' + .db rd3-$-1 + jr rd5 +rd3: + call nextdata +rd4: + jr z,rd5 ; found a data statement + pop de + jp qhow ; nothing found, so how to read? + +rd5: + ld (readptr),de ; update read pointer + pop de + call testvar + jp c,qwhat ; no variable + push hl ; save address of variable + push de ; and text pointer + ld de,(readptr) ; point to next data value + call parsenum ; parse the constant + jr nc, rd6 + pop de ; spmething bad happened when + jp qhow ; parsing the number +rd6: + ld (readptr),de ; update read pointer + pop de ; and restore text pointer + ld b,h ; move value to bc + ld c,l + pop hl ; get address of variable + ld (hl),c ; assign value + inc hl + ld (hl),b + + call testc ; do we have more variables? + .db ',' + .db rd7-$-1 + jr read ; yes, read next +rd7: + call finish ; all done +finddata: + inc de ; skip over line no. + inc de + call skipspace + ld hl,datastmt + ld b,4 +fd1: + ld a,(de) + cp (hl) + jp nz,nextdata ; not what we're looking for + dec b ; are we done comparing + jr z,fd2 ; yes + inc de + inc hl + jr fd1 +fd2: + inc de ; first char past statement + ret ; nc,z:found; nc,nz:no + +nextdata: + ld hl,0 + call findskip ; find the next line + jr nc,finddata ; and try there + or 1 ; no more lines + ret ; nc,nz: not found! + +;************************************************************* +; +; *** PEEK *** POKE *** IN *** & OUT *** +; +; 'PEEK()' RETURNS THE VALUE OF THE BYTE AT THE GIVEN +; ADDRESS. +; 'POKE ,' SETS BYTE AT ADDRESS TO +; VALUE +; 'IN(,' WRITES VALUE TO PORT . +; +;************************************************************* +peek: + call parn ; ** Peek(expr) ** + ld a,h ; expression must be positive + or a + jp m,qhow + ld a,(hl) ; peek address + ld h,0 + ld l,a + ret +inp: + call parn ; ** In(expr) ** + ld a,0 ; is port > 255? + cp h + jp nz,qhow ; yes, so not a valid port + ld c,l + in l,(c) ; read port + ld h,0 + 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 ot1-$-1 ; what, no? + call expr ; get value to store + ld a,0 ; is it > 255? + cp h + jp z,pk1 ; no, all good + pop hl + jp qhow +pk1: + ld a,l ; save value + pop hl + ld (hl),a + call finish +outp: + call expr ; ** Out ** + ld a,0 ; is port > 255? + cp h + jp nz,qhow ; yes, so not a valid port + push hl + call testc ; is next char a comma? + .db ',' + .db ot1-$-1 ; what, no? + call expr ; get value to write + ld a,0 ; is it > 255? + cp h + jp z,ot2 ; no, all good + pop hl + jp qhow +ot2: + ld a,l ; output value + pop hl + ld c,l + out (c),a + call finish +ot1: + 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,0 ; set hl=0, a=1 + ld a,1 + ret +expr2: + call testc ; is it minus sign? + .db '-' + .db xp21-$-1 + ld hl,0 ; 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,0 + 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 through 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: + call parsenum ; ** TestNum ** + ret nc ; if not a number, return nc and 0 in b and hl + jr qhow ; carry set, so overflowed +parsenum: + ld hl,0 ; try to parse text as a number + ld b,h ; if not a number, return 0 in b and hl + call skipspace +tn1: + cp '0' + jr nc,tn2 + ccf ; reset carry + ret +tn2: + 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 z,tn3 ; next digit, so set carry + scf + ret +tn3: + 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 + scf + ret +qhow: + push de ; ** Error How? ** +ahow: + ld de,how + jp handleerror + +welcome +#ifdef PLATFORM + .db PLATFORM," " +#endif + .db "TASTY BASIC" +#ifdef VERSION + .db " (",VERSION,")" +#endif + .db cr +free .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,0 + 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. +;************************************************************* +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 ** + call rstreadptr + 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? + jp 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,0 ; 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,0 + add hl,sp + ld b,h + ld c,l + ld hl,0ah + 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 usr func pointer + ld (usrptr),hl + ld a,0c9h ; initialise usr func (RET) + ld (usrfunc),a + 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,welcome ; output welcome message + call printstr + call crlf + call size ; output free size message + call printnum + ld de,free + call printstr + jp rstart + + +;************************************************************* + +#ifdef ROMWBW +#include "romwbwio.asm" +#endif + +#ifdef CPM +#include "cpmio.asm" +#endif + +#ifndef PLATFORM +#include "zemuio.asm" +#endif + +;************************************************************* +chkio: + call haschar ; check if character available + ret z ; no, return +#ifndef CPM + call getchar ; get the character +#endif + push bc ; is it a lf? + ld b,a + sub lf + jr z,io1 ; yes, ignore a 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 + +;************************************************************* +; +; *** 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) +#ifdef PLATFORM + .db "BYE" + dwa(bye) +#endif +tab2: ; direct/statements + .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 "OUT" + dwa(outp) +#ifdef CPM + .db "LOAD" + dwa(load) + .db "SAVE" + dwa(save) +#endif +datastmt: + .db "DATA" + dwa(data) + .db "READ" + dwa(read) + .db "RESTORE" + dwa(restore) + .db "END" + dwa(endd) + dwa(deflt) +tab4: ; functions + .db "PEEK" + dwa(peek) + .db "IN" + dwa(inp) + .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 +padding .equ (TBC_LOC + USRPTR_OFFSET - $) + .echo "TASTYBASIC ROM padding: " + .echo padding + .echo " bytes.\n" + .org TBC_LOC + USRPTR_OFFSET +usrptr .ds 2 ; -> user defined function area +usrfunc .equ $ ; start of user defined function area + .org TBC_LOC + INTERNAL_OFFSET ; 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 +readptr .ds 2 ; read pointer +textunfilled .ds 2 ; -> unfilled text area +textbegin .ds 2 ; start of text save area + .org TBC_LOC + TEXTEND_OFFSET +textend .ds 0 ; end of text area +varbegin .ds 55 ; variable @(0) +varend .equ $ ; end of variable area +buffer .ds 72 ; input buffer +bufend .ds 1 +stacklimit .equ $ + .org TBC_LOC + STACK_OFFSET +stack .equ $ + +#ifdef ROMWBW +slack .equ (TBC_END - LST_ROM) + .fill slack,'t' + + .echo "TASTYBASIC space remaining: " + .echo slack + .echo " bytes.\n" +#endif + .end diff --git a/Source/TastyBasic/src/zemuio.asm b/Source/TastyBasic/src/zemuio.asm new file mode 100644 index 00000000..d4acb063 --- /dev/null +++ b/Source/TastyBasic/src/zemuio.asm @@ -0,0 +1,54 @@ + +; ----------------------------------------------------------------------------- +; Copyright 2021 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 +; . +; ----------------------------------------------------------------------------- + +USRPTR_OFFSET .equ 09feh +INTERNAL_OFFSET .equ 0c00h +TEXTEND_OFFSET .equ 07dffh +STACK_OFFSET .equ 07fffh + +tty_data .equ 7ch +tty_status .equ 7dh +rx_full .equ 1 +tx_empty .equ 0 + +putchar: + 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 + ret +haschar: + in a,(tty_status) ; check if character available + bit rx_full,a + ret + +getchar: + in a,(tty_data) ; get the character + ret diff --git a/Source/ver.inc b/Source/ver.inc index 5797acd2..09a06696 100644 --- a/Source/ver.inc +++ b/Source/ver.inc @@ -2,4 +2,4 @@ #DEFINE RMN 1 #DEFINE RUP 1 #DEFINE RTP 0 -#DEFINE BIOSVER "3.1.1-pre.133" +#DEFINE BIOSVER "3.1.1-pre.134" diff --git a/Source/ver.lib b/Source/ver.lib index c13e585e..b86cd056 100644 --- a/Source/ver.lib +++ b/Source/ver.lib @@ -3,5 +3,5 @@ rmn equ 1 rup equ 1 rtp equ 0 biosver macro - db "3.1.1-pre.133" + db "3.1.1-pre.134" endm