Subversion Repositories cpu8080

;**************************************************************

!**************************************************************

;*

!*

;*                TINY BASIC FOR INTEL 8080

!*                tiny basic for intel 8080

;*                      VERSION 1.0

!*                      version 1.0

;*                    BY LI-CHEN WANG

!*                    by li-chen wang

;*                     10 JUNE, 1976

!*                     10 june, 1976

;*                       @COPYLEFT

!*                       @copyleft

;*                  ALL WRONGS RESERVED

!*                  all wrongs reserved

;*

!*

;**************************************************************

!**************************************************************

;*

!*

;*  ;*** ZERO PAGE SUBROUTINES ***

!*  !*** zero page subroutines ***

;*

!*

;*  THE 8080 INSTRUCTION SET LETS YOU HAVE 8 ROUTINES IN LOW

!*  the 8080 instruction set lets you have 8 routines in low

;*  MEMORY THAT MAY BE CALLED BY RST N, N BEING 0 THROUGH 7.

!*  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

!*  this is a one byte instruction and has the same power as

;*  THE THREE BYTE INSTRUCTION CALL LLHH.  TINY BASIC WILL

!*  the three byte instruction call llhh.  tiny basic will

;*  USE RST 0 AS START AND RST 1 THROUGH RST 7 FOR

!*  use rst 0 as start and rst 1 through rst 7 for

;*  THE SEVEN MOST FREQUENTLY USED SUBROUTINES.

!*  the seven most frequently used subroutines.

;*  TWO OTHER SUBROUTINES (CRLF AND TSTNUM) ARE ALSO IN THIS

!*  two other subroutines (crlf and tstnum) are also in this

;*  SECTION.  THEY CAN BE REACHED ONLY BY 3-BYTE CALLS.

!*  section.  they can be reached only by 3-byte calls.

;*  IN ORDER TO CONFIGURE THE SYSTEM FOR USE WITH CPM I HAVE

!

;*  MOVED SOME OF THE ROUTINES AROUND.  START WILL NOW BE AT

! Note: this version was extensively damaged to adapt to CP/M,

;*  LOCATION 100H AND THIS SECTION WILL END AT LOCATION 3FH

! I am attempting to find other copies to reference to in order

;*  WITH A JUMP TO 108H.

! to correct it.

;*

!

;       ORG  8H

!*

;       XTHL           ;*** TSTC OR RST 1 ***

       jmp  ninit     ! go main start

;       RST  5         ;IGNORE BLANKS AND

       alignp 8

;       CMP  M         ;TEST CHARACTER

*

;       JMP  TC1       ;REST OF THIS IS AT TC1

       xthl           !*** tstc or rst 1 ***

;*

       rst  5         !ignore blanks and

;CRLF   MVI  A,0DH     ;*** CRLF ***

       cmp  m         !test character

;*

       jmp  tc1       !rest of this is at tc1

;       PUSH PSW       ;*** OUTC OR RST 2 ***

*

;       LDA  OCSW      ;PRINT CHARACTER ONLY

crlf:  mvi  a,0dh     !*** crlf ***

;       ORA  A         ;IFF OCSW SWITCH IS ON

*

;       JMP  OC2       ;REST OF THIS IS AT OC2

       push psw       !*** outc or rst 2 ***

;*

       lda  ocsw      !print character only

;       CALL EXPR2     ;*** EXPR OR RST 3 ***

       ora  a         !iff ocsw switch is on

;       PUSH H         ;EVALUATE AN EXPRESION

       jmp  oc2       !rest of this is at oc2

;       JMP  EXPR1     ;REST OF IT IS AT EXPR1

*

;       DB   'W'

       call expr2     !*** expr or rst 3 ***

;*

       push h         !evaluate an expresion

;       MOV  A,H       ;*** COMP OR RST 4 ***

       jmp  expr1     !rest of it is at expr1

;       CMP  D         ;COMPARE HL WITH DE

       defb 'w'

;       RNZ            ;RETURN CORRECT C AND

*

;       MOV  A,L       ;Z FLAGS

       mov  a,h       !*** comp or rst 4 ***

;       CMP  E         ;BUT OLD A IS LOST

       cmp  d         !compare hl with de

;       RET

       rnz            !return correct c and

;       DB   'AN'

       mov  a,l       !z flags

;*

       cmp  e         !but old a is lost

;SS1    LDAX D         ;*** IGNBLK/RST 5 ***

       ret

;       CPI  40Q       ;IGNORE BLANKS

       defb 'an'

;       RNZ            ;IN TEXT (WHERE DE->)

*

;       INX  D         ;AND RETURN THE FIRST

ss1:   ldax d         !*** ignblk/rst 5 ***

;       JMP  SS1       ;NON-BLANK CHAR. IN A

       cpi  40q       !ignore blanks

;*

       rnz            !in text (where de->)

;       POP  PSW       ;*** FINISH/RST 6 ***

       inx  d         !and return the first

;       CALL FIN       ;CHECK END OF COMMAND

       jmp  ss1       !non-blank char. in a

;       JMP  QWHAT     ;PRINT "WHAT?" IFF WRONG

*

;       DB   'G'

       pop  psw       !*** finish/rst 6 ***

;*

       call fin       !check end of command

;       RST  5         ;*** TSTV OR RST 7 ***

       jmp  qwhat     !print "what?" iff wrong

;       SUI  100Q      ;TEST VARIABLES

       defb 'g'

;       RC             ;C:NOT A VARIABLE

*

;       JMP  TSTV1     ;JUMP AROUND RESERVED AREA

       rst  5         !*** tstv or rst 7 ***

       ORG  100H      ;OF CPM.

       sui  100q      !test variables

START  JMP  NINIT      ;GO TO INITIALIZATION ROUTINE.   JIF

       rc             !c:not a variable

TSTV1  JNZ  TV1       ;NOT "@" ARRAY

*

       INX  D         ;IT IS THE "@" ARRAY

tstv1: jnz  tv1       !not "@" array

       CALL PARN      ;@ SHOULD BE FOLLOWED

       inx  d         !it is the "@" array

       DAD  H         ;BY (EXPR) AS ITS INDEX

       call parn      !@ should be followed

       JC   QHOW      ;IS INDEX TOO BIG?

       dad  h         !by (expr) as its index

       PUSH D         ;WILL IT OVERWRITE

       jc   qhow      !is index too big?

       XCHG           ;TEXT?

       push d         !will it overwrite

       CALL SIZE      ;FIND SIZE OF FREE

       xchg           !text?

       RST  4         ;AND CHECK THAT

       call size      !find size of free

       JC   ASORRY    ;IFF SO, SAY "SORRY"

       rst  4         !and check that

SS1A   LXI  H,VARBGN  ;IFF NOT, GET ADDRESS

       jc   asorry    !iff so, say "sorry"

       CALL SUBDE     ;OF @(EXPR) AND PUT IT

ss1a:  lxi  h,varbgn  !iff not, get address

       POP  D         ;IN HL

       call subde     !of @(expr) and put it

       RET            ;C FLAG IS CLEARED

       pop  d         !in hl

TV1    CPI  33Q       ;NOT @, IS IT A TO Z?

       ret            !c flag is cleared

       CMC            ;IFF NOT RETURN C FLAG

tv1:   cpi  33q       !not @, is it a to z?

       RC

       cmc            !iff not return c flag

       INX  D         ;IFF A THROUGH Z

       rc

TV1A   LXI  H,VARBGN  ;COMPUTE ADDRESS OF

       inx  d         !iff a through z

       RLC            ;THAT VARIABLE

tv1a:  lxi  h,varbgn  !compute address of

       ADD  L         ;AND RETURN IT IN HL

       rlc            !that variable

       MOV  L,A       ;WITH C FLAG CLEARED

       add  l         !and return it in hl

       MVI  A,0

       mov  l,a       !with c flag cleared

       ADC  H

       mvi  a,0

       MOV  H,A

       adc  h

       RET

       mov  h,a

;*

       ret

;*                 TSTC   XCH  HL,(SP)   ;*** TSTC OR RST 1 ***

!*

;*                        IGNBLK         THIS IS AT LOC. 8

!*                 tstc   xch  hl,(sp)   !*** tstc or rst 1 ***

;*                        CMP  M         AND THEN JMP HERE

!*                        ignblk         this is at loc. 8

TC1    INX  H         ;COMPARE THE BYTE THAT

!*                        cmp  m         and then jmp here

       JZ   TC2       ;FOLLOWS THE RST INST.

tc1:   inx  h         !compare the byte that

       PUSH B         ;WITH THE TEXT (DE->)

       jz   tc2       !follows the rst inst.

       MOV  C,M       ;IFF NOT =, ADD THE 2ND

       push b         !with the text (de->)

       MVI  B,0       ;BYTE THAT FOLLOWS THE

       mov  c,m       !iff not =, add the 2nd

       DAD  B         ;RST TO THE OLD PC

       mvi  b,0       !byte that follows the

       POP  B         ;I.E., DO A RELATIVE

       dad  b         !rst to the old pc

       DCX  D         ;JUMP IFF NOT =

       pop  b         !i.e., do a relative

