; vim: set fileformat=dos:
;
; Backported Tiny BASIC to bare bones i8080 without CP/M
; Stefan Tramm, November 2015
;
; used source is located at:
;  http://www.nicholson.com/rhn/files/tinybasic.tar.Z
;
; find details about this BASIC at:
;  https://en.wikipedia.org/wiki/Li-Chen_Wang
;
;**************************************************************
;*
;*                TINY BASIC FOR INTEL 8080
;*                      VERSION 1.0
;*                    BY LI-CHEN WANG
;*                     10 JUNE, 1976
;*                       @COPYLEFT
;*                  ALL WRONGS RESERVED
;*
;**************************************************************
;*
;*  ;*** ZERO PAGE SUBROUTINES ***
;*
;*  THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW
;*  MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.
;*  THIS IS A ONE BYTE INSTRUCTION AND HAS THE SAME POWER AS
;*  THE THREE BYTE INSTRUCTION CALL LLHH.  TINY BASIC WILL
;*  USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR
;*  THE SEVEN MOST FREQUENTLY USED SUBROUTINES.
;*  TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS
;*  SECTION.  THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.
;----
;*  O B S O L E T E
;*  IN ORDER TO CONFIGURE THE SYSTEM FOR USE WITH CPM I HAVE
;*  MOVED SOME OF THE ROUTINES AROUND.  START WILL NOW BE AT
;*  LOCATION 100H AND THIS SECTION WILL END AT LOCATION 3FH
;*  WITH A JUMP TO 108H.
;----
;*
       ORG  0
RSTART DI             ;*** START/RSTART OR RST 0 ***
       LXI  SP,STACK  ;INIT STACK
INIPAT JMP  INIT      ;THIS IS PATCHED AFTER 1ST RUN
       DB   'L'
;*
       XTHL           ;*** TSTC OR RST 1 ***
       RST  5         ;IGNORE BLANKS AND
       CMP  M         ;TEST CHARACTER
       JMP  TC1       ;REST OF THIS IS AT TC1
;*
CRLF   MVI  A,0DH     ;*** CRLF ***
;*
       PUSH PSW       ;*** OUTC OR RST 2 ***
       LDA  OCSW      ;PRINT CHARACTER ONLY
       ORA  A         ;IFF OCSW SWITCH IS ON
       JMP  OC2       ;REST OF THIS IS AT OC2
;*
       CALL EXPR2     ;*** EXPR OR RST 3 ***
       PUSH H         ;EVALUATE AN EXPRESION
       JMP  EXPR1     ;REST OF IT IS AT EXPR1
       DB   'W'
;*
       MOV  A,H       ;*** COMP OR RST 4 ***
       CMP  D         ;COMPARE HL WITH DE
       RNZ            ;RETURN CORRECT C AND
       MOV  A,L       ;Z FLAGS
       CMP  E         ;BUT OLD A IS LOST
       RET
       DB   'AN'
;*
SS1    LDAX D         ;*** IGNBLK/RST 5 ***
       CPI  40Q       ;IGNORE BLANKS
       RNZ            ;IN TEXT (WHERE DE->)
       INX  D         ;AND RETURN THE FIRST
       JMP  SS1       ;NON-BLANK CHAR. IN A
;*
       POP  PSW       ;*** FINISH/RST 6 ***
       CALL FIN       ;CHECK END OF COMMAND
       JMP  QWHAT     ;PRINT "WHAT?" IFF WRONG
       DB   'G'
;*
       RST  5         ;*** TSTV OR RST 7 ***
       SUI  100Q      ;TEST VARIABLES
       RC             ;C:NOT A VARIABLE
TSTV1  JNZ  TV1       ;NOT "@" ARRAY
       INX  D         ;IT IS THE "@" ARRAY
       CALL PARN      ;@ SHOULD BE FOLLOWED
       DAD  H         ;BY (EXPR) AS ITS INDEX
       JC   QHOW      ;IS INDEX TOO BIG?
       PUSH D         ;WILL IT OVERWRITE
       XCHG           ;TEXT?
       CALL SIZE      ;FIND SIZE OF FREE
       RST  4         ;AND CHECK THAT
       JC   ASORRY    ;IFF SO, SAY "SORRY"
SS1A   LXI  H,VARBGN  ;IFF NOT, GET ADDRESS
       CALL SUBDE     ;OF @(EXPR) AND PUT IT
       POP  D         ;IN HL
       RET            ;C FLAG IS CLEARED
TV1    CPI  33Q       ;NOT @, IS IT A TO Z?
       CMC            ;IFF NOT RETURN C FLAG
       RC
       INX  D         ;IFF A THROUGH Z
TV1A   LXI  H,VARBGN  ;COMPUTE ADDRESS OF
       RLC            ;THAT VARIABLE
       ADD  L         ;AND RETURN IT IN HL
       MOV  L,A       ;WITH C FLAG CLEARED
       MVI  A,0
       ADC  H
       MOV  H,A
       RET
;*
;*                 TSTC   XCH  HL,(SP)   ;*** TSTC OR RST 1 ***
;*                        IGNBLK         THIS IS AT LOC. 8
;*                        CMP  M         AND THEN JMP HERE
TC1    INX  H         ;COMPARE THE BYTE THAT
       JZ   TC2       ;FOLLOWS THE RST INST.
       PUSH B         ;WITH THE TEXT (DE->)
       MOV  C,M       ;IFF NOT =, ADD THE 2ND
       MVI  B,0       ;BYTE THAT FOLLOWS THE
       DAD  B         ;RST TO THE OLD PC
       POP  B         ;I.E., DO A RELATIVE
       DCX  D         ;JUMP IFF NOT =
TC2    INX  D         ;IFF =, SKIP THOSE BYTES
       INX  H         ;AND CONTINUE
       XTHL
       RET
;*
TSTNUM LXI  H,0       ;*** TSTNUM ***
       MOV  B,H       ;TEST IFF THE TEXT IS
       RST  5         ;A NUMBER
TN1    CPI  60Q       ;IFF NOT, RETURN 0 IN
       RC             ;B AND HL
       CPI  72Q       ;IFF NUMBERS, CONVERT
       RNC            ;TO BINARY IN HL AND
       MVI  A,360Q    ;SET A TO # OF DIGITS
       ANA  H         ;IFF H>255, THERE IS NO
       JNZ  QHOW      ;ROOM FOR NEXT DIGIT
       INR  B         ;B COUNTS # OF DIGITS
       PUSH B
       MOV  B,H       ;HL=10;*HL+(NEW DIGIT)
       MOV  C,L
       DAD  H         ;WHERE 10;* IS DONE BY
       DAD  H         ;SHIFT AND ADD
       DAD  B
       DAD  H
       LDAX D         ;AND (DIGIT) IS FROM
       INX  D         ;STRIPPING THE ASCII
       ANI  17Q       ;CODE
       ADD  L
       MOV  L,A
       MVI  A,0
       ADC  H
       MOV  H,A
       POP  B
       LDAX D         ;DO THIS DIGIT AFTER
       JP   TN1       ;DIGIT. S SAYS OVERFLOW
QHOW   PUSH D         ;*** ERROR: "HOW?" ***
AHOW   LXI  D,HOW
       JMP  ERROR
HOW    DB   'HOW?',0DH
OK     DB   'OK',0DH
WHAT   DB   'WHAT?',0DH
SORRY  DB   'SORRY',0DH
;*
;**************************************************************
;*
;* *** 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.  IFF 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.  IFF A LINE WITH THE SAME LINE
;* NUMBER IS ALREDY THERE, IT IS REPLACED BY THE NEW ONE.  IF
;* THE REST OF THE LINE CONSISTS OF A 0DHONLY, IT IS NOT STORED
;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.
;*
;* AFTER A LINE ISs INSERTED, REPLACED, OR DELETED, THE PROGRAM
;* LOOPS BACK AND ASK FOR ANOTHER LINE.  THIS LOOP WILL BE
;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE
;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRCT".
;*
;* TINY BASIC PROGRAM SAVE AREA STARTS AT THE MEMORY LOCATION
;* LABELED "TXTBGN" AND ENDED 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  LXI  SP,STACK
ST1    CALL CRLF      ;AND JUMP TO HERE
       LXI  D,OK      ;DE->STRING
       SUB  A         ;A=0
       CALL PRTSTG    ;PRINT STRING UNTIL 0DH
       LXI  H,ST2+1   ;LITERAL 0
       SHLD CURRNT    ;CURRNT->LINE # = 0
ST2    LXI  H,0
       SHLD LOPVAR
       SHLD STKGOS
ST3    MVI  A,76Q     ;PROMPT '>' AND
       CALL GETLN     ;READ A LINE
       PUSH D         ;DE->END OF LINE
