Subversion Repositories cpu8080

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

!*

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

!

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

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

! to correct it.

!

!*

       jmp  ninit     ! go main start

       alignp 8

*

       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

       defb '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

       defb '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

       defb '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:   defb 'how?',0dh

ok:    defb 'ok',0dh

what:  defb 'what?',0dh

sorry: defb '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  !set stack pointer

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

       defb 'list'

       defb list shr 8 + 128,list and 0ffh

       defb 'run'

       defb run shr 8 + 128,run and 255

       defb 'new'

       defb new shr 8 + 128,new and 255

       defb 'load'

       defb dload shr 8 + 128,dload and 255

       defb 'save'

       defb dsave shr 8 + 128,dsave and 255

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

tab2:  equ  $         !direct/tatement

       defb 'next'

       defb next shr 8 + 128,next and 255

       defb 'let'

       defb let shr 8 + 128,let and 255

       defb 'out'

       defb outcmd shr 8 + 128,outcmd and 255

       defb 'poke'

       defb poke shr 8 + 128,poke and 255

       defb 'wait'

       defb waitcm shr 8 + 128,waitcm and 255

       defb 'if'

       defb iff shr 8 + 128,iff and 255

       defb 'goto'

       defb goto shr 8 + 128,goto and 255

       defb 'gosub'

       defb gosub shr 8 + 128,gosub and 255

       defb 'return'

       defb return shr 8 + 128,return and 255

       defb 'rem'

       defb rem shr 8 + 128,rem and 255

       defb 'for'

       defb for shr 8 + 128,for and 255

       defb 'input'

       defb input shr 8 + 128,input and 255

       defb 'print'

       defb print shr 8 + 128,print and 255

       defb 'stop'

       defb stop shr 8 + 128,stop and 255

       defb deflt shr 8 + 128,deflt and 255

       defb 'you can add more' !commands but

            !remember to move default down.

tab4:  equ  $         !functions

       defb 'rnd'

       defb rnd shr 8 + 128,rnd and 255

       defb 'inp'

       defb inp shr 8 + 128,inp and 255

       defb 'peek'

       defb peek shr 8 + 128,peek and 255

       defb 'usr'

       defb usr shr 8 + 128,usr and 255

       defb 'abs'

       defb abs shr 8 + 128,abs and 255

       defb 'size'

       defb size shr 8 + 128,size and 255

       defb xp40 shr 8 + 128,xp40 and 255

       defb 'you can add more' !functions but remember

                      !to move xp40 down

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

       defb 'to'

       defb fr1 shr 8 + 128,fr1 and 255

       defb qwhat shr 8 + 128,qwhat and 255

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

       defb 'step'

       defb fr2 shr 8 + 128,fr2 and 255

       defb fr3 shr 8 + 128,fr3 and 255

tab8:  equ  $         !relation operators

       defb '>='

       defb xp11 shr 8 + 128,xp11 and 255

       defb '#'

       defb xp12 shr 8 + 128,xp12 and 255

       defb '>'

       defb xp13 shr 8 + 128,xp13 and 255

       defb '='

       defb xp15 shr 8 + 128,xp15 and 255

       defb '<='

       defb xp14 shr 8 + 128,xp14 and 255

       defb '<'

       defb xp16 shr 8 + 128,xp16 and 255

       defb 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.

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

       jmp rstart

!*

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

cpm:   equ  5         !disk parameters

fcb:   equ  5ch

setdma:equ  26

open:  equ  15

readd: equ  20

writed:equ  21

close: equ  16

make:  equ  22

delete:equ  19

!*

dload: rst  5         !ignore blanks

       push h         !save h

       call fcbset    !set up file control block

       push d         !save the rest

       push b

       lxi  d,fcb     !get fcb address

       mvi  c,open    !prepare to open file

       call cpm       !open it

       cpi  0ffh      !is it there?

       jz   qhow      !no, send error

       xra  a         !clear a

       sta  fcb+32    !start at record 0

       lxi  d,txtunf  !get beginning

load:  push d         !save dma address

       mvi  c,setdma  !

       call cpm       !set dma address

       mvi  c,readd   !

       lxi  d,fcb

       call cpm       !read sector

       cpi  1         !done?

       jc   rdmore    !no, read more

       jnz  qhow      !bad read

       mvi  c,close

       lxi  d,fcb

       call cpm       !close file

       pop  d         !throw away dma add.

       pop  b         !get old registers back

       pop  d

       pop  h

       rst  6         !finish

rdmore:pop  d         !get dma address

       lxi  h,80h     !get 128

       dad  d         !add 128 to dma add.

       xchg           !put it back in d

       jmp  load      !and read some more

!*

dsave: rst  5         !ignore blanks

       push h         !save h

       call fcbset    !setup fcb

       push d

       push b         !save others

       lxi  d,fcb

       mvi  c,delete

       call cpm       !erase file if it exists

       lxi  d,fcb

       mvi  c,make

       call cpm       !make a new one

       cpi  0ffh      !is there space?

       jz   qhow      !no, error

       xra  a         !clear a

       sta  fcb+32    !start at record 0

       lxi  d,txtunf  !get beginning

save:  push d         !save dma address

       mvi  c,setdma  !

       call cpm       !set dma address

       mvi  c,writed

       lxi  d,fcb

       call cpm       !write sector

       ora  a         !set flags

       jnz  qhow      !if not zero, error

       pop  d         !get dma add. back

       lda  txtunf+1  !and msb of last add.

       cmp  d         !is d smaller?

       jc   savdon    !yes, done

       jnz  writmor   !dont test e if not equal

       lda  txtunf    !is e smaller?

       cmp  e

       jc   savdon    !yes, done

writmor:lxi  h,80h

       dad  d         !add 128 to dma add.

       xchg           !get it back in d

       jmp  save      !write some more

savdon:mvi  c,close

       lxi  d,fcb

       call cpm       !close file

       pop  b         !get registers back

       pop  d

       pop  h

       rst  6         !finish

!*

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

       mvi  m,0       !clear entry type

fnclr: inx  h         !next location

       mvi  m,' '     !clear to space

       mvi  a,fcb+8 and 255

       cmp  l         !done?

       jnz  fnclr     !no, do it again

       inx  h         !next

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

       inx  h

       mvi  m,'b'

       inx  h

       mvi  m,'i'

exrc:  inx  h         !clear rest of fcb

       mvi  m,0

       mvi  a,fcb+15 and 255

       cmp  l         !done?

       jnz  exrc      !no, continue

       lxi  h,fcb+1   !get filename start

fn:    ldax d         !get character

       cpi  0dh       !is it a 'cr'

       rz             !yes, done

       cpi  '!'       !legal character?

       jc   qwhat     !no, send error

       cpi  '['       !again

       jnc  qwhat     !ditto

       mov  m,a        !save it in fcb

       inx  h         !next

       inx  d

       mvi  a,fcb+9 and 255

       cmp  l         !last?

       jnz  fn        !no, continue

       ret            !truncate at 8 characters

!*

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

!*

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

       defb 73q

       defb 6q

       call crlf      !give cr-lf and

       jmp  runsml    !continue same line

pr2:   rst  1         !iff null list (cr)

       defb 0dh

       defb 6q

       call crlf      !also give cr-lf and

       jmp  runnxl    !go to next line

pr0:   rst  1         !else is it format?

       defb '#'

       defb 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

       defb ','

       defb 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

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

       defb 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

!*

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. ','?

       defb ','

       defb 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.

       defb ','

       defb 3q

       jmp  let       !item by item

lt1:   rst  6         !until finish

!*

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