TC2    INX  D         ;IFF =, SKIP THOSE BYTES

       dcx  d         !jump iff not =

       INX  H         ;AND CONTINUE

tc2:   inx  d         !iff =, skip those bytes

       XTHL

       inx  h         !and continue

       RET

       xthl

;*

       ret

TSTNUM LXI  H,0       ;*** TSTNUM ***

!*

       MOV  B,H       ;TEST IFF THE TEXT IS

tstnum:lxi  h,0       !*** tstnum ***

       RST  5         ;A NUMBER

       mov  b,h       !test iff the text is

TN1    CPI  60Q       ;IFF NOT, RETURN 0 IN

       rst  5         !a number

       RC             ;B AND HL

tn1:   cpi  60q       !iff not, return 0 in

       CPI  72Q       ;IFF NUMBERS, CONVERT

       rc             !b and hl

       RNC            ;TO BINARY IN HL AND

       cpi  72q       !iff numbers, convert

       MVI  A,360Q    ;SET A TO # OF DIGITS

       rnc            !to binary in hl and

       ANA  H         ;IFF H>255, THERE IS NO

       mvi  a,360q    !set a to # of digits

       JNZ  QHOW      ;ROOM FOR NEXT DIGIT

       ana  h         !iff h>255, there is no

       INR  B         ;B COUNTS # OF DIGITS

       jnz  qhow      !room for next digit

       PUSH B

       inr  b         !b counts # of digits

       MOV  B,H       ;HL=10;*HL+(NEW DIGIT)

       push b

       MOV  C,L

       mov  b,h       !hl=10!*hl+(new digit)

       DAD  H         ;WHERE 10;* IS DONE BY

       mov  c,l

       DAD  H         ;SHIFT AND ADD

       dad  h         !where 10!* is done by

       DAD  B

       dad  h         !shift and add

       DAD  H

       dad  b

       LDAX D         ;AND (DIGIT) IS FROM

       dad  h

       INX  D         ;STRIPPING THE ASCII

       ldax d         !and (digit) is from

       ANI  17Q       ;CODE

       inx  d         !stripping the ascii

       ADD  L

       ani  17q       !code

       MOV  L,A

       add  l

       MVI  A,0

       mov  l,a

       ADC  H

       mvi  a,0

       MOV  H,A

       adc  h

       POP  B

       mov  h,a

       LDAX D         ;DO THIS DIGIT AFTER

       pop  b

       JP   TN1       ;DIGIT. S SAYS OVERFLOW

       ldax d         !do this digit after

QHOW   PUSH D         ;*** ERROR: "HOW?" ***

       jp   tn1       !digit. s says overflow

AHOW   LXI  D,HOW

qhow:  push d         !*** error: "how?" ***

       JMP  ERROR

ahow:  lxi  d,how

HOW    DB   'HOW?',0DH

       jmp  error

OK     DB   'OK',0DH

how:   defb 'how?',0dh

WHAT   DB   'WHAT?',0DH

ok:    defb 'ok',0dh

SORRY  DB   'SORRY',0DH

what:  defb 'what?',0dh

;*

sorry: defb 'sorry',0dh

;**************************************************************

!*

;*

!**************************************************************

;* *** MAIN ***

!*

;*

!* *** main ***

;* THIS IS THE MAIN LOOP THAT COLLECTS THE TINY BASIC PROGRAM

!*

;* AND STORES IT IN THE MEMORY.

!* 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

!* at start, it prints out "(cr)ok(cr)", and initializes the

;* ">" AND READS A LINE.  IFF THE LINE STARTS WITH A NON-ZERO

!* stack and some other internal variables.  then it prompts

;* NUMBER, THIS NUMBER IS THE LINE NUMBER.  THE LINE NUMBER

!* ">" and reads a line.  iff the line starts with a non-zero

;* (IN 16 BIT BINARY) AND THE REST OF THE LINE (INCLUDING CR)

!* number, this number is the line number.  the line number

;* IS STORED IN THE MEMORY.  IFF A LINE WITH THE SAME LINE

!* (in 16 bit binary) and the rest of the line (including cr)

;* NUMBER IS ALREDY THERE, IT IS REPLACED BY THE NEW ONE.  IF

!* is stored in the memory.  iff a line with the same line

;* THE REST OF THE LINE CONSISTS OF A 0DHONLY, IT IS NOT STORED

!* number is alredy there, it is replaced by the new one.  if

;* AND ANY EXISTING LINE WITH THE SAME LINE NUMBER IS DELETED.

!* 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

!* after a line iss inserted, replaced, or deleted, the program

;* TERMINATED WHEN IT READS A LINE WITH ZERO OR NO LINE

!* loops back and ask for another line.  this loop will be

;* NUMBER; AND CONTROL IS TRANSFERED TO "DIRCT".

!* 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

!* tiny basic program save area starts at the memory location

;* AREA STARTING AT "TXTBGN", THE UNFILLED PORTION IS POINTED

!* labeled "txtbgn" and ended at "txtend".  we always fill this

;* BY THE CONTENT OF A MEMORY LOCATION LABELED "TXTUNF".

!* 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

!* the memory location "currnt" points to the line number

;* THIS LOOP OR WHILE WE ARE INTERPRETING A DIRECT COMMAND

!* that is currently being interpreted.  while we are in

;* (SEE NEXT SECTION), "CURRNT" SHOULD POINT TO A 0.

!* this loop or while we are interpreting a direct command

;*

!* (see next section), "currnt" should point to a 0.

RSTART LXI  SP,STACK  ;SET STACK POINTER

!*

ST1    CALL CRLF      ;AND JUMP TO HERE

rstart:lxi  sp,stack  !set stack pointer

       LXI  D,OK      ;DE->STRING

st1:   call crlf      !and jump to here

       SUB  A         ;A=0

       lxi  d,ok      !de->string

       CALL PRTSTG    ;PRINT STRING UNTIL 0DH

       sub  a         !a=0

       LXI  H,ST2+1   ;LITERAL 0

       call prtstg    !print string until 0dh

       SHLD CURRNT    ;CURRNT->LINE # = 0

       lxi  h,st2+1   !literal 0

ST2    LXI  H,0

       shld currnt    !currnt->line # = 0

       SHLD LOPVAR

st2:   lxi  h,0

       SHLD STKGOS

       shld lopvar

ST3    MVI  A,76Q     ;PROMPT '>' AND

       shld stkgos

       CALL GETLN     ;READ A LINE

st3:   mvi  a,76q     !prompt '>' and

       PUSH D         ;DE->END OF LINE

       call getln     !read a line

ST3A   LXI  D,BUFFER  ;DE->BEGINNING OF LINE

       push d         !de->end of line

       CALL TSTNUM    ;TESt IFF IT IS A NUMBER

st3a:  lxi  d,buffer  !de->beginning of line

       RST  5

       call tstnum    !test iff it is a number

       MOV  A,H       ;HL=VALUE OF THE # OR

       rst  5

       ORA  L         ;0 IFF NO # WAS FOUND

       mov  a,h       !hl=value of the # or

       POP  B         ;BC->END OF LINE

       ora  l         !0 iff no # was found

       JZ   DIRECT

       pop  b         !bc->end of line

       DCX  D         ;BACKUP DE AND SAVE

       jz   direct

       MOV  A,H       ;VALUE OF LINE # THERE

       dcx  d         !backup de and save

       STAX D

       mov  a,h       !value of line # there

       DCX  D

       stax d

       MOV  A,L

       dcx  d

       STAX D

       mov  a,l

       PUSH B         ;BC,DE->BEGIN, END

       stax d

       PUSH D

       push b         !bc,de->begin, end

       MOV  A,C

       push d

       SUB  E

       mov  a,c

       PUSH PSW       ;A=# OF BYTES IN LINE

       sub  e

       CALL FNDLN     ;FIND THIS LINE IN SAVE

       push psw       !a=# of bytes in line

       PUSH D         ;AREA, DE->SAVE AREA

       call fndln     !find this line in save

       JNZ  ST4       ;NZ:NOT FOUND, INSERT

       push d         !area, de->save area

       PUSH D         ;Z:FOUND, DELETE IT

       jnz  st4       !nz:not found, insert

       CALL FNDNXT    ;FIND NEXT LINE

       push d         !z:found, delete it

;*                                       DE->NEXT LINE

       call fndnxt    !find next line

       POP  B         ;BC->LINE TO BE DELETED

!*                                       de->next line

       LHLD TXTUNF    ;HL->UNFILLED SAVE AREA

       pop  b         !bc->line to be deleted

       CALL MVUP      ;MOVE UP TO DELETE

       lhld txtunf    !hl->unfilled save area

       MOV  H,B       ;TXTUNF->UNFILLED AREA

       call mvup      !move up to delete

       MOV  L,C

       mov  h,b       !txtunf->unfilled area

       SHLD TXTUNF    ;UPDATE

       mov  l,c