ST3A   LXI  D,BUFFER  ;DE->BEGINNING OF LINE
       CALL TSTNUM    ;TESt IFF IT IS A NUMBER
       RST  5
       MOV  A,H       ;HL=VALUE OF THE # OR
       ORA  L         ;0 IFF NO # WAS FOUND
       POP  B         ;BC->END OF LINE
       JZ   DIRECT
       DCX  D         ;BACKUP DE AND SAVE
       MOV  A,H       ;VALUE OF LINE # THERE
       STAX D
       DCX  D
       MOV  A,L
       STAX D
       PUSH B         ;BC,DE->BEGIN, END
       PUSH D
       MOV  A,C
       SUB  E
       PUSH PSW       ;A=# OF BYTES IN LINE
       CALL FNDLN     ;FIND THIS LINE IN SAVE
       PUSH D         ;AREA, DE->SAVE AREA
       JNZ  ST4       ;NZ:NOT FOUND, INSERT
       PUSH D         ;Z:FOUND, DELETE IT
       CALL FNDNXT    ;FIND NEXT LINE
;*                                       DE->NEXT LINE
       POP  B         ;BC->LINE TO BE DELETED
       LHLD TXTUNF    ;HL->UNFILLED SAVE AREA
       CALL MVUP      ;MOVE UP TO DELETE
       MOV  H,B       ;TXTUNF->UNFILLED AREA
       MOV  L,C
       SHLD TXTUNF    ;UPDATE
ST4    POP  B         ;GET READY TO INSERT
       LHLD TXTUNF    ;BUT FIRT CHECK IF
       POP  PSW       ;THE LENGTH OF NEW LINE
       PUSH H         ;IS 3 (LINE # AND CR)
       CPI  3         ;THEN DO NOT INSERT
       JZ   RSTART    ;MUST CLEAR THE STACK
       ADD  L         ;COMPUTE NEW TXTUNF
       MOV  L,A
       MVI  A,0
       ADC  H
       MOV  H,A       ;HL->NEW UNFILLED AREA
ST4A   LXI  D,TXTEND  ;CHECK TO SEE IF THERE
       RST  4         ;IS ENOUGH SPACE
       JNC  QSORRY    ;SORRY, NO ROOM FOR IT
       SHLD TXTUNF    ;OK, UPDATE TXTUNF
       POP  D         ;DE->OLD UNFILLED AREA
       CALL MVDOWN
       POP  D         ;DE->BEGIN, HL->END
       POP  H
       CALL MVUP      ;MOVE NEW LINE TO SAVE
       JMP  ST3       ;AREA
;*
;**************************************************************
;*
;* *** 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 AD 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.  IFF THE
;* STRING DOES NOT MATCH ANY OF THE OTHER ITEMS, IT WILL
;* MATCH THIS NULL ITEM AS DEFAULT.
;*
TAB1   EQU  $         ;DIRECT COMMANDS
       DB   'LIST'
       DB   LIST SHR 8 + 128,LIST AND 0FFH
       DB   'RUN'
       DB   RUN SHR 8 + 128,RUN AND 255
       DB   'NEW'
       DB   NEW SHR 8 + 128,NEW AND 255
       DB   'LOAD'
       DB   DLOAD SHR 8 + 128,DLOAD AND 255
       DB   'SAVE'
       DB   DSAVE SHR 8 + 128,DSAVE AND 255
       DB   'BYE'
       DB   BYE SHR 8 + 128,BYE AND 255
TAB2   EQU  $         ;DIRECT/TATEMENT
       DB   'NEXT'
       DB   NEXT SHR 8 + 128,NEXT AND 255
       DB   'LET'
       DB   LET SHR 8 + 128,LET AND 255
       DB   'OUT'
       DB   OUTCMD SHR 8 + 128,OUTCMD AND 255
       DB   'POKE'
       DB   POKE SHR 8 + 128,POKE AND 255
       DB   'WAIT'
       DB   WAITCM SHR 8 + 128,WAITCM AND 255
       DB   'IF'
       DB   IFF SHR 8 + 128,IFF AND 255
       DB   'GOTO'
       DB   GOTO SHR 8 + 128,GOTO AND 255
       DB   'GOSUB'
       DB   GOSUB SHR 8 + 128,GOSUB AND 255
       DB   'RETURN'
       DB   RETURN SHR 8 + 128,RETURN AND 255
       DB   'REM'
       DB   REM SHR 8 + 128,REM AND 255
       DB   'FOR'
       DB   FOR SHR 8 + 128,FOR AND 255
       DB   'INPUT'
       DB   INPUT SHR 8 + 128,INPUT AND 255
       DB   'PRINT'
       DB   PRINT SHR 8 + 128,PRINT AND 255
       DB   'STOP'
       DB   STOP SHR 8 + 128,STOP AND 255
       DB   DEFLT SHR 8 + 128,DEFLT AND 255
       DB   'YOU CAN ADD MORE' ;COMMANDS BUT
            ;REMEMBER TO MOVE DEFAULT DOWN.
TAB4   EQU  $         ;FUNCTIONS
       DB   'RND'
       DB   RND SHR 8 + 128,RND AND 255
       DB   'INP'
       DB   INP SHR 8 + 128,INP AND 255
       DB   'PEEK'
       DB   PEEK SHR 8 + 128,PEEK AND 255
       DB   'USR'
       DB   USR SHR 8 + 128,USR AND 255
       DB   'ABS'
       DB   ABS SHR 8 + 128,ABS AND 255
       DB   'SIZE'
       DB   SIZE SHR 8 + 128,SIZE AND 255
       DB   XP40 SHR 8 + 128,XP40 AND 255
       DB   'YOU CAN ADD MORE' ;FUNCTIONS BUT REMEMBER
                      ;TO MOVE XP40 DOWN
TAB5   EQU  $         ;"TO" IN "FOR"
       DB   'TO'
       DB   FR1 SHR 8 + 128,FR1 AND 255
       DB   QWHAT SHR 8 + 128,QWHAT AND 255
TAB6   EQU  $         ;"STEP" IN "FOR"
       DB   'STEP'
       DB   FR2 SHR 8 + 128,FR2 AND 255
       DB   FR3 SHR 8 + 128,FR3 AND 255
TAB8   EQU  $         ;RELATION OPERATORS
       DB   '>='
       DB   XP11 SHR 8 + 128,XP11 AND 255
       DB   '#'
       DB   XP12 SHR 8 + 128,XP12 AND 255
       DB   '>'
       DB   XP13 SHR 8 + 128,XP13 AND 255
       DB   '='
       DB   XP15 SHR 8 + 128,XP15 AND 255
       DB   '<='
       DB   XP14 SHR 8 + 128,XP14 AND 255
       DB   '<'
       DB   XP16 SHR 8 + 128,XP16 AND 255
       DB   XP17 SHR 8 + 128,XP17 AND 255
;*
DIRECT LXI  H,TAB1-1  ;*** DIRECT ***
;*
EXEC   EQU  $         ;*** EXEC ***
EX0    RST  5         ;IGNORE LEADING BLANKS
       PUSH D         ;SAVE POINTER
EX1    LDAX D         ;IFF FOUND '.' IN STRING
       INX  D         ;BEFORE ANY MISMATCH
       CPI  56Q       ;WE DECLARE A MATCH
       JZ   EX3
       INX  H         ;HL->TABLE
       CMP  M         ;IFF MATCH, TEST NEXT
       JZ   EX1
       MVI  A,177Q    ;ELSE, SEE IFF BIT 7
       DCX  D         ;OF TABLEIS SET, WHICH
       CMP  M         ;IS THE JUMP ADDR. (HI)
       JC   EX5       ;C:YES, MATCHED
EX2    INX  H         ;NC:NO, FIND JUMP ADDR.
       CMP  M
       JNC  EX2
       INX  H         ;BUMP TO NEXT TAB. ITEM
       POP  D         ;RESTORE STRING POINTER
       JMP  EX0       ;TEST AGAINST NEXT ITEM
EX3    MVI  A,177Q    ;PARTIAL MATCH, FIND
EX4    INX  H         ;JUMP ADDR., WHICH IS
       CMP  M         ;FLAGGED BY BIT 7
       JNC  EX4
EX5    MOV  A,M       ;LOAD HL WITH THE JUMP
       INX  H         ;ADDRESS FROM THE TABLE
       MOV  L,M
       ANI  177Q      ;MASK OFF BIT 7
       MOV  H,A
       POP  PSW       ;CLEAN UP THE GABAGE
       PCHL           ;AND WE GO DO IT
;*
;**************************************************************
;*
;* 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
;* TANSFERED TO OTHER SECTIONS AS FOLLOWS:
;*
;* FOR 'LIST', 'NEW', AND 'STOP': GO BACK TO 'RSTART'
;* FOR 'RUN': GO EXECUTE THE FIRST STORED LINE IFF 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: IFF 'CURRNT' -> 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
;* 'CURRNT'), 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.
;***ST*** fixme
;* 'DLOAD' LOADS A NAMED PROGRAM FROM DISK.
;* 'DSAVE' SAVES A NAMED PROGRAM ON DISK.
;* 'FCBSET' SETS UP THE FILE CONTROL BLOCK FOR SUBSEQUENT DISK I/O.
;*
NEW    CALL ENDCHK    ;*** NEW(CR) ***
       LXI  H,TXTBGN
       SHLD TXTUNF
