;************************************************************* ; ; TINY BASIC FOR ZILOG Z80 ; VERSION 2.0 ; BY LI-CHEN WANG ; ; MODIFIED AND TRANSLATED ; TO INTEL MNEMONICS ; BY ROGER RAUSKOLB ; 10 OCTOBER,1976 ; ; MODIFIED AND TRANSLATED ; TO ZILOG MNEMONICS ; BY DOUG GABBARD ; www.retrodepot.net ; ; RELEASED TO THE PUBLIC ; 10 OCTOBER,2017 ; YEAH, 41 YEARS LATER.... ; ; @COPYLEFT ; ALL WRONGS RESERVED ; ;************************************************************* ; This code is derived from the original 8080 Tiny Basic. ; It was first compiled in 8080 Mnemonics, then disassembled ; into Zilog Mnemonics. And then checked against the original ; to ensure accuracy. It was then partially enhanced with z80 ; specific code. And once done, it was then modified to work ; with the G80-S Micro Computer. However, that portion of the ; code has been left out in order to make this code a little ; more portable. There are only three routines that one needs ; to write, and specifing the serial port's I/O address, in ; order to make this version work with your own DIY computer. ; Those routines can be found at the end of the source code. ; ; I hope you find good use for this relic. However, I would ; ask that if you do find use for it, please put a reference ; to me in your work. And please, distribute freely. ;************************************************************* ; Notes for JTFrame version: ; Adapted to work with GNU z80asm ; Added interrupt handling ; Notes for this monitor port: ; Converted to sdasz80 syntax and linked as a ROM application at 2200. ; Fixed-page RST calls were converted to local CALLs. ; UART access uses the resident BIOS ABI at C050/C053. .include "bios.inc" SPACE = 0x020 ; Space TAB = 0x09 ; HORIZONTAL TAB CTRLC = 0x03 ; Control "C" CTRLG = 0x07 ; Control "G" BKSP = 0x08 ; Back space LF = 0x0A ; Line feed CS = 0x0C ; Clear screen CR = 0x0D ; Carriage return CTRLO = 0x0F ; Control "O" CTRLQ = 0x011 ; Control "Q" CTRLR = 0x012 ; Control "R" CTRLS = 0x013 ; Control "S" CTRLU = 0x015 ; Control "U" ESC = 0x01B ; Escape DEL = 0x07F ; Delete ; Tiny BASIC owns lower RAM 8000-BFFF. The resident BIOS and monitor own ; C000-FFFF, so BASIC cannot overwrite them even when its stack is deep. STACK = 0xBFFF ; Tiny BASIC stack grows down through B078-BFFF OCSW = 0x8000 ;SWITCH FOR OUTPUT CURRNT = OCSW+1 ;POINTS FOR OUTPUT STKGOS = OCSW+3 ;SAVES SP IN 'GOSUB' VARNXT = OCSW+5 ;TEMP STORAGE STKINP = OCSW+7 ;SAVES SP IN 'INPUT' LOPVAR = OCSW+9 ;'FOR' LOOP SAVE AREA LOPINC = OCSW+11 ;INCREMENT LOPLMT = OCSW+13 ;LIMIT LOPLN = OCSW+15 ;LINE NUMBER LOPPT = OCSW+17 ;TEXT POINTER RANPNT = OCSW+19 ;RANDOM NUMBER POINTER TXTUNF = OCSW+21 ;->UNFILLED TEXT AREA TXTBGN = OCSW+23 ;TEXT SAVE AREA BEGINS TXTEND = 0xB000 ;TEXT SAVE AREA ENDS VARBGN = 0xB000 ;VARIABLE @(0) BUFFER = 0xB037 ;55-byte variable area ends here BUFEND = 0xB077 ;64-byte input buffer ends here STKLMT = 0xB078 ;LOWEST ALLOWED STACK ADDRESS ;************************************************************* ; *** ZERO PAGE SUBROUTINES *** ; ; THE Z80 INSTRUCTION SET ALLOWS FOR 8 ROUTINES IN LOW MEMORY ; THAT MAY BE CALLED BY RST 0x00, 0x08, 0x10, 0x18, 0x20, 0x28, 0x30, ; AND 0x38. THIS IS A ONE BYTE INSTRUCTION, AND IS FUNCTIONALLY ; SIMILAR TO THE THREE BYTE INSTRUCTION 'CALL XXXX'. TINY BASIC ; WILL USE THE RST INSTRUCTION FOR THE 7 MOST FREQUENTLY USED ; SUBROUTINES. TWO OTHER SUBROUTINES (CRLF & TSTNUM) ARE ALSO ; IN THIS SECTION. THEY CAN BE REACHED WITH 'CALL'. ;************************************************************* .area TINYBASIC (ABS) .org TINYBASIC_ROM_ADDRESS main: START: LD SP,#STACK ;*** COLD START *** LD A,#0x0FF LD (OCSW),A ;OUTPUT ENABLED INITIALLY JP INIT RST08: EX (SP),HL ;*** TSTC OR CALL RST08 *** CALL RST28 ;IGNORE BLANKS AND CP (HL) ;TEST CHARACTER JP TC1 ;REST OF THIS IS AT TC1 CRLF: LD A,#CR ;*** CRLF *** RST10: PUSH AF ;*** OUTC OR CALL RST10 *** LD A,(OCSW) ;PRINT CHARACTER ONLY OR A ;IF OCSW SWITCH IS ON JP OUTC ;REST OF THIS AT OUTC RST18: CALL EXPR2 ;*** EXPR OR CALL RST18 *** PUSH HL ;EVALUATE AN EXPRESSION JP EXPR1 ;REST OF IT AT EXPR1 .db 'W' RST20: LD A,H ;*** COMP OR CALL RST20 *** CP D ;COMPARE HL WITH DE RET NZ ;RETURN CORRECT C AND LD A,L ;Z FLAGS CP E ;BUT OLD A IS LOST RET .ascii "AN" SS1: RST28: LD A,(DE) ;*** IGNBLK/CALL RST28 *** CP #0x20 ;IGNORE BLANKS RET NZ ;IN TEXT (WHERE DE->) INC DE ;AND RETURN THE FIRST JP SS1 ;NON-BLANK CHAR. IN A RST30: POP AF ;*** FINISH/CALL RST30 *** CALL FIN ;CHECK END OF COMMAND JP QWHAT ;PRINT "WHAT?" IF WRONG .db 'G' RST38: CALL RST28 ;*** TSTV OR CALL RST38 *** SUB #0x40 ;TEST VARIABLES RET C ;C:NOT A VARIABLE JR NZ,TV1 ;NOT "@" ARRAY INC DE ;IT IS THE "@" ARRAY CALL PARN ;@ SHOULD BE FOLLOWED ADD HL,HL ;BY (EXPR) AS ITS INDEX JR C,QHOW ;IS INDEX TOO BIG? PUSH DE ;WILL IT OVERWRITE EX DE,HL ;TEXT? CALL SIZE ;FIND SIZE OF FREE CALL RST20 ;AND CHECK THAT JP C,ASORRY ;IF SO, SAY "SORRY" LD HL,#VARBGN ;IF NOT GET ADDRESS CALL SUBDE ;OF @(EXPR) AND PUT IT POP DE ;IN HL RET ;C FLAG IS CLEARED TV1: CP #0x1B ;NOT @, IS IT A TO Z? CCF ;IF NOT RETURN C FLAG RET C INC DE ;IF A THROUGH Z LD HL,#VARBGN ;COMPUTE ADDRESS OF RLCA ;THAT VARIABLE ADD A,L ;AND RETURN IT IN HL LD L,A ;WITH C FLAG CLEARED LD A,#0x00 ADC A,H LD H,A RET NMI66: ;MUST BE AT 0x66 RETI TC1: INC HL ;COMPARE THE BYTE THAT JR Z,TC2 ;FOLLOWS THE RST INST. PUSH BC ;WITH THE TEXT (DE->) LD C,(HL) ;IF NOT =, ADD THE 2ND LD B,#0x00 ;BYTE THAT FOLLOWS THE ADD HL,BC ;RST TO THE OLD PC POP BC ;I.E., DO A RELATIVE DEC DE ;JUMP IF NOT = TC2: INC DE ;IF =, SKIP THOSE BYTES INC HL ;AND CONTINUE EX (SP),HL RET TSTNUM: LD HL,#0x0000 ;*** TSTNUM *** LD B,H ;TEST IF THE TEXT IS CALL RST28 ;A NUMBER TN1: CP #0x30 ;IF NOT, RETURN 0 IN RET C ;B AND HL CP #0x3A ;IF NUMBERS, CONVERT RET NC ;TO BINARY IN HL AND LD A,#0x0F0 ;SET B TO # OF DIGITS AND H ;IF H>255, THERE IS NO JR NZ,QHOW ;ROOM FOR NEXT DIGIT INC B ;B COUNTS # OF DIGITS PUSH BC LD B,H ;HL=10*HL+(NEW DIGIT) LD C,L ADD HL,HL ;WHERE 10* IS DONE BY ADD HL,HL ;SHIFT AND ADD ADD HL,BC ADD HL,HL LD A,(DE) ;AND (DIGIT) IS FROM INC DE ;STRIPPING THE ASCII AND #0x0F ;CODE ADD A,L LD L,A LD A,#0x00 ADC A,H LD H,A POP BC LD A,(DE) ;DO THIS DIGIT AFTER JP P,TN1 ;DIGIT. S SAYS OVERFLOW QHOW: PUSH DE ;*** ERROR "HOW?" *** AHOW: LD DE,#HOW JP ERROR_ROUTINE HOW: .ascii "HOW?" .db CR OK: .ascii "OK" .db CR WHAT: .ascii "WHAT?" .db CR SORRY: .ascii "SORRY" .db 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 ;AND JUMP TO HERE LD DE,#OK ;DE->STRING SUB A ;A=0 CALL PRTSTG ;PRINT STRING UNTIL CR LD HL,#ST2+1 ;LITERAL 0 LD (CURRNT),HL ;CURRENT->LINE # = 0 ST2: LD HL,#0x0000 LD (LOPVAR),HL LD (STKGOS),HL ST3: LD A,#'>' ;PROMPT '>' AND CALL GETLN ;READ A LINE PUSH DE ;DE->END OF LINE LD DE,#BUFFER ;DE->BEGINNING OF LINE CALL TSTNUM ;TEST IF IT IS A NUMBER CALL RST28 LD A,H ;HL=VALUE OF THE # OR OR L ;0 IF NO # WAS FOUND POP BC ;BC->END OF LINE JP Z,DIRECT DEC DE ;BACKUP DE AND SAVE LD A,H ;VALUE OF LINE # THERE LD (DE),A DEC DE LD A,L LD (DE),A PUSH BC ;BC,DE->BEGIN, END PUSH DE LD A,C SUB E PUSH AF ;A=# OF BYTES IN LINE CALL FNDLN ;FIND THIS LINE IN SAVE PUSH DE ;AREA, DE->SAVE AREA JR NZ,ST4 ;NZ:NOT FOUND, INSERT PUSH DE ;Z:FOUND, DELETE IT CALL FNDNXT ;FIND NEXT LINE ;DE->NEXT LINE POP BC ;BC->LINE TO BE DELETED LD HL,(TXTUNF) ;HL->UNFILLED SAVE AREA CALL MVUP ;MOVE UP TO DELETE LD H,B ;TXTUNF->UNFILLED ARA LD L,C LD (TXTUNF),HL ;UPDATE ST4: POP BC ;GET READY TO INSERT LD HL,(TXTUNF) ;BUT FIRST CHECK IF POP AF ;THE LENGTH OF NEW LINE PUSH HL ;IS 3 (LINE # AND CR) CP #0x03 ;THEN DO NOT INSERT JR Z,RSTART ;MUST CLEAR THE STACK ADD A,L ;COMPUTE NEW TXTUNF LD L,A LD A,#0x00 ADC A,H LD H,A ;HL->NEW UNFILLED AREA LD DE,#TXTEND ;CHECK TO SEE IF THERE CALL RST20 ;IS ENOUGH SPACE JP NC,QSORRY ;SORRY, NO ROOM FOR IT LD (TXTUNF),HL ;OK, UPDATE TXTUNF POP DE ;DE->OLD UNFILLED AREA CALL MVDOWN POP DE ;DE->BEGIN, HL->END POP HL CALL MVUP ;MOVE NEW LINE TO SAVE JR ST3 ;AREA ;************************************************************* ; ; WHAT FOLLOWS IS THE CODE TO EXECUTE DIRECT AND STATEMENT ; COMMANDS. CONTROL IS TRANSFERED TO THESE POINTS VIA THE ; COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST ; SECTION. AFTER THE COMMAND IS EXECUTED, CONTROL IS ; TRANSFERED TO OTHERS SECTIONS AS FOLLOWS: ; ; FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART' ; FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IF ANY, ELSE ; GO BACK TO 'RSTART'. ; FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE. ; FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE. ; FOR ALL OTHERS: IF 'CURRENT' -> 0, GO TO 'RSTART', ELSE ; GO EXECUTE NEXT COMMAND. (THIS IS DONE IN 'FINISH'.) ;************************************************************* ; ; *** NEW *** STOP *** RUN (& FRIENDS) *** & GOTO *** ; ; 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN' ; ; 'STOP(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(CR) *** LD HL,#TXTBGN LD (TXTUNF),HL STOP: CALL ENDCHK ;*** STOP(CR) *** JP RSTART RUN: CALL ENDCHK ;*** RUN(CR) *** LD DE,#TXTBGN ;FIRST SAVED LINE RUNNXL: LD HL,#0x00 ;*** RUNNXL *** CALL FNDLP ;FIND WHATEVER LINE # JP C,RSTART ;C:PASSED TXTUNF, QUIT RUNTSL: EX DE,HL ;*** RUNTSL *** LD (CURRNT),HL ;SET 'CURRENT'->LINE # EX DE,HL INC DE ;BUMP PASS LINE # INC DE RUNSML: CALL CHKIO ;*** RUNSML *** LD HL,#TAB2-1 ;FIND COMMAND IN TAB2 JP EXEC ;AND EXECUTE IT GOTO: CALL RST18 ;*** GOTO EXPR *** PUSH DE ;SAVE FOR ERROR ROUTINE CALL ENDCHK ;MUST FIND A CR CALL FNDLN ;FIND THE TARGET LINE JP NZ,AHOW ;NO SUCH LINE # POP AF ;CLEAR THE PUSH 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 TSTNUM ;TEST IF THERE IS A # CALL ENDCHK ;IF NO # WE GET A 0 CALL FNDLN ;FIND THIS OR NEXT LINE LS1: JP C,RSTART ;C:PASSED TXTUNF CALL PRTLN ;PRINT THE LINE CALL CHKIO ;STOP IF HIT CONTROL-C CALL FNDLP ;FIND NEXT LINE JR LS1 ;AND LOOP BACK PRINT: LD C,#0x06 ;C = # OF SPACES CALL RST08 ;F NULL LIST & ";" .db 0x3B .db PR2-.-1 CALL CRLF ;GIVE CR-LF AND JR RUNSML ;CONTINUE SAME LINE PR2: CALL RST08 ;IF NULL LIST (CR) .db CR .db PR0-.-1 CALL CRLF ;ALSO GIVE CR-LF AND JR RUNNXL ;GO TO NEXT LINE PR0: CALL RST08 ;ELSE IS IT FORMAT? .db '#' .db PR1-.-1 CALL RST18 ;YES, EVALUATE EXPR. LD C,L ;AND SAVE IT IN C JR PR3 ;LOOK FOR MORE TO PRINT PR1: CALL QTSTG ;OR IS IT A STRING? JR PR8 ;IF NOT, MUST BE EXPR. PR3: CALL RST08 ;IF ",", GO FIND NEXT .db ',' .db PR6-.-1 CALL FIN ;IN THE LIST. JR PR0 ;LIST CONTINUES PR6: CALL CRLF ;LIST ENDS CALL RST30 PR8: CALL RST18 ;EVALUATE THE EXPR PUSH BC CALL PRTNUM ;PRINT THE VALUE POP BC JR PR3 ;MORE TO PRINT? ;************************************************************* ; ; *** 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 ;SAVE THE CURRENT "FOR" CALL RST18 ;PARAMETERS PUSH DE ;AND TEXT POINTER CALL FNDLN ;FIND THE TARGET LINE JP NZ,AHOW ;NOT THERE. SAY "HOW?" LD HL,(CURRNT) ;FOUND IT, SAVE OLD. PUSH HL ;'CURRNT' OLD 'STKGOS' LD HL,(STKGOS) PUSH HL LD HL,#0x0000 ;AND LOAD NEW ONES LD (LOPVAR),HL ADD HL,SP LD (STKGOS),HL JP RUNTSL ;THEN RUN THAT LINE RETURN: CALL ENDCHK ;THERE MUST BE A CR LD HL,(STKGOS) ;OLD STACK POINTER LD A,H ;0 MEANS NOT EXIST OR L JP Z,QWHAT ;SO, WE SAY: "WHAT?" LD SP,HL ;ELSE, RESTORE IT POP HL LD (STKGOS),HL ;AND THE OLD "STKGOS" POP HL LD (CURRNT),HL ;AND THE OLD 'CURRNT' POP DE ;OLD TEXT POINTER CALL POPA ;OLD "FOR" PARAMETERS CALL RST30 ;AND WE ARE BACK HOME ;************************************************************* ; ; *** 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 THE OLD SAVE AREA CALL SETVAL ;SET THE CONTROL VAR. DEC HL ;HL IS ITS ADDRESS LD (LOPVAR),HL ;SAVE THAT LD HL,#TAB5-1 ;USE 'EXEC' TO LOOK JP EXEC ;FOR THE WORK 'TO' FR1: CALL RST18 ;EVALUATE THE LIMITE LD (LOPLMT),HL ;SAVE THAT LD HL,#TAB6-1 ;USE 'EXEC' TO LOOK JP EXEC ;FOR THE WORD 'STEP' FR2: CALL RST18 ;FOUND IT, GET STEP JR FR4 FR3: LD HL,#0x0001 ;NOT FOUND, SET TO 1 FR4: LD (LOPINC),HL ;SAVE THAT TOO FR5: LD HL,(CURRNT) ;SAVE CURRENT LINE # LD (LOPLN),HL EX DE,HL ;AND TEXT POINTER LD (LOPPT),HL LD BC,#0x0A ;DIG INTO STACK TO LD HL,(LOPVAR) ;FIND 'LOPVAR' EX DE,HL LD H,B LD L,B ;HL=0 NOW ADD HL,SP ;HERE IS THE STACK .db 0x3E ;DISASSEMBLY SAID "ld a,09h" FR7: ADD HL,BC ;EACH LEVEL IS 10 DEEP - DIS = 09 LD A,(HL) ;GET THAT OLD 'LOPVAR' INC HL OR (HL) JR Z,FR8 ;0 SAYS NO MORE IN IT LD A,(HL) DEC HL CP D ;SAME AS THIS ONE? JR NZ,FR7 LD A,(HL) ;THE OTHER HALF? CP E JR NZ,FR7 EX DE,HL ;YES, FOUND ONE LD HL,#0x0000 ADD HL,SP ;TRY TO MOVE SP LD B,H LD C,L LD HL,#0x000A ADD HL,DE CALL MVDOWN ;AND PURGE 10 WORDS LD SP,HL ;IN THE STACK FR8: LD HL,(LOPPT) ;JOB DONE, RESTORE DE EX DE,HL CALL RST30 ;AND CONTINUE ; NEXT: CALL RST38 ;GET ADDRESS OF VAR. JP C,QWHAT ;NO VARIABLE, "WHAT?" LD (VARNXT),HL ;YES, SAVE IT NX0: PUSH DE ;SAVE TEXT POINTER EX DE,HL LD HL,(LOPVAR) ;GET VAR. IN 'FOR' LD A,H OR L ;0 SAYS NEVER HAD ONE JP Z,AWHAT ;SO WE ASK: "WHAT?" CALL RST20 ;ELSE WE CHECK THEM JR Z,NX3 ;OK, THEY AGREE POP DE ;NO, LET'S SEE CALL POPA ;PURGE CURRENT LOOP LD HL,(VARNXT) ;AND POP ONE LEVEL JR NX0 ;GO CHECK AGAIN NX3: LD E,(HL) ;COME HERE WHEN AGREED INC HL LD D,(HL) ;DE=VALUE OF VAR. LD HL,(LOPINC) PUSH HL LD A,H XOR D LD A,D ADD HL,DE ;ADD ONE STEP JP M,NX4 XOR H JP M,NX5 NX4: EX DE,HL LD HL,(LOPVAR) ;PUT IT BACK LD (HL),E INC HL LD (HL),D LD HL,(LOPLMT) ;HL->LIMIT POP AF ;OLD HL OR A JP P,NX1 ;STEP > 0 EX DE,HL ;STEP < 0 NX1: CALL CKHLDE ;COMPARE WITH LIMIT POP DE ;RESTORE TEXT POINTER JR C,NX2 ;OUTSIDE LIMIT LD HL,(LOPLN) ;WITHIN LIMIT, GO LD (CURRNT),HL ;BACK TO THE SAVED LD HL,(LOPPT) ;'CURRNT' AND TEXT EX DE,HL ;POINTER CALL RST30 NX5: POP HL POP DE NX2: CALL POPA ;PURGE THIS LOOP CALL RST30 ;************************************************************* ; ; *** 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,#0x0000 ;*** REM *** .db 0x3E ;THIS IS LIKE 'IF 0' IFF: CALL RST18 ;*** IF *** LD A,H ;IS THE EXPR.=0? OR L JP NZ,RUNSML ;NO, CONTINUE CALL FNDSKP ;YES, SKIP REST OF LINE JP NC,RUNTSL ;AND RUN THE NEXT LINE JP RSTART ;IF NO NEXT, RE-START INPERR: LD HL,(STKINP) ;*** INPERR *** LD SP,HL ;RESTORE OLD SP POP HL ;AND OLD 'CURRNT' LD (CURRNT),HL POP DE ;AND OLD TEXT POINTER POP DE ;REDO INPUT INPUT: ;*** INPUT *** IP1: PUSH DE ;SAVE IN CASE OF ERROR CALL QTSTG ;IS NEXT ITEM A STRING? JR IP2 ;NO CALL RST38 ;YES, BUT FOLLOWED BY A JR C,IP4 ;VARIABLE? NO. JR IP3 ;YES. INPUT VARIABLE IP2: PUSH DE ;SAVE FOR 'PRTSTG' CALL RST38 ;MUST BE VARIABLE NOW JP C,QWHAT ;"WHAT?" IT IS NOT? LD A,(DE) ;GET READY FOR 'PRTSTR' LD C,A SUB A LD (DE),A POP DE CALL PRTSTG ;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,(CURRNT) ;ALSO SAVE 'CURRNT' PUSH HL LD HL,#IP1 ;A NEGATIVE NUMBER LD (CURRNT),HL ;AS A FLAG LD HL,#0x0000 ;SAVE SP TOO ADD HL,SP LD (STKINP),HL PUSH DE ;OLD HL LD A,#0x3A ;PRINT THIS TOO CALL GETLN ;AND GET A LINE LD DE,#BUFFER ;POINTS TO BUFFER CALL RST18 ;EVALUATE INPUT NOP ;CAN BE 'CALL ENDCHK' NOP NOP POP DE ;OK,GET OLD HL EX DE,HL LD (HL),E ;SAVE VALUE IN VAR. INC HL LD (HL),D POP HL ;GET OLD 'CURRNT' LD (CURRNT),HL POP DE ;AND OLD TEXT POINTER IP4: POP AF ;PURGE JUNK IN STACK CALL RST08 ;IS NEXT CH. ','? .db ',' .db IP5-.-1 JR IP1 ;YES, MORE ITEMS. IP5: CALL RST30 DEFLT: LD A,(DE) ;*** DEFLT *** CP #CR ;EMPTY LINE IS OK JR Z,LT1 ;ELSE IT IS 'LET' LET: CALL SETVAL ;*** LET *** CALL RST08 ;SET VALUE TO VAR .db ',' ;---DISASSEMBLE = INC L .db LT1-.-1 ;---DISASSEMBLE = INC BC JR LET ;ITEM BY ITEM LT1: CALL RST30 ;UNTIL FINISH ;************************************************************* ; ; *** 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 ;LOOKUP 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 ;FALSE, RETURN HL=0 LD L,A ;TRUE, RETURN HL=1 RET XP13: CALL XP18 ;REL.OP.">" RET Z ;FALSE RET C ;ALSO FALSE, HL=0 LD L,A ;TRUE, HL=1 RET XP14: CALL XP18 ;REL.OP."<=" LD L,A ;SET HL=1 RET Z ;REL. TRUE, RETURN RET C LD L,H ;ELSE SET HL=0 RET XP15: CALL XP18 ;REL.OP."=" RET NZ ;FALSE, RETURN HL=0 LD L,A ;ELSE SET HL=1 RET XP16: CALL XP18 ;REL.OP."<" RET NC ;FALSE, RETURN HL=0 LD L,A ;ELSE SET HL=1 RET XP17: POP HL ;NOT .REL.OP RET ;RETURN HL= XP18: LD A,C ;SUBROUTINE FOR ALL POP HL ;REL.OP.'S POP BC PUSH HL ;REVERSE TOP OF STACK PUSH BC LD C,A CALL EXPR2 ;GET 2ND EX DE,HL ;VALUE IN DE NOW EX (SP),HL ;1ST IN HL CALL CKHLDE ;COMPARE 1ST WITH 2ND POP DE ;RESTORE TEXT POINTER LD HL,#0x0000 ;SET HL=0, A=1 LD A,#0x01 RET EXPR2: CALL RST08 ;NEGATIVE SIGN? .db '-' .db XP21-.-1 LD HL,#0x0000 ;YES, FAKE '0-' JR XP26 ;TREAT LIKE SUBTRACT XP21: CALL RST08 ;POSITIVE SIGN? IGNORE .db '+' .db XP22-.-1 XP22: CALL EXPR3 ;1ST XP23: CALL RST08 ;ADD? .db '+' .db XP25-.-1 PUSH HL ;YES, SAVE VALUE CALL EXPR3 ;GET 2ND 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 ;1ST AND 2ND SIGN DIFFER XOR H ;1ST AND 2ND SIGN EQUAL JP P,XP23 ;SO IS RESULT JP QHOW ;ELSE WE HAVE OVERFLOW XP25: CALL RST08 ;SUBTRACT? .db '-' .db XP42-.-1 XP26: PUSH HL ;YES, SAVE 1ST CALL EXPR3 ;GET 2ND CALL CHGSGN ;NEGATE JR XP24 ;AND ADD THEM ; EXPR3: CALL EXPR4 ;GET 1ST XP31: CALL RST08 ;MULTIPLY? .db '*' .db XP34-.-1 PUSH HL ;YES, SAVE 1ST CALL EXPR4 ;AND GET 2ND LD B,#0x00 ;CLEAR B FOR SIGN CALL CHKSGN ;CHECK SIGN EX (SP),HL ;1ST IN HL CALL CHKSGN ;CHECK SIGN OF 1ST EX DE,HL EX (SP),HL LD A,H ;IS HL > 255 ? OR A JR Z,XP32 ;NO LD A,D ;YES, HOW ABOUT DE OR D EX DE,HL ;PUT SMALLER IN HL JP NZ,AHOW ;ALSO >, WILL OVERFLOW XP32: LD A,L ;THIS IS DUMB LD HL,#0x0000 ;CLEAR RESULT OR A ;ADD AND COUNT JR Z,XP35 XP33: ADD HL,DE JP C,AHOW ;OVERFLOW DEC A JR NZ,XP33 JR XP35 ;FINISHED XP34: CALL RST08 ;DIVIDE? .db '/' .db XP42-.-1 PUSH HL ;YES, SAVE 1ST CALL EXPR4 ;AND GET THE SECOND ONE LD B,#0x00 ;CLEAR B FOR SIGN CALL CHKSGN ;CHECK SIGN OF 2ND EX (SP),HL ;GET 1ST IN HL CALL CHKSGN ;CHECK SIGN OF 1ST EX DE,HL EX (SP),HL EX DE,HL LD A,D ;DIVIDE BY 0? OR E JP Z,AHOW ;SAY "HOW?" PUSH BC ;ELSE SAVE SIGN CALL DIVIDE ;USE SUBROUTINE LD H,B ;RESULT IN HL NOW LD L,C POP BC ;GET SIGN BACK XP35: POP DE ;AND TEXT POINTER LD A,H ;HL MUST BE + OR A JP M,QHOW ;ELSE IT IS OVERFLOW LD A,B OR A CALL M,CHGSGN ;CHANGE SIGN IF NEEDED JR XP31 ;LOOK FOR MORE TERMS EXPR4: LD HL,#TAB4-1 ;FIND FUNCTION IN TAB4 JP EXEC ;AND GO DO IT XP40: CALL RST38 ;NO, NOT A FUNCTION JR C,XP41 ;NOR A VARIABLE LD A,(HL) ;VARIABLE INC HL LD H,(HL) ;VALUE IN HL LD L,A RET XP41: CALL TSTNUM ;OR IS IT A NUMBER LD A,B ;# OF DIGIT OR A RET NZ ;OK PARN: CALL RST08 .db '(' .db XP43-.-1 CALL RST18 ;"(EXPR)" CALL RST08 .db ')' .db XP43-.-1 XP42: RET XP43: JP QWHAT ;ELSE SAY: "WHAT?" RND: CALL PARN ;*** RND(EXPR) *** LD A,H ;EXPR MUST BE + OR A JP M,QHOW OR L ;AND NON-ZERO JP Z,QHOW PUSH DE ;SAVE BOTH PUSH HL LD HL,(RANPNT) ;GET MEMORY AS RANDOM LD DE,#LSTROM ;NUMBER CALL RST20 JR C,RA1 ;WRAP AROUND IF LAST LD HL,#START RA1: LD E,(HL) INC HL LD D,(HL) LD (RANPNT),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 CHKSGN ;CHECK SIGN INC DE RET SIZE: LD HL,(TXTUNF) ;*** SIZE *** PUSH DE ;GET THE NUMBER OF FREE EX DE,HL ;BYTES BETWEEN 'TXTUNF' LD HL,#VARBGN ;AND 'VARBGN' CALL SUBDE POP DE RET ;************************************************************* ; ; *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE *** ; ; 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL ; ; 'SUBDE' SUBSTRACTS DE FROM HL ; ; 'CHKSGN' CHECKS SIGN OF HL. IF +, NO CHANGE. IF -, CHANGE ; SIGN AND FLIP SIGN OF B. ; ; 'CHGSGN' CHECKS SIGN N OF HL AND B UNCONDITIONALLY. ; ; 'CKHLDE' CHECKS SIGN OF HL AND DE. IF DIFFERENT, HL AND DE ; ARE INTERCHANGED. IF SAME SIGN, NOT INTERCHANGED. EITHER ; CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS. ;************************************************************* DIVIDE: PUSH HL ;*** DIVIDE *** LD L,H ;DIVIDE H BY DE LD H,#0x00 CALL DV1 LD B,C ;SAVE RESULT IN B LD A,L ;(REMAINDER+L)/DE POP HL LD H,A DV1: LD C,#0x0FF ;RESULT IN C DV2: INC C ;DUMB ROUTINE CALL SUBDE ;DIVIDE BY SUBTRACT JR NC,DV2 ;AND COUNT ADD HL,DE RET SUBDE: LD A,L ;*** SUBDE *** SUB E ;SUBSTRACT DE FROM LD L,A ;HL LD A,H SBC A,D LD H,A RET CHKSGN: LD A,H ;*** CHKSGN *** OR A ;CHECK SIGN OF HL RET P CHGSGN: LD A,H ;*** CHGSGN *** PUSH AF CPL ;CHANGE SIGN OF HL LD H,A LD A,L CPL LD L,A INC HL POP AF XOR H JP P,QHOW LD A,B ;AND ALSO FLIP B XOR #0x80 LD B,A RET CKHLDE: LD A,H ;SAME SIGN? XOR D ;YES, COMPARE JP P,CK1 ;NO, XCHANGE AND COMP EX DE,HL CK1: CALL RST20 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 RST38 ;*** SETVAL *** JP C,QWHAT ;"WHAT?" NO VARIABLE PUSH HL ;SAVE ADDRESS OF VAR. CALL RST08 ;PASS "=" SIGN .db '=' .db SV1-.-1 CALL RST18 ;EVALUATE EXPR. 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 ;NO "=" SIGN FIN: CALL RST08 ;*** FIN *** .db 0x3B .db FI1-.-1 POP AF ;";", PURGE RET. ADDR. JP RUNSML ;CONTINUE SAME LINE FI1: CALL RST08 ;NOT ";", IS IT CR? .db CR .db FI2-.-1 POP AF ;YES, PURGE RET. ADDR. JP RUNNXL ;RUN NEXT LINE FI2: RET ;ELSE RETURN TO CALLER ENDCHK: CALL RST28 ;*** ENDCHK *** CP #CR ;END WITH CR? RET Z ;OK, ELSE SAY: "WHAT?" QWHAT: PUSH DE ;*** QWHAT *** AWHAT: LD DE,#WHAT ;*** AWHAT *** ERROR_ROUTINE: SUB A ;*** ERROR *** CALL PRTSTG ;PRINT 'WHAT?', 'HOW?' POP DE ;OR 'SORRY' LD A,(DE) ;SAVE THE CHARACTER PUSH AF ;AT WHERE OLD DE -> SUB A ;AND PUT A 0 THERE LD (DE),A LD HL,(CURRNT) ;GET CURRENT LINE # PUSH HL LD A,(HL) ;CHECK THE VALUE INC HL OR (HL) POP DE JP Z,RSTART ;IF ZERO, JUST RESTART LD A,(HL) ;IF NEGATIVE, OR A JP M,INPERR ;REDO INPUT CALL PRTLN ;ELSE PRINT THE LINE DEC DE ;UPTO WHERE THE 0 IS POP AF ;RESTORE THE CHARACTER LD (DE),A LD A,#0x3F ;PRINT A "?" CALL RST10 SUB A ;AND THE REST OF THE CALL PRTSTG ;LINE JP RSTART ;THEN RESTART QSORRY: PUSH DE ;*** QSORRY *** ASORRY: LD DE,#SORRY ;*** ASORRY *** JR ERROR_ROUTINE ;************************************************************* ; ; *** 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. ;************************************************************* GETLN: CALL RST10 ;*** GETLN *** LD DE,#BUFFER ;PROMPT AND INIT. GL1: ;-- Z80-FPGA: Testing! CALL CHKIO ;CHECK KEYBOARD JR Z,GL1 ;NO INPUT, WAIT CP #DEL ;DELETE LAST CHARACTER? JR Z,GL3 ;YES CP #BKSP ;SOME TERMINALS SEND BS JR Z,GL3 CP #CTRLU ;DELETE THE WHOLE LINE? JR Z,GL4 CALL RST10 ;INPUT, ECHO BACK CP #0x0A ;IGNORE LF JR Z,GL1 OR A ;IGNORE NULL JR Z,GL1 LD (DE),A ;ELSE SAVE INPUT INC DE ;AND BUMP POINTER CP #0x0D ;WAS IT CR RET Z ;YES, END OF LINE LD A,E ;ELSE MORE FREE ROOM? CP #BUFEND & 0x0FF JR NZ,GL1 ;YES, GET NEXT INPUT GL3: LD A,E ;DELETE LAST CHARACTER CP #BUFFER & 0x0FF ;BUT DO WE HAVE ANY? JR Z,GL1 ;NO, IGNORE IT DEC DE ;YES, BACKUP POINTER LD A,#BKSP ;VISUALLY ERASE IT CALL RST10 LD A,#SPACE CALL RST10 LD A,#BKSP CALL RST10 JR GL1 ;GO GET NEXT INPUT GL4: CALL CRLF ;REDO ENTIRE LINE LD A,#0x05E ;CR, LF AND UP-ARROW JR GETLN FNDLN: LD A,H ;*** FNDLN *** OR A ;CHECK SIGN OF HL JP M,QHOW ;IT CANNOT BE - LD DE,#TXTBGN ;INIT TEXT POINTER FNDLP: ;*** FDLNP *** FL1: PUSH HL ;SAVE LINE # LD HL,(TXTUNF) ;CHECK IF WE PASSED END DEC HL CALL RST20 POP HL ;GET LINE # BACK RET C ;C,NZ PASSED END LD A,(DE) ;WE DID NOT, GET BYTE 1 SUB L ;IS THIS THE LINE? LD B,A ;COMPARE LOW ORDER INC DE LD A,(DE) ;GET BYTE 2 SBC A,H ;COMPARE HIGH ORDER JR C,FL2 ;NO, NOT THERE YET DEC DE ;ELSE WE EITHER FOUND OR B ;IT, OR IT IS NOT THERE RET ;NC,Z;FOUND, NC,NZ:NO FNDNXT: ;*** FNDNXT *** INC DE ;FIND NEXT LINE FL2: INC DE ;JUST PASSED BYTE 1 & 2 FNDSKP: LD A,(DE) ;*** FNDSKP *** 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. ;************************************************************* PRTSTG: LD B,A ;*** PRTSTG *** PS1: LD A,(DE) ;GET A CHARACTER INC DE ;BUMP POINTER CP B ;SAME AS OLD A? RET Z ;YES, RETURN CALL RST10 ;NO, NEXT CP #CR ;WAS IT A CR? JR NZ,PS1 ;NO, NEXT RET ;YES, RETURN QTSTG: CALL RST08 ;*** QTSTG *** .db '"' .db QT3-.-1 LD A,#0x22 ;IT IS A " QT1: CALL PRTSTG ;PRINT UNTIL ANOTHER CP #CR ;WAS LAST ONE A CR? POP HL ;RETURN ADDRESS JP Z,RUNNXL ;WAS CR, RUN NEXT LINE QT2: INC HL ;SKIP 3 BYTES ON RETURN INC HL INC HL JP (HL) ;RETURN QT3: CALL RST08 ;IS IT A '? .db 0x27 .db QT4-.-1 LD A,#0x27 ;YES, DO THE SAME JR QT1 ;AS IN "" QT4: CALL RST08 ;IS IT BACK-ARROW? .db 0x5F .db QT5-.-1 LD A,#0x8D ;YES, CR WITHOUT LF CALL RST10 ;DO IT TWICE TO GIVE CALL RST10 ;TTY ENOUGH TIME POP HL ;RETURN ADDRESS JR QT2 QT5: RET ;NONE OF ABOVE ; PRTNUM: LD B,#0x00 ;*** PRTNUM *** CALL CHKSGN ;CHECK SIGN JP P,PN1 ;NO SIGN LD B,#'-' ;B=SIGN DEC C ;'-' TAKES SPACE PN1: PUSH DE ;SAVE LD DE,#0x000A ;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 ;MOVE RESULT TO BC LD L,C JR PN2 ;AND DIVIDE BY 10 PN3: POP BC ;WE GOT ALL DIGITS IN PN4: DEC C ;THE STACK LD A,C ;LOOK AT SPACE COUNT OR A JP M,PN5 ;NO LEADING BLANKS LD A,#0x20 ;LEADING BLANKS CALL RST10 JR PN4 ;MORE? PN5: LD A,B ;PRINT SIGN OR A CALL NZ,0x0010 LD E,L ;LAST REMAINDER IN E PN6: LD A,E ;CHECK DIGIT IN E CP #0x0A ;10 IS FLAG FOR NO MORE POP DE RET Z ;IF SO, RETURN ADD A,#0x30 ;ELSE, CONVERT TO ASCII CALL RST10 ;PRINT THE DIGIT JR PN6 ;GO BACK FOR MORE PRTLN: LD A,(DE) ;*** PRTLN *** LD L,A ;LOW ORDER LINE # INC DE LD A,(DE) ;HIGH ORDER LD H,A INC DE LD C,#0x04 ;PRINT 4 DIGIT LINE # CALL PRTNUM LD A,#0x20 ;FOLLOWED BY A BLANK CALL RST10 SUB A ;AND THEN THE NEXT CALL PRTSTG 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 RST20 ;*** MVUP *** RET Z ;DE = HL, RETURN LD A,(DE) ;GET ONE BYTE LD (BC),A ;MOVE IT INC DE ;INCREASE BOTH POINTERS INC BC JR MVUP ;UNTIL DONE MVDOWN: LD A,B ;*** MVDOWN *** SUB D ;TEST 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 LD A,(DE) ;BOTH POINTERS AND LD (HL),A ;THEN DO IT JR MVDOWN ;LOOP BACK POPA: POP BC ;BC = RETURN ADDR. POP HL ;RESTORE LOPVAR, BUT LD (LOPVAR),HL ;=0 MEANS NO MORE LD A,H OR L JR Z,PP1 ;YEP, GO RETURN POP HL ;NOP, RESTORE OTHERS LD (LOPINC),HL POP HL LD (LOPLMT),HL POP HL LD (LOPLN),HL POP HL LD (LOPPT),HL PP1: PUSH BC ;BC = RETURN ADDR. RET PUSHA: LD HL,#STKLMT ;*** PUSHA *** CALL CHGSGN POP BC ;BC=RETURN ADDRESS ADD HL,SP ;IS STACK NEAR THE TOP? JP NC,QSORRY ;YES, SORRY FOR THAT LD HL,(LOPVAR) ;ELSE SAVE LOOP VAR'S LD A,H ;BUT IF LOPVAR IS 0 OR L ;THAT WILL BE ALL JR Z,PU1 LD HL,(LOPPT) ;ELSE, MORE TO SAVE PUSH HL LD HL,(LOPLN) PUSH HL LD HL,(LOPLMT) PUSH HL LD HL,(LOPINC) PUSH HL LD HL,(LOPVAR) PU1: PUSH HL PUSH BC ;BC = RETURN ADDR. RET ;************************************************************* ; ; *** OUTC *** & CHKIO *** ; ; THESE ARE THE ONLY I/O ROUTINES IN TBI. ; 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'. IF OCSW=0 ; 'OUTC' WILL JUST RETURN TO THE CALLER. IF OCSW IS NOT 0, ; IT WILL OUTPUT THE BYTE IN A. IF THAT IS A CR, A LF IS ALSO ; SEND OUT. ONLY THE FLAGS MAY BE CHANGED AT RETURN. ALL REG. ; ARE RESTORED. ; ; 'CHKIO' CHECKS THE INPUT. IF NO INPUT, IT WILL RETURN TO ; THE CALLER WITH THE Z FLAG SET. IF THERE IS INPUT, Z FLAG ; IS CLEARED AND THE INPUT BYTE IS IN A. HOWEVER, IF THE ; INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND ; Z FLAG IS RETURNED. IF A CONTROL-C IS READ, 'CHKIO' WILL ; RESTART TBI AND DO NOT RETURN TO THE CALLER. ; ; Do not modify these routines. Routines requiring ; modification are : SERIAL_INIT, RX_RDY, and TX_RDY. ;************************************************************* INIT: EI CALL SERIAL_INIT ;INITIALIZE THE SIO LD D,#0x19 PATLOP: CALL CRLF DEC D JR NZ,PATLOP SUB A LD DE,#MSG1 ;PRINT THE BOOT MESSAGES CALL PRTSTG LD DE,#MSG2 CALL PRTSTG LD HL,#START LD (RANPNT),HL LD HL,#TXTBGN LD (TXTUNF),HL JP RSTART OUTC: JR NZ,OUTC2 ;OUTPUT SWITCH IS ON POP AF ;IT IS OFF RET ;RESTORE AF AND RETURN OUTC2: CALL TX_RDY ;SEE IF TRANSMIT IS AVAILABLE POP AF ;RESTORE THE REGISTER CALL BIOS_PUTC ;SEND THE BYTE THROUGH BIOS UART CP #CR RET NZ LD A,#LF CALL RST10 LD A,#CR RET CHKIO: CALL RX_RDY ;CHECK IF CHARACTER AVAILABLE RET Z ;RETURN IF NO CHARACTER AVAILABLE PUSH BC ;IF IT'S A LF, IGNORE AND RETURN LD B,A ; AS IF THERE WAS NO CHARACTER. SUB #LF JR Z,CHKIO2 LD A,B ;OTHERWISE RESTORE 'A' AND 'BC' POP BC ; AND CONTINUE ON. CP #0x0F ;IS IT CONTROL-0? JR NZ,CI1 ;NO, MORE CHECKING LD A,(OCSW) ;CONTROL-0 FLIPS OCSW CPL ;ON TO OFF, OFF TO ON LD (OCSW),A JR CHKIO ;GET ANOTHER INPUT CHKIO2: LD A,#0x00 ;CLEAR A OR A ;ZET THE Z-FLAG POP BC ;RESTORE THE 'BC' PAIR RET ;RETURN WITH 'Z' SET. CI1: CP #0x03 ;IS IT CONTROL-C? RET NZ ;NO, RETURN "NZ" JP RSTART ;YES, RESTART TBI MSG1: .db ESC .ascii "[2J" .db ESC .ascii "[H" ;SCREEN CLEAR .ascii "Z80 TINY BASIC 2.0g" .db CR ;BOOT MESSAGE MSG2: .ascii "PORTED BY DOUG GABBARD, 2017" .db CR ;************************************************************* ; ; *** 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 0xFF MARKER FOLLOWED BY A LITTLE-endian jump address. ; ; 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 .ascii "LIST" .db 0xff .dw LIST .ascii "RUN" .db 0xff .dw RUN .ascii "NEW" .db 0xff .dw NEW TAB2: ;DIRECT/STATEMENT .ascii "NEXT" .db 0xff .dw NEXT .ascii "LET" .db 0xff .dw LET .ascii "IF" .db 0xff .dw IFF .ascii "GOTO" .db 0xff .dw GOTO .ascii "GOSUB" .db 0xff .dw GOSUB .ascii "RETURN" .db 0xff .dw RETURN .ascii "REM" .db 0xff .dw REM .ascii "FOR" .db 0xff .dw FOR .ascii "INPUT" .db 0xff .dw INPUT .ascii "PRINT" .db 0xff .dw PRINT .ascii "STOP" .db 0xff .dw STOP .db 0xff .dw DEFLT TAB4: ;FUNCTIONS .ascii "RND" .db 0xff .dw RND .ascii "ABS" .db 0xff .dw ABS .ascii "SIZE" .db 0xff .dw SIZE .db 0xff .dw XP40 TAB5: ;"TO" IN "FOR" .ascii "TO" .db 0xff .dw FR1 .db 0xff .dw QWHAT TAB6: ;"STEP" IN "FOR" .ascii "STEP" .db 0xff .dw FR2 .db 0xff .dw FR3 TAB8: ;RELATION OPERATORS .ascii ">=" .db 0xff .dw XP11 .db '#' .db 0xff .dw XP12 .db '>' .db 0xff .dw XP13 .db '=' .db 0xff .dw XP15 .ascii "<=" .db 0xff .dw XP14 .db '<' .db 0xff .dw XP16 .db 0xff .dw XP17 DIRECT: LD HL,#TAB1-1 ;*** DIRECT *** EXEC: ;*** EXEC *** EX0: CALL RST28 ;IGNORE LEADING BLANKS PUSH DE ;SAVE POINTER EX1: LD A,(DE) ;IF FOUND '.' IN STRING INC DE ;BEFORE ANY MISMATCH CP #'.' ;WE DECLARE A PARTIAL MATCH JR Z,EX3 INC HL ;HL->TABLE CP (HL) ;IF MATCH, TEST NEXT JR Z,EX1 LD A,#0x7F ;ELSE SEE IF BIT 7 DEC DE ;OF TABLE IS SET, WHICH CP (HL) ;IS THE JUMP ADDR. (HI) JR C,EX5 ;C:YES, MATCHED EX2: INC HL ;NC:NO, FIND JUMP ADDR. CP (HL) JR NC,EX2 INC HL ;SKIP MARKER AND ADDRESS INC HL POP DE ;RESTORE STRING POINTER JR EX0 ;TEST AGAINST NEXT ITEM EX3: LD A,#0x7F ;PARTIAL MATCH, FIND EX4: INC HL ;JUMP ADDR., WHICH IS CP (HL) ;FLAGGED BY BIT 7 JR NC,EX4 EX5: INC HL ;SKIP ADDRESS MARKER LD A,(HL) ;LOAD HL WITH THE JUMP INC HL ;ADDRESS FROM THE TABLE LD H,(HL) LD L,A POP AF ;CLEAN UP THE GABAGE JP (HL) ;AND WE GO DO IT ;------------------------------------------------------------------------------- ;/////////////////////////////////////////////////////////////////////////////// ;------------------------------------------------------------------------------- ;COMPUTER SPECIFIC ROUTINES. ;------------------------------------------------------------------------------- SERIAL_INIT: ; This routine is for initializing your serial port. RET ;------------------------------------------------------------------------------- TX_RDY: ; This routine is checking if the Serial Port is ready to send ; a character. RET ;------------------------------------------------------------------------------- RX_RDY: ; This routine is for checking if a character is available over ; serial. If a character is available, it returns to the calling ; function with the character in 'A' and the Z-flag reset. ; However, if a character is not available, it returns with the ; Z-flag set. CALL BIOS_TRY_GETC OR A RET ;------------------------------------------------------------------------------- ;/////////////////////////////////////////////////////////////////////////////// ;------------------------------------------------------------------------------- LSTROM: ;ALL ABOVE CAN BE ROM