ST4    POP  B         ;GET READY TO INSERT

       shld txtunf    !update

       LHLD TXTUNF    ;BUT FIRT CHECK IF

st4:   pop  b         !get ready to insert

       POP  PSW       ;THE LENGTH OF NEW LINE

       lhld txtunf    !but firt check if

       PUSH H         ;IS 3 (LINE # AND CR)

       pop  psw       !the length of new line

       CPI  3         ;THEN DO NOT INSERT

       push h         !is 3 (line # and cr)

       JZ   RSTART    ;MUST CLEAR THE STACK

       cpi  3         !then do not insert

       ADD  L         ;COMPUTE NEW TXTUNF

       jz   rstart    !must clear the stack

       MOV  L,A

       add  l         !compute new txtunf

       MVI  A,0

       mov  l,a

       ADC  H

       mvi  a,0

       MOV  H,A       ;HL->NEW UNFILLED AREA

       adc  h

ST4A   LXI  D,TXTEND  ;CHECK TO SEE IF THERE

       mov  h,a       !hl->new unfilled area

       RST  4         ;IS ENOUGH SPACE

st4a:  lxi  d,txtend  !check to see if there

       JNC  QSORRY    ;SORRY, NO ROOM FOR IT

       rst  4         !is enough space

       SHLD TXTUNF    ;OK, UPDATE TXTUNF

       jnc  qsorry    !sorry, no room for it

       POP  D         ;DE->OLD UNFILLED AREA

       shld txtunf    !ok, update txtunf

       CALL MVDOWN

       pop  d         !de->old unfilled area

       POP  D         ;DE->BEGIN, HL->END

       call mvdown

       POP  H

       pop  d         !de->begin, hl->end

       CALL MVUP      ;MOVE NEW LINE TO SAVE

       pop  h

       JMP  ST3       ;AREA

       call mvup      !move new line to save

;*

       jmp  st3       !area

;**************************************************************

!*

;*

!**************************************************************

;* *** TABLES *** DIRECT *** & EXEC ***

!*

;*

!* *** 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

!* this section of the code tests a string against a table.

;* OF CODE ACCORDING TO THE 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,

!* at 'exec', de should point to the string ad hl should point

;* HL WILL BE SET UP TO POINT TO TAB1-1, WHICH IS THE TABLE OF

!* to the table-1.  at 'direct', de should point to the string,

;* ALL DIRECT AND STATEMENT COMMANDS.

!* 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.',

!* a '.' in the string will terminate the test and the partial

;* 'PRI.', 'PRIN.', OR 'PRINT' WILL ALL MATCH 'PRINT'.

!* 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

!* the table consists of any number of items.  each item

;* A JUMP ADDRESS STORED HI-LOW WITH BIT 7 OF THE HIGH

!* is a string of characters with bit 7 set to 0 and

;* BYTE SET TO 1.

!* 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

!* end of table is an item with a jump address only.  iff the

;* MATCH THIS NULL ITEM AS DEFAULT.

!* string does not match any of the other items, it will

;*

!* match this null item as default.

TAB1   EQU  $         ;DIRECT COMMANDS

!*

       DB   'LIST'

tab1:  equ  $         !direct commands

       DB   LIST SHR 8 + 128,LIST AND 0FFH

       defb 'list'

       DB   'RUN'

       defb list shr 8 + 128,list and 0ffh

       DB   RUN SHR 8 + 128,RUN AND 255

       defb 'run'

       DB   'NEW'

       defb run shr 8 + 128,run and 255

       DB   NEW SHR 8 + 128,NEW AND 255

       defb 'new'

       DB   'LOAD'

       defb new shr 8 + 128,new and 255

       DB   DLOAD SHR 8 + 128,DLOAD AND 255

       defb 'load'

       DB   'SAVE'

       defb dload shr 8 + 128,dload and 255

       DB   DSAVE SHR 8 + 128,DSAVE AND 255

       defb 'save'

       DB   'BYE',80H,0H   ;GO BACK TO CPM

       defb dsave shr 8 + 128,dsave and 255

TAB2   EQU  $         ;DIRECT/TATEMENT

       defb 'bye',80h,0h   !go back to cpm

       DB   'NEXT'

tab2:  equ  $         !direct/tatement

       DB   NEXT SHR 8 + 128,NEXT AND 255

       defb 'next'

       DB   'LET'

       defb next shr 8 + 128,next and 255

       DB   LET SHR 8 + 128,LET AND 255

       defb 'let'

       DB   'OUT'

       defb let shr 8 + 128,let and 255

       DB   OUTCMD SHR 8 + 128,OUTCMD AND 255

       defb 'out'

       DB   'POKE'

       defb outcmd shr 8 + 128,outcmd and 255

       DB   POKE SHR 8 + 128,POKE AND 255

       defb 'poke'

       DB   'WAIT'

       defb poke shr 8 + 128,poke and 255

       DB   WAITCM SHR 8 + 128,WAITCM AND 255

       defb 'wait'

       DB   'IF'

       defb waitcm shr 8 + 128,waitcm and 255

       DB   IFF SHR 8 + 128,IFF AND 255

       defb 'if'

       DB   'GOTO'

       defb iff shr 8 + 128,iff and 255

       DB   GOTO SHR 8 + 128,GOTO AND 255

       defb 'goto'

       DB   'GOSUB'

       defb goto shr 8 + 128,goto and 255

       DB   GOSUB SHR 8 + 128,GOSUB AND 255

       defb 'gosub'

       DB   'RETURN'

       defb gosub shr 8 + 128,gosub and 255

       DB   RETURN SHR 8 + 128,RETURN AND 255

       defb 'return'

       DB   'REM'

       defb return shr 8 + 128,return and 255

       DB   REM SHR 8 + 128,REM AND 255

       defb 'rem'

       DB   'FOR'

       defb rem shr 8 + 128,rem and 255

       DB   FOR SHR 8 + 128,FOR AND 255

       defb 'for'

       DB   'INPUT'

       defb for shr 8 + 128,for and 255

       DB   INPUT SHR 8 + 128,INPUT AND 255

       defb 'input'

       DB   'PRINT'

       defb input shr 8 + 128,input and 255

       DB   PRINT SHR 8 + 128,PRINT AND 255

       defb 'print'

       DB   'STOP'

       defb print shr 8 + 128,print and 255

       DB   STOP SHR 8 + 128,STOP AND 255

       defb 'stop'

       DB   DEFLT SHR 8 + 128,DEFLT AND 255

       defb stop shr 8 + 128,stop and 255

       DB   'YOU CAN ADD MORE' ;COMMANDS BUT

       defb deflt shr 8 + 128,deflt and 255

            ;REMEMBER TO MOVE DEFAULT DOWN.

       defb 'you can add more' !commands but

TAB4   EQU  $         ;FUNCTIONS

            !remember to move default down.

       DB   'RND'

tab4:  equ  $         !functions

       DB   RND SHR 8 + 128,RND AND 255

       defb 'rnd'

       DB   'INP'

       defb rnd shr 8 + 128,rnd and 255

       DB   INP SHR 8 + 128,INP AND 255

       defb 'inp'

       DB   'PEEK'

       defb inp shr 8 + 128,inp and 255

       DB   PEEK SHR 8 + 128,PEEK AND 255

       defb 'peek'

       DB   'USR'

       defb peek shr 8 + 128,peek and 255

       DB   USR SHR 8 + 128,USR AND 255

       defb 'usr'

       DB   'ABS'

       defb usr shr 8 + 128,usr and 255

       DB   ABS SHR 8 + 128,ABS AND 255

       defb 'abs'

       DB   'SIZE'

       defb abs shr 8 + 128,abs and 255

       DB   SIZE SHR 8 + 128,SIZE AND 255

       defb 'size'

       DB   XP40 SHR 8 + 128,XP40 AND 255

       defb size shr 8 + 128,size and 255

       DB   'YOU CAN ADD MORE' ;FUNCTIONS BUT REMEMBER

       defb xp40 shr 8 + 128,xp40 and 255

                      ;TO MOVE XP40 DOWN

       defb 'you can add more' !functions but remember

TAB5   EQU  $         ;"TO" IN "FOR"

                      !to move xp40 down

       DB   'TO'

tab5:  equ  $         !"to" in "for"

       DB   FR1 SHR 8 + 128,FR1 AND 255

       defb 'to'

       DB   QWHAT SHR 8 + 128,QWHAT AND 255

       defb fr1 shr 8 + 128,fr1 and 255

TAB6   EQU  $         ;"STEP" IN "FOR"

       defb qwhat shr 8 + 128,qwhat and 255

       DB   'STEP'

tab6:  equ  $         !"step" in "for"

       DB   FR2 SHR 8 + 128,FR2 AND 255

       defb 'step'

       DB   FR3 SHR 8 + 128,FR3 AND 255

       defb fr2 shr 8 + 128,fr2 and 255

TAB8   EQU  $         ;RELATION OPERATORS

       defb fr3 shr 8 + 128,fr3 and 255

       DB   '>='

tab8:  equ  $         !relation operators

       DB   XP11 SHR 8 + 128,XP11 AND 255

       defb '>='

       DB   '#'

       defb xp11 shr 8 + 128,xp11 and 255

       DB   XP12 SHR 8 + 128,XP12 AND 255

       defb '#'

       DB   '>'

       defb xp12 shr 8 + 128,xp12 and 255

       DB   XP13 SHR 8 + 128,XP13 AND 255

       defb '>'

       DB   '='

       defb xp13 shr 8 + 128,xp13 and 255

       DB   XP15 SHR 8 + 128,XP15 AND 255

       defb '='

       DB   '<='

       defb xp15 shr 8 + 128,xp15 and 255

       DB   XP14 SHR 8 + 128,XP14 AND 255

       defb '<='

       DB   '<'

       defb xp14 shr 8 + 128,xp14 and 255

       DB   XP16 SHR 8 + 128,XP16 AND 255

       defb '<'

       DB   XP17 SHR 8 + 128,XP17 AND 255

       defb xp16 shr 8 + 128,xp16 and 255

;*

       defb xp17 shr 8 + 128,xp17 and 255

DIRECT LXI  H,TAB1-1  ;*** DIRECT ***

!*

;*

direct:lxi  h,tab1-1  !*** direct ***

EXEC   EQU  $         ;*** EXEC ***

!*

EX0    RST  5         ;IGNORE LEADING BLANKS

exec:  equ  $         !*** exec ***

       PUSH D         ;SAVE POINTER

ex0:   rst  5         !ignore leading blanks

EX1    LDAX D         ;IFF FOUND '.' IN STRING

       push d         !save pointer

       INX  D         ;BEFORE ANY MISMATCH

ex1:   ldax d         !iff found '.' in string

       CPI  56Q       ;WE DECLARE A MATCH

       inx  d         !before any mismatch

       JZ   EX3

       cpi  56q       !we declare a match

       INX  H         ;HL->TABLE

       jz   ex3

       CMP  M         ;IFF MATCH, TEST NEXT

       inx  h         !hl->table

       JZ   EX1

       cmp  m         !iff match, test next

       MVI  A,177Q    ;ELSE, SEE IFF BIT 7

       jz   ex1

       DCX  D         ;OF TABLEIS SET, WHICH

       mvi  a,177q    !else, see iff bit 7

       CMP  M         ;IS THE JUMP ADDR. (HI)

       dcx  d         !of tableis set, which

       JC   EX5       ;C:YES, MATCHED

       cmp  m         !is the jump addr. (hi)

EX2    INX  H         ;NC:NO, FIND JUMP ADDR.

       jc   ex5       !c:yes, matched

       CMP  M

ex2:   inx  h         !nc:no, find jump addr.

       JNC  EX2

       cmp  m

       INX  H         ;BUMP TO NEXT TAB. ITEM

       jnc  ex2

       POP  D         ;RESTORE STRING POINTER

       inx  h         !bump to next tab. item

       JMP  EX0       ;TEST AGAINST NEXT ITEM

       pop  d         !restore string pointer

EX3    MVI  A,177Q    ;PARTIAL MATCH, FIND

       jmp  ex0       !test against next item

EX4    INX  H         ;JUMP ADDR., WHICH IS

ex3:   mvi  a,177q    !partial match, find

       CMP  M         ;FLAGGED BY BIT 7

ex4:   inx  h         !jump addr., which is

       JNC  EX4

       cmp  m         !flagged by bit 7

EX5    MOV  A,M       ;LOAD HL WITH THE JUMP

       jnc  ex4

       INX  H         ;ADDRESS FROM THE TABLE

ex5:   mov  a,m       !load hl with the jump

       MOV  L,M

       inx  h         !address from the table

       ANI  177Q      ;MASK OFF BIT 7

       mov  l,m

       MOV  H,A

       ani  177q      !mask off bit 7

       POP  PSW       ;CLEAN UP THE GABAGE

       mov  h,a

       PCHL           ;AND WE GO DO IT

       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

!* what follows is the code to execute direct and statement

;* COMMAND TABLE LOOKUP CODE OF 'DIRECT' AND 'EXEC' IN LAST

!* commands.  control is transfered to these points via the

;* SECTION.  AFTER THE COMMAND IS EXECUTED, CONTROL IS

!* command table lookup code of 'direct' and 'exec' in last

;* TANSFERED TO OTHER SECTIONS AS FOLLOWS:

!* 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

!* for 'list', 'new', and 'stop': go back to 'rstart'

;* GO BACK TO 'RSTART'.

!* for 'run': go execute the first stored line iff any! else

;* FOR 'GOTO' AND 'GOSUB': GO EXECUTE THE TARGET LINE.

!* go back to 'rstart'.

;* FOR 'RETURN' AND 'NEXT': GO BACK TO SAVED RETURN LINE.

!* for 'goto' and 'gosub': go execute the target line.

;* FOR ALL OTHERS: IFF 'CURRNT' -> 0, GO TO 'RSTART', ELSE

!* for 'return' and 'next': go back to saved return line.

;* GO EXECUTE NEXT COMMAND.  (THIS IS DONE IN 'FINISH'.)

!* 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 *** stop *** run (& friends) *** & goto ***

;* 'NEW(CR)' SETS 'TXTUNF' TO POINT TO 'TXTBGN'

!*

;*

!* 'new(cr)' sets 'txtunf' to point to 'txtbgn'

;* 'STOP(CR)' GOES BACK TO 'RSTART'

!*

;*

!* '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

!* 'run(cr)' finds the first stored line, store its address (in

;* COMMANDS IN TAB2 ARE LEGAL FOR STORED PROGRAM.

!* '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.

!* there are 3 more entries in 'run':

;* 'RUNTSL' STORES THE ADDRESS OF THIS LINE AND EXECUTES IT.

!* 'runnxl' finds next line, stores its addr. and executes it.

;* 'RUNSML' CONTINUES THE EXECUTION ON SAME LINE.

!* '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.

!* 'goto expr(cr)' evaluates the expression, find the target

;* 'DLOAD' LOADS A NAMED PROGRAM FROM DISK.

!* line, and jump to 'runtsl' to do it.

;* 'DSAVE' SAVES A NAMED PROGRAM ON DISK.

!* 'dload' loads a named program from disk.

;* 'FCBSET' SETS UP THE FILE CONTROL BLOCK FOR SUBSEQUENT DISK I/O.

!* '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

new:   call endchk    !*** new(cr) ***

       SHLD TXTUNF

       lxi  h,txtbgn

;*

       shld txtunf

STOP   CALL ENDCHK    ;*** STOP(CR) ***

!*

       JMP RSTART

stop:  call endchk    !*** stop(cr) ***

;*

       jmp rstart

RUN    CALL ENDCHK    ;*** RUN(CR) ***

!*

       LXI  D,TXTBGN  ;FIRST SAVED LINE

run:   call endchk    !*** run(cr) ***

;*

       lxi  d,txtbgn  !first saved line

RUNNXL LXI  H,0       ;*** RUNNXL ***

!*

       CALL FNDLNP    ;FIND WHATEVER LINE #

runnxl:lxi  h,0       !*** runnxl ***

       JC   RSTART    ;C:PASSED TXTUNF, QUIT

       call fndlnp    !find whatever line #

;*

       jc   rstart    !c:passed txtunf, quit

RUNTSL XCHG           ;*** RUNTSL ***

!*

       SHLD CURRNT    ;SET 'CURRNT'->LINE #

runtsl:xchg           !*** runtsl ***

       XCHG

       shld currnt    !set 'currnt'->line #

       INX  D         ;BUMP PASS LINE #

       xchg

       INX  D

       inx  d         !bump pass line #

;*

       inx  d

RUNSML CALL CHKIO     ;*** RUNSML ***

!*

       LXI  H,TAB2-1  ;FIND COMMAND IN TAB2

runsml:call chkio     !*** runsml ***

       JMP  EXEC      ;AND EXECUTE IT

       lxi  h,tab2-1  !find command in tab2

;*

       jmp  exec      !and execute it

GOTO   RST  3         ;*** GOTO EXPR ***

!*

       PUSH D         ;SAVE FOR ERROR ROUTINE

goto:  rst  3         !*** goto expr ***

       CALL ENDCHK    ;MUST FIND A 0DH

       push d         !save for error routine

       CALL FNDLN     ;FIND THE TARGET LINE

       call endchk    !must find a 0dh

       JNZ  AHOW      ;NO SUCH LINE #

       call fndln     !find the target line

       POP  PSW       ;CLEAR THE "PUSH DE"

       jnz  ahow      !no such line #

       JMP  RUNTSL    ;GO DO IT

       pop  psw       !clear the "push de"

CPM    EQU  5         ;DISK PARAMETERS

       jmp  runtsl    !go do it

FCB    EQU  5CH

cpm:   equ  5         !disk parameters

SETDMA EQU  26

fcb:   equ  5ch

OPEN   EQU  15

setdma:equ  26

READD  EQU  20

open:  equ  15

WRITED EQU  21

readd: equ  20

CLOSE  EQU  16

writed:equ  21

MAKE   EQU  22

close: equ  16

DELETE EQU  19

make:  equ  22

;*

delete:equ  19

DLOAD  RST  5         ;IGNORE BLANKS

!*

       PUSH H         ;SAVE H

dload: rst  5         !ignore blanks

       CALL FCBSET    ;SET UP FILE CONTROL BLOCK

       push h         !save h

       PUSH D         ;SAVE THE REST

       call fcbset    !set up file control block

       PUSH B

       push d         !save the rest

       LXI  D,FCB     ;GET FCB ADDRESS

       push b

       MVI  C,OPEN    ;PREPARE TO OPEN FILE

       lxi  d,fcb     !get fcb address

       CALL CPM       ;OPEN IT

       mvi  c,open    !prepare to open file

       CPI  0FFH      ;IS IT THERE?

       call cpm       !open it

       JZ   QHOW      ;NO, SEND ERROR

       cpi  0ffh      !is it there?

       XRA  A         ;CLEAR A

       jz   qhow      !no, send error

       STA  FCB+32    ;START AT RECORD 0

       xra  a         !clear a

       LXI  D,TXTUNF  ;GET BEGINNING

       sta  fcb+32    !start at record 0

LOAD   PUSH D         ;SAVE DMA ADDRESS

       lxi  d,txtunf  !get beginning

       MVI  C,SETDMA  ;

load:  push d         !save dma address

       CALL CPM       ;SET DMA ADDRESS

       mvi  c,setdma  !

       MVI  C,READD   ;

       call cpm       !set dma address

       LXI  D,FCB

       mvi  c,readd   !

       CALL CPM       ;READ SECTOR

       lxi  d,fcb

       CPI  1         ;DONE?

       call cpm       !read sector

       JC   RDMORE    ;NO, READ MORE

       cpi  1         !done?

       JNZ  QHOW      ;BAD READ

       jc   rdmore    !no, read more

       MVI  C,CLOSE

       jnz  qhow      !bad read

       LXI  D,FCB

       mvi  c,close

       CALL CPM       ;CLOSE FILE

       lxi  d,fcb

       POP  D         ;THROW AWAY DMA ADD.

       call cpm       !close file

       POP  B         ;GET OLD REGISTERS BACK

       pop  d         !throw away dma add.

       POP  D

       pop  b         !get old registers back

       POP  H

       pop  d

       RST  6         ;FINISH

       pop  h

RDMORE POP  D         ;GET DMA ADDRESS

       rst  6         !finish

       LXI  H,80H     ;GET 128

rdmore:pop  d         !get dma address

       DAD  D         ;ADD 128 TO DMA ADD.

       lxi  h,80h     !get 128

       XCHG           ;PUT IT BACK IN D

       dad  d         !add 128 to dma add.

       JMP  LOAD      ;AND READ SOME MORE

       xchg           !put it back in d

;*

       jmp  load      !and read some more

DSAVE  RST  5         ;IGNORE BLANKS

!*

       PUSH H         ;SAVE H

dsave: rst  5         !ignore blanks

       CALL FCBSET    ;SETUP FCB

       push h         !save h

       PUSH D

       call fcbset    !setup fcb

       PUSH B         ;SAVE OTHERS

       push d

       LXI  D,FCB

       push b         !save others

       MVI  C,DELETE

       lxi  d,fcb

       CALL CPM       ;ERASE FILE IF IT EXISTS

       mvi  c,delete

       LXI  D,FCB

       call cpm       !erase file if it exists

       MVI  C,MAKE

       lxi  d,fcb

       CALL CPM       ;MAKE A NEW ONE

       mvi  c,make

       CPI  0FFH      ;IS THERE SPACE?

       call cpm       !make a new one

       JZ   QHOW      ;NO, ERROR

       cpi  0ffh      !is there space?

       XRA  A         ;CLEAR A

       jz   qhow      !no, error

       STA  FCB+32    ;START AT RECORD 0

       xra  a         !clear a

       LXI  D,TXTUNF  ;GET BEGINNING

       sta  fcb+32    !start at record 0

SAVE   PUSH D         ;SAVE DMA ADDRESS

       lxi  d,txtunf  !get beginning

       MVI  C,SETDMA  ;

save:  push d         !save dma address

       CALL CPM       ;SET DMA ADDRESS

       mvi  c,setdma  !

       MVI  C,WRITED

       call cpm       !set dma address

       LXI  D,FCB

       mvi  c,writed

       CALL CPM       ;WRITE SECTOR

       lxi  d,fcb

       ORA  A         ;SET FLAGS

       call cpm       !write sector

       JNZ  QHOW      ;IF NOT ZERO, ERROR

       ora  a         !set flags

       POP  D         ;GET DMA ADD. BACK

       jnz  qhow      !if not zero, error

       LDA  TXTUNF+1  ;AND MSB OF LAST ADD.

       pop  d         !get dma add. back

       CMP  D         ;IS D SMALLER?

       lda  txtunf+1  !and msb of last add.

       JC   SAVDON    ;YES, DONE

       cmp  d         !is d smaller?

       JNZ  WRITMOR   ;DONT TEST E IF NOT EQUAL

       jc   savdon    !yes, done

       LDA  TXTUNF    ;IS E SMALLER?

       jnz  writmor   !dont test e if not equal

       CMP  E

       lda  txtunf    !is e smaller?

       JC   SAVDON    ;YES, DONE

       cmp  e

WRITMOR LXI  H,80H

       jc   savdon    !yes, done

       DAD  D         ;ADD 128 TO DMA ADD.

writmor:lxi  h,80h

       XCHG           ;GET IT BACK IN D

       dad  d         !add 128 to dma add.

       JMP  SAVE      ;WRITE SOME MORE

       xchg           !get it back in d

SAVDON MVI  C,CLOSE

       jmp  save      !write some more

       LXI  D,FCB

savdon:mvi  c,close

       CALL CPM       ;CLOSE FILE

       lxi  d,fcb

       POP  B         ;GET REGISTERS BACK

       call cpm       !close file

       POP  D

       pop  b         !get registers back

       POP  H

       pop  d

       RST  6         ;FINISH

       pop  h

;*

       rst  6         !finish

FCBSET LXI  H,FCB     ;GET FILE CONTROL BLOCK ADDRESS

!*

       MVI  M,0       ;CLEAR ENTRY TYPE

fcbset:lxi  h,fcb     !get file control block address

FNCLR  INX  H         ;NEXT LOCATION

       mvi  m,0       !clear entry type

       MVI  M,' '     ;CLEAR TO SPACE

fnclr: inx  h         !next location

       MVI  A,FCB+8 AND 255

       mvi  m,' '     !clear to space

       CMP  L         ;DONE?

       mvi  a,fcb+8 and 255

       JNZ  FNCLR     ;NO, DO IT AGAIN

       cmp  l         !done?

       INX  H         ;NEXT

       jnz  fnclr     !no, do it again

       MVI  M,'T'     ;SET FILE TYPE TO 'TBI'

       inx  h         !next

       INX  H

       mvi  m,'t'     !set file type to 'tbi'

       MVI  M,'B'

       inx  h

       INX  H

       mvi  m,'b'

       MVI  M,'I'

       inx  h

EXRC   INX  H         ;CLEAR REST OF FCB

       mvi  m,'i'

       MVI  M,0

exrc:  inx  h         !clear rest of fcb

       MVI  A,FCB+15 AND 255

       mvi  m,0

       CMP  L         ;DONE?

       mvi  a,fcb+15 and 255

       JNZ  EXRC      ;NO, CONTINUE

       cmp  l         !done?

       LXI  H,FCB+1   ;GET FILENAME START

       jnz  exrc      !no, continue

FN     LDAX D         ;GET CHARACTER

       lxi  h,fcb+1   !get filename start

       CPI  0DH       ;IS IT A 'CR'

fn:    ldax d         !get character

       RZ             ;YES, DONE

       cpi  0dh       !is it a 'cr'

       CPI  '!'       ;LEGAL CHARACTER?

       rz             !yes, done

       JC   QWHAT     ;NO, SEND ERROR

       cpi  '!'       !legal character?

       CPI  '['       ;AGAIN

       jc   qwhat     !no, send error

       JNC  QWHAT     ;DITTO

       cpi  '['       !again

       MOV  M,A        ;SAVE IT IN FCB

       jnc  qwhat     !ditto

       INX  H         ;NEXT

       mov  m,a        !save it in fcb

       INX  D

       inx  h         !next

       MVI  A,FCB+9 AND 255

       inx  d

       CMP  L         ;LAST?

       mvi  a,fcb+9 and 255

       JNZ  FN        ;NO, CONTINUE

       cmp  l         !last?

       RET            ;TRUNCATE AT 8 CHARACTERS

       jnz  fn        !no, continue

;*

       ret            !truncate at 8 characters

;*************************************************************

!*

;*

!*************************************************************

;* *** LIST *** & PRINT ***

!*

;*

!* *** list *** & print ***

;* LIST HAS TWO FORMS:

!*

;* 'LIST(CR)' LISTS ALL SAVED LINES

!* list has two forms:

;* 'LIST #(CR)' START LIST AT THIS LINE #

!* 'list(cr)' lists all saved lines

;* YOU CAN STOP THE LISTING BY CONTROL C KEY

!* '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-

!* print command is 'print ....!' or 'print ....(cr)'

;* ARROWS, AND STRINGS.  THESE ITEMS ARE SEPERATED BY COMMAS.

!* 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

!* a format is a pound sign followed by a number.  it controlss

;* BE PRINTED.  IT STAYS EFFECTIVE FOR THE REST OF THE PRINT

!* the number of spaces the value of a expresion is going to

;* COMMAND UNLESS CHANGED BY ANOTHER FORMAT.  IFF NO FORMAT IS

!* be printed.  it stays effective for the rest of the print

;* SPECIFIED, 6 POSITIONS WILL BE USED.

!* 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 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 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

!* a (crlf) is generated after the entire list has been

;* ENDED WITH A COMMA, NO (CRL) IS GENERATED.

!* 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

list:  call tstnum    !test iff there is a #

       CALL FNDLN     ;FIND THIS OR NEXT LINE

       call endchk    !iff no # we get a 0

LS1    JC   RSTART    ;C:PASSED TXTUNF

       call fndln     !find this or next line

       CALL PRTLN     ;PRINT THE LINE

ls1:   jc   rstart    !c:passed txtunf

       CALL CHKIO     ;STOP IFF HIT CONTROL-C

       call prtln     !print the line

       CALL FNDLNP    ;FIND NEXT LINE

       call chkio     !stop iff hit control-c

       JMP  LS1       ;AND LOOP BACK

       call fndlnp    !find next line

;*

       jmp  ls1       !and loop back

PRINT  MVI  C,6       ;C = # OF SPACES

!*

       RST  1         ;IFF NULL LIST & ";"

print: mvi  c,6       !c = # of spaces

       DB   73Q

       rst  1         !iff null list & "!"

       DB   6Q

       defb 73q

       CALL CRLF      ;GIVE CR-LF AND

       defb 6q

       JMP  RUNSML    ;CONTINUE SAME LINE

       call crlf      !give cr-lf and

PR2    RST  1         ;IFF NULL LIST (CR)

       jmp  runsml    !continue same line

       DB   0DH

pr2:   rst  1         !iff null list (cr)

       DB   6Q

       defb 0dh

       CALL CRLF      ;ALSO GIVE CR-LF AND

       defb 6q

       JMP  RUNNXL    ;GO TO NEXT LINE

       call crlf      !also give cr-lf and

PR0    RST  1         ;ELSE IS IT FORMAT?

       jmp  runnxl    !go to next line

       DB   '#'

pr0:   rst  1         !else is it format?

       DB   5Q

       defb '#'

       RST  3         ;YES, EVALUATE EXPR.

       defb 5q

       MOV  C,L       ;AND SAVE IT IN C

       rst  3         !yes, evaluate expr.

       JMP  PR3       ;LOOK FOR MORE TO PRINT

       mov  c,l       !and save it in c

PR1    CALL QTSTG     ;OR IS IT A STRING?

       jmp  pr3       !look for more to print

       JMP  PR8       ;IFF NOT, MUST BE EXPR.

pr1:   call qtstg     !or is it a string?

PR3    RST  1         ;IFF ",", GO FIND NEXT

       jmp  pr8       !iff not, must be expr.

       DB   ','

pr3:   rst  1         !iff ",", go find next

       DB   6Q

       defb ','

       CALL FIN       ;IN THE LIST.

       defb 6q

       JMP  PR0       ;LIST CONTINUES

       call fin       !in the list.

PR6    CALL CRLF      ;LIST ENDS

       jmp  pr0       !list continues

       RST  6

pr6:  call crlf      !list ends

PR8    RST  3         ;EVALUATE THE EXPR

       rst  6

       PUSH B

pr8:   rst  3         !evaluate the expr

       CALL PRTNUM    ;PRINT THE VALUE

       push b

       POP  B

       call prtnum    !print the value

       JMP  PR3       ;MORE TO PRINT?

       pop  b

;*

       jmp  pr3       !more to print?

;**************************************************************

!*

;*

!**************************************************************

;* *** GOSUB *** & RETURN ***

!*

;*

!* *** gosub *** & return ***

;* 'GOSUB EXPR;' OR 'GOSUB EXPR (CR)' IS LIKE THE 'GOTO'

!*

;* COMMAND, EXCEPT THAT THE CURRENT TEXT POINTER, STACK POINTER

!* 'gosub expr!' or 'gosub expr (cr)' is like the 'goto'

;* ETC. ARE SAVE SO THAT EXECUTION CAN BE CONTINUED AFTER THE

!* command, except that the current text pointer, stack pointer

;* SUBROUTINE 'RETURN'.  IN ORDER THAT 'GOSUB' CAN BE NESTED

!* etc. are save so that execution can be continued after the

;* (AND EVEN RECURSIVE), THE SAVE AREA MUST BE STACKED.

!* subroutine 'return'.  in order that 'gosub' can be nested

;* THE STACK POINTER IS SAVED IN 'STKGOS'. THE OLD 'STKGOS' IS

!* (and even recursive), the save area must be stacked.

;* SAVED IN THE STACK.  IFF WE ARE IN THE MAIN ROUTINE, 'STKGOS'

!* the stack pointer is saved in 'stkgos'. the old 'stkgos' is

;* IS ZERO (THIS WAS DONE BY THE "MAIN" SECTION OF THE CODE),

!* saved in the stack.  iff we are in the main routine, 'stkgos'

;* BUT WE STILL SAVE IT AS A FLAG FORr NO FURTHER 'RETURN'S.

!* 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

!* 'return(cr)' undos everyhing that 'gosub' did, and thus

;* 'GOSUB'.  IFF 'STKGOS' IS ZERO, IT INDICATES THAT WE

!* return the excution to the command after the most recent

;* NEVER HAD A 'GOSUB' AND IS THUS AN ERROR.

!* '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

gosub: call pusha     !save the current "for"

       PUSH D         ;AND TEXT POINTER

       rst  3         !parameters

       CALL FNDLN     ;FIND THE TARGET LINE

       push d         !and text pointer

       JNZ  AHOW      ;NOT THERE. SAY "HOW?"

       call fndln     !find the target line

       LHLD CURRNT    ;FOUND IT, SAVE OLD

       jnz  ahow      !not there. say "how?"

       PUSH H         ;'CURRNT' OLD 'STKGOS'

       lhld currnt    !found it, save old

       LHLD STKGOS

       push h         !'currnt' old 'stkgos'

       PUSH H

       lhld stkgos

       LXI  H,0       ;AND LOAD NEW ONES

       push h

       SHLD LOPVAR

       lxi  h,0       !and load new ones

       DAD  SP

       shld lopvar

       SHLD STKGOS

       dad  sp

       JMP  RUNTSL    ;THEN RUN THAT LINE

       shld stkgos

RETURN CALL ENDCHK    ;THERE MUST BE A 0DH

       jmp  runtsl    !then run that line

       LHLD STKGOS    ;OLD STACK POINTER

return:call endchk    !there must be a 0dh

       MOV  A,H       ;0 MEANS NOT EXIST

       lhld stkgos    !old stack pointer

       ORA  L

       mov  a,h       !0 means not exist

       JZ   QWHAT     ;SO, WE SAY: "WHAT?"

       ora  l

       SPHL           ;ELSE, RESTORE IT

       jz   qwhat     !so, we say: "what?"

       POP  H

       sphl           !else, restore it

       SHLD STKGOS    ;AND THE OLD 'STKGOS'

       pop  h

       POP  H

       shld stkgos    !and the old 'stkgos'

       SHLD CURRNT    ;AND THE OLD 'CURRNT'

       pop  h

       POP  D         ;OLD TEXT POINTER

       shld currnt    !and the old 'currnt'

       CALL POPA      ;OLD "FOR" PARAMETERS

       pop  d         !old text pointer

       RST  6         ;AND WE ARE BACK HOME

       call popa      !old "for" parameters

;*

       rst  6         !and we are back home

;**************************************************************

!*

;*

!**************************************************************

;* *** FOR *** & NEXT ***

!*

;*

!* *** for *** & next ***

;* 'FOR' HAS TWO FORMS:

!*

;* 'FOR VAR=EXP1 TO EXP2 STEP EXP1' AND 'FOR VAR=EXP1 TO EXP2'

!* 'for' has two forms:

;* THE SECOND FORM MEANS THE SAME THING AS THE FIRST FORM WITH

!* 'for var=exp1 to exp2 step exp1' and 'for var=exp1 to exp2'

;* EXP1=1.  (I.E., WITH A STEP OF +1.)

!* the second form means the same thing as the first form with

;* TBI WILL FIND THE VARIABLE VAR. AND SET ITS VALUE TO THE

!* exp1=1.  (i.e., with a step of +1.)

;* CURRENT VALUE OF EXP1.  IT ALSO EVALUATES EXPR2 AND EXP1

!* tbi will find the variable var. and set its value to the

;* AND SAVE ALL THESE TOGETHER WITH THE TEXT POINTERr ETC. IN

!* current value of exp1.  it also evaluates expr2 and exp1

;* THE 'FOR' SAVE AREA, WHICH CONSISTS OF 'LOPVAR', 'LOPINC',

!* and save all these together with the text pointerr etc. in

;* 'LOPLMT', 'LOPLN', AND 'LOPPT'.  IFF THERE IS ALREADY SOME-

!* the 'for' save area, which consists of 'lopvar', 'lopinc',

;* THING IN THE SAVE AREA (THIS IS INDICATED BY A NON-ZERO

!* 'loplmt', 'lopln', and 'loppt'.  iff there is already some-

;* 'LOPVAR'), THEN THE OLD SAVE AREA IS SAVED IN THE STACK

!* thing in the save area (this is indicated by a non-zero

;* BEFORE THE NEW ONE OVERWRITES IT.

!* 'lopvar'), then the old save area is saved in the stack

;* TBI WILL THEN DIG IN THE STACK AND FIND OUT IFF THIS SAME

!* before the new one overwrites it.

;* VARIABLE WAS USED IN ANOTHER CURRENTLY ACTIVE 'FOR' LOOP.

!* tbi will then dig in the stack and find out iff this same

;* IFF THAT IS THE CASE THEN THE OLD 'FOR' LOOP IS DEACTIVATED.

!* variable was used in another currently active 'for' loop.

;* (PURGED FROM THE STACK..)

!* 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

!* 'next var' serves as the logical (not necessarilly physical)

;* WITH THE 'LOPVAR'.  IFF THEY ARE NOT THE SAME, TBI DIGS IN

!* end of the 'for' loop.  the control variable var. is checked

;* THE STACK TO FIND THE RIGHTt ONE AND PURGES ALL THOSE THAT

!* with the 'lopvar'.  iff they are not the same, tbi digs in

;* DID NOT MATCH.  EITHER WAY, TBI THEN ADDS THE 'STEP' TO

!* the stack to find the rightt one and purges all those that

;* THAT VARIABLE AND CHECK THE RESULT WITH THE LIMIT.  IFF IT

!* did not match.  either way, tbi then adds the 'step' to

;* IS WITHIN THE LIMIT, CONTROL LOOPS BACK TO THE COMMAND

!* that variable and check the result with the limit.  iff it

;* FOLLOWING THE 'FOR'.  IFF OUTSIDE THE LIMIT, THE SAVE ARER

!* is within the limit, control loops back to the command

;* IS PURGED AND EXECUTION CONTINUES.

!* 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.

for:   call pusha     !save the old save area

       DCX  H         ;HL IS ITS ADDRESS

       call setval    !set the control var.

       SHLD LOPVAR    ;SAVE THAT

       dcx  h         !hl is its address

       LXI  H,TAB5-1  ;USE 'EXEC' TO LOOK

       shld lopvar    !save that

       JMP  EXEC      ;FOR THE WORD 'TO'

       lxi  h,tab5-1  !use 'exec' to look

FR1    RST  3         ;EVALUATE THE LIMIT

       jmp  exec      !for the word 'to'

       SHLD LOPLMT    ;SAVE THAT

fr1:   rst  3         !evaluate the limit

       LXI  H,TAB6-1  ;USE 'EXEC' TO LOOK

       shld loplmt    !save that

       JMP  EXEC      ;FOR THE WORD 'STEP'

       lxi  h,tab6-1  !use 'exec' to look

FR2    RST  3         ;FOUND IT, GET STEP

       jmp  exec      !for the word 'step'

       JMP  FR4

fr2:   rst  3         !found it, get step

FR3    LXI  H,1Q      ;NOT FOUND, SET TO 1

       jmp  fr4

FR4    SHLD LOPINC    ;SAVE THAT TOO

fr3:   lxi  h,1q      !not found, set to 1

FR5    LHLD CURRNT    ;SAVE CURRENT LINE #

fr4:   shld lopinc    !save that too

       SHLD LOPLN

fr5:   lhld currnt    !save current line #

       XCHG           ;AND TEXT POINTER

       shld lopln

       SHLD LOPPT

       xchg           !and text pointer

       LXI  B,12Q     ;DIG INTO STACK TO

       shld loppt

       LHLD LOPVAR    ;FIND 'LOPVAR'

       lxi  b,12q     !dig into stack to

       XCHG

       lhld lopvar    !find 'lopvar'

       MOV  H,B

       xchg

       MOV  L,B       ;HL=0 NOW

       mov  h,b

       DAD  SP        ;HERE IS THE STACK

       mov  l,b       !hl=0 now

       DB   76Q

       dad  sp        !here is the stack

FR7    DAD  B         ;EACH LEVEL IS 10 DEEP

       defb 76q

       MOV  A,M       ;GET THAT OLD 'LOPVAR'

fr7:   dad  b         !each level is 10 deep

       INX  H

       mov  a,m       !get that old 'lopvar'

       ORA  M

       inx  h

       JZ   FR8       ;0 SAYS NO MORE IN IT

       ora  m

       MOV  A,M

       jz   fr8       !0 says no more in it

       DCX  H

       mov  a,m

       CMP  D         ;SAME AS THIS ONE?

       dcx  h

       JNZ  FR7

       cmp  d         !same as this one?

       MOV  A,M       ;THE OTHER HALF?

       jnz  fr7

       CMP  E

       mov  a,m       !the other half?

       JNZ  FR7

       cmp  e

       XCHG           ;YES, FOUND ONE

       jnz  fr7

       LXI  H,0Q

       xchg           !yes, found one

       DAD  SP        ;TRY TO MOVE SP

       lxi  h,0q

       MOV  B,H

       dad  sp        !try to move sp

       MOV  C,L

       mov  b,h

       LXI  H,12Q

       mov  c,l

       DAD  D

       lxi  h,12q

       CALL MVDOWN    ;AND PURGE 10 WORDS

       dad  d

       SPHL           ;IN THE STACK

       call mvdown    !and purge 10 words

FR8    LHLD LOPPT     ;JOB DONE, RESTORE DE

       sphl           !in the stack

       XCHG

fr8:   lhld loppt     !job done, restore de

       RST  6         ;AND CONTINUE

       xchg

;*

       rst  6         !and continue

NEXT   RST  7         ;GET ADDRESS OF VAR.

!*

       JC   QWHAT     ;NO VARIABLE, "WHAT?"

next:  rst  7         !get address of var.

       SHLD VARNXT    ;YES, SAVE IT

       jc   qwhat     !no variable, "what?"

NX0    PUSH D         ;SAVE TEXT POINTER

       shld varnxt    !yes, save it

       XCHG

nx0:   push d         !save text pointer

       LHLD LOPVAR    ;GET VAR. IN 'FOR'

       xchg

       MOV  A,H

       lhld lopvar    !get var. in 'for'

       ORA  L         ;0 SAYS NEVER HAD ONE

       mov  a,h

       JZ   AWHAT     ;SO WE ASK: "WHAT?"

       ora  l         !0 says never had one

       RST  4         ;ELSE WE CHECK THEM

       jz   awhat     !so we ask: "what?"

       JZ   NX3       ;OK, THEY AGREE

       rst  4         !else we check them

       POP  D         ;NO, LET'S SEE

       jz   nx3       !ok, they agree

       CALL POPA      ;PURGE CURRENT LOOP

       pop  d         !no, let's see

       LHLD VARNXT    ;AND POP ONE LEVEL

       call popa      !purge current loop

       JMP  NX0       ;GO CHECK AGAIN

       lhld varnxt    !and pop one level

NX3    MOV  E,M       ;COME HERE WHEN AGREED

       jmp  nx0       !go check again

       INX  H

nx3:   mov  e,m       !come here when agreed

       MOV  D,M       ;DE=VALUE OF VAR.

       inx  h

       LHLD LOPINC

       mov  d,m       !de=value of var.

       PUSH H

       lhld lopinc

       DAD  D         ;ADD ONE STEP

       push h

       XCHG

       dad  d         !add one step

       LHLD LOPVAR    ;PUT IT BACK

       xchg

       MOV  M,E

       lhld lopvar    !put it back

       INX  H

       mov  m,e

       MOV  M,D

       inx  h

       LHLD LOPLMT    ;HL->LIMIT

       mov  m,d

       POP  PSW       ;OLD HL

       lhld loplmt    !hl->limit

       ORA  A

       pop  psw       !old hl

       JP   NX1       ;STEP > 0

       ora  a

       XCHG

       jp   nx1       !step > 0

NX1    CALL CKHLDE    ;COMPARE WITH LIMIT

       xchg

       POP  D         ;RESTORE TEXT POINTER

nx1:   call ckhlde    !compare with limit

       JC   NX2       ;OUTSIDE LIMIT

       pop  d         !restore text pointer

       LHLD LOPLN     ;WITHIN LIMIT, GO

       jc   nx2       !outside limit

       SHLD CURRNT    ;BACK TO THE SAVED

       lhld lopln     !within limit, go

       LHLD LOPPT     ;'CURRNT' AND TEXT

       shld currnt    !back to the saved

       XCHG           ;POINTER

       lhld loppt     !'currnt' and text

       RST  6

       xchg           !pointer

NX2    CALL POPA      ;PURGE THIS LOOP

       rst  6

       RST  6

nx2:   call popa      !purge this loop

;*

       rst  6

;**************************************************************

!*

;*

!**************************************************************

;* *** REM *** IFF *** INPUT *** & LET (& DEFLT) ***

!*

;*

!* *** 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.

!* '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.

!* 'if' is followed by an expr. as a condition and one or more

;* NOTE THAT THE WORD 'THEN' IS NOT USED.  TBI EVALUATES THE

!* commands (including outher 'if's) seperated by semi-colons.

;* EXPR. IFF IT IS NON-ZERO, EXECUTION CONTINUES.  IFF THE

!* note that the word 'then' is not used.  tbi evaluates the

;* EXPR. IS ZERO, THE COMMANDS THAT FOLLOWS ARE IGNORED AND

!* expr. iff it is non-zero, execution continues.  iff the

;* EXECUTION CONTINUES AT THE NEXT LINE.

!* 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

!* 'iput' command is like the 'print' command, and is followed

;* DOUBLE QUOTES, OR IS A BACK-ARROW, IT HAS THE SAME EFFECT AS

!* by a list of items.  iff the item is a string in single or

;* IN 'PRINT'.  IFF AN ITEM IS A VARIABLE, THIS VARIABLE NAME IS

!* double quotes, or is a back-arrow, it has the same effect as

;* PRINTED OUT FOLLOWED BY A COLON.  THEN TBI WAITS FOR AN

!* in 'print'.  iff an item is a variable, this variable name is

;* EXPR. TO BE TYPED IN.  THE VARIABLE ISs THEN SET TO THE

!* printed out followed by a colon.  then tbi waits for an

;* VALUE OF THIS EXPR.  IFF THE VARIABLE IS PROCEDED BY A STRING

!* expr. to be typed in.  the variable iss then set to the

;* (AGAIN IN SINGLE OR DOUBLE QUOTES), THE STRING WILL BE

!* value of this expr.  iff the variable is proceded by a string

;* PRINTED FOLLOWED BY A COLON.  TBI THEN WAITS FOR INPUT EXPR.

!* (again in single or double quotes), the string will be

;* AND SET THE VARIABLE TO THE VALUE OF THE EXPR.

!* 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.

!* iff the input expr. is invalid, tbi will print "what?",

;* THE EXECUTION WILL NOT TERMINATE UNLESS YOU TYPE CONTROL-C.

!* "how?" or "sorry" and reprint the prompt and redo the input.

;* THIS IS HANDLED IN 'INPERR'.

!* 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.

!* 'let' is followed by a list of items seperated by commas.

;* TBI EVALUATES THE EXPR. AND SET THE VARIBLE TO THAT VALUE.

!* each item consists of a variable, an equal sign, and an expr.

;* TB WILL ALSO HANDLE 'LET' COMMAND WITHOUT THE WORD 'LET'.

!* tbi evaluates the expr. and set the varible to that value.

;* THIS IS DONE BY 'DEFLT'.

!* tb will also handle 'let' command without the word 'let'.

;*

!* this is done by 'deflt'.

REM    LXI  H,0Q      ;*** REM ***

!*

       DB   76Q

rem:   lxi  h,0q      !*** rem ***

;*

       defb 76q

IFF     RST  3         ;*** IFF ***

!*

       MOV  A,H       ;IS THE EXPR.=0?

iff:    rst  3         !*** iff ***

       ORA  L

       mov  a,h       !is the expr.=0?

       JNZ  RUNSML    ;NO, CONTINUE

       ora  l

       CALL FNDSKP    ;YES, SKIP REST OF LINE

       jnz  runsml    !no, continue

       JNC  RUNTSL

       call fndskp    !yes, skip rest of line

       JMP  RSTART

       jnc  runtsl

;*

       jmp  rstart

INPERR LHLD STKINP    ;*** INPERR ***

!*

       SPHL           ;RESTORE OLD SP

inperr:lhld stkinp    !*** inperr ***

       POP  H         ;AND OLD 'CURRNT'

       sphl           !restore old sp

       SHLD CURRNT

       pop  h         !and old 'currnt'

       POP  D         ;AND OLD TEXT POINTER

       shld currnt

       POP  D         ;REDO INPUT

       pop  d         !and old text pointer

;*

       pop  d         !redo input

INPUT  EQU  $         ;*** INPUT ***

!*

IP1    PUSH D         ;SAVE IN CASE OF ERROR

input: equ  $         !*** input ***

       CALL QTSTG     ;IS NEXT ITEM A STRING?

ip1:   push d         !save in case of error

       JMP  IP2       ;NO

       call qtstg     !is next item a string?

       RST  7         ;YES. BUT FOLLOWED BY A

       jmp  ip2       !no

       JC   IP4       ;VARIABLE?   NO.

       rst  7         !yes. but followed by a

       JMP  IP3       ;YES.  INPUT VARIABLE

       jc   ip4       !variable?   no.

IP2    PUSH D         ;SAVE FOR 'PRTSTG'

       jmp  ip3       !yes.  input variable

       RST  7         ;MUST BE VARIABLE NOW

ip2:   push d         !save for 'prtstg'

       JC   QWHAT     ;"WHAT?" IT IS NOT?

       rst  7         !must be variable now

       LDAX D         ;GET READY FOR 'RTSTG'

       jc   qwhat     !"what?" it is not?

       MOV  C,A

       ldax d         !get ready for 'rtstg'

       SUB  A

       mov  c,a

       STAX D

       sub  a

       POP  D

       stax d

       CALL PRTSTG    ;PRINT STRING AS PROMPT

       pop  d

       MOV  A,C       ;RESTORE TEXT

       call prtstg    !print string as prompt

       DCX  D

       mov  a,c       !restore text

       STAX D

       dcx  d

IP3    PUSH D         ;SAVE IN CASE OF ERROR

       stax d

       XCHG

ip3:   push d         !save in case of error

       LHLD CURRNT    ;ALSO SAVE 'CURRNT'

       xchg

       PUSH H

       lhld currnt    !also save 'currnt'

       LXI  H,IP1     ;A NEGATIVE NUMBER

       push h

       SHLD CURRNT    ;AS A FLAG

       lxi  h,ip1     !a negative number

       LXI  H,0Q      ;SAVE SP TOO

       shld currnt    !as a flag

       DAD  SP

       lxi  h,0q      !save sp too

       SHLD STKINP

       dad  sp

       PUSH D         ;OLD HL

       shld stkinp

       MVI  A,72Q     ;PRINT THIS TOO

       push d         !old hl

       CALL GETLN     ;AND GET A LINE

       mvi  a,72q     !print this too

IP3A   LXI  D,BUFFER  ;POINTS TO BUFFER

       call getln     !and get a line

       RST  3         ;EVALUATE INPUT

ip3a:  lxi  d,buffer  !points to buffer

       NOP            ;CAN BE 'CALL ENDCHK'

       rst  3         !evaluate input

       NOP

       nop            !can be 'call endchk'

       NOP

       nop

       POP  D         ;OK, GET OLD HL

       nop

       XCHG

       pop  d         !ok, get old hl

       MOV  M,E       ;SAVE VALUE IN VAR.

       xchg

       INX  H

       mov  m,e       !save value in var.

       MOV  M,D

       inx  h

       POP  H         ;GET OLD 'CURRNT'

       mov  m,d

       SHLD CURRNT

       pop  h         !get old 'currnt'

       POP  D         ;AND OLD TEXT POINTER

       shld currnt

IP4    POP  PSW       ;PURGE JUNK IN STACK

       pop  d         !and old text pointer

       RST  1         ;IS NEXT CH. ','?

ip4:   pop  psw       !purge junk in stack

       DB   ','

       rst  1         !is next ch. ','?

       DB   3Q

       defb ','

       JMP  IP1       ;YES, MORE ITEMS.

       defb 3q

IP5    RST  6

       jmp  ip1       !yes, more items.

;*

ip5:   rst  6

DEFLT  LDAX D         ;*** DEFLT ***

!*

       CPI  0DH       ;EMPTY LINE IS OK

deflt: ldax d         !*** deflt ***

       JZ   LT1       ;ELSE IT IS 'LET'

       cpi  0dh       !empty line is ok

;*

       jz   lt1       !else it is 'let'

LET    CALL SETVAL    ;*** LET ***

!*

       RST  1         ;SET VALUE TO VAR.

let:   call setval    !*** let ***

       DB   ','

       rst  1         !set value to var.

       DB   3Q

       defb ','

       JMP  LET       ;ITEM BY ITEM

       defb 3q

LT1    RST  6         ;UNTIL FINISH

       jmp  let       !item by item

;*

lt1:   rst  6         !until finish

;**************************************************************

!*