;*
STOP   CALL ENDCHK    ;*** STOP(CR) ***
       RST  0
;*
RUN    CALL ENDCHK    ;*** RUN(CR) ***
       LXI  D,TXTBGN  ;FIRST SAVED LINE
;*
RUNNXL LXI  H,0       ;*** RUNNXL ***
       CALL FNDLNP    ;FIND WHATEVER LINE #
       JC   RSTART    ;C:PASSED TXTUNF, QUIT
;*
RUNTSL XCHG           ;*** RUNTSL ***
       SHLD CURRNT    ;SET 'CURRNT'->LINE #
       XCHG
       INX  D         ;BUMP PASS LINE #
       INX  D
;*
RUNSML CALL CHKIO     ;*** RUNSML ***
       LXI  H,TAB2-1  ;FIND COMMAND IN TAB2
       JMP  EXEC      ;AND EXECUTE IT
;*
GOTO   RST  3         ;*** GOTO EXPR ***
       PUSH D         ;SAVE FOR ERROR ROUTINE
       CALL ENDCHK    ;MUST FIND A 0DH
       CALL FNDLN     ;FIND THE TARGET LINE
       JNZ  AHOW      ;NO SUCH LINE #
       POP  PSW       ;CLEAR THE "PUSH DE"
       JMP  RUNTSL    ;GO DO IT
;*
DSAVE  CALL ENDCHK    ;*** SAVE(CR) ***
       LXI  D,TXTBGN  ;HL POINTER
       LHLD TXTUNF    ;DE ENDMARKER
       XCHG
DS1    MOV  A,L       ;UNUSED MEM REACHED?
       CMP  E
       JNZ  DS2
       MOV  A,H
       CMP  D
       JZ   DS4       ;YES, DONE, WRITE CTRL-Z
DS2    MOV  A,M       ;FETCH PROGRAM BYTE
       INX  H         ;ADVANCE POINTER
       CPI  ' '       ;CONTROL CHAR?
       JM   DS3       ;YES, HANDLE AS OCT
       OUT  5         ;NO, WRITE IT
       CPI  '\'       ;DOUBLE THE ESC CHAR
       JNZ  DS1
       OUT  5
       JMP  DS1
DS3    MOV  B,A       ;WRITE "\OOO"
       MVI  A,'\'     ;WRITE ESC CHAR
       OUT  5
       MOV  A,B       ;HIGHEST OCT DIGIT
       RLC
       RLC
       ANI  3         ;JUST TWO VALID BITS
       ADI  '0'
       OUT  5
       MOV  A,B       ;MIDDLE OCT DIGIT
       RRC
       RRC
       RRC
       ANI  7
       ADI  '0'
       OUT  5
       MOV  A,B       ;LOWEST OCT DIGIT
       ANI  7
       ADI  '0'
       OUT  5
       JMP  DS1
DS4    MVI  A,1AH     ;WRITE END MARKER CTRL-Z
       OUT  5
       RST  0
;*
DLOAD  CALL ENDCHK    ;*** LOAD(CR) ***
       LXI  H,TXTBGN  ;POINTER TO FIRST PROG LOCATION
DL1    CALL TAPIN     ;END REACHED CTRL-Z?
       JZ   DL9       ;EOF, STORE POINTER
       CPI  '\'       ;NO, CHECK ESC
       JZ   DL3       ;YES, HANDLE ESC
DL2    MOV  M,A       ;NO, STORE CHARACTER
       INX  H
       JMP  DL1
DL3    LXI  B,3       ;LOOP THREE DIGITS
DL4    MOV  A,B       ;MAKE ROOM FOR NEXT DIGIT IN B
       RLC
       RLC
       RLC
       MOV  B,A
       CALL TAPIN     ;READ NEXT CHAR
       JZ   DL9       ;EOF, STORE POINTER
       CPI  '0'       ;OCT DIGIT?
       JM   DL2       ;NO, JUST WRITE IT
       CPI  '8'
       JP   DL2
       SUI  '0'       ;CONVERT OCT TO BIN
       ORA  B         ;PATCH TOGETHER
       MOV  B,A       ;STORE BACK TO B
       DCR  C         ;LOOP END REACHED
       JNZ  DL4       ;NO, NEXT DIGIT
       JMP  DL2       ;YES, WRITE BYTE INTO MEM
DL9    SHLD TXTUNF    ;STORE FIRST UNUSED LOCATION
       RST  0
;*
TAPIN  IN   4         ;TAPE READY?
       ORA  A
       JZ   TAPIN     ;NO, POLL
       IN   5         ;YES, READ
       CPI  1AH       ;Z-FLAG FOR EOF
       RET
;*
;*************************************************************
;*
;* *** 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 CONTROLSs
;* 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.  IFF 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 IFF THE LIST IS A NULL LIST.  HOWEVER IFF THE LIST
;* ENDED WITH A COMMA, NO (CRL) IS GENERATED.
;*
LIST   CALL TSTNUM    ;TEST IFF THERE IS A #
       CALL ENDCHK    ;IFF NO # WE GET A 0
       CALL FNDLN     ;FIND THIS OR NEXT LINE
LS1    JC   RSTART    ;C:PASSED TXTUNF
       CALL PRTLN     ;PRINT THE LINE
       CALL CHKIO     ;STOP IFF HIT CONTROL-C
       CALL FNDLNP    ;FIND NEXT LINE
       JMP  LS1       ;AND LOOP BACK
;*
PRINT  MVI  C,6       ;C = # OF SPACES
       RST  1         ;IFF NULL LIST & ";"
       DB   73Q
       DB   6Q
       CALL CRLF      ;GIVE CR-LF AND
       JMP  RUNSML    ;CONTINUE SAME LINE
PR2    RST  1         ;IFF NULL LIST (CR)
       DB   0DH
       DB   6Q
       CALL CRLF      ;ALSO GIVE CR-LF AND
       JMP  RUNNXL    ;GO TO NEXT LINE
PR0    RST  1         ;ELSE IS IT FORMAT?
       DB   '#'
       DB   5Q
       RST  3         ;YES, EVALUATE EXPR.
       MOV  C,L       ;AND SAVE IT IN C
       JMP  PR3       ;LOOK FOR MORE TO PRINT
PR1    CALL QTSTG     ;OR IS IT A STRING?
       JMP  PR8       ;IFF NOT, MUST BE EXPR.
PR3    RST  1         ;IFF ",", GO FIND NEXT
       DB   ','
       DB   6Q
       CALL FIN       ;IN THE LIST.
       JMP  PR0       ;LIST CONTINUES
PR6    CALL CRLF      ;LIST ENDS
       RST  6
PR8    RST  3         ;EVALUATE THE EXPR
       PUSH B
       CALL PRTNUM    ;PRINT THE VALUE
       POP  B
       JMP  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.  IFF 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 FORr NO FURTHER 'RETURN'S.
;*
;* 'RETURN(CR)' UNDOS EVERYHING THAT 'GOSUB' DID, AND THUS
;* RETURN THE EXCUTION TO THE COMMAND AFTER THE MOST RECENT
;* 'GOSUB'.  IFF 'STKGOS' IS ZERO, IT INDICATES THAT WE
;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.
;*
GOSUB  CALL PUSHA     ;SAVE THE CURRENT "FOR"
       RST  3         ;PARAMETERS
       PUSH D         ;AND TEXT POINTER
       CALL FNDLN     ;FIND THE TARGET LINE
       JNZ  AHOW      ;NOT THERE. SAY "HOW?"
       LHLD CURRNT    ;FOUND IT, SAVE OLD
       PUSH H         ;'CURRNT' OLD 'STKGOS'
       LHLD STKGOS
       PUSH H
       LXI  H,0       ;AND LOAD NEW ONES
       SHLD LOPVAR
       DAD  SP
       SHLD STKGOS
       JMP  RUNTSL    ;THEN RUN THAT LINE
RETURN CALL ENDCHK    ;THERE MUST BE A 0DH
       LHLD STKGOS    ;OLD STACK POINTER
       MOV  A,H       ;0 MEANS NOT EXIST
       ORA  L
       JZ   QWHAT     ;SO, WE SAY: "WHAT?"
       SPHL           ;ELSE, RESTORE IT
       POP  H
       SHLD STKGOS    ;AND THE OLD 'STKGOS'
       POP  H
       SHLD CURRNT    ;AND THE OLD 'CURRNT'
       POP  D         ;OLD TEXT POINTER
       CALL POPA      ;OLD "FOR" PARAMETERS
       RST  6         ;AND WE ARE BACK HOME
;*
;**************************************************************
;*
;* *** FOR *** & NEXT ***
;*
;* 'FOR' HAS TWO FORMS:
;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2'
;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH
;* EXP1=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 EXPR2 AND EXP1
;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTERr ETC. IN
;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',
;* 'LOPLMT', 'LOPLN', AND 'LOPPT'.  IFF 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 IFF THIS SAME
;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.
;* IFF 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'.  IFF THEY ARE NOT THE SAME, TBI DIGS IN
;* THE STACK TO FIND THE RIGHTt 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.  IFF IT
;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND
;* FOLLOWING THE 'FOR'.  IFF OUTSIDE THE LIMIT, THE SAVE ARER
;* IS PURGED AND EXECUTION CONTINUES.
;*
FOR    CALL PUSHA     ;SAVE THE OLD SAVE AREA
       CALL SETVAL    ;SET THE CONTROL VAR.
       DCX  H         ;HL IS ITS ADDRESS
       SHLD LOPVAR    ;SAVE THAT
       LXI  H,TAB5-1  ;USE 'EXEC' TO LOOK
       JMP  EXEC      ;FOR THE WORD 'TO'
FR1    RST  3         ;EVALUATE THE LIMIT
       SHLD LOPLMT    ;SAVE THAT
       LXI  H,TAB6-1  ;USE 'EXEC' TO LOOK
       JMP  EXEC      ;FOR THE WORD 'STEP'
FR2    RST  3         ;FOUND IT, GET STEP
       JMP  FR4
FR3    LXI  H,1Q      ;NOT FOUND, SET TO 1
FR4    SHLD LOPINC    ;SAVE THAT TOO
FR5    LHLD CURRNT    ;SAVE CURRENT LINE #
       SHLD LOPLN
       XCHG           ;AND TEXT POINTER
       SHLD LOPPT
       LXI  B,12Q     ;DIG INTO STACK TO
       LHLD LOPVAR    ;FIND 'LOPVAR'
       XCHG
       MOV  H,B
       MOV  L,B       ;HL=0 NOW
       DAD  SP        ;HERE IS THE STACK
       DB   76Q
FR7    DAD  B         ;EACH LEVEL IS 10 DEEP
       MOV  A,M       ;GET THAT OLD 'LOPVAR'
       INX  H
       ORA  M
       JZ   FR8       ;0 SAYS NO MORE IN IT
       MOV  A,M
       DCX  H
       CMP  D         ;SAME AS THIS ONE?
       JNZ  FR7
       MOV  A,M       ;THE OTHER HALF?
       CMP  E
       JNZ  FR7
       XCHG           ;YES, FOUND ONE
       LXI  H,0Q
       DAD  SP        ;TRY TO MOVE SP
       MOV  B,H
       MOV  C,L
       LXI  H,12Q
       DAD  D
       CALL MVDOWN    ;AND PURGE 10 WORDS
       SPHL           ;IN THE STACK
FR8    LHLD LOPPT     ;JOB DONE, RESTORE DE
       XCHG
       RST  6         ;AND CONTINUE
;*
NEXT   RST  7         ;GET ADDRESS OF VAR.
       JC   QWHAT     ;NO VARIABLE, "WHAT?"
       SHLD VARNXT    ;YES, SAVE IT
NX0    PUSH D         ;SAVE TEXT POINTER
       XCHG
       LHLD LOPVAR    ;GET VAR. IN 'FOR'
       MOV  A,H
       ORA  L         ;0 SAYS NEVER HAD ONE
       JZ   AWHAT     ;SO WE ASK: "WHAT?"
       RST  4         ;ELSE WE CHECK THEM
       JZ   NX3       ;OK, THEY AGREE
       POP  D         ;NO, LET'S SEE
       CALL POPA      ;PURGE CURRENT LOOP
       LHLD VARNXT    ;AND POP ONE LEVEL
       JMP  NX0       ;GO CHECK AGAIN
NX3    MOV  E,M       ;COME HERE WHEN AGREED
       INX  H
       MOV  D,M       ;DE=VALUE OF VAR.
       LHLD LOPINC
       PUSH H
       DAD  D         ;ADD ONE STEP
       XCHG
       LHLD LOPVAR    ;PUT IT BACK
       MOV  M,E
       INX  H
       MOV  M,D
       LHLD LOPLMT    ;HL->LIMIT
       POP  PSW       ;OLD HL
       ORA  A
       JP   NX1       ;STEP > 0
       XCHG
NX1    CALL CKHLDE    ;COMPARE WITH LIMIT
       POP  D         ;RESTORE TEXT POINTER
       JC   NX2       ;OUTSIDE LIMIT
       LHLD LOPLN     ;WITHIN LIMIT, GO
       SHLD CURRNT    ;BACK TO THE SAVED
       LHLD LOPPT     ;'CURRNT' AND TEXT
       XCHG           ;POINTER
       RST  6
NX2    CALL POPA      ;PURGE THIS LOOP
       RST  6
;*
;**************************************************************
;*
;* *** REM *** IFF *** 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 OUTHER 'IF'S) SEPERATED BY SEMI-COLONS.
;* NOTE THAT THE WORD 'THEN' IS NOT USED.  TBI EVALUATES THE
;* EXPR. IFF IT IS NON-ZERO, EXECUTION CONTINUES.  IFF THE
;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND
;* EXECUTION CONTINUES AT THE NEXT LINE.
;*
;* 'IPUT' COMMAND IS LIKE THE 'PRINT' COMMAND, AND IS FOLLOWED
;* BY A LIST OF ITEMS.  IFF THE ITEM IS A STRING IN SINGLE OR
;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS
;* IN 'PRINT'.  IFF 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 ISs THEN SET TO THE
;* VALUE OF THIS EXPR.  IFF 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.
;*
;* IFF 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 VARIBLE TO THAT VALUE.
;* TB WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.
;* THIS IS DONE BY 'DEFLT'.
;*
REM    LXI  H,0Q      ;*** REM ***
       DB   76Q
;*
IFF    RST  3         ;*** IFF ***
       MOV  A,H       ;IS THE EXPR.=0?
       ORA  L
       JNZ  RUNSML    ;NO, CONTINUE
       CALL FNDSKP    ;YES, SKIP REST OF LINE
       JNC  RUNTSL
;       JMP  RSTART
       RST  0
;*
INPERR LHLD STKINP    ;*** INPERR ***
       SPHL           ;RESTORE OLD SP
       POP  H         ;AND OLD 'CURRNT'
       SHLD CURRNT
       POP  D         ;AND OLD TEXT POINTER
       POP  D         ;REDO INPUT
;*
INPUT  EQU  $         ;*** INPUT ***
IP1    PUSH D         ;SAVE IN CASE OF ERROR
       CALL QTSTG     ;IS NEXT ITEM A STRING?
       JMP  IP2       ;NO
       RST  7         ;YES. BUT FOLLOWED BY A
       JC   IP4       ;VARIABLE?   NO.
       JMP  IP3       ;YES.  INPUT VARIABLE
IP2    PUSH D         ;SAVE FOR 'PRTSTG'
       RST  7         ;MUST BE VARIABLE NOW
       JC   QWHAT     ;"WHAT?" IT IS NOT?
       LDAX D         ;GET READY FOR 'RTSTG'
       MOV  C,A
       SUB  A
       STAX D
       POP  D
       CALL PRTSTG    ;PRINT STRING AS PROMPT
       MOV  A,C       ;RESTORE TEXT
       DCX  D
       STAX D
IP3    PUSH D         ;SAVE IN CASE OF ERROR
       XCHG
       LHLD CURRNT    ;ALSO SAVE 'CURRNT'
       PUSH H
       LXI  H,IP1     ;A NEGATIVE NUMBER
       SHLD CURRNT    ;AS A FLAG
       LXI  H,0Q      ;SAVE SP TOO
       DAD  SP
       SHLD STKINP
       PUSH D         ;OLD HL
       MVI  A,72Q     ;PRINT THIS TOO
       CALL GETLN     ;AND GET A LINE
IP3A   LXI  D,BUFFER  ;POINTS TO BUFFER
       RST  3         ;EVALUATE INPUT
       NOP            ;CAN BE 'CALL ENDCHK'
       NOP
       NOP
       POP  D         ;OK, GET OLD HL
       XCHG
       MOV  M,E       ;SAVE VALUE IN VAR.
       INX  H
       MOV  M,D
       POP  H         ;GET OLD 'CURRNT'
       SHLD CURRNT
       POP  D         ;AND OLD TEXT POINTER
IP4    POP  PSW       ;PURGE JUNK IN STACK
       RST  1         ;IS NEXT CH. ','?
       DB   ','
       DB   3Q
       JMP  IP1       ;YES, MORE ITEMS.
IP5    RST  6
;*
DEFLT  LDAX D         ;*** DEFLT ***
       CPI  0DH       ;EMPTY LINE IS OK
       JZ   LT1       ;ELSE IT IS 'LET'
;*
LET    CALL SETVAL    ;*** LET ***
       RST  1         ;SET VALUE TO VAR.
       DB   ','
       DB   3Q
       JMP  LET       ;ITEM BY ITEM
LT1    RST  6         ;UNTIL FINISH
;*
;**************************************************************
;*
;* *** EXPR ***
;*
;* 'EXPR' EVALUATES ARITHMETICAL OR LOGICAL EXPRESSIONS.
;* <EXPR>::=<EXPR2>
;*          <EXPR2><REL.OP.><EXPR2>
;* WHERE <REL.OP.> IS ONE OF THE OPERATORSs IN TAB8 AND THE
;* RESULT OF THESE OPERATIONS IS 1 IFF TRUE AND 0 IFF FALSE.
;* <EXPR2>::=(+ OR -)<EXPR3>(+ OR -<EXPR3>)(....)
;* WHERE () ARE OPTIONAL AND (....) ARE OPTIONAL REPEATS.
;* <EXPR3>::=<EXPR4>(<* OR /><EXPR4>)(....)
;* <EXPR4>::=<VARIABLE>
;*           <FUNCTION>
;*           (<EXPR>)
;* <EXPR> IS RECURSIVE SO THAT VARIABLE '@' CAN HAVE AN <EXPR>
;* AS INDEX, FNCTIONS CAN HAVE AN <EXPR> AS ARGUMENTS, AND
;* <EXPR4> CAN BE AN <EXPR> IN PARANTHESE.
;*
;*                 EXPR   CALL EXPR2     THIS IS AT LOC. 18
;*                        PUSH HL        SAVE <EXPR2> VALUE
EXPR1  LXI  H,TAB8-1  ;LOOKUP REL.OP.
       JMP  EXEC      ;GO DO IT
XP11   CALL XP18      ;REL.OP.">="
       RC             ;NO, RETURN HL=0
       MOV  L,A       ;YES, RETURN HL=1
       RET
XP12   CALL XP18      ;REL.OP."#"
       RZ             ;FALSE, RETURN HL=0
       MOV  L,A       ;TRUE, RETURN HL=1
       RET
XP13   CALL XP18      ;REL.OP.">"
       RZ             ;FALSE
       RC             ;ALSO FALSE, HL=0
       MOV  L,A       ;TRUE, HL=1
       RET
XP14   CALL XP18      ;REL.OP."<="
       MOV  L,A       ;SET HL=1
       RZ             ;REL. TRUE, RETURN
       RC
       MOV  L,H       ;ELSE SET HL=0
       RET
XP15   CALL XP18      ;REL.OP."="
       RNZ            ;FALSE, RETRUN HL=0
       MOV  L,A       ;ELSE SET HL=1
       RET
XP16   CALL XP18      ;REL.OP."<"
       RNC            ;FALSE, RETURN HL=0
       MOV  L,A       ;ELSE SET HL=1
       RET
XP17   POP  H         ;NOT REL.OP.
       RET            ;RETURN HL=<EXPR2>
XP18   MOV  A,C       ;SUBROUTINE FOR ALL
       POP  H         ;REL.OP.'S
       POP  B
       PUSH H         ;REVERSE TOP OF STACK
       PUSH B
       MOV  C,A
       CALL EXPR2     ;GET 2ND <EXPR2>
       XCHG           ;VALUE IN DE NOW
       XTHL           ;1ST <EXPR2> IN HL
       CALL CKHLDE    ;COMPARE 1ST WITH 2ND
       POP  D         ;RESTORE TEXT POINTER
       LXI  H,0Q      ;SET HL=0, A=1
       MVI  A,1
       RET
;*
EXPR2  RST  1         ;NEGATIVE SIGN?
       DB   '-'
       DB   6Q
       LXI  H,0Q      ;YES, FAKE '0-'
       JMP  XP26      ;TREAT LIKE SUBTRACT
XP21   RST  1         ;POSITIVE SIGN?  IGNORE
       DB   '+'
       DB   0Q
XP22   CALL EXPR3     ;1ST <EXPR3>
XP23   RST  1         ;ADD?
       DB   '+'
       DB   25Q
       PUSH H         ;YES, SAVE VALUE
       CALL EXPR3     ;GET 2ND<EXPR3>
XP24   XCHG           ;2ND IN DE
       XTHL           ;1ST IN HL
       MOV  A,H       ;COMPARE SIGN
       XRA  D
       MOV  A,D
       DAD  D
       POP  D         ;RESTORE TEXT POINTER
       JM   XP23      ;1ST 2ND SIGN DIFFER
       XRA  H         ;1ST 2ND SIGN EQUAL
       JP   XP23      ;SO ISp RESULT
       JMP  QHOW      ;ELSE WE HAVE OVERFLOW
XP25   RST  1         ;SUBTRACT?
       DB   '-'
       DB   203Q
XP26   PUSH H         ;YES, SAVE 1ST <EXPR3>
       CALL EXPR3     ;GET 2ND <EXPR3>
       CALL CHGSGN    ;NEGATE
       JMP  XP24      ;AND ADD THEM
;*
EXPR3  CALL EXPR4     ;GET 1ST <EXPR4>
XP31   RST  1         ;MULTIPLY?
       DB   '*'
       DB   54Q
       PUSH H         ;YES, SAVE 1ST
       CALL EXPR4     ;AND GET 2ND <EXPR4>
       MVI  B,0Q      ;CLEAR B FOR SIGN
       CALL CHKSGN    ;CHECK SIGN
       XCHG           ;2ND IN DE NOW
       XTHL           ;1ST IN HL
       CALL CHKSGN    ;CHECK SIGN OF 1ST
       MOV  A,H       ;IS HL > 255 ?
       ORA  A
       JZ   XP32      ;NO
       MOV  A,D       ;YES, HOW ABOUT DE
       ORA  D
       XCHG           ;PUT SMALLER IN HL
       JNZ  AHOW      ;ALSO >, WILL OVERFLOW
XP32   MOV  A,L       ;THIS IS DUMB
       LXI  H,0Q      ;CLEAR RESULT
       ORA  A         ;ADD AND COUNT
       JZ   XP35
XP33   DAD  D
       JC   AHOW      ;OVERFLOW
       DCR  A
       JNZ  XP33
       JMP  XP35      ;FINISHED
XP34   RST  1         ;DIVIDE?
       DB   '/'
       DB   104Q
       PUSH H         ;YES, SAVE 1ST <EXPR4>
       CALL EXPR4     ;AND GET 2ND ONE
       MVI  B,0Q      ;CLEAR B FOR SIGN
       CALL CHKSGN    ;CHECK SIGN OF 2ND
       XCHG           ;PUT 2ND IN DE
       XTHL           ;GET 1ST IN HL
       CALL CHKSGN    ;CHECK SIGN OF 1ST
       MOV  A,D       ;DIVIDE BY 0?
       ORA  E
       JZ   AHOW      ;SAY "HOW?"
       PUSH B         ;ELSE SAVE SIGN
       CALL DIVIDE    ;USE SUBROUTINE
       MOV  H,B       ;RESULT IN HL NOW
       MOV  L,C
       POP  B         ;GET SIGN BACK
XP35   POP  D         ;AND TEXT POINTER
       MOV  A,H       ;HL MUST BE +
       ORA  A
       JM   QHOW      ;ELSE IT IS OVERFLOW
       MOV  A,B
       ORA  A
       CM   CHGSGN    ;CHANGE SIGN IFF NEEDED
       JMP  XP31      ;LOOK OR MORE TERMS
;*
EXPR4  LXI  H,TAB4-1  ;FIND FUNCTION IN TAB4
       JMP  EXEC      ;AND GO DO IT
XP40   RST  7         ;NO, NOT A FUNCTION
       JC   XP41      ;NOR A VARIABLE
       MOV  A,M       ;VARIABLE
       INX  H
       MOV  H,M       ;VALUE IN HL
       MOV  L,A
       RET
XP41   CALL TSTNUM    ;OR IS IT A NUMBER
       MOV  A,B       ;# OF DIGIT
       ORA  A
       RNZ            ;OK
PARN   RST  1         ;NO DIGIT, MUST BE
       DB   '('
       DB   5Q
       RST  3         ;"(EXPR)"
       RST  1
       DB   ')'
       DB   1Q
XP42   RET
XP43   JMP  QWHAT     ;ELSE SAY: "WHAT?"
;*
RND    CALL PARN      ;*** RND(EXPR) ***
       MOV  A,H       ;EXPR MUST BE +
       ORA  A
       JM   QHOW
       ORA  L         ;AND NON-ZERO
       JZ   QHOW
       PUSH D         ;SAVE BOTH
       PUSH H
       LHLD RANPNT    ;GET MEMORY AS RANDOM
       LXI  D,LSTROM  ;NUMBER
       RST  4
       JC   RA1       ;WRAP AROUND IFF LAST
       LXI  H,RSTART
RA1    MOV  E,M
       INX  H
       MOV  D,M
       SHLD RANPNT
       POP  H
       XCHG
       PUSH B
       CALL DIVIDE    ;RND(N)=MOD(M,N)+1
       POP  B
       POP  D
       INX  H
       RET
;*
ABS    CALL PARN      ;*** ABS(EXPR) ***
       CALL CHKSGN    ;CHECK SIGN
       MOV  A,H       ;NOTE THAT -32768
       ORA  H         ;CANNOT CHANGE SIGN
       JM   QHOW      ;SO SAY: "HOW?"
       RET
SIZE   LHLD TXTUNF    ;*** SIZE ***
       PUSH D         ;GET THE NUMBER OF FREE
       XCHG           ;BYTES BETWEEN 'TXTUNF'
SIZEA  LXI  H,VARBGN  ;AND 'VARBGN'
       CALL SUBDE
       POP  D
       RET
;*
;*********************************************************
;*
;*   *** OUT *** INP *** WAIT *** POKE *** PEEK *** & USR
;*
;*  OUT I,J(,K,L)
;*
;*  OUTPUTS EXPRESSION 'J' TO PORT 'I', AND MAY BE REPEATED
;*  AS IN DATA 'L' TO PORT 'K' AS MANY TIMES AS NEEDED
;*  THIS COMMAND MODIFIES ;*  THIS COMMAND MODIFIES
;*  THIS COMMAND MODIFY'S A SMALL SECTION OF CODE LOCATED
;*  JUST ABOVE ADDRESS 2K
;*
;*  INP (I)
;*
;*  THIS FUNCTION RETURNS DATA READ FROM INPUT PORT 'I' AS
;*  IT'S VALUE.
;*  IT ALSO MODIFIES CODE JUST ABOVE 2K.
;*
;*  WAIT I,J,K
;*
;*  THIS COMMAND READS THE STATUS OF PORT 'I', EXCLUSIVE OR'S
;*  THE RESULT WITH 'K' IF THERE IS ONE, OR IF NOT WITH 0,
;*  AND'S WITH 'J' AND RETURNS WHEN THE RESULT IS NONZERO.
;*  ITS MODIFIED CODE IS ALSO ABOVE 2K.
;*
;*  POKE I,J(,K,L)
;*
;*  THIS COMMAND WORKS LIKE OUT EXCEPT THAT IT PUTS DATA 'J'
;*  INTO MEMORY LOCATION 'I'.
;*
;*  PEEK (I)
;*
;*  THIS FUNCTION WORKS LIKE INP EXCEPT IT GETS IT'S VALUE
;*  FROM MEMORY LOCATION 'I'.
;*
;*  USR (I(,J))
;*
;*  USR CALLS A MACHINE LANGUAGE SUBROUTINE AT LOCATION 'I'
;*  IF THE OPTIONAL PARAMETER 'J' IS USED ITS VALUE IS PASSED
;*  IN H&L.  THE VALUE OF THE FUNCTION SHOULD BE RETURNED IN H&L.
;*
;************************************************************
;*
OUTCMD RST  3
       MOV  A,L
       STA  OUTIO + 1
       RST  1
       DB   ','
       DB   2FH
       RST  3
       MOV  A,L
       CALL OUTIO
       RST  1
       DB   ','
       DB   03H
       JMP  OUTCMD
       RST  6
WAITCM RST  3
       MOV  A,L
       STA  WAITIO + 1
       RST  1
       DB   ','
       DB   1BH
       RST  3
       PUSH H
       RST  1
       DB   ','
       DB   7H
       RST  3
       MOV  A,L
       POP  H
       MOV  H,A
       JMP  $ + 2
       MVI  H,0
       JMP  WAITIO
INP    CALL PARN
       MOV  A,L
       STA  INPIO + 1
       MVI  H,0
       JMP  INPIO
       JMP  QWHAT
POKE   RST  3
       PUSH H
       RST  1
       DB   ','
       DB   12H
       RST  3
       MOV  A,L
       POP  H
       MOV  M,A
       RST  1
       DB   ',',03H
       JMP  POKE
       RST 6
PEEK   CALL PARN
       MOV  L,M
       MVI  H,0
       RET
       JMP  QWHAT
USR    PUSH B
       RST  1
       DB   '(',28D    ;QWHAT
       RST  3          ;EXPR
       RST  1
       DB   ')',7      ;PASPARM
       PUSH D
       LXI  D,USRET
       PUSH D
       PUSH H
       RET             ;CALL USR ROUTINE
PASPRM RST  1
       DB   ',',14D
       PUSH H
       RST  3
       RST  1
       DB   ')',9
       POP  B
       PUSH D
       LXI  D,USRET
       PUSH D
       PUSH B
       RET             ;CALL USR ROUTINE
USRET  POP  D
       POP  B
       RET
       JMP  QWHAT
;*
;**************************************************************
;*
;* *** DIVIDE *** SUBDE *** CHKSGN *** CHGSGN *** & CKHLDE ***
;*
;* 'DIVIDE' DIVIDES HL BY DE, RESULT IN BC, REMAINDER IN HL
;*
;* 'SUBDE' SUBTRACTS DE FROM HL
;*
;* 'CHKSGN' CHECKS SIGN OF HL.  IFF +, NO CHANGE.  IFF -, CHANGE
;* SIGN AND FLIP SIGN OF B.
;*
;* 'CHGSGN' CHNGES SIGN OF HL AND B UNCONDITIONALLY.
;*
;* 'CKHLE' CHECKS SIGN OF HL AND DE.  IFF DIFFERENT, HL AND DE
;* ARE INTERCHANGED.  IFF SAME SIGN, NOT INTERCHANGED.  EITHER
;* CASE, HL DE ARE THEN COMPARED TO SET THE FLAGS.
;*
DIVIDE PUSH H         ;*** DIVIDE ***
       MOV  L,H       ;DIVIDE H BY DE
       MVI  H,0
       CALL DV1
       MOV  B,C       ;SAVE RESULT IN B
       MOV  A,L       ;(REMAINDER+L)/DE
       POP  H
       MOV  H,A
DV1    MVI  C,377Q    ;RESULT IN C
DV2    INR  C         ;DUMB ROUTINE
       CALL SUBDE     ;DIVIDE BY SUBTRACT
       JNC  DV2       ;AND COUNT
       DAD  D
       RET
;*
SUBDE  MOV  A,L       ;*** SUBDE ***
       SUB  E         ;SUBTRACT DE FROM
       MOV  L,A       ;HL
       MOV  A,H
       SBB  D
       MOV  H,A
       RET
;*
CHKSGN MOV  A,H       ;*** CHKSGN ***
       ORA  A         ;CHECK SIGN OF HL
       RP             ;IFF -, CHANGE SIGN
;*
CHGSGN MOV  A,H       ;*** CHGSGN ***
       CMA            ;CHANGE SIGN OF HL
       MOV  H,A
       MOV  A,L
       CMA
       MOV  L,A
       INX  H
       MOV  A,B       ;AND ALSO FLIP B
       XRI  200Q
       MOV  B,A
       RET
;*
CKHLDE MOV  A,H
       XRA  D         ;SAME SIGN?
       JP   CK1       ;YES, COMPARE
       XCHG           ;NO, XCH AND COMP
CK1    RST  4
       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.  IFF IT ENDED WITH ";",
;* EXECUTION CONTINUES.  IFF IT ENDED WITH A CR, IT FINDS THE
;* NEXT LINE AND CONTINUE FROM THERE.
;*
;* "ENDCHK" CHECKS IFF 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
;* O THE STACK) POINTS TO.  EXECUTION OF TB IS STOPPED
;* AND TBI IS RESTARTED.  HOWEVER, IFF 'CURRNT' -> ZERO
;* (INDICATING A DIRECT COMMAND), THE DIRECT COMMAND IS NOT
;*  PRINTED.  AND IFF '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.
;* 'QHOW' AND 'AHOW' IN THE ZERO PAGE SECTION ALSO DO THIS
;*
SETVAL RST  7         ;*** SETVAL ***
       JC   QWHAT     ;"WHAT?" NO VARIABLE
       PUSH H         ;SAVE ADDRESS OF VAR.
       RST  1         ;PASS "=" SIGN
       DB   '='
       DB   10Q
       RST  3         ;EVALUATE EXPR.
       MOV  B,H       ;VALUE IN BC NOW
       MOV  C,L
       POP  H         ;GET ADDRESS
       MOV  M,C       ;SAVE VALUE
       INX  H
       MOV  M,B
       RET
SV1    JMP  QWHAT     ;NO "=" SIGN
;*
FIN    RST  1         ;*** FIN ***
       DB   73Q
       DB   4Q
       POP  PSW       ;";", PURGE RET ADDR.
       JMP  RUNSML    ;CONTINUE SAME LINE
FI1    RST  1         ;NOT ";", IS IT CR?
       DB   0DH
       DB   4Q
       POP  PSW       ;YES, PURGE RET ADDR.
       JMP  RUNNXL    ;RUN NEXT LINE
FI2    RET            ;ELSE RETURN TO CALLER
;*
ENDCHK RST  5         ;*** ENDCHK ***
       CPI  0DH       ;END WITH CR?
       RZ             ;OK, ELSE SAY: "WHAT?"
;*
QWHAT  PUSH D         ;*** QWHAT ***
AWHAT  LXI  D,WHAT    ;*** AWHAT ***
ERROR  SUB  A         ;*** ERROR ***
       CALL PRTSTG    ;PRINT 'WHAT?', 'HOW?'
       POP  D         ;OR 'SORRY'
       LDAX D         ;SAVE THE CHARACTER
       PUSH PSW       ;AT WHERE OLD DE ->
       SUB  A         ;AND PUT A 0 THERE
       STAX D
       LHLD CURRNT    ;GET CURRENT LINE #
       PUSH H
       MOV  A,M       ;CHECK THE VALUE
       INX  H
       ORA  M
       POP  D
       JZ   RSTART    ;IFF ZERO, JUST RERSTART
       MOV  A,M       ;IFF NEGATIVE,
       ORA  A
       JM   INPERR    ;REDO INPUT
       CALL PRTLN     ;ELSE PRINT THE LINE
       DCX  D         ;UPTO WHERE THE 0 IS
       POP  PSW       ;RESTORE THE CHARACTER
       STAX D
       MVI  A,77Q     ;PRINTt A "?"
       RST  2
       SUB  A         ;AND THE REST OF THE
       CALL PRTSTG    ;LINE
;       JMP  RSTART
       RST  0
QSORRY PUSH D         ;*** QSORRY ***
ASORRY LXI  D,SORRY   ;*** ASORRY ***
       JMP  ERROR
;*
;**************************************************************
;*
;* *** 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
;* 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 CHARATER (IFF THERE IS ONE), AND ALT-MOD IS USED TO
;* CAUSE IT TO DELETE THE WHOLE LINE AND START IT ALL OVER.
;* 0DHSIGNALS THE END OF A LINE, AND CAUE '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.  IFF 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.
;* IFF THAT LINE IS NOT THERE AND A LINE WITH A HIGHER LINE #
;* IS FOUND, DE POINTS TO THERE AND FLAGS ARE NC & NZ.  IFF
;* WE REACHED THE END OF TEXT SAVE ARE 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 0DHAND THEN START SEARCH.
;* 'FNDSKP' USE DE TO FIND A CR, AND THEN STRART SEARCH.
;*
GETLN  RST  2         ;*** GETLN ***
       LXI  D,BUFFER  ;PROMPT AND INIT
GL1    CALL CHKIO     ;CHECK KEYBOARD
       JZ   GL1       ;NO INPUT, WAIT
       CPI  177Q      ;DELETE LST CHARACTER?
       JZ   GL3       ;YES
       CPI  12Q       ;IGNORE LF
       JZ   GL1
       ORA  A         ;IGNORE NULL
       JZ   GL1
       CPI  134Q      ;DELETE THE WHOLE LINE?
       JZ   GL4       ;YES
       STAX D         ;ELSE, SAVE INPUT
       INX  D         ;AND BUMP POINTER
       CPI  15Q       ;WAS IT CR?
       JNZ  GL2       ;NO
       MVI  A,12Q     ;YES, GET LINE FEED
       RST  2         ;CALL OUTC AND LINE FEED
       RET            ;WE'VE GOT A LINE
GL2    MOV  A,E       ;MORE FREE ROOM?
       CPI  BUFEND AND 0FFH
       JNZ  GL1       ;YES, GET NEXT INPUT
GL3    MOV  A,E       ;DELETE LAST CHARACTER
       CPI  BUFFER AND 0FFH    ;BUT DO WE HAVE ANY?
       JZ   GL4       ;NO, REDO WHOLE LINE
       DCX  D         ;YES, BACKUP POINTER
       MVI  A,8       ;AND ECHO A BACK-SPACE
       RST  2
       MVI  A,' '
       RST  2
       MVI  A,8
       RST  2
       JMP  GL1       ;GO GET NEXT INPUT
GL4    CALL CRLF      ;REDO ENTIRE LINE
       MVI  A,136Q    ;CR, LF AND UP-ARROW
       JMP  GETLN
;*
FNDLN  MOV  A,H       ;*** FNDLN ***
       ORA  A         ;CHECK SIGN OF HL
       JM   QHOW      ;IT CANNT BE -
       LXI  D,TXTBGN  ;INIT. TEXT POINTER
;*
FNDLNP EQU  $         ;*** FNDLNP ***
FL1    PUSH H         ;SAVE LINE #
       LHLD TXTUNF    ;CHECK IFF WE PASSED END
       DCX  H
       RST  4
       POP  H         ;GET LINE # BACK
       RC             ;C,NZ PASSED END
       LDAX D         ;WE DID NOT, GET BYTE 1
       SUB  L         ;IS THIS THE LINE?
       MOV  B,A       ;COMPARE LOW ORDER
       INX  D
       LDAX D         ;GET BYTE 2
       SBB  H         ;COMPARE HIGH ORDER
       JC   FL2       ;NO, NOT THERE YET
       DCX  D         ;ELSE WE EITHER FOUND
       ORA  B         ;IT, OR IT IS NOT THERE
       RET            ;NC,Z:FOUND; NC,NZ:NO
;*
FNDNXT EQU  $         ;*** FNDNXT ***
       INX  D         ;FIND NEXT LINE
FL2    INX  D         ;JUST PASSED BYTE 1 & 2
;*
FNDSKP LDAX D         ;*** FNDSKP ***
       CPI  0DH       ;TRY TO FIND 0DH
       JNZ  FL2       ;KEEP LOOKING
       INX  D         ;FOUND CR, SKIP OVER
       JMP  FL1       ;CHECK IFF END OF TEXT
;*
;*************************************************************
;*
;* *** PRTSTG *** QTSTG *** PRTNUM *** & PRTLN ***
;*
;* 'PRTSTG' PRINTS A STRING POINTED BY DE.  IT STOPS PRINTING
;* AND RETURNS TO CALĖER WHEN EITHER A 0DHIS 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.  IFF NONE OF THESE, RETURN TO CALLER.  IFF BACK-ARROW,
;* OUTPUT A 0DHWITHOUT A LF.  IFF 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
;* IFF NEEDED TO PAD THE NUMBER OF SPACES TO THE NUMBER IN C.
;* HOWEVER, IFF 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' PRINSrA SAVED TEXT LINE WITH LINE # AND ALL.
;*
PRTSTG MOV  B,A       ;*** PRTSTG ***
PS1    LDAX D         ;GET A CHARACTERr
       INX  D         ;BUMP POINTER
       CMP  B         ;SAME AS OLD A?
       RZ             ;YES, RETURN
       RST  2         ;ELSE PRINT IT
       CPI  0DH       ;WAS IT A CR?
       JNZ  PS1       ;NO, NEXT
       RET            ;YES, RETURN
;*
QTSTG  RST  1         ;*** QTSTG ***
       DB   '"'
       DB   17Q
       MVI  A,42Q     ;IT IS A "
QT1    CALL PRTSTG    ;PRINT UNTIL ANOTHER
       CPI  0DH       ;WAS LAST ONE A CR?
       POP  H         ;RETURN ADDRESS
       JZ   RUNNXL    ;WAS CR, RUN NEXT LINE
QT2    INX  H         ;SKIP 3 BYTES ON RETURN
       INX  H
       INX  H
       PCHL           ;RETURN
QT3    RST  1         ;IS IT A ' ?
       DB   47Q
       DB   5Q
       MVI  A,47Q     ;YES, DO SAME
       JMP  QT1       ;AS IN "
QT4    RST  1         ;IS IT BACK-ARROW?
       DB   137Q
       DB   10Q
       MVI  A,215Q    ;YES, 0DHWITHOUT LF!!
       RST  2         ;DO IT TWICE TO GIVE
       RST  2         ;TTY ENOUGH TIME
       POP  H         ;RETURN ADDRESS
       JMP  QT2
QT5    RET            ;NONE OF ABOVE
;*
PRTNUM PUSH D         ;*** PRTNUM ***
       LXI  D,12Q     ;DECIMAL
       PUSH D         ;SAVE AS A FLAG
       MOV  B,D       ;B=SIGN
       DCR  C         ;C=SPACES
       CALL CHKSGN    ;CHECK SIGN
       JP   PN1       ;NO SIGN
       MVI  B,55Q     ;B=SIGN
       DCR  C         ;'-' TAKES SPACE
PN1    PUSH B         ;SAVE SIGN & SPACE
PN2    CALL DIVIDE    ;DEVIDE HL BY 10
       MOV  A,B       ;RESULT 0?
       ORA  C
       JZ   PN3       ;YES, WE GOT ALL
       XTHL           ;NO, SAVE REMAINDER
       DCR  L         ;AND COUNT SPACE
       PUSH H         ;HL IS OLD BC
       MOV  H,B       ;MOVE RESULT TO BC
       MOV  L,C
       JMP  PN2       ;AND DIVIDE BY 10
PN3    POP  B         ;WE GOT ALL DIGITS IN
PN4    DCR  C         ;THE STACK
       MOV  A,C       ;LOOK AT SPACE COUNT
       ORA  A
       JM   PN5       ;NO LEADING BLANKS
       MVI  A,40Q     ;LEADING BLANKS
       RST  2
       JMP  PN4       ;MORE?
PN5    MOV  A,B       ;PRINT SIGN
       RST  2         ;MAYBE - OR NULL
       MOV  E,L       ;LAST REMAINDER IN E
PN6    MOV  A,E       ;CHECK DIGIT IN E
       CPI  12Q       ;10 IS FLAG FOR NO MORE
       POP  D
       RZ             ;IFF SO, RETURN
       ADI  60Q		;ELSE CONVERT TO ASCII
       RST  2         ;AND PRINT THE DIGIT
       JMP  PN6       ;GO BACK FOR MORE
;*
PRTLN  LDAX D         ;*** PRTLN ***
       MOV  L,A       ;LOW ORDER LINE #
       INX  D
       LDAX D         ;HIGH ORDER
       MOV  H,A
       INX  D
       MVI  C,4Q      ;PRINT 4 DIGIT LINE #
       CALL PRTNUM
       MVI  A,40Q     ;FOLLOWED BY A BLANK
       RST  2
       SUB  A         ;AND THEN THE TEXT
       CALL PRTSTG
       RET
;*
;**************************************************************
;*
;* *** MVUP *** MVDOWN *** POPA *** & PUSHA ***
;*
;* 'MVUP' MOVES A BLOCK UP FROM HERE 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   RST  4         ;*** MVUP ***
       RZ             ;DE = HL, RETURN
       LDAX D         ;GET ONE BYTE
       STAX B         ;MOVE IT
       INX  D         ;INCREASE BOTH POINTERS
       INX  B
       JMP  MVUP      ;UNTIL DONE
;*
MVDOWN MOV  A,B       ;*** MVDOWN ***
       SUB  D         ;TEST IFF DE = BC
       JNZ  MD1       ;NO, GO MOVE
       MOV  A,C       ;MAYBE, OTHER BYTE?
       SUB  E
       RZ             ;YES, RETURN
MD1    DCX  D         ;ELSE MOVE A BYTE
       DCX  H         ;BUT FIRST DECREASE
       LDAX D         ;BOTH POINTERS AND
       MOV  M,A       ;THEN DO IT
       JMP  MVDOWN    ;LOOP BACK
;*
POPA   POP  B         ;BC = RETURN ADDR.
       POP  H         ;RESTORE LOPVAR, BUT
       SHLD LOPVAR    ;=0 MEANS NO MORE
       MOV  A,H
       ORA  L
       JZ   PP1       ;YEP, GO RETURN
       POP  H         ;NOP, RESTORE OTHERS
       SHLD LOPINC
       POP  H
       SHLD LOPLMT
       POP  H
       SHLD LOPLN
       POP  H
       SHLD LOPPT
PP1    PUSH B         ;BC = RETURN ADDR.
       RET
;*
PUSHA  LXI  H,STKLMT  ;*** PUSHA ***
       CALL CHGSGN
       POP  B         ;BC=RETURN ADDRESS
       DAD  SP        ;IS STACK NEAR THE TOP?
       JNC  QSORRY    ;YES, SORRY FOR THAT.
       LHLD LOPVAR    ;ELSE SAVE LOOP VAR.S
       MOV  A,H       ;BUT IFF LOPVAR IS 0
       ORA  L         ;THAT WILL BE ALL
       JZ   PU1
       LHLD LOPPT     ;ELSE, MORE TO SAVE
       PUSH H
       LHLD LOPLN
       PUSH H
       LHLD LOPLMT
       PUSH H
       LHLD LOPINC
       PUSH H
       LHLD LOPVAR
PU1    PUSH H
       PUSH B         ;BC = RETURN ADDR.
       RET
;*
;**************************************************************
;*
;* *** OUTC *** & CHKIO ****!
;* THESE ARE THE ONLY I/O ROUTINES IN TBI.
;* 'OUTC' IS CONTROLLED BY A SOFTWARE SWITCH 'OCSW'.  IFF OCSW=0
;* 'OUTC' WILL JUST RETURN TO THE CALLER.  IFF OCSW IS NOT 0,
;* IT WILL OUTPUT THE BYTE IN A.  IFF 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.  IFF NO INPUT, IT WILL RETURN TO
;* THE CALLER WITH THE Z FLAG SET.  IFF THERE IS INPUT, Z FLAG
;* IS CLEARED AND THE INPUT BYTE IS IN A.  HOWERER, IFF THE
;* INPUT IS A CONTROL-O, THE 'OCSW' SWITCH IS COMPLIMENTED, AND
;* Z FLAG IS RETURNED.  IFF A CONTROL-C IS READ, 'CHKIO' WILL
;* RESTART TBI AND DO NOT RETURN TO THE CALLER.
;*
;*                 OUTC   PUSH PSW       THIS IS AT LOC. 10
;*                        LD   A,OCSW    CHECK SOFTWARE SWITCH
;*                        IOR  A
OC2    JNZ  OC3       ;IT IS ON
       POP  PSW       ;IT IS OFF
       RET            ;RESTORE AF AND RETURN
OC3    POP  PSW       ;GET OLD A BACK
       OUT  1         ;WRITE TO CONSOLE
       CPI  0DH       ;WAS IT A 'CR'?
       RNZ            ;NO, DONE
       PUSH PSW
       MVI  A,0AH     ;GET LINEFEDD
       OUT  1         ;WRITE TO CONSOLE
       POP  PSW
       RET
CHKIO  IN   0         ;READ CONSOLE STATUS (0FFH==avail)
       ORA  A         ;SET FLAGS
       RZ             ;NOTHING, RETURN
       IN   1         ;READ CONSOLE CHAR
       ANI  7FH       ;CLEAR BIT 8
       CPI  0FH       ;IS IT CONTROL-O?
       JNZ  CI1       ;NO, MORE CHECKING
       LDA  OCSW      ;CONTROL-O  FLIP OCSW
       CMA            ;ON TO OFF, OFF TO ON
       STA  OCSW      ;AND PUT IT BACK
       JMP  CHKIO     ;AND GET ANOTHER CHARACTER
CI1    CPI  3         ;IS IT CONTROL-C?
       JZ   RSTART    ;YES, RESTART TBI
       CPI  8         ;IS IT BS?
       JNZ  CI2       ;NO, ECHO IT
       MVI  A,177Q    ;MAKE IT DEL
       ORA  A         ;SET NZ
       RET
CI2    CPI  0DH       ;CR?
       JZ   CI3       ;YES, ECHO, DONE
       CPI  ' '       ;CONTROL CHAR?
       JP   CI3       ;NO, ECHO IR
       XRI  A         ;YES, IGNORE IT, SET Z
       RET
CI3    OUT  1         ;ECHO CHAR ON CONSOLE
       ORA  A         ;SET NZ
       RET
;*
;**************************************************************
;*
;* QUIT THE PROGRAM BY HALTING THE PROCESSOR
;*
BYE    HLT
       RST  0         ;RESTART IF CONTINUED
;*
LSTROM EQU  $         ;ALL ABOVE CAN BE ROM
;*
OUTIO  OUT  0FFH
       RET
WAITIO IN   0FFH
       XRA  H
       ANA  L
       JZ   WAITIO
       RST  6
INPIO  IN   0FFH
       MOV  L,A
       RET
OCSW   DB   0FFH      ;SWITCH FOR OUTPUT
CURRNT DW   0         ;POINTS TO CURRENT LINE
STKGOS DW   0         ;SAVES SP IN 'GOSUB'
VARNXT DW   0         ;TEMPORARY STORAGE
STKINP DW   0         ;SAVES SP IN 'INPUT'
LOPVAR DW   0         ;'FOR' LOOP SAVE AREA
LOPINC DW   0         ;INCREMENT
LOPLMT DW   0         ;LIMIT
LOPLN  DW   0         ;LINE NUMBER
LOPPT  DW   0         ;TEXT POINTER
RANPNT DW   RSTART    ;RANDOM NUMBER POINTER
TXTUNF DW   TXTBGN    ;->UNFILLED TEXT AREA
TXTBGN DS   1         ;TEXT SAVE AREA BEGINS
;*
;* WILL BE OVERWRITTEN BY USER PROGRAM
;*
MSG1   DB   0CH,'LI-CHEN WANG TINY BASIC VER. 1.0 10-JUN-1976',0DH,0
INIT   MVI  A,0FFH
       STA  OCSW      ;TURN ON OUTPUT SWITCH
       SUB  A         ;CLEAR ACCUMULATOR
       LXI  D,MSG1    ;GET INIT MESSAGE
       CALL PRTSTG    ;SEND IT
       LXI  H,ST1     ;PATCH RST 0 CODE
       SHLD INIPAT+1
       RST  0
;*
       ORG  1F00H
TXTEND EQU  $         ;TEXT SAVE AREA ENDS
VARBGN DS   2*27      ;VARIABLE @(0)
       DS   1         ;EXTRA BYTE FOR BUFFER
BUFFER DS   80        ;INPUT BUFFER
BUFEND EQU  $         ;BUFFER ENDS
       DS   40        ;EXTRA BYTES FOR STACK
STKLMT EQU  $         ;TOP LIMIT FOR STACK
       ORG  2000H
STACK  EQU  $         ;STACK STARTS HERE
       END
