*HEADING IMSAI 8080 4K BASIC
      ORG   0
;
;
BASIC EQU   $
      LD    HL,RAM+1024      ;POINT FIRST POSSIBLE END OF RAM
      LD    A,0FAH           ;GET MODE SET
      JP    CONTI            ;GO CONTINUE
;
;
      ORG   8
RST1  EQU   $
;
;SKIP CHARS POINTED TO BY HL UNTIL NON-BLANK,
;LEAVE IN REG A
;
      LD    A,(HL)           ;LOAD THE BYTE AT (HL)
      CP    ' '              ;TEST  IF BLANK
      RET   NZ               ;RETURN IF NOT
      INC   HL               ;POINT NEXT
      JP    RST1             ;LOOP
;
;
      ORG   16
RST2  EQU   $
;
;COMPARE STRING AT (HL) TO STRING AT (DE)
;RETURN IF EQUAL (THRU X'00' IN DE) OR ON FIRST NOT EQUAL
;IGNORE ALL SPACES
;
      RST   8                ;SKIP SPACES
      LD    A,(DE)           ;GET CHAR TO MATCH WITH
      OR    A                ;TEST IT
      JP    NZ,COMP2         ;BRIF NOT EQUAL
      LD    A,(HL)           ;GET CHAR FOLLOWING
      RET                    ;RETURN
;
;
      ORG   24
RST3  EQU   $
;
;PRINT: 'XX ERR @ NNNN'
;
      LD    HL,IOBUF         ;POINT BUFFER
      LD    (HL),B           ;MOVE HI CHAR
      INC   HL               ;POINT NEXT
      JP    ERROR            ;CONTINUE ELSEWHERE
;
;
      ORG   32
RST4  EQU   $
;
;SHIFT THE LOW ORDER 4 BITS OF REG A TO THE HIGH 4 BITS
;
      AND   0FH              ;ISOLATE LOW 4
      RLA                    ;SHIFT ONE BIT
      RLA                    ;AGAIN
      RLA                    ;AGAIN
      RLA                    ;ONE LAST TIME
      RET                    ;RETURN
;
;
      ORG   40
RST5  EQU   $
;
;LOAD THE FLOATING POINT ACCUMULATOR WITH THE 4 BYTES AT (HL)
;
      LD    DE,FACC          ;POINT FLOAT ACC
      LD    B,4              ;BYTE COUNT
      JP    COPYH            ;GO MOVE IT
;
;
      ORG 48
RST6  EQU   $
;
;STORE THE FLOATING POINT ACCUMULATOR AT (HL)
;
      LD    DE,FACC          ;POINT FLOAT ACC
      LD    B,4              ;BYTE COUNT
      JP    COPYD            ;GO MOVE IT
;
;
      ORG   56
RST7  EQU   $
;
;INCREMENT HL BY BYTE AT (SP), RETURN TO (SP)+1
;
      EX    (SP),HL          ;GET RETURN ADDR IN HL
      LD    A,(HL)           ;GET THE INCREMENT
      INC   HL               ;POINT TRUE RETURN
      EX    (SP),HL          ;PUT BACK TO STACK
      PUSH  DE               ;SAVE DE
      LD    E,A              ;PUT IT IN LOW
      OR    A                ;TEST SIGN
      LD    D,0              ;DEFAULT POSITIVE
      JP    P,RST7A          ;BRIF +
      LD    D,0FFH           ;ELSE, NEG
RST7A ADD   HL,DE            ;BUMP HL
      POP   DE               ;RESTORE DE
      RET                    ;RETURN
;
;
;
CONTI EQU   $
;
;INITIALIZATION ROUTINE
;DETERMINE MEMORY SIZE. (START AT 4K AND TRY 1K INCREMENTS)
;SETUP POINTERS FOR STACK, DATA, AND PROGRAM
;INIT SIO BOARD
;
      OUT   (TTY-1),A        ;WRITE TO SIO
      LD    A,17H            ;CMND: DTR, ENABLE TRNS, & RCVR,
      OUT   (TTY-1),A        ;WRITE TO SIO
      LD    BC,1024          ;1K INCR
FINDL EQU   $
      LD    A,(HL)           ;GET A BYTE FROM MEMORY
      CPL                    ;COMPLEMENT
      LD    (HL),A           ;REPLACE
      CP    (HL)             ;TEST IF RAM/ROM/END
      JP    NZ,MEMEN         ;BRIF OUT OF RAM
      CPL                    ;RE-COMPLEMENT
      LD    (HL),A           ;PUT ORIG BACK
      ADD   HL,BC            ;POINT NEXT 1K BLOCK
      JP    NC,FINDL         ;LOOP TILL 64K
MEMEN LD    SP,HL            ;SET STACK POINTER TO END OF MEMORY
      RST   RST7             ;GO BUMP HL ADDR
      DEFB  -100             ;ALLOW 100 BYTES
      LD    (DATAB),HL       ;SAVE ADDR OF START OF DATA
      XOR   A                ;GET A ZERO IN A
      LD    (HL),A           ;MARK EMPTY DATA
      LD    (OUTSW),A        ;TURN OUTPUT SUPPRESS OFF
      PUSH  AF               ;SET STACK 1 LEVEL DEEP WITHOUT
      LD    HL,0             ;CLEAR HL
      ADD   HL,SP            ;SP TO HL
      LD    (STACK),HL       ;SAVE BEG OF STACK
      LD    HL,BEGPR-1       ;POINT ONE BEFORE START OF PROGRAM
      LD    (HL),A           ;MARK EMPTY
      LD    HL,RNDX          ;POINT INIT RND NUMBER
      RST   RST5             ;GO LOAD TO FACC
      LD    HL,RNDNU         ;POINT RAM AREA
      RST   RST6             ;GO STORE
      LD    HL,RAM           ;POINT 1 BEFORE IOBUFF
      LD    (HL),0FFH        ;SET HIGH VALUE
GENRN CALL  RND              ;GO GENERATE A RANDUM NUMBER
      IN    A,(TTY-1)        ;GET TTY STATUS
      AND   40H              ;ISOLATE RXRDY
      JP    Z,GENRN
*HEADING IMSAI 8080 4K BASIC
READY EQU   $
;
;
;COMMAND INPUT ROUTINE
;
;READ A LINE FROM THE TTY
;IF STARTS WITH NUMERIC CHARACTERS, ASSUME IT'S A BASIC STA
;IF NOT, THEN IT IS EITHER AN IMMEDIATE STATEMENT OR A COM
;
GETCM XOR   A                ;SET NO PROMPT
      LD    HL,(STACK)       ;GET STACK ADDRESS
      LD    SP,HL            ;SET REG SP
      CALL  TERMI            ;GET A LINE
      CALL  PACK             ;GO PACK THE NUMBER INTO BC
      LD    A,B              ;GET HI BYTE OF LINE NUMBER
      OR    C                ;PLUS LOW BYTE
      JP    Z,EXEC           ;BRIF EXEC STATEMENT
      PUSH  BC               ;SAVE LINE NUMBER
      LD    DE,IMMED+1       ;POINT SAVE AREA
      EX    DE,HL            ;FLIP/FLOP
      LD    (HL),B           ;PUT LO LINE
      INC   HL               ;POINT NEXT
      LD    (HL),C           ;PUT LO LINE
      INC   HL               ;POINT NEXT
      LD    B,3              ;INIT COUNT
EDIT1 LD    A,(DE)           ;GET A BYTE
      LD    (HL),A           ;PUT IT DOWN
      INC   B                ;COUNT IT
      INC   HL               ;POINT NEXT
      INC   DE               ;DITTO
      OR    A                ;TEST BYTE JUST MOVED
      JP    NZ,EDIT1         ;LOOP
      LD    A,B              ;GET COUNT
      LD    (IMMED),A        ;STORE THE COUNT
      POP   BC               ;GET LINE NUMBER
      LD    HL,BEGPR         ;POINT BEGINNING OF PROGRAM
EDIT2 LD    A,(HL)           ;GET LEN CODE
      PUSH  HL               ;SAVE ADDR
      OR    A                ;TEST IT
      JP    Z,EDIT5          ;BRIF END
      INC   HL               ;POINT HI LINE
      LD    A,(HL)           ;LOAD IT
      CP    B                ;COMPARE
      JP    C,EDIT4          ;BRIF LOW
      JP    NZ,EDIT5         ;EDIT5 BRIF HIGH
      INC   HL               ;POINT LO LINE
      LD    A,(HL)           ;LOAD IT
      CP    C                ;COMPARE
      JP    C,EDIT4          ;BRIF LOW
      JP    NZ,EDIT5         ;BRIF HIGH
      DEC   HL               ;POINT BACK
      DEC   HL               ;TO BEGIN
      LD    D,H              ;COPY ADDR
      LD    E,L              ;TO DE
      LD    B,0              ;GET A ZERO
      LD    C,(HL)           ;GET LEN
      ADD   HL,BC            ;POINT NEXT STMT
EDIT3 LD    A,(HL)           ;GET LEN NEXT STMT
      OR    A                ;TEST IT
      JP    Z,EDITX          ;BRIF END
      LD    B,A              ;SET LENGTH
      CALL  COPYH            ;ELSE MOVE LINE
      JP    EDIT3            ;LOOP
EDIT4 POP   HL               ;GET ADDR
      LD    D,0              ;ZERO HI LEN
      LD    E,(HL)           ;GET LO LEN
      ADD   HL,DE            ;COMPUTE ADDR NEXT LINE
      JP    EDIT2            ;LOOP
EDITX EX    DE,HL            ;PUT NEW ADDR TO HL
      LD    (HL),A           ;MARK END
      LD    (PROGE),HL       ;AND UPDATE ADDRESS
EDIT5 LD    A,(IMMED)        ;GET LEN OF INSERT
      CP    4                ;TEST IF DELETE
      JP    Z,GETCM          ;BRIF IS
      LD    C,A              ;SET LO LEN
      LD    B,0              ;ZERO HI LEN
      LD    HL,(PROGE)       ;GET END OF PROG
      LD    D,H              ;COPY TO
      LD    E,L              ;DE
      ADD   HL,BC            ;DISP LEN OF INSERT
      LD    (PROGE),HL       ;UPDATE END POINT
      POP   BC               ;GET ADDR
EDIT6 LD    A,(DE)           ;GET A BYTE
      LD    (HL),A           ;COPY IT
      DEC   DE               ;POINT PRIOR
      DEC   HL               ;DITTO
      LD    A,D              ;GET HI ADDR
      CP    B                ;COMPARE
      JP    Z,EDIT7          ;BRIF HI EQUAL
      JP    NC,EDIT6         ;BRIF NOT LESS
EDIT7 LD    A,E              ;GET LO ADDR
      CP    C                ;COMPARE
      JP    NC,EDIT6         ;BRIF NOT LESS
      INC   DE               ;POINT FORWARD
      LD    HL,IMMED         ;POINT INSERT
      LD    B,(HL)           ;GET LENGTH
      CALL  COPYH            ;GO MOVE IT
      JP    GETCM            ;GO COMMAND
*HEADING IMSAI 8080 4K BASIC
EXEC  EQU   $
;
;
;
;DECODE COMMAND IN IOBUFF
;EXECUTE IF POSSIBLE
;THEN GOTO GET NEXT COMMAND
;
;
      LD    DE,NEWLI         ;POINT "NEW"
      LD    HL,IOBUF         ;POINT BUFFER
      RST   RST2             ;GO COMPARE
      JP    NZ,NOTSC         ;BRIF NOT
      LD    HL,BEGPR         ;POINT BEGINNING OF PGM
      LD    (PROGE),HL       ;SAVE END ADDRESS
      XOR   A                ;GET A ZERO
      LD    (HL),A           ;MARK EMPTY
      LD    HL,(DATAB)       ;POINT BEGINNING OF DATA
      LD    (HL),A           ;MARK EMPTY
      JP    READY            ;GO GET NEXT COMMAND
NOTSC LD    DE,LISTL         ;POINT LITERAL
      LD    HL,IOBUF         ;POINT BUFFER
      RST   RST2             ;GO COMPARE
      JP    Z,LIST           ;BRIF 'LIST'
      LD    DE,RUNLI         ;POINT LITERAL
      LD    HL,IOBUF         ;POINT BUFFER
      RST   RST2             ;GO COMPARE
      JP    Z,RUNIT          ;BRIF 'RUN'
      LD    (RUNSW),A        ;SET IMMEDIATE MODE
      LD    HL,IOBUF         ;POINT STMT
      LD    DE,IMMED         ;POINT NEW AREA
IMED  LD    A,(HL)           ;GET A BYTE
      LD    (DE),A           ;PUT TO D
      INC   DE               ;POINT NEXT
      INC   HL               ;DITTO
      OR    A                ;TEST IF END
      JP    NZ,IMED          ;LOOP
      LD    HL,NULLI         ;POINT FFFF
      LD    (LINE),HL        ;SAVE ADDR
      LD    HL,IMMED         ;POINT START OF CMMD
      JP    IMMD             ;GO IMMEDIATE
*HEADING IMSAI 8080 4K BASIC
RUNIT EQU   $
;
;
;RUN PROCESSOR, GET NEXT STATEMENT, AND EXECUTE IT
;IF IN IMMEDIATE MODE, THEN RETURN TO GETCMMD
;
;
      XOR   A                ;CLEAR A REG
      LD    (RUNSW),A        ;RESET SWITCH
      LD    (FORNE),A        ;INIT FOR/NEXT TABLE
      LD    HL,(DATAB)       ;POINT START OF VARIABLES
      LD    (HL),0           ;CLEAR IT
      LD    HL,BEGPR-1       ;GET ADDR OF PROGRAM
      LD    (DATAP),HL       ;'RESTORE'
      INC   HL               ;POINT 1ST BYTE
      LD    (STMT),HL        ;SAVE IT
      JP    NEXTS            ;GO PROCESS IT
;
RUN   LD    HL,(STMT)        ;GET ADDR OF PREVIOUS STMT
      LD    E,(HL)           ;GET LEN CODE
      LD    D,0              ;CLEAR HIGH BYTE OF ADDR
      ADD   HL,DE            ;INCR STMT POINTER
      LD    (STMT),HL        ;SAVE IT
;
NEXTS EQU   $
      LD    A,(RUNSW)        ;GET RUN TYPE
      OR    A                ;TEST IT
      JP    NZ,GETCM         ;BRIF IMMEDIATE MODE
      LD    A,(HL)           ;GET LEN CODE
      OR    A                ;SEE IF NO MORE STATEMENTS
      JP    Z,READY          ;BRIF END
NOTDO EQU   $
      INC   HL               ;POINT LINE NUMBER
      LD    (LINE),HL        ;SAVE ADDR
      INC   HL               ;POINT 2ND BYTE
      INC   HL               ;POINT 1ST PGM BYTE
IMMD  RST   RST1             ;SKIP BLANKS
CONTX LD    (ADDR1),HL       ;SAVE ADDR
      CALL  TSTCH            ;GO SEE IF CONTROL-C
      LD    DE,JMPTB         ;POINT TO TABLE
TABLO LD    A,(DE)           ;GET FIRST BYTE OF LIT
      OR    A                ;TEST IF END OF TABLE
      JP    Z,TABEN          ;BRIF IS
      LD    HL,(ADDR1)       ;GET ADDRESS OF CMMD
      RST   RST2             ;GO COMPARE
      JP    NZ,NOJMP         ;BRIF NOT EQUAL
      PUSH  HL               ;SAVE HL
      INC   DE               ;POINT NEXT BYTE
      LD    A,(DE)           ;LOAD IT
      LD    L,A              ;LOW BYTE TOL
      INC   DE               ;POINT NEXT BYTE
      LD    A,(DE)           ;LOAD IT
      LD    H,A              ;HIGH BYTE TO H
      EX    (SP),HL          ;HL TO STACK, STACK TO HL
      RET                    ;JUMP TO PROPER ROUTINE
NOJMP INC   DE               ;POINT NEXT
      LD    A,(DE)           ;LOAD IT
      OR    A                ;TEST IT
      JP    NZ,NOJMP         ;BRIF NOT
      INC   DE               ;POINT NEXT
      INC   DE               ;DITTO
      INC   DE               ;POINT FIRST BYTE NEXT LIT
      JP    TABLO            ;LOOP
;
TABEN LD    HL,(ADDR1)       ;RESTORE HL POINTER
      JP    LET              ;ASSUME IT'S A LET STATEMENT
*HEADING IMSAI 8080 4K BASIC
LIST  EQU   $
;
;
;LIST PROCESSOR
;DUMP THE SOURCE PROGRAM TO TTY OR PAPER TAPE
;
;
      LD    HL,BEGPR         ;POINT BEGINNING OF PROGRAM
LISTX LD    A,(HL)           ;GET LEN CODE
      OR    A                ;TEST IF END OF PGM
      JP    Z,READY          ;BRIF END OF PGM
      SUB   3                ;SUBTRACT THREE
      LD    B,A              ;SAVE LEN
      INC   HL               ;POINT HI BYTE OF LINE #
      LD    DE,IOBUF         ;POINT BUFFER AREA
      CALL  LINEO            ;CONVERT LINE NUMBER
      CALL  COPYH            ;GO MOVE THE LINE
      CALL  TSTCH            ;GO SEE IF CONTROL-C
      PUSH  HL               ;SAVE HL ADDR
      CALL  TERMO            ;GO TYPE IT
      POP   HL               ;RETREIVE H ADDR
      JP    LISTX            ;CONTINUE
;
*HEADING IMSAI 8080 4K BASIC
GOSUB EQU   $
;
;
; STMT:  GOSUB NNNN
;
      EX    DE,HL            ;FLIP/FLOP DE HL
      LD    HL,(STMT)        ;GET STATEMENT ADDRESS
      PUSH  HL               ;SAVE RETURN ADDRESS IN STACK
      LD    A,0FFH           ;MARK AS GOSUB
      PUSH  AF               ;SAVE STATUS
      EX    DE,HL            ;RESTORE HL
;
;
GOTO  EQU   $
;
;
; STMT:  GOTO NNNN
;
      CALL  PACK             ;GO GET LINE NUMBER IN BC
      LD    HL,BEGPR         ;POINT BEGINNING OF PROGRAM
GOTO1 LD    A,(HL)           ;GET LEN
      OR    A                ;TEST IF END OF PROGRAM
      JP    Z,ULERR          ;BRIF UNDEFIND STATEMENT
      INC   HL               ;POINT NEXT
      LD    A,(HL)           ;GET THE HIGH LINE NUMBER
      CP    B                ;TEST WITH DESIRED
      JP    C,GOTO2          ;BRIF LOW
      INC   HL               ;POINT NEXT BYTE
      LD    A,(HL)           ;GET LOW LINE NUMBER
      DEC   HL               ;POINT BACK
      CP    C                ;TEST WITH WANTED
      JP    C,GOTO2          ;BRIF LOW
      JP    NZ,ULERR         ;BRIF LINE MISSING
      DEC   HL               ;POINT TO START OF STMT
      LD    (STMT),HL        ;SAVE ADDR
      JP    NEXTS            ;GO PROCESS THE STATEMENT
GOTO2 DEC   HL               ;POINT START OF STMT
      LD    E,(HL)           ;GET LENGTH
      LD    D,0              ;ZERO MDB
      ADD   HL,DE            ;POINT NEXT STMT
      JP    GOTO1            ;LOOP
*HEADING IMSAI 8080 4K BASIC
RETUR EQU   $
;
;
; STMT:  RETURN
;
      POP   AF               ;POP THE STACK
      CP    0FFH             ;TEST IF GOSUB IN EFFECT
      JP    NZ,RTERR         ;BRIF ERROR
      POP   HL               ;GET RETURNED STATEMENT ADDRESS
      LD    (STMT),HL        ;RESTORE
      JP    RUN              ;CONTINUE AT STMT FOLLOWING GOSUB
*HEADING IMSAI 8080 4K BASIC
PRINT EQU   $
;
;
; STMT:  PRINT . . . .
;
;
      XOR   A                ;CLEAR REG A
      LD    (PRSW),A         ;SET SWITCH
PR1   LD    DE,IOBUF         ;POINT BUFFER
      RST   RST1             ;SKIP TO NEXT FIELD
      CP    '"'              ;TEST IF QUOTE
      JP    NZ,PR6           ;BRIF NOT LITERAL
PR2   INC   HL               ;POINT NEXT
      LD    A,(HL)           ;GET THE CHAR
      OR    A                ;TEST IF END OF STMT
      JP    Z,SNERR          ;BRIF MISSING END OF QUOTE
PR3   CP    '"'              ;TEST IF END QUOTE
      JP    NZ,PR5           ;BRIF NOT
      INC   HL               ;POINT NEXT
PRNXT LD    A,0FEH           ;SET CODE = NO CR/LF
      LD    (DE),A           ;PUT TO BUFFER
      PUSH  HL               ;SAVE HL
      CALL  TERMO            ;GO PRINT IT
      POP   HL               ;RESTORE HL
      JP    PRINT            ;RECURSIVE TO NEXT FIELD
PR4   LD    A,(PRSW)         ;GET SWITCH
      OR    A                ;TEST IF STMT ENDED WITH , OR ;
      CALL  Z,CRLF           ;CALL IF NOT
      JP    RUN              ;CONTINUE NEXT STMT
PR5   LD    (DE),A           ;PUT CHAR TO BUFFER
      INC   DE               ;POINT NEXT OUT
      JP    PR2              ;LOOP
PR6   OR    A                ;TEST IF END OF STMT
      JP    Z,PR4            ;BRIF IT IS
      CP    ','              ;TEST IF COMMA
      JP    Z,PR7            ;BRIF IT IS
      CP    ';'              ;TEST IF SEMI-COLON
      JP    Z,PR8            ;BRIF IT IS
      PUSH  DE               ;SAVE DE
      CALL  EXPR             ;GO EVALUATE EXPRESSION
      POP   DE               ;RESTORE DE
      PUSH  HL               ;SAVE HL
      EX    DE,HL            ;FLIP/FLOP
      CALL  FOUT             ;GO CONVERT OUTPUT
      INC   HL               ;POINT NEXT
      LD    (HL),' '         ;SPACE FOLLOWS NUMBERS
      INC   HL               ;POINT NEXT
      EX    DE,HL            ;FLIP/FLOP
      POP   HL               ;RESTORE HL
      JP    PRNXT            ;CONTINUE
PR7   LD    A,(COLUM)        ;GET COLUMN POINTER
      CP    56               ;COMPARE TO 56
      JP    NC,TBEND         ;BRIF NO ROOM LEFT
      LD    B,A              ;SAVE IT
      XOR   A                ;INIT POSITION
TBLP  CP    B                ;COMPARE
      JP    Z,TBLP2          ;BRIF ON A TAB STOP
      JP    NC,TBON          ;BRIF SHY OF TAB
TBLP2 ADD   A,14             ;POINT NEXT STOP
      JP    TBLP             ;LOOP
TBON  LD    (COLUM),A        ;UPDATE CTR
      SUB   B                ;COMPUTE NUMBER OF SPACES
      LD    B,A              ;SAVE IT
TBSPA CALL  TESTO            ;WAIT TILL READY
      LD    A,' '            ;SPACE TO REG A
      OUT   (TTY),A          ;OUTPUT IT
      DEC   B                ;SUB 1 FROM CTR
      JP    NZ,TBSPA         ;LOOP IF NOT
PR8   INC   HL               ;POINT NEXT
      LD    (PRSW),A         ;SET THE SWITCH
      JP    PR1              ;GO NEXT FIELD
TBEND CALL  CRLF             ;PUT CR/LF
      JP    PR8              ;GO SET SW
*HEADING IMSAI 8080 4K BASIC
FOR   EQU   $
;
;
; STMT:  FOR VAR = EXPR TO EXPR :STEP EXPR:
;
;
      CALL  VAR              ;NEXT WORD MUST BE VARIABLE
      EX    DE,HL            ;FLIP/FLOP
      LD    (INDX),HL        ;SAVE VARIABLE NAME
      EX    DE,HL            ;FLIP/FLOP AGAIN
      CP    '='              ;TEST FOR EQUAL SIGN
      JP    NZ,SNERR         ;BRIF NO EQUAL
      INC   HL               ;POINT NEXT
      CALL  EXPR             ;GO EVALUATE EXPR IF ANY
      PUSH  HL               ;SAVE HL
      LD    HL,(INDX)        ;GET INDEX NAME
      EX    DE,HL            ;FLIP/FLOP
      CALL  SEARC            ;GO LOCATE NAME
      EX    DE,HL            ;PUT ADDR IN HL
      LD    (ADDR1),HL       ;SAVE ADDR
      RST   RST6             ;GO STORE THE VALUE
      POP   HL               ;RESTORE POINTER TO STMT
      LD    DE,TOLIT         ;GET LIT ADDR
      RST   RST2             ;GO COMPARE
      JP    NZ,SNERR         ;BRIF ERROR
      CALL  EXPR             ;GO EVALUATE TO-EXPR
      PUSH  HL               ;SAVE HL
      LD    HL,TVAR1         ;POINT SAVE AREA
      RST   RST6             ;SAVE 'TO' EXPR
      LD    HL,ONE           ;POINT CONSTANT: 1
      RST   RST5             ;LOAD IT
      POP   HL               ;RESTORE HL
      LD    A,(HL)           ;GET THAT CHAR
      OR    A                ;TEST FOR END OF STATEMENT
      JP    Z,NOSTP          ;BRIF NO STEP
      LD    DE,STEPL         ;TEST FOR LIT STEP
      RST   RST2             ;GO COMPARE
      JP    NZ,SNERR         ;BRIF NOT STEP
FORST CALL  EXPR             ;GO EVAL STEP
NOSTP LD    HL,TVAR2         ;GET ADDR OF TEMP VARIABLE
      RST   RST6             ;SAVE END VALUE
      CALL  FTEST            ;GET SIGN OF FACC
      PUSH  AF               ;SAVE A, STATUS
      LD    HL,TVAR1         ;GET END VALUE
      RST   RST5             ;LOAD IT
      LD    HL,(ADDR1)       ;GET ADDR OF INDEX
      CALL  FSUB             ;COMPAE TO END VALUE
      POP   AF               ;RESTORE STATUS
      JP    P,FORPO          ;BRIF FOR IS POS
FORXE CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    Z,FORTA          ;BRIF START = END
      JP    M,FORTA          ;BRIF START > END
      JP    LNEXT            ;GO LOCATE MATCHING NEXT
FORPO CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    M,LNEXT          ;BRIF START > END
FORTA LD    DE,FORNE         ;POINT TABLE
      LD    HL,(INDX)        ;GET INDEX NAME
      EX    DE,HL            ;FLIP/FLOP
      LD    A,(HL)           ;GET COUNT
      LD    B,A              ;STORE IT
      LD    C,1              ;NEW CTR
      OR    A                ;TEST IF ZERO
      INC   HL               ;POINT
      JP    Z,FOREQ          ;BRIF TABLE EMPTY
FORLP LD    A,(HL)           ;GET 1ST BYTE
      CP    D                ;TEST IF EQUAL
      JP    NZ,FORNO         ;BRIF NOT
      INC   HL               ;POINT NEXT
      LD    A,(HL)           ;GET NEXT BYTE
      DEC   HL               ;POINT BACK
      CP    E                ;TEST IF EQUAL
      JP    NZ,FOREQ         ;BRIF EQUAL
FORNO RST   RST7             ;GO BUMP HL
      DEFB  12               ;BY 12
      INC   C                ;COUNT IT
      DEC   B                ;DECR CTR
      JP    NZ,FORLP         ;LOOP
FOREQ LD    A,C              ;GET UPDATED COUNT
      CP    9                ;TEST IF TBL EXCEEDED
      JP    NC,FOERR         ;ERROR IF MORE THAN 8 OPEN FOR/NEXT
      LD    (FORNE),A        ;PUT IN TABLE
      LD    (HL),D           ;STORE IT
      INC   HL               ;POINT NEXT
      LD    (HL),E           ;STORE IT TOO
      INC   HL               ;POINT NEXT
      PUSH  HL               ;SAVE HL
      LD    HL,TVAR2         ;POINT STEP
      RST   RST5             ;GO LOAD IT
      POP   HL               ;RESTORE HL
      RST   RST6             ;PUT IN TABLE
      PUSH  HL               ;SAVE HL
      LD    HL,TVAR1         ;POINT TO-VAL
      RST   RST5             ;GO LOAD IT
      POP   HL               ;RESTORE HL
      RST   RST6             ;PUT IN TABLE
      LD    A,(STMT+1)       ;GET HIGH STMT ADDR
      LD    (HL),A           ;PUT IT
      INC   HL               ;POINT NEXT
      LD    A,(STMT)         ;GET LOW STMT ADDR
      LD    (HL),A           ;PUT IT
      JP    RUN              ;CONTINUE
LNEXT LD    HL,(STMT)        ;GET ADDR OF STMT
      LD    E,(HL)           ;GET LENGTH CODE
      LD    D,0              ;INIT INCREMENT
      ADD   HL,DE            ;COMPUTE ADDR OF NEXT STATEMENT
      LD    A,(HL)           ;GET NEW LEN CODE
      OR    A                ;SEE IF END OF PGM
      JP    Z,NXERR          ;BRIF IT IS
      LD    (STMT),HL        ;SAVE ADDRESS
      RST   RST7             ;GO BUMP HL
      DEFB  3                ;BY THREE
      RST   RST1             ;SKIP SPACES
      LD    DE,NEXTL         ;POINT 'NEXT'
      RST   RST2             ;SEE IF IT IS A NEXT STMT
      JP    NZ,LNEXT         ;LOOP IF NOT
      RST   RST1             ;SKIP SPACES
      LD    A,(INDX+1)       ;GET FIRST CHAR
      CP    (HL)             ;COMPARE
      JP    NZ,LNEXT         ;BRIF NOT MATCH NEXT
      LD    A,(INDX)         ;GET 2ND CHAR
      INC   HL               ;DITTO
      CP    ' '              ;SEE IF SINGLE CHAR
      JP    Z,FORN1          ;BRIF IT IS
      CP    (HL)             ;COMPARE THE TWO
      JP    NZ,LNEXT         ;BRIF NOT EQUAL
FORN1 RST   RST1             ;SKIP TO END (HOPEFULLY)
      OR    A                ;SEE IF END
      JP    NZ,LNEXT         ;BRIF NOT END
      JP    RUN              ;ELSE, GO NEXT STMT
*HEADING IMSAI 8080 4K BASIC
IF    EQU   $
;
;
; STMT:  IF EXPR RELATION EXPR THEN STMT #
;
;
      CALL  EXPR             ;GO EVALUATE LEFT EXPRESSION
      PUSH  HL               ;SAVE HL
      LD    HL,TVAR1         ;GET ADDR OF TEMP STORAGE
      RST   RST6             ;SAVE IT
      POP   HL               ;RESTORE HL
      XOR   A                ;CLEAR A
      LD    C,A              ;SAVE IN REG C
      LD    B,A              ;INIT REG
IFREL LD    A,(HL)           ;GET OPERATOR
      INC   B                ;COUNT
      CP    '='              ;TEST FOR EQUAL
      JP    NZ,IFEQ          ;BRIF IT IS
      INC   C                ;ADD 1 TO C
      INC   HL               ;POINT NEXT
IFEQ  CP    '>'              ;TEST FOR GREATER THAN
      JP    NZ,IFGT          ;BRIF IT IS
      INC   C                ;ADD TWO
      INC   C                ;TO REL CODE
      INC   HL               ;POINT NEXT
IFGT  CP    '<'              ;TEST FOR LESS THAN
      JP    NZ,IFLT          ;BRIF IT IS
      LD    A,C              ;GET REL CODE
      ADD   A,4              ;PLUS FOUR
      LD    C,A              ;PUT BACK
      INC   HL               ;POINT NEXT
IFLT  LD    A,C              ;GET REL CODE
      OR    A                ;TEST IT
      JP    Z,SNERR          ;BRIF SOME ERROR
      LD    (REL),A          ;SAVE CODE
      LD    A,B              ;GET COUNT
      CP    2                ;TEST FOR TWO
      JP    NZ,IFREL         ;SEE IF MULTIPLE RELATION
      CALL  EXPR             ;GO EVALUATE RIGHT SIDE
      PUSH  HL               ;SAVE STMT LOCATION
      LD    HL,TVAR1         ;POINT LEFT
      CALL  FSUB             ;SUBTRACT LEFT FROM RIGHT
      POP   HL               ;RESTORE STMT ADDR
      LD    A,(REL)          ;GET RELATION
      RRA                    ;TEST BIT D0
      JP    NC,IFNOT         ;BRIF NO EQUAL TEST
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    Z,TRUE           ;BRIF LEFT=RIGHT
IFNOT LD    A,(REL)          ;LOAD RELATION
      AND   02H              ;MASK IT
      JP    Z,IFNTX          ;BRIF NO >
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    M,TRUE           ;BRIF GT
IFNTX LD    A,(REL)          ;LOAD RELATION
      AND   04H              ;MASK IT
      JP    Z,RUN            ;BRIF NO <
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    M,RUN            ;BRIF GT
      JP    Z,RUN            ;BRIF EQUAL
TRUE  LD    DE,THENL         ;GET ADDR 'THEN'
      RST   RST2             ;GO COMPARE
      JP    NZ,SNERR         ;BRIF ERROR
      JP    GOTO             ;BRIF IT IS
*HEADING IMSAI 8080 4K BASIC
LET   EQU   $
;
;
; STMT:  :LET: VAR = EXPR
;
;
      CALL  VAR              ;NEXT MUST BE VARIABLE NAME
      CP    '='              ;TEST FOR EQUAL SIGN
      JP    NZ,SNERR         ;BRIF MISSING EQUAL
      CALL  SEARC            ;GO FIND ADDRESS OF VAR
      PUSH  DE               ;SAVE ADDRESS
      INC   HL               ;POINT NEXT
      CALL  EXPR             ;GO EVALUATE EXPRESSION
      POP   HL               ;RESTORE ADDRESS
      RST   RST6             ;GO STORE VARIABLE
      JP    RUN              ;CONTINUE
*HEADING IMSAI 8080 4K BASIC
NEXT  EQU   $
;
;
; STMT:  NEXT VAR
;
;
      CALL  VAR              ;GET VARIABLE NAME
      EX    DE,HL            ;FLIP/FLOP
      LD    (INDX),HL        ;SAVE VAR NAME
      PUSH  HL               ;SAVE VAR NAME
      LD    HL,FORNE         ;POINT FOR/NEXT TABLE
      LD    B,(HL)           ;GET SIZE
      LD    A,B              ;LOAD IT
      OR    A                ;TEST IT
      JP    Z,NXERR          ;BRIF TABLE EMPTY
      INC   HL               ;POINT NEXT
      POP   DE               ;RESTORE VAR NAME
NXLP  LD    A,(HL)           ;GET 1ST BYTE
      INC   HL               ;POINT NEXT
      CP    D                ;COMPARE
      JP    NZ,NXNE          ;BRIF NOT EQUAL
      LD    A,(HL)           ;GET 2ND BYTE
      CP    E                ;COMPARE
      JP    Z,NXEQ           ;BRIF EQUAL
NXNE  RST   RST7             ;GO BUMP HL
      DEFB  11               ;BY ELEVEN
      DEC   B                ;DECR COUNT
      JP    NZ,NXLP          ;LOOP
      JP    NXERR            ;GO PUT ERROR MSG
NXEQ  LD    A,(FORNE)        ;GET ORIG COUNT
      SUB   B                ;MINUS REMAIN
      INC   A                ;PLUS ONE
      LD    (FORNE),A        ;STORE NEW COUNT
      INC   HL               ;POINT STEP
      PUSH  HL               ;SAVE HL ADDR
      CALL  SEARC            ;GO GET ADDR OF INDEX
      EX    DE,HL            ;PUT TO HL
      LD    (ADDR1),HL       ;SAVR IT
      RST   RST5             ;LOAD INDEX
      POP   HL               ;GET HL (TBL)
      PUSH  HL               ;RESAVE
      CALL  FADD             ;ADD STEP VALUE
      LD    HL,TVAR1         ;POINT NEW INDEX
      RST   RST6             ;STORE IT
      POP   HL               ;GET HL (TBL)
      PUSH  HL               ;RESAVE
      RST   RST7             ;GO BUMP HL
      DEFB  4                ;BY FOUR
      CALL  FSUB             ;SUBTRACT TO VALUE
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    Z,NXTZR          ;BRIF ZERO
      POP   HL               ;GET HL (PTR TO STEP)
      PUSH  HL               ;RE-SAVE
      LD    A,(HL)           ;GET SIGN & EXPONENT OF STEP
      OR    A                ;TEST IT
      LD    A,(FACC)         ;GET SIGN & EXPONENT OF DIFFERENCE
      JP    M,NXTNE          ;BRIF NEGATIVE
NXTPO OR    A                ;TEST IT
      JP    M,NXTZR          ;BRIF LESS THAN TO-EXPR
      JP    NEXTZ            ;GO PAST NEXT
NXTNE OR    A                ;TEST IT
      JP    M,NEXTZ          ;BRIF END OF LOOP
NXTZR POP   HL               ;POP THE STACK
      RST   RST7             ;GO BUMP HL
      DEFB  8                ;BY EIGHT
      LD    D,(HL)           ;GET HI BYTE
      INC   HL               ;POINT NEXT
      LD    E,(HL)           ;GET LOW BYTE
      EX    DE,HL            ;PUT TO HL
      LD    (STMT),HL        ;SAVE ADDR OF FOR
      LD    DE,TVAR1         ;POINT UPDATED INDEX VALUE
      LD    HL,(ADDR1)       ;GET ADDR
      LD    B,4              ;LENGTH
      CALL  COPYD            ;GO MOVE TO I
      JP    RUN              ;CONTINUE STMT AFTER FOR
NEXTZ EQU   $
      LD    HL,FORNE         ;GET ADDR TABLE
      DEC   (HL)             ;SUBTRACT ONE FROM COUNT
      JP    RUN              ;GO STMT AFTER NEXT
*HEADING IMSAI 8080 4K BASIC
INPUT EQU   $
;
;
; STMT:  INPUT VAR :, VAR, VAR:
;
;
      LD    DE,IOBUF         ;GET ADDR OF BUFFER
      EX    DE,HL            ;FLIP/FLOP
      LD    (ADDR1),HL       ;SAVE ADDR
      LD    (HL),0           ;MARK BUFFER EMPTY
      EX    DE,HL            ;FLIP/BACK
IN1   CALL  VAR              ;GO GET VAR NAME
      CALL  SEARC            ;GO ;LOOK UP ADDRESS
      PUSH  HL               ;SAVE HL ADDR
      PUSH  DE               ;SAVE VAR ADDRE
      LD    HL,(ADDR1)       ;GET ADDR PREV BUFFER
      LD    A,(HL)           ;LOAD CHAR
      CP    ','              ;TEST IF COMMA
      INC   HL               ;POINT NEXT
      JP    Z,IN2            ;BRIF CONTINUE FROM PREV
      OR    A                ;TEST IF END OF LINE
      JP    NZ,SNERR         ;BRIF ERROR
      LD    A,'?'            ;PROMPT CHAR
      CALL  TERMI            ;GO READ FROM TTY
IN2   CALL  FIN              ;GO CONVERT TO FLOATING
      LD    (ADDR1),HL       ;SAVE ADDRESS
      POP   HL               ;GET VAR ADDRESS
      RST   RST6             ;GO STORE THE NUMBER
      POP   HL               ;RESTORE STMT POINTER
      RST   RST1             ;SKIP SPACES
      CP    ','              ;TEST FOR COMMA
      INC   HL               ;POINT NEXT
      JP    Z,IN1            ;RECURSIVE IF COMMA
      DEC   HL               ;POINT BACK
      JP    RUN              ;GO NEXT STMT
*HEADING IMSAI 8080 4K BASIC
READ  EQU   $
;
; STMT:  READ VAR :,VAR ...:
;
      CALL  VAR              ;GO GET VAR NAME
      CALL  SEARC            ;GO GET ADDRESS
      PUSH  HL               ;SAVE HL
      PUSH  DE               ;SAVE DE
      LD    HL,(DATAP)       ;GET DATA STMT POINTER
      LD    A,(HL)           ;LOAD THE CHAR
      OR    A                ;TEST IF END OF STMT
      JP    NZ,NOTDT         ;BRIF NOT END OF STMT
      INC   HL               ;POINT START NEXT STMT
DATAN LD    A,(HL)           ;LOAD LEN
      LD    (DATAP),HL       ;SAVE ADDR
      OR    A                ;TEST IF END OF PGM
      JP    Z,DAERR          ;BRIF OUT OF DATA
      INC   HL               ;POINT NEXT
      LD    (DASTM),HL       ;SAVE ADDR OF LINE NUMBER
      INC   HL               ;SKIP LINE NUMBER
      INC   HL               ;POINT 1ST DATA BYTE
      RST   RST1             ;SKIP BLANKS
      LD    DE,DATAL         ;POINT 'DATA'
      RST   RST2             ;COMPARE
      JP    Z,NOTDT          ;BRIF IT IS DATA STMT
      LD    HL,(DATAP)       ;GET ADDR START
      LD    E,(HL)           ;GET LEN CODE
      LD    D,0              ;CLEAR D
      ADD   HL,DE            ;POINT NEXT STMT
      JP    DATAN            ;LOOP NEXT STMT
NOTDT CALL  FIN              ;GO CONVERT VALUE
      LD    A,(HL)           ;GET CHAR WHICH STOPPED US
      CP    ','              ;TEST IF COMMA
      JP    NZ,NOTCO         ;BRIF NOT
      INC   HL               ;POINT NEXT
DATOK LD    (DATAP),HL       ;SAVE ADDRESS
      POP   HL               ;RESTORE ADDR OF VAR
      RST   RST6             ;STORE THE VALUE
      POP   HL               ;RESTORE POINTER TO STM
      LD    A,(HL)           ;LOAD THE CHAR
      CP    ','              ;TEST IF COMMA
      INC   HL               ;POINT NEXT
      JP    Z,READ           ;RECURSIVE IF IT IS
      DEC   HL               ;RESET
      JP    RUN              ;CONTINUE
NOTCO OR    A                ;TEST IF END OF STMT
      JP    Z,DATOK          ;BRIF OK
      LD    HL,(DASTM)       ;GET DATA STMT LINE NUMBER
      LD    (LINE),HL        ;SAVE IN LINE NUMBER
      JP    SNERR            ;GO PROCESS ERROR
;
*HEADING IMSAI 8080 4K BASIC
FIN   EQU   $
;
;FLOATING POINT INPUT CONVERSION ROUTINE
;
;THIS SUBROUTINE CONVERTS AN ASCII STRING OF CHARACTERS TO
;POINT ACCUMULATOR.  THE INPUT FIELD MAY CONTAIN ANY VALID
;INCLUDING SCIENTIFIC (NNN.NNNNE+NN)
;THE INPUT STRING IS TERMINATED BY ANY NON-NUMERIC CHARACT
;
;
      EX    DE,HL            ;FLIP/FLOP DE HL
      LD    HL,FACC          ;POINT TO FACC
      LD    B,4              ;LOOP CTR
      CALL  ZEROM            ;GO CLEAR THE FACC
      RST   RST7             ;GO BUMP HL
      DEFB  -4               ;BY NEG FOUR
      LD    C,B              ;INIT DIGIT COUNTER
      LD    A,(DE)           ;GET FIRST BYTE
      CP    '+'              ;TEST FOR PLUS SIGN
      JP    Z,FIN2           ;BRIF IS
      CP    '-'              ;TEST FOR MINUS SIGN
      JP    NZ,FIN3          ;BRIF NOT
      LD    (HL),80H         ;SET MINUS MANTISSA
FIN2  INC   DE               ;POINT NEXT DIGIT
      LD    A,(DE)           ;GET THE BYTE
FIN3  CP    '0'              ;TEST FOR LEADING ZERO
      JP    Z,FIN2           ;BRIF IT IS
FIN4  CP    '9'+1            ;TEST FOR NINE
      JP    NC,FIN14         ;BRIF NOT NUMERIC
      CP    '0'              ;TEST FOR ZERO
      JP    C,FIN5           ;BRIF NOT NUMERIC
      INC   B                ;COUNT EXPONENT
      CALL  FIN9             ;STORE THE DIGIT
      INC   DE               ;POINT NEXT
      LD    A,(DE)           ;GET THE DIGIT
      JP    FIN4             ;LOOP
FIN5  CP    '.'              ;TEST FOR DOT
      JP    NZ,FIN19         ;BRIF NOT
      LD    A,C              ;GET DIGIT COUNT
      OR    A                ;TEST FOR ZERO
      JP    NZ,FIN7          ;BRIF NOT
FIN6  INC   DE               ;POINT NEXT
      LD    A,(DE)           ;GET DIGIT
      CP    '0'              ;TEST FOR ZERO
      JP    NZ,FIN8          ;BRIF NOT
      DEC   B                ;COUNT IT
      JP    FIN6             ;LOOP
FIN7  INC   DE               ;POINT NEXT
      LD    A,(DE)           ;GET THE DIGIT
FIN8  CP    '0'              ;TEST FOR ZERO
      JP    C,FIN19          ;BRIF LOWER
      CP    '9'+1            ;TEST FOR NINE
      JP    NC,FIN14         ;BRIF HIGH
      CALL  FIN9             ;GO STORE DIGIT
      JP    FIN7             ;LOOP
FIN9  LD    A,C              ;GET DIGIT COUNT
      CP    6                ;TEST FOR MAX
      RET   Z                ;RETURN IF EQUAL
      INC   A                ;ADD ONE
      LD    C,A              ;REPLACE PREV COUNT
      INC   A                ;PLUS ONE
      RRA                    ;DIVIDE BY TWO
      AND   0FH              ;MASK OFF UNUSED BITS
      ADD   A,L              ;PLUS LOW BYTE OF H
      LD    L,A              ;REPLACE LOW BYTE OF HL
      LD    A,C              ;RE-LOAD DIGIT COUNT
      RRA                    ;TEST EVEN/ODD
      LD    A,(DE)           ;GET THE DIGIT
      JP    C,FIN12          ;BRIF ODD DIGIT
      AND   0FH              ;LOW 4 BITS ONLY
      OR    (HL)             ;GET HIGH 4 BITS
      JP    FIN13            ;GO RETURN
FIN12 RST   RST4             ;SHIFT LEFT
FIN13 LD    (HL),A           ;REPLACE
      LD    HL,FACC          ;POINT TO FACC
      RET                    ;RETURN
FIN14 CP    'E'              ;TEST FOR EXPLICIT EXPONENT
      JP    NZ,FIN19         ;BRIF NOT EQUAL
      INC   DE               ;POINT NEXT
      LD    A,(DE)           ;GET DIGIT
      LD    C,0              ;CLEAR COUNTER
      CP    '+'              ;TEST FOR PLUS
      JP    Z,FIN17          ;BRIF EQUAL
      CP    '-'              ;TEST FOR MINUS
      JP    NZ,FIN16         ;BRIF NOT EQUAL
      CALL  FIN15            ;GET NUMERIC EXPONENT
      LD    A,C              ;LOAD THE NUMBER
      CPL                    ;COMPLEMENT
      INC   A                ;PLUS ONE (TWOS COMPLEMENT)
      JP    FIN18            ;CONTINUE
FIN15 INC   DE               ;POINT NEXT
      LD    A,(DE)           ;GET DIGIT
      CP    '0'              ;TEST ZERO
      RET   C                ;RETURN IF ERROR
      CP    '9'+1            ;TEST NINE
      RET   NC               ;RETURN IF NOT NUMERIC
      LD    A,C              ;GET PRIOR
      ADD   A,A              ;TIMES TWO
      LD    C,A              ;SAVE
      ADD   A,A              ;TIMES FOUR
      ADD   A,A              ;TIMES EIGHT
      ADD   A,C              ;TIMES TEN
      LD    C,A              ;SAVE
      LD    A,(DE)           ;GET THIS DIGIT
      AND   0FH              ;MASK OFF HIGH FOUR BITS
      ADD   A,C              ;PLUS PREV*10
      LD    C,A              ;SAVE
      JP    FIN15            ;LOOP
FIN16 DEC   DE               ;POINT PRIOR TEMP
FIN17 CALL  FIN15            ;GO GET NUMERIC EXPONENT
      LD    A,C              ;LOAD THE EXPONENT
FIN18 ADD   A,B              ;PLUS COMPUTED EXPONENT
      LD    B,A              ;SAVE IT
      LD    A,(DE)           ;GET LAST CHAR
FIN19 INC   HL               ;POINT 1ST DIGIT
      LD    A,(HL)           ;LOAD
      OR    A                ;TEST IF ZERO
      JP    Z,FIN20          ;BRIF ZERO
      DEC   HL               ;POINT EXPONENT
      DEC   B                ;SUB ONE FROM EXPONENT
      LD    A,B              ;GET EXPONENT
      AND   7FH              ;TURN OFF HIGH BIT
      OR    (HL)             ;OR IN MANTISSA SIGN
      LD    (HL),A           ;STORE IN FACC
      XOR   A                ;TURN CY OFF, CLEAR ACC
FIN20 EX    DE,HL            ;FLIP/FLOP
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
FOUT  EQU   $
;
;FLOATING POINT OUTPUT FORMAT ROUTINE
;
;THIS SUBROUTINE CONVERTS A NUMBER IN THE FLOATING POINT AC
;TO A FORMAT SUITABLE FOR PRINTING. THAT IS, THE NUMBER WIL
;SCIENTIFIC NOTATION (+N.NNNNNE+NN) IF THE EXPONENT IS > 5
;OTHERWISE IT WILL BE ZERO SUPPRESSED BOTH ON THE LEFT OF T
;PORTION AND ON THE RIGHT OF THE FRACTION.
;
      LD    DE,FACC          ;POINT TO FLOATING POINT ACCUMULATOR
      LD    A,(DE)           ;GET EXPONENT BYTE
      LD    C,A              ;SAVE IT
      RLA                    ;SHIFT (TEST MANTISSA SIGN)
      LD    (HL),' '         ;DEFAULT POSITIVE
      JP    NC,FOUT1         ;BRIF POSITIVE
      LD    (HL),'-'         ;MOVE DASH
FOUT1 INC   DE               ;POINT TO FIRST & SECOND DIGITS
      INC   HL               ;AND NEXT OUTPUT POSITION
      LD    A,(DE)           ;PUT TO ACC
      CALL  RIGHT            ;SHIFT RIGHT
      OR    '0'              ;DECIMAL ZONE
      LD    (HL),A           ;PUT OUT
      INC   HL               ;POINT NEXT OUT
      LD    (HL),'.'         ;MOVE DECIMAL POINT
      LD    B,3              ;INIT LOOP COUNTER
      JP    FOUT3            ;JUMP INTO MIDDLE OF LOOP
FOUT2 INC   HL               ;POINT NEXT OUT
      INC   DE               ;NEXT 2 DIGITS
      LD    A,(DE)           ;GET HIGH & LOW
      CALL  RIGHT            ;SHIFT RIGHT
      OR    '0'              ;DECIMAL ZONE
      LD    (HL),A           ;PUT TO OUTPUT
FOUT3 INC   HL               ;POINT NEXT OUTPUT
      LD    A,(DE)           ;GET DIGITS AGAIN
      AND   0FH              ;MASK OFF HIGH
      OR    '0'              ;DECIMAL ZONE
      LD    (HL),A           ;PUT TO OUTPUT
      DEC   B                ;TEST LOOP COUNTER
      JP    NZ,FOUT2         ;BRIF MORE
      INC   HL               ;POINT NEXT OUTPUT
      LD    (HL),'E'         ;MOVE LIT E
      INC   HL               ;POINT NEXT
      LD    A,C              ;GET EXPONENT BYTE
      AND   3FH              ;MASK OFF SIGNS
      LD    B,A              ;SAVE IN B
      LD    A,C              ;GET EXPONENT BYTE
      RLA                    ;IGNORE MANTISSA SIGN
      RLA                    ;TEST EXPONENT SIGN
      LD    (HL),'+'         ;DEFAULT POSITIVE
      JP    NC,FOUT4         ;BRIF POSITIVE
      LD    (HL),'-'         ;ELSE MOVE DASH
      LD    A,C              ;RELOAD EXPONENT BYTE
      OR    0C0H             ;SET ALL ON
      CPL                    ;COMPLEMENT ACC
      INC   A                ;PLUS 1 (TWOS COMPLEMENT)
      LD    B,A              ;SAVE IN B
FOUT4 INC   HL               ;POINT NEXT OUT
      LD    A,B              ;GET EXPONENT
      LD    B,2FH            ;INIT COUNTER
FOUT5 SUB   10               ;SUBTRACT 10
      INC   B                ;COUNT 1
      JP    NC,FOUT5         ;BRIF NOT NEG
      LD    (HL),B           ;POINT TO OUTPUT
      INC   HL               ;POINT NEXT
      ADD   A,58             ;ADJUST
      LD    (HL),A           ;MOVE 2ND DIGIT
      LD    A,C              ;GET EXPONENT
      RLA                    ;SHIFT OFF MANTISSA SIGN
      OR    A                ;TEST
      JP    P,FOUT6          ;BRIF POSITIVE
      SCF                    ;SET CY
      RRA                    ;SHIFT BACK
      CP    -2               ;TEST FOR MIN
      RET   C                ;RETURN IF LESS THAN -2
      JP    FOUT7            ;GO AROUND
FOUT6 RRA                    ;SHIFT BACK
      CP    6                ;TEST IF TOO BIG
      RET   NC               ;RETURN IF 6 OR GREATER
FOUT7 LD    C,A              ;SAVE EXPONENT
      LD    B,4              ;CTR
FOUT8 LD    (HL),' '         ;SPACE OUT EXPONENT
      DEC   HL               ;POINT PRIOR
      DEC   B                ;DECR CTR
      JP    NZ,FOUT8         ;LOOP
      EX    DE,HL            ;FLIP/FLOP
      LD    A,E              ;GET LOW BYTE
      SUB   5                ;POINT TO DOT
      LD    L,A              ;PUT DOWN
      LD    A,D              ;GET HIGH
      SBC   A,0              ;IN CASE OF BORROW
      LD    H,A              ;PUT DOWN
      LD    A,C              ;GET EXPONENT
      OR    A                ;TEST SIGN
      JP    Z,FOX1           ;BRIF ZERO
      JP    M,FOX2           ;BRIF NEGATIVE
FOUT9 LD    B,(HL)           ;GET HIGH BYTE
      INC   HL               ;POINT NEXT
      LD    A,(HL)           ;GET LOW BYTE
      LD    (HL),B           ;SHIFT DOT TO RIGHT
      DEC   HL               ;POINT BACK
      LD    (HL),A           ;MOVE THE DIGIT LEFT
      INC   HL               ;POINT NEXT
      DEC   C                ;DECR CTR
      JP    NZ,FOUT9         ;LOOP
FOX1  EX    DE,HL            ;POINT END
FOX3  LD    A,(HL)           ;GET A DIGIT/DOT
      CP    '0'              ;TEST FOR A TRAILING ZERO
      JP    NZ,FOX4          ;BRIF NOT
      LD    (HL),' '         ;SPACE FILL
      DEC   HL               ;POINT PRIOR
      JP    FOX3             ;LOOP
FOX4  CP    '.'              ;TEST FOR TRAILING DOT
      RET   NZ               ;RETURN IF NOT
      LD    (HL),' '         ;SPACE IT OUT
      DEC   HL               ;POINT PRIOR
      RET                    ;RETURN
FOX2  CP    0FFH             ;TEST IF -1
      JP    NZ,FOX5          ;ELSE -2
      DEC   HL               ;POINT SIGNIFICANT
      LD    A,(HL)           ;GET THE CHAR
      LD    (HL),'.'         ;MOVE THE DOT
      INC   HL               ;POINT NEXT
      LD    (HL),A           ;SHIFT THE DIGIT
      JP    FOX1             ;GO ZERO SUPPRESS
FOX5  DEC   HL               ;POINT ONE TO LEFT
      LD    A,(HL)           ;PICK UP DIGIT
      LD    (HL),'0'         ;REPLACE
      INC   HL               ;POINT RIGHT
      LD    (HL),A           ;PUT THE DIGIT
      LD    H,D              ;GET LOW ADDR
      LD    L,E              ;POINT LAST DIGIT
      LD    B,6              ;CTR
FOX6  DEC   HL               ;POINT PRIOR
      LD    A,(HL)           ;GET A DIGIT
      INC   HL               ;POINT
      LD    (HL),A           ;PUT IT ONE TO RIGHT
      DEC   HL               ;POINT
      DEC   B                ;DECR CTR
      JP    NZ,FOX6          ;LOOP
      LD    (HL),'.'         ;MOVE THE DOT
      JP    FOX1             ;CONTINUE
*HEADING IMSAI 8080 4K BASIC
FADD  EQU   $
;
;
;FLOATING POINT ADD THE NUMBER AT (HL) TO THE FACC
;
;
      INC   HL               ;POINT FIRST DIGIT
      LD    A,(HL)           ;LOAD IT
      OR    A                ;TEST IT
      RET   Z                ;RETURN IF ZERO
      DEC   HL               ;POINT BACK
      CALL  FTEST            ;GO TEST SIGN OF FACC
      JP    Z,RST5           ;JUST LOAD IF FACC = 0
      LD    DE,FACC          ;POINT FACC
      LD    A,(DE)           ;GET EXPONENT OF FACC
      CALL  FEXP             ;GO GET EXPONENT
      LD    B,A              ;SAVE EXPONENT
      LD    A,(HL)           ;GET EXPONENT OF ADDR
      CALL  FEXP             ;GO GET EXPONENT
      LD    C,A              ;SAVE THE EXPONENT
      SUB   B                ;GET DIFFERENCE OF TWO EXPONENTS
      JP    Z,FADD4          ;BRIF THEY'RE EQUAL
      JP    P,FADD3          ;BRIF DIFFERENCE IS POSITIVE
      CPL                    ;COMPLEMENT ACC
      INC   A                ;PLUS ONE (TWO'S COMPLEMENT)
FADD3 CP    6                ;COMPARE DIFFERENCE TO SIX
      JP    C,FADD4          ;BRIF 5 OR LESS
      LD    A,B              ;GET EXPON OF ADDUEND
      SUB   C                ;GET TRUE DIFFERENCE AGAIN
      RET   P                ;RETURN IF FACC > ADDER
      JP    RST5             ;ELSE, ADDER > FACC
FADD4 PUSH  AF               ;SAVE DIFFERENCE
      PUSH  BC               ;SAVE EXPONENTS
      LD    DE,FTEMP         ;GET ADDR OF TEMP ACC
      LD    B,4              ;FOUR BYTES
      CALL  COPYH            ;GO COPY
      POP   BC               ;GET EXPONENTS
      POP   AF               ;GET DIFFERENCE
      JP    Z,FADD9          ;JUST ADD IF ZERO
      LD    HL,FTEMP+1       ;DEFAULT
      PUSH  AF               ;SAVE DIFFERENCE
      LD    A,B              ;GET FACC EXPON
      SUB   C                ;MINUS FTEMP EXPON
      JP    P,FADD6          ;BRIF TEMP MUST BE SHIFTED
      LD    HL,FACC          ;POINT FLOAT ACC
      LD    A,C              ;GET EXPONENT, SIGN
      AND   7FH              ;STRIP EXP SIGN
      LD    C,A              ;PUT BACK
      LD    A,(HL)           ;GET THE EXP
      AND   80H              ;STRIP OFF OLD EXPON
      OR    C                ;MOVE ADDER EXPON TO IT
      LD    (HL),A           ;REPLACE
      INC   HL               ;POINT FIRST DATA BYTE
FADD6 POP   AF               ;GET DIFFER
      LD    C,A              ;SAVE IT
FADD7 LD    B,3              ;LOOP CTR (INNER)
      LD    D,0              ;INIT CARRY OVER TO ZERO
      PUSH  HL               ;SAVE ADDR
      CALL  FSHFT            ;GO SHIFT
      POP   HL               ;GET ADDR
      DEC   C                ;DECR CTR
      JP    NZ,FADD7         ;LOOP
FADD9 EQU   $
      LD    DE,FACC          ;POINT SIGN OF ADDUEND
      LD    HL,FTEMP         ;AND SIGN OF ADDER
      LD    A,(DE)           ;GET SIGN OF ADDUEND
      XOR   (HL)             ;COMPARE THE TWO SIGNS
      JP    M,FADD1          ;BRIF SIGNS DIFFER
      LD    DE,FACC+3        ;POINT LOW END
      LD    HL,FTEMP+3       ;DITTO
      LD    B,3              ;THREE BYTES
      CALL  FADDT            ;GO ADD TWO TOGETHER
      RET   NC               ;RETURN IF NO CARRY
FADX1 LD    HL,FACC          ;GET ADDR OF ACC
      LD    A,(HL)           ;LOAD THE EXPON
      AND   80H              ;ISOLATE SIGN
      LD    B,A              ;SAVE SIGN
      LD    A,(HL)           ;GET EXPON
      CALL  FEXP             ;GO GET EXPONENT
      INC   A                ;ADD ONE
      AND   7FH              ;ISOLATE
      OR    B                ;PUT BACK SIGN
      LD    (HL),A           ;PUT IT DOWN
      INC   HL               ;POINT DATA
      LD    D,10H            ;(THE CARRY)
      LD    B,3              ;CTR
      CALL  FSHFT            ;GO SHIFT IT
      RET                    ;RETURN
FADD1 EQU   $
      LD    HL,FTEMP+4       ;POINT TEMP2 AREA
      LD    B,4              ;PREPARE TO SAVE ACC
      CALL  COPYD            ;GO COPY
FADX2 LD    DE,FACC+3        ;POINT LOW ACC
      LD    HL,FTEMP+3          ;AND LOW TEMP
      LD    B,3              ;CTR
      CALL  FSUBT            ;GO SUBTRACT THE TWO
      JP    NC,FNORM         ;BRIF NO BORROW
      LD    DE,FACC          ;POINT ACC
      LD    HL,FTEMP         ;POINT TEMP
      LD    B,8              ;CTR
      CALL  COPYH            ;GO COPY
      LD    DE,FACC          ;POINT
      LD    HL,FTEMP         ;TEMP
      LD    A,(HL)           ;GET ORIG ACC EXPONENT
      XOR   80H              ;REVERSE SIGN
      LD    (DE),A           ;PUT TO NEW ACC
      JP    FADX2            ;GO SUBTRACT AGAIN
*HEADING IMSAI 8080 4K BASIC
FNORM EQU   $
;
;
;NORMALIZE THE FLOATING ACCUMULATOR
;THAT IS, THE FIRST DIGIT MUST BE SIGNIFICANT
;
;
      LD    HL,FACC+1        ;POINT TO FIRST BYTE
      LD    A,(HL)           ;LOAD IT
      AND   0F0H             ;ISOLATE
      RET   NZ               ;RETURN IF ALREADY NORMALIZED
      LD    A,(HL)           ;GET THE BYTE
      INC   HL               ;POINT NEXT
      OR    (HL)             ;OR THE NEXT BYTE
      INC   HL               ;POINT LAST
      OR    (HL)             ;OR THAT BYTE (ACC HAS LOGICAL S
      JP    NZ,FNOR1         ;BRIF NOT ZERO
      LD    HL,FACC          ;ELSE POINT FLOAT ACC
      LD    (HL),0           ;CLEAR THE EXPONENT
      RET                    ;RETURN
FNOR1 LD    HL,FACC+3        ;POINT LST BYTE
      LD    B,3              ;3 BYTE LOOP
      LD    D,0              ;INIT CARRY OVER
FNOR2 LD    A,(HL)           ;GET A BYTE
      LD    C,A              ;SAVE IT
      RST   RST4             ;SHIFT LEFT 4 BITS
      OR    D                ;PLUS PREV SHIFT OUT
      LD    (HL),A           ;PUT BACK
      LD    A,C              ;GET SAVED BYTE
      CALL  RIGHT            ;SHIFT RIGHT 4 BITS
      LD    D,A              ;SAVE FOR NEXT TIME
      DEC   HL               ;POINT NEXT BYTE
      DEC   B                ;DECR CTR
      JP    NZ,FNOR2         ;LOOP
      LD    A,(HL)           ;GET EXPONENT
      AND   80H              ;ISOLATE SIGN
      LD    B,A              ;SAVE
      LD    A,(HL)           ;GET AGAIN
      CALL  FEXP             ;GO GET EXPONENT
      DEC   A                ;MINUS ONE
      AND   7FH              ;TURN OFF HIGH BIT
      OR    B                ;PLUS SAVED SIGN
      LD    (HL),A           ;PUT BACK
      JP    FNORM            ;GO NORMALIZE
*HEADING IMSAI 8080 4K BASIC
FSUB  EQU   $
;
;
;FLOATING POINT SUBTRACT THE NUMBER AT (HL) FROM THE FACC
;
;
      INC   HL               ;POINT FIRST DATA BYTE OF SUBTRA
      LD    A,(HL)           ;LOAD IT
      OR    A                ;TEST
      RET   Z                ;RETURN IF ZERO
      DEC   HL               ;POINT BACK
      LD    DE,FTEMP         ;GET TEMPORARY STORAGE AREA
      LD    B,4              ;FOUR BYTES
      CALL  COPYH            ;GO COPY
      LD    HL,FTEMP         ;POINT NEW AREA
      LD    A,(HL)           ;GET EXPONENT
      XOR   80H              ;REVERSE SIGN
      LD    (HL),A           ;REPLACE
      JP    FADD             ;GO ADD THE TWO
*HEADING IMSAI 8080 4K BASIC
FMUL  EQU   $
;
;
;FLOATING POINT MULTIPLY THE NUMBER AT (HL) TO THE FACC
;
;
      CALL  FTEST            ;TEST FACC
      RET   Z                ;RETURN IF ZERO
      INC   HL               ;POINT 1ST DIGIT OF MULTIPLIER
      LD    A,(HL)           ;LOAD IT
      DEC   HL               ;RESTORE
      OR    A                ;TEST IF ZERO
      JP    Z,RST5           ;GO LOAD TO FACC IF IT IS
      LD    DE,FACC          ;POINT EXP OF FACC
      LD    A,(DE)           ;LOAD EXPONENT
      OR    A                ;TEST IF 10 TO 0
      JP    NZ,FMUL1         ;BRIF NOT
      INC   DE               ;POINT NEXT
      LD    A,(DE)           ;LOAD IT
      CP    10H              ;TEST IF 1
      JP    NZ,FMUL1         ;BRIF NOT
      INC   DE               ;POINT NEXT
      LD    A,(DE)           ;LOAD IT
      OR    A                ;TEST IF ZERO
      JP    NZ,FMUL1         ;BRIF NOT
      INC   DE               ;POINT NEXT
      LD    A,(DE)           ;LOAD IT
      OR    A                ;TEST IF ZERO
      JP    Z,RST5           ;GO LOAD IF FACC = 1.00000
FMUL1 LD    DE,FACC          ;POINT EXPONENT
      LD    A,(DE)           ;LOAD IT
      CALL  FEXP             ;GO GET EXPONENT
      LD    B,A              ;SAVE IN B
      LD    A,(HL)           ;GET EXPONENT OF MULTIPLIER
      CALL  FEXP             ;GO GET EXPONENT
      SCF                    ;TURN ON CY
      ADC   A,B              ;ADD EXPONENTS TOGETHER
      CALL  FOVUN            ;GO SEE IF OVERFLOW/UNDERFLOW
      AND   7FH              ;TURN OFF SIGN
      LD    B,A              ;SAVE
      LD    A,(DE)           ;GET SIGN OF FACC
      XOR   (HL)             ;PRODUCT SIGN IS NEG IF TWO SIGN
      AND   80H              ;MASK
      OR    B                ;PUT SIGN AND EXPONENT TOGETHER
      LD    (DE),A           ;PUT IN FACC
      PUSH  HL               ;SAVE HL
      LD    HL,FTEMP         ;POINT DIGIT 7 OF RESULT
      LD    B,6              ;LOOP CTR
      CALL  ZEROM            ;GO ZERO 6 BYTES
      LD    DE,FACC+1        ;POINT 1ST DIGIT OF ACC
      LD    B,3              ;LOOP CTR
FMUL5 LD    A,(DE)           ;GET AN ACC DIGIT PAIR
      LD    (HL),A           ;PUT TO TEMP STORAGE
      XOR   A                ;ZERO A
      LD    (DE),A           ;CLEAR ACC
      INC   DE               ;POINT NEXT
      INC   HL               ;DITTO
      DEC   B                ;DECR CTR
      JP    NZ,FMUL5         ;LOOP
      LD    C,6              ;OUTER LOOP CTR
      POP   HL               ;GET ADDR OF MULTIPLIER
      RST   RST7             ;GO BUMP HL
      DEFB  3                ;BY THREE
FMUL6 LD    A,C              ;GET CTR
      RRA                    ;TEST IF EVEN/ODD
      LD    A,(HL)           ;GET MULTIPLIER DIGIT PAIR
      JP    C,FMUL7          ;BRIF LEFT NEEDED
      AND   0FH              ;MASK
      JP    FMUL8            ;GO AROUND
FMUL7 CALL  RIGHT            ;SHIFT RIGHT 4 BITS
FMUL8 LD    B,A              ;SAVE DIGIT
      PUSH  HL               ;SAVE ADDRESS
      PUSH  BC               ;SAVE COUNTERS
      LD    C,B              ;SWAP B/C
      OR    A                ;TEST MULTIPLIER
      JP    Z,FMUX1          ;BRIF ZERO
FMUL9 LD    DE,FTEMP+2       ;POINT PRODUCT
      LD    HL,FTEMP+8       ;POINT MULTIPLICAND
      LD    B,6              ;6 DIGITS PARTICIPATE
      CALL  FADDT            ;GO ADD
      DEC   C                ;DECR OUTER LOOP CTR
      JP    NZ,FMUL9         ;LOOP
FMUX1 LD    D,0              ;INIT SHIFT DIGIT
      LD    B,6              ;LOOP CTR
      LD    HL,FTEMP+8       ;POINT MULTIPLICAND
      CALL  FSHFX            ;GO SHIFT
      POP   BC               ;RESTORE CTRS
      POP   HL               ;ANDADDRESS
      DEC   C                ;DECR CTR
      JP    Z,FMUX2          ;GO AROUND IF ZERO
      LD    A,C              ;LOAD THE CTR
      RRA                    ;TEST EVEN/ODD
      JP    C,FMUL6          ;LOOP IF ODD
      DEC   HL               ;ELSE, POINT NEXT
      JP    FMUL6            ;LOOP
FMUX2 LD    HL,FACC+1        ;POINT MSD OF PRODUCT
      LD    A,(HL)           ;GET MSD PAIR
      AND   0F0H             ;ISOLATE LEFT HALF
      JP    NZ,FMUX3         ;BRIF NORMALIZED
      LD    B,5              ;CTR
      LD    D,H              ;COPY HL
      LD    E,L              ;TO DE
FMUX4 LD    A,(HL)           ;GET A PAIR OF DIGITS
      RST   RST4             ;SHIFT RIGHT TO LEFT
      LD    C,A              ;SAVE DIGIT
      INC   HL               ;POINT NEXT PAIR
      LD    A,(HL)           ;GET NEXT PAIR
      CALL  RIGHT            ;SHIFT LEFT TO RIGHT
      OR    C                ;COMBINE
      LD    (DE),A           ;PUT DOWN
      INC   DE               ;POINT NEXT OUTPUT PAIR
      DEC   B                ;DECR CTR
      JP    NZ,FMUX4         ;LOOP
      LD    A,(HL)           ;GET LAST PAIR
      RST   RST4             ;SHIFT LEFT
      LD    (DE),A           ;PUT DOWN
      LD    A,(FACC)         ;GET EXPON & SIGN
      LD    C,A              ;SAVE
      AND   80H              ;ISOLATE SIGN
      LD    B,A              ;SAVE SIGN
      LD    A,C              ;GET EXPON & SIGN
      CALL  FEXP             ;GO GET EXPON
      DEC   A                ;SUBTRACT ONE
      AND   7FH              ;STRIP 8TH BIT
      OR    B                ;MERGE IN SIGN BIT
      LD    (FACC),A         ;PUT DOWN
      JP    FMUX2            ;CONTINUE
FMUX3 LD    A,(FTEMP)        ;GET 1ST DIGIT PAIR FOLLOWING FA
      ADD   A,50H            ;ADD 5
      DAA                    ;ADJUST
      JP    NC,FNORM         ;BRIF 4 OR LESS
FROUN LD    HL,FACC+3        ;ELSE, POINT LSD OF FACC
      LD    B,3              ;LOOP CTR
      SCF                    ;TURN ON CY INDICATOR
FMUX5 LD    A,(HL)           ;GET A DIGIT PAIR
      ADC   A,0              ;ADD THE CARRY
      DAA                    ;ADJUST
      LD    (HL),A           ;PUT BACK
      DEC   HL               ;POINT NEXT
      DEC   B                ;DECR CTR
      JP    NZ,FMUX5         ;LOOP
      JP    C,FADX1          ;BRIF CARRY INTO 7 DIGITS
      JP    FNORM            ;GO NORMALIZE
*HEADING IMSAI 8080 4K BASIC
FDIV  EQU   $
;
;
;FLOATING POINT DIVIDE THE NUMBER AT (HL) INTO FACC
;
;
      CALL  FTEST            ;TEST IF FACC ZERO
      RET   Z                ;RETURN IF ZERO
      INC   HL               ;POINT 1ST DIGIT OF DIVISOR
      LD    A,(HL)           ;LOAD IT
      DEC   HL               ;POINT BACK
      OR    A                ;TEST IF ZERO
      JP    Z,OVERR          ;DIVISION BY ZERO = ERROR
      LD    A,(HL)           ;LOAD EXPONENT OF DIVISOR
      CALL  FEXP             ;GO GET EXPON
      LD    B,A              ;SAVE IT
      LD    DE,FACC          ;POINT EXPONENT OF DIVIDEND
      LD    A,(DE)           ;LOAD IT
      CALL  FEXP             ;GO GET EXPON
      SUB   B                ;SUBTRACT THE TWO EXPONENTS
      CALL  FOVUN            ;GO SAE IF OVERFLOW/UNDERFLOW
      AND   7FH              ;TRUNCATE TO 7 BITS
      LD    B,A              ;SAVE IT
      LD    A,(DE)           ;GET EXPONENT
      XOR   (HL)             ;IF SIGNS ARE EQUAL, RESULT IS P
      AND   80H              ;MASK OFF UNUSED BITS
      OR    B                ;CREATE SIGN OF QUOTIENT
      LD    (DE),A           ;PUT TO FACC
      PUSH  HL               ;SAVE ADDR
      INC   DE               ;POINT MSD OF DIVIDEND
      LD    HL,FTEMP         ;POINT TEMPORARY STORAGE
      LD    (HL),0           ;CLEAR HIGH ORDER POSITION
      INC   HL               ;POINT NEXT
      LD    B,3              ;LOOP CTR
FDIV3 LD    A,(DE)           ;GET BYTE FROM FACC
      LD    (HL),A           ;PUT TO FTEMP
      XOR   A                ;CLEAR A
      LD    (DE),A           ;ZERO FACC
      INC   HL               ;POINT NEXT
      INC   DE               ;DITTO
      DEC   B                ;DECR CTR
      JP    NZ,FDIV3         ;LOOP
      LD    (DIVSW),A        ;RESET SWITCH
      LD    (HL),A           ;CLEAR HIGH PAIR OF DIVISOR
      POP   DE               ;GET ADDR
      LD    B,3              ;LOOP CTR
      INC   DE               ;POINT MSD OF DIVISOR
      INC   HL               ;AND OF DIVIDEND
      CALL  COPYD            ;GO MOVE IT
      LD    C,6              ;OUTER LOOP CTR
FDIV5 LD    B,-1             ;INIT CTR
FDIV7 LD    DE,FTEMP+3       ;POINT DIVIDEND
      LD    HL,FTEMP+7       ;POINT DIVISOR
      PUSH  BC               ;SAVE BC
      LD    B,4              ;LOOP CTR
      CALL  FSUBT            ;GO SUBTRACT THE TWO
      POP   BC               ;GET COUNTERS
      INC   B                ;COUNT ONE MORE
      JP    NC,FDIV7         ;LOOP IF NOT TOO FAR
      LD    A,(DIVSW)        ;GET SWITCH
      OR    A                ;TEST IT
      JP    NZ,FDIV1         ;BRIF SET
      PUSH  BC               ;SAVE BC
      LD    C,3              ;THREE BYTE LOOP
      LD    HL,FACC+3        ;POINT LSD OF QUOTIENT
FDIX1 LD    A,(HL)           ;GET DIGIT PAIR
      LD    D,A              ;SAVE IT
      RST   RST4             ;SHIFT LEFT
      OR    B                ;MERGE WITH PREV
      LD    (HL),A           ;PUT BACK
      LD    A,D              ;GET SAVED PAIR
      CALL  RIGHT            ;SHIFT RIGHT
      LD    B,A              ;SAVE IT
      DEC   HL               ;POINT NEXT
      DEC   C                ;DECR CTR
      JP    NZ,FDIX1         ;LOOP
      POP   BC               ;GET CTRS
      LD    DE,FTEMP+3       ;POINT PREV
      LD    HL,FTEMP+7       ;POINT DIVISOR
      LD    B,4              ;LOOP CTR
      CALL  FADDT            ;GO ADD
      LD    B,4              ;INNER CTR
      LD    HL,FTEMP+3       ;POINT LSD OF DIVIDEND
      LD    D,0              ;SAVE DIGIT
      CALL  FSHFX            ;GO SHIFT
      DEC   C                ;DECR OUTER CTR
      JP    NZ,FDIV5         ;LOOP IF NOT ZERO
      LD    A,(FACC+1)       ;GET MSD OF QUOTIENT
      AND   0F0H             ;ISOLATE LEFT HALF
      JP    NZ,FDIX2         ;BRIF NORMALIZED
      LD    A,(FACC)         ;GET EXPON & SIGN
      LD    B,A              ;SAVE
      AND   80H              ;ISOLATE SIGN
      LD    C,A              ;SAVE
      LD    A,B              ;GET EXPON & SIGN
      CALL  FEXP             ;GO GET EXPONENT
      DEC   A                ;SUBTRACT ONE
      AND   7FH              ;TRUNCATE 8TH BIT
      OR    C                ;MERGE SIGN BIT
      LD    (FACC),A         ;PUT DOWN
      LD    C,1              ;NEW LOOP CTR
      JP    FDIV5            ;ONE MORE TIME
FDIX2 LD    A,1              ;GET A ONE
      LD    (DIVSW),A        ;SET SWITCH
      JP    FDIV5            ;GO ONE MORE DIGIT
FDIV1 LD    A,B              ;GET THE EXTRA QUOTIENT DIGIT
      CP    5                ;COMPARE TO 5
      JP    C,FNORM          ;BRIF LESS
      JP    FROUN            ;ELSE, GO ROUND IT
FOVUN EQU   $                ;TEST IF EXPONENT OVERFLOW/UNDER
      JP    P,FOVUX          ;BRIF POSITIVE
      CP    0C1H             ;TEST FOR UNDERFLOW
      RET   NC               ;RETIFNOT UNDERFLOW
      JP    OVERR            ;ELSE, ERROR
FOVUX CP    40H              ;TEST IF OVERFLOW
      RET   C                ;RETIF LESS
      JP    OVERR            ;ELSE, OVER/UNDEFLOW
*HEADING IMSAI 8080 4K BASIC
FTEST EQU   $
;
;TEST THE SIGN OF THE NUMBER IN THE FACC
;RETURN WITH S & Z ZET TO SIGN
;
      LD    A,(FACC+1)       ;GET MSD
      OR    A                ;TEST IT
      RET   Z                ;RETURN IF ZERO
      LD    A,(FACC)         ;GET SIGN & EXPON BYTE
      OR    7FH              ;TEST SIGN BIT ONLY
      LD    A,(FACC)         ;RE-LOAD EXPON BYTE
      RET                    ;THEN RETURN
*HEADING IMSAI 8080 4K BASIC
FEXP  EQU   $
;
;EXPAND EXPONENT INTO 8 BINARY BITS
;
      RLA                    ;DROP MANTISSA SIGN
      OR    A                ;TEST SIGN OF EXPON
      JP    P,FEXP1          ;BRIF POSITIVE
      SCF                    ;ELSE, TURN ON CY
FEXP1 RRA                    ;SHIFT BACK
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
FSUBT EQU   $
;
;DECIMAL SUBTRACT THE TWO 6 DIGIT NUMBERS (DE) & (HL)
;
      XOR   A                ;CLEAR STATUS
FSUX1 PUSH  BC               ;SAVE CTR
      LD    A,(DE)           ;GET ACC DIGIT PAIR
      SBC   A,(HL)             ;SUBTRACT PAIR FROM SUBTRAHEND
      PUSH  AF               ;SAVE A, FLAGS
      POP   BC               ;GET A, FLAGS IN BC
      LD    A,C              ;GET FLAGS
      AND   10H              ;TEST AC STATUS
      JP    NZ,FSUX2         ;BRIF SET
      LD    A,B              ;GET DIFFERENCE
      SUB   06H              ;ADJUST RIGHT SIDE
      LD    B,A              ;SAVE
FSUX2 LD    A,C              ;GET FLAGS
      RRA                    ;TEST CY
      JP    NC,FSUX3         ;BRIF NOT SET
      LD    A,B              ;GET DIFF
      SUB   60H              ;ADJUST LEFT SIDE
      LD    B,A              ;SAVE
FSUX3 PUSH  BC               ;RESAVE A, FLAGS
      POP   AF               ;RE-LOAD DIFFERENCE, FLAGS
      LD    (DE),A           ;PUT TO ACC
      POP   BC               ;GET BC
      DEC   DE               ;POINT PRIOR
      DEC   HL               ;DITTO
      DEC   B                ;DECR CTR
      JP    NZ,FSUX1         ;LOOP
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
FADDT EQU   $
;
;ADD TWO DECIMAL NUMBERS (DE) & (HL)
;
      XOR   A                ;CLEAR STATUS
FADXT LD    A,(DE)           ;GET PAIR
      ADC   A,(HL)           ;ADD OTHER PAIR
      DAA                    ;ADJUST
      LD    (DE),A           ;PUT DOWN
      DEC   DE               ;POINT NEXT
      DEC   HL               ;DITTO
      DEC   B                ;DECR LOOP CTR
      JP    NZ,FADXT         ;LOOP
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
FSHFT EQU   $
;
;INCREMENTING SHIFT RIGHT
;
      LD    A,(HL)           ;GET A BYTE
      LD    E,A              ;SAVE IT
      CALL  RIGHT            ;SHIFT RIGHT
      OR    D                ;PLUS PREV
      LD    (HL),A           ;STORE
      LD    A,E              ;GET PREV
      RST   RST4             ;SHIFT LEFT
      LD    D,A              ;SAVE FOR NEXT
      INC   HL               ;POINT NEXT
      DEC   B                ;DECR CTR
      JP    NZ,FSHFT         ;LOOP
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
FSHFX EQU   $
;
;DECREMENTING SHIFT RIGHT
;
      LD    A,(HL)           ;GET A BYTE
      CALL  RIGHT            ;SHIFT RIGHT
      LD    E,A              ;SAVE IT
      LD    A,(HL)           ;RELOAD
      RST   RST4             ;SHIFT LEFT
      OR    D                ;MERGE
      LD    (HL),A           ;REPLACE
      LD    D,E              ;UPDATE SAVED
      DEC   HL               ;POINT NEXT
      DEC   B                ;DECR CTR
      JP    NZ,FSHFX         ;LOOP
      RET                    ;RETURN
;
;
*HEADING IMSAI 8080 4K BASIC
ABS   EQU   $
;
;
;RETURN THE ABSOLUTE VALUE OF THE FLOATING ACCUMULATOR
;
;
      LD    A,(FACC)         ;GET EXPONENT
      AND   7FH              ;STRIP NEGATIVE SIGN
      LD    (FACC),A         ;REPLACE
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
SGN   EQU   $
;
;
;RETURNS THE SIGN OF THE FLOATING ACCUMULATOR
;THAT IS:
; 1 IF FACC > 0
; 0 IF FACC = 0
;-1 IF FACC < 0
;
      CALL FTEST             ;GO TEST FACC
      RET   Z                ;RETURN IF ZERO
      AND   80H              ;ISOLATE IT
      PUSH  AF               ;SAVE IT
      LD    HL,ONE           ;GET ADDRESS OF CONSTANT 1
      RST   RST5             ;GO LOAD IT
      POP   AF               ;RESTORE SIGN
      LD    (FACC),A         ;SET THE SIGN & EXPONENT
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
INT   EQU   $
;
;
;RETURNS THE GREATEST INTEGER NOT LARGER THAN THE ABSOLUTE VALUE
;
;
      LD    HL,FACC          ;POINT FLOAT ACC
      LD    A,(HL)           ;GET EXPONENT
      AND   40H              ;GET SIGN OF CHARACTERISTIC
      JP    Z,INT2           ;BRIF GE ZERO
      LD    B,4              ;FOUR BYTE LOOP
      JP    ZEROM            ;ZERO FACC AND RETURN
INT2  LD    A,(HL)           ;GET EXPONENT
      AND   3FH              ;ISOLATE CHARACTERISTIC
      CP    5                ;TEST FOR FIVE OR LARGER
      RET   P                ;RETURN IF >= 5
      LD    B,A              ;SAVE EXPONENT
      LD    A,5              ;GET CONSTANT
      SUB   B                ;MINUS EXPONENT = LOOP CTR
      LD    B,A              ;SAVE IT
      LD    HL,FACC+3        ;POINT LSD
INT3  LD    A,(HL)           ;LOAD A BYTE
      AND   0F0H             ;DROP RIGHT HALF
      LD    (HL),A           ;PUT BACK
      DEC   B                ;DECR CTR
      RET   Z                ;RETURN IF ZERO
      LD    (HL),0           ;ZERO LEFT HALF
      DEC   HL               ;POINT NEXT
      DEC   B                ;DECR CTR
      JP    NZ,INT3          ;LOOP
      RET                    ;CONTINUE EVALUATION
*HEADING IMSAI 8080 4K BASIC
SQR   EQU   $
;
;
;COMPUTE THE SQUARE ROOT OF THE FACC
;USES NEWTON'S THIRD ORDER ITERATION
;
;
      CALL  FTEST            ;GO GET SIGN OF FACC
      JP    M,OVERR          ;BRIF SQUARE ROOT OF NEGATIVE
      RET   Z                ;RETURN IF SQUARE ROOT OF ZERO
      LD    HL,ORIGS         ;POINT TO TEMP AREA
      RST   RST6             ;SAVE ORIGINAL NUMBER
      LD    HL,ONE           ;POINT CONSTANT
      CALL  FADD             ;ADD ONE
      LD    HL,TWO           ;POINT CONSTANT
      CALL  FDIV             ;DIVIDE BY TWO
;
;FIRST APPROXIMATION = (X+1)/2
;
SQRLP LD    HL,TSTSQ         ;GET ADDR OF TEST
      RST   RST6             ;SAVE IT
      LD    HL,TSTSQ         ;POINT PREV ITERATION
      CALL  FMUL             ;SQUARE IT
      LD    HL,TST2S         ;POINT SAVE AREA
      RST   RST6             ;SAVE IT
      LD    HL,ORIGS         ;GET ORIGINAL NUMBER
      CALL  FSUB             ;SUBTRACT FROM PREV**2
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    M,SQRGO          ;BRIF PREV**2 < ORIGINAL
      JP    Z,SQRGO          ;BRIF PREV**2 = ORIGINAL
      LD    HL,TST2S         ;GET PREV**2
      RST   RST5             ;GO LOAD IT
      LD    HL,THREE         ;POINT CONSTANT OF 3
      CALL  FMUL             ;MULTIPLY WITH PREV**2
      LD    HL,ORIGS         ;GET ORIGINAL NUMBER
      CALL  FADD             ;GO ADD
      LD    HL,SQRX          ;POINT TEMP AREA
      RST   RST6             ;SAVE DIVISOR
      LD    HL,THREE         ;POINT CONSTANT OF 3
      RST   RST5             ;GO LOAD IT
      LD    HL,ORIGS         ;GET ORIGINAL NUMBER
      CALL  FMUL             ;MULTIPLY BY THREE
      LD    HL,TST2S         ;GET SQUARE OF PREV ITERATION
      CALL  FADD             ;GO ADD IT
      LD    HL,TSTSQ         ;GET PREV ITERATION
      CALL  FMUL             ;GO MULTIPLY
      LD    HL,SQRX          ;POINT DIVISOR
      CALL  FDIV             ;GO DIVIDE
      LD    HL,SQRX          ;POINT TEMP AREA
      RST   RST6             ;SAVE IT
      LD    HL,TSTSQ         ;GET PREV ESTIMATE
      CALL  FSUB             ;GO COMPARE THEM
      LD    HL,SQRX          ;POINT THIS ANSWER
      CALL  FTEST            ;GET SIGN OF DIFFERENCE
      JP    Z,SQRGX          ;BRIF SAME GUESS
      RST   RST5             ;ELSE, LOAD THIS GUESS
;NEXT ITERATION = PREV*(3*X+PREV**2)/(3*PREV**2+X)
      JP    SQRLP            ;LOOP
SQRGO LD    HL,TSTSQ         ;POINT SQUARE ROOT
SQRGX RST   RST5             ;GO LOAD ACC
      RET                    ;THEN RETURN
*HEADING IMSAI 8080 4K BASIC
NEG   EQU   $
;
;
;REVERSES THE SIGN OF THE FLOATING ACC
;
;
      CALL  FTEST            ;GET SIGN OF FACC
      RET   Z                ;RETURN IF ZERO
      XOR   80H              ;REVERSE SIGN
      LD    (FACC),A         ;RESTORE EXPONENT
      RET                    ;CONTINUE EVALUATION
*HEADING IMSAI 8080 4K BASIC
RND   EQU   $
;
;
;PSEUDO RANDOM NUMBER GENERATOR
;
;
      LD    HL,RNDNU         ;POINT PREV RND
      RST   RST5             ;LOAD TO FACC
      LD    HL,RNDX          ;POINT MULTIPLIER
      CALL  FMUL             ;GO MULTIPLY
      LD    HL,FACC          ;POINT RESULT
      LD    (HL),7FH         ;DEFAULT . XXXXXX
      INC   HL               ;POINT MSD
      LD    B,(HL)           ;LOAD IT
      INC   HL               ;POINT MSD+2
      LD    C,(HL)           ;LOAD IT
      LD    (HL),B           ;SWAP BYTES
      DEC   HL               ;POINT BACK MSD
      LD    (HL),C           ;MOV MSD+2
      CALL  FNORM            ;GO NORMALIZE
      LD    HL,RNDNU         ;POINT NEW RND NUMBER
      RST   RST6             ;GO STORE IT
      RET                    ;RETURN
*HEADING IMSAI 8080 4K BASIC
EXPR  EQU   $
;
;
;EVALUATE EXPRESSION ROUTINE
;LEAVE RESULT IN FACC
;RETURN WHEN EXPRESSION ENDS (TYPICALLY AT END OF LINE)
;
;
      XOR   A                ;CLEAR REG A
      LD    (PARCT),A        ;SET PAREN CTR
      LD    (SPCTR),A        ;SET STACK CTR
      EX    DE,HL            ;SAVE HL IN DE
      LD    HL,(PROGE)       ;POINT END OF PROGRAM AREA
      LD    (EXPRS),HL       ;SAVE IT
      EX    DE,HL            ;RESTORE HL
;
LOOKD EQU   $                ;LOOK FOR CONSTANT, VARIABLE, OR
      CALL  NUMER            ;GO TEST IF NUMERIC
      JP    NZ,LDALP         ;BRIF NOT
LDNUM CALL  FIN              ;GO CONVERT NUMERIC (PUT TO FACC
LDF   LD    B,H              ;COPY HL TO BC
      LD    C,L              ;SAME
      LD    HL,(EXPRS)       ;GET ADDR OF EXPR AREA
      CALL  GTEMP            ;GO STORE THE FACC IN TEMP AREA
      LD    (EXPRS),HL       ;SAVE UPDATED ADDRESS
      LD    H,B              ;RESTORE H
      LD    L,C              ;RESTORE L
      JP    LOOKO            ;GO GET AN OPERATION CODE
LDALP CP    '.'              ;SEE IF LEADING DECIMAL POINT
      JP    Z,LDNUM          ;BRIF IS
      CALL  ALPHA            ;GO SEE IF ALPHA
      JP    NZ,LDDTN         ;BRIF NOT
      LD    B,(HL)           ;SAVE 1ST CHAR
      INC   HL               ;POINT NEXT
      LD    C,' '            ;DEFAULT FOR 1 CHAR VAR
      CALL  NUMER            ;GO SEE IF 2ND IS NUMERIC
      JP    NZ,LDFN          ;BRIF NOT
      INC   HL               ;POINT NEXT
      LD    C,A              ;SAVE THE CHAR
LDVR1 PUSH  HL               ;SAVE HL
      LD    D,B              ;COPY BC
      LD    E,C              ;TO DE
      CALL  SEARC            ;GO GET VAR ADDR IN DE
      LD    HL,(EXPRS)       ;GET EXPR ADDR
      CALL  SADR             ;GO STORE ADDRESS
      LD    (EXPRS),HL       ;SAVE ADDRESS
      POP   HL               ;RESTORE HL
      JP    LOOKO            ;GO LOOK FOR OPCODE
LDFN  CALL  ALPHA            ;GO SEE IF FUNCTION
      JP    NZ,LDVR1         ;BRIF IT'S NOT
LDFN1 DEC   HL               ;POINT BACK TO 1ST
      LD    A,(HL)           ;GET THAT CHAR
      CP    ' '              ;TEST IF SPACE
      JP    Z,LDFN1          ;LOOP IF IS
      PUSH  HL               ;SAVE HL
      LD    DE,RNDLI         ;POINT LITERAL
      RST   RST2             ;GO COMPARE
      JP    Z,LDRND          ;BRIF RND
      POP   HL               ;GET HL
      PUSH  HL               ;RESAVE IT
      LD    DE,SQRLI         ;POINT LITERAL
      RST   RST2             ;GO COMPARE
      LD    BC,SQR           ;GET ADDR OF ROUTINE
      JP    Z,LDFNC          ;BRIF IS
      POP   HL               ;GET HL
      PUSH  HL               ;RESAVE
      LD    DE,INTLI         ;POINT
      RST   RST2             ;GO COMPARE
      LD    BC,INT           ;ROUTINE ADDR
      JP    Z,LDFNC          ;BRIF EQUAL
      POP   HL               ;GET HL
      PUSH  HL               ;SAVE IT
      LD    DE,ABSLI         ;LITERAL
      RST   RST2             ;COMPARE
      LD    BC,ABS           ;ROUTINE
      JP    Z,LDFNC          ;BRIF EQUAL
      POP   HL               ;GET HL
      PUSH  HL               ;SAVE IT
      LD    DE,SGNLI         ;LITERAL
      RST   RST2             ;GO COMPARE
      LD    BC,SGN           ;ROUTINE
      JP    Z,LDFNC          ;BRIF EQUAL
      POP   HL               ;GET HL
      LD    B,(HL)           ;GET 1ST CHAR
      LD    C,' '            ;SPACE 2ND CHAR
      INC   HL               ;POINT NEXT
      JP    LDVR1            ;BRIF VARIABLE
LDRND PUSH  HL               ;SAVE HL
      CALL  RND              ;GO GET RANDOM NUMBER
      POP   HL               ;RESTORE HL
      POP   DE               ;RESTORE STACK POINTER
      JP    LDF              ;ACT AS IF CONSTANT
LDFNC POP   DE               ;POP THE STACK
      EX    DE,HL            ;FLIP/FLOP
      LD    HL,(EXPRS)       ;GET ADDR
      INC   HL               ;POINT NEXT
      LD    (HL),B           ;HIGH ADDR
      INC   HL               ;POINT NEXT
      LD    (HL),C           ;LOW ADDR
      INC   HL               ;POINT NEXT
      LD    (HL),1           ;CODE
      LD    (EXPRS),HL       ;SAVE ADDR
      EX    DE,HL            ;RESTORE HL
      JP    LOOKD            ;NEXT MUST BE DATA TOO
LDDTN CP    '-'              ;TEST IF UNARY MINUS
      JP    NZ,LDDTP         ;BRIF NOT
      LD    BC,NEG           ;SET UP CALL
      INC   HL               ;POINT NEXT
      PUSH  HL               ;SAVE HL
      JP    LDFNC            ;GO AS IF FUNCTION
LDDTP CP    '('              ;TEST IF OPEN PAREN
      JP    NZ,SNERR         ;BRIF NOT CONSTANT, FUNCTION, OR
      LD    A,(PARCT)        ;GET OPEN COUNT
      INC   A                ;ADD ONE
      LD    (PARCT),A        ;STORE IT
      EX    DE,HL            ;SAVE HL
      LD    HL,(EXPRS)       ;GET ADDR
      INC   HL               ;POINT NEXT
      LD    (HL),'('         ;PUT CODE
      LD    (EXPRS),HL       ;SAVE ADDR
      EX    DE,HL            ;RESTORE HL
      INC   HL               ;POINT NEXT
      JP    LOOKD            ;NEXT HAS TO BE DATA TOO
LOOKO RST   RST1             ;SKIP BLANKS
      CP    '+'              ;TEST IF PLUS
      JP    Z,OP1            ;BRIF IS
      CP    '-'              ;TEST IF MINUS
      JP    Z,OP1            ;BRIF IS
      CP    '*'              ;TEST IF MULTIPLY
      JP    Z,OP2            ;BRIF IS
      CP    '/'              ;TEST IF DIVIDE
      JP    Z,OP2            ;BRIF IS
      CP    ')'              ;TEST IF CLOSE PAREN
      JP    Z,OP3            ;BRIF IS
;ELSE MUST BE END OF EXPRESSION
      LD    A,(PARCT)        ;GET OPEN PAREN COUNT
      OR    A                ;TEST IT
      JP    NZ,SNERR         ;BRIF # OF ('S NOT = # OF )'S
      LD    (ADDR3),HL       ;SAVE ADDR OF STMT
      JP    EVAL             ;GO EVALUATE
OP1   PUSH  HL               ;SAVE HL
      LD    C,(HL)           ;SAVE OPERATION
      LD    B,0              ;INIT CTR
      LD    HL,(EXPRS)       ;GET END POINTER
OP1L1 INC   B                ;COUNT ONE MORE
      LD    A,(HL)           ;LOAD TYPE CODE
      CP    '('              ;TEST IF OPEN PAREN
      JP    Z,INSOP          ;BRIF IS
      OR    A                ;TEST IF END BUFF
      JP    Z,INSOP          ;BRIF IS
      OR    A                ;TEST IF DATA
      JP    Z,OP1L2          ;BRIF IS
      CP    1                ;TEST IF FUNCT
      JP    NZ,OP1L3         ;BRIF NOT EQUAL
OP1L2 DEC   HL               ;POINT NEXT
      DEC   HL               ;DITTO
      INC   B                ;COUNT
      INC   B                ;TWO BYTES
OP1L3 DEC   HL               ;POINT NEXT OPCODE
      JP    OP1L1            ;LOOP
INSOP INC   HL               ;POINT FIRST CHAR
      LD    A,(HL)           ;PICK UP OLD VALUE
      LD    (HL),C           ;PUT PREV
      LD    C,A              ;ROTATE
      DEC   B                ;DECR COUNT
      JP    NZ,INSOP         ;LOOP
      LD    (EXPRS),HL       ;SAVE ADDR
      POP   HL               ;GET STMT POINTER
      INC   HL               ;POINT NEXT
      JP    LOOKD            ;NEXT IS DATA
OP2   PUSH  HL               ;SAV HL
      LD    C,(HL)           ;SAVE OPCODE
      LD    B,1              ;INIT CTR
      LD    HL,(EXPRS)       ;GET CURRENT END
OP2A  RST   RST7             ;GO BUMP HL
      DEFB  -3               ;BY NEG THREE
      INC   B                ;ADD
      INC   B                ;THREE
      INC   B                ;TO B
      LD    A,(HL)           ;GET TYPE CODE
      CP    1                ;SEE IF FUNCTION
      JP    Z,OP2A           ;BRIF IS
      JP    INSOP            ;GO INSERT OPCODE
OP3   LD    A,(PARCT)        ;GET OPEN PAREN COUNT
      DEC   A                ;SUBTRACT ONE
      LD    (PARCT),A        ;SAVE IT
      JP    M,SNERR          ;BRIF TOO MANY )'S
      INC   HL               ;POINT NEXT SOURCE
      LD    (ADDR3),HL       ;SAVE ADDR
EVAL  LD    HL,(EXPRS)       ;GET END OF EXPR
EV0   LD    BC,0             ;INIT BC TO ZERO
EV1   INC   B                ;COUNT EACH BYTE
      LD    A,(HL)           ;GET CODE IN REG A
      DEC   HL               ;POINT NEXT
      CP    0E3H             ;TEST IT
      JP    NZ,EV2           ;BRIF NOT DATA
      DEC   HL               ;POINT NEXT
      DEC   HL               ;DITTO
      INC   B                ;BUMP CTR
      INC   B                ;BY TWO
      INC   C                ;COUNT THE TERM
      JP    EV1              ;LOOP
EV2   CP    1                ;TEST IF FUNCTION
      JP    NZ,EV5           ;BRIF NOT
      INC   HL               ;RESET TO TYPE CODE
      INC   HL               ;POINT BACK PREV DATA
      LD    D,(HL)           ;MOVE HIGH TO D
      INC   HL               ;POINT ONE MORE
      LD    E,(HL)           ;MOV LOW
      PUSH  BC               ;SAVE CTRS
      PUSH  HL               ;SAVE LOCATION
      EX    DE,HL            ;FLIP/FLOP
      RST   RST5             ;GO LOAD THE VARIABLE
      POP   HL               ;RESTORE LOCATION
      RST   RST7             ;GO BUMP HL
      DEFB  -3
      LD    E,(HL)           ;LOW BYTE
      DEC   HL               ;POINT BACK
      LD    D,(HL)           ;HIGH BYTE
      PUSH  HL               ;SAVE LOCATION
      LD    HL,EV3           ;GET RETURN ADDRESS
      PUSH  HL               ;SAVE ON STACK
      EX    DE,HL            ;PUT TO HL
      JP    (HL)             ;GO EXECUTE THE FUNCTION
EV3   EQU   $                ;FUNCTIONS RETURN HERE
      POP   DE               ;GET LOCATION
      POP   BC               ;GET COUNTERS
      LD    HL,0             ;LOAD ZERO TO HL
      PUSH  HL               ;GET BLOCK OF
      PUSH  HL               ;4 BYTES
      LD    A,(SPCTR)        ;GET TEMP CTR
      INC   A                ;COUNT ONE
      LD    (SPCTR),A        ;SAVE IT
      ADD   HL,SP            ;GET STACK ADDR
      PUSH  BC               ;SAVE CTRS
      PUSH  DE               ;SAVE LOCATION
      PUSH  HL               ;SAVE ADDR
      RST   RST6             ;GO STORE THE VARIABLE
      POP   DE               ;RESTORE ADDR
      POP   HL               ;RESTORE LOCATION
      POP   BC               ;RESTORE COUNTERS
      LD    (HL),D           ;PUT HIGH ADDR BYTE
      INC   HL               ;POINT NEXT
      LD    (HL),E           ;PUT LOW ADDR BYTE
      INC   HL               ;POINT NEXT
      LD    (HL),0E3H        ;SET CODE = DATA
      LD    D,H              ;COPY
      LD    E,L              ;HL TO DE
      DEC   B                ;SUB 1 FROM BYTE COUNT
      INC   DE               ;POINT
      INC   DE               ;TO
      INC   DE               ;CORRECT
      CALL  SQUIS            ;GO COMPRESS STACK
      LD    HL,(EXPRS)       ;GET ADDR
      RST   RST7             ;GO DECR HL
      DEFB  -3               ;BY THREE
      LD    (EXPRS),HL       ;SAVE UPDATED ADDR
      JP    EVAL             ;START AT BEGINNING
EV5   CP    '('              ;TEST IF OPEN PAREN
      JP    NZ,EV6           ;BRIF NOT
      LD    A,C              ;GET TERM CT
      CP    1                ;TEST IF ONE
      JP    NZ,STERR         ;ERROR IF ONE TERM NOT REMAIN
      LD    D,H              ;COPY HL
      LD    E,L              ;TO DE
      INC   DE               ;POINT SENDING
      DEC   B                ;SUBT ONE FROM COUNT
      CALL  SQUIS            ;GO COMPRESS IT
      LD    HL,(EXPRS)       ;GET POINTER
      DEC   HL               ;LESS ONE
      LD    (EXPRS),HL       ;UPDATE IT
      LD    HL,(ADDR3)       ;RESTORE STMT POINTERS
      JP    LOOKO            ;CONTINUE
EV6   OR    A                ;TEST IF END OF EXPRESSION
      JP    NZ,EV9           ;BRIF NOT
      LD    A,C              ;GET TERM COUNT
      CP    1                ;TEST IF ONE
      JP    NZ,STERR         ;ERROR IF NOT ONE
      INC   HL               ;POINT HIGH ADDR
      INC   HL               ;SAME
      LD    D,(HL)           ;HIGH TO D
      INC   HL               ;POINT LOW
      LD    E,(HL)           ;LOW TO E
      EX    DE,HL            ;PUT DATA ADDRESS IN HL
      RST   RST5             ;GO LOAD IT
      LD    HL,(ADDR3)       ;RESTORE STMT POINTER
      LD    A,(SPCTR)        ;GET STACK WORD (4BYTE) COUNTER
      OR    A                ;TEST IT
      RET   Z                ;RETURN IF ZERO
EV7   POP   DE               ;RETURN 2 BYTES
      POP   DE               ;RETURN 2 MORE
      DEC   A                ;DECR CTR
      JP    NZ,EV7           ;LOOP
      RET                    ;RETURN TO STMT PROCESSOR
EV9   CP    '+'              ;TEST IF PLUS
      LD    DE,FADDJ         ;ADDR
      JP    Z,EV10           ;BRIF IS
      CP    '-'              ;TEST IF MINUS
      LD    DE,FSUBJ         ;ADDR
      JP    Z,EV10           ;BRIF IS
      CP    '*'              ;TEST IF MUL
      LD    DE,FMULJ         ;ADDR
      JP    Z,EV10           ;BRIF IS
      CP    '/'              ;TEST IF DIV
      LD    DE,FDIVJ         ;ADDR
      JP    NZ,STERR         ;ERROR IF NOT
EV10  INC   HL               ;POINT TO
      INC   HL               ;1ST DATA
      PUSH  BC               ;SAVE CTRS
      PUSH  DE               ;SAVE ROUTINE ADDR
      LD    D,(HL)           ;HIGH TO D
      INC   HL               ;POINT NEXT
      LD    E,(HL)           ;LOW TO E
      PUSH  HL               ;SAVE POINTER
      EX    DE,HL            ;ADDR TO HL
      RST   RST5             ;GO LOAD IT
      POP   HL               ;RESTORE HL
      INC   HL               ;POINT 2ND DATA
      INC   HL               ;SAME
      LD    D,(HL)           ;HIGH TO D
      INC   HL               ;POINT NEXT
      LD    E,(HL)           ;LOW TO E
      EX    (SP),HL          ;POP ADDR FROM STACK, PUSH HL ON
      JP    (HL)             ;JUMP TO ROUTINE
FADDJ EX    DE,HL            ;GET HL
      CALL  FADD             ;GO ADD
      JP    EV11             ;CONTINUE
FSUBJ EX    DE,HL            ;GET HL
      CALL  FSUB             ;GO SUBTRACT
      JP    EV11             ;CONTINUE
FMULJ EX    DE,HL            ;GET HL
      CALL  FMUL             ;GO MULTIPLY
      JP    EV11             ;CONTINUE
FDIVJ EX    DE,HL            ;GET HL
      CALL  FDIV             ;GO DIVIDE
EV11  POP   HL               ;GET HL
      POP   BC               ;GET CTRS
      RST   RST7             ;GO DECR HL
      DEFB  -6
      CALL  GTEMP            ;GO SAVE FACC
      LD    D,H              ;COPY HL
      LD    E,L              ;TO DE
      INC   DE               ;POSITION
      INC   DE               ;TO
      INC   DE               ;FOUR
      INC   DE               ;BYTES OFFSET
      LD    A,B              ;GET CTR
      SUB   3                ;MINUS THREE
      LD    B,A              ;SAVE
      CALL  SQUIS            ;GO COMPRESS
      LD    HL,(EXPRS)       ;GET ADDR
      RST   RST7             ;GO DECR HL
      DEFB  -4               ;BY FOUR
      LD    (EXPRS),HL       ;RESTORE
      JP    EVAL             ;CONTINUE
;
;
*HEADING IMSAI 8080 4K BASIC
TERMI EQU   $
;
;READ A LINE FROM THE TTY
;FIRST PROMPT WITH THE CHAR IN THE A REG
;TERMINATE THE LINE WITH A X'00'
;IGNORE EMPTY LINES
;CONTROL C WILL CANCEL THE LINE
;RUBOUT WILL DELETE THE LAST CHAR INPUT
;
;
      LD    (PROMP),A        ;SAVE THE PROMPT CHAR
      LD    A,0FFH           ;GET BEGIN MARKER
      LD    (IOBUF-1),A      ;PUT IT
REIN  LD    HL,IOBUF         ;POINT TO INPUT BUFFER
      LD    A,(PROMP)        ;GET THE PROMPT AGAIN
      OR    A                ;TEST IT
      JP    Z,TREAD          ;BRIF NULL
      CALL  TESTO            ;GO WRITE IT
      LD    A,' '            ;GET A SPACE
      CALL  TESTO            ;WRITE SPACE
TREAD EQU   $
      CALL  TESTI            ;GO WAIT FOR READY
      CALL  GETCH            ;GO GET THE CHARACTER
      LD    (HL),A           ;PUT IN BUFFER
      LD    A,(HL)           ;RELOAD THE CHAR
      CP    0AH              ;TEST IF LINE FEED
      JP    Z,TREAD          ;IGNORE IF IT IS
      CALL  TESTO            ;ECHO THE CHARACTER
      CP    0DH              ;TEST IF CR
      JP    NZ,NOTCR         ;BRIF NOT
      CALL  CRLF             ;GO WRITE CRLF
CR1   LD    (HL),0           ;MARK END WITH ALL HIGH
      DEC   HL               ;POINT PRIOR
      LD    A,(HL)           ;LOAD IT
      CP    ' '              ;TEST IF SPACE
      JP    Z,CR1            ;BRIF SPACE
      CP    0FFH             ;TEST IF AT BEGINNING
      JP    Z,REIN           ;BRIF IS (NULL LINE)
      LD    HL,IOBUF         ;POINT TO START
      RET                    ;ELSE, RETURN
TESTI EQU   $
      IN    A,(TTY-1)        ;GET TERM STATUS
      AND   40H              ;MASK FOR RXRDY
      JP    Z,TESTI          ;LOOP TILL READY
      RET                    ;RETURN
TESTO EQU   $
      PUSH  AF               ;SAVE CHAR TO OUTPUT
      LD    A,(OUTSW)        ;GET OUTPUT SWITCH
      OR    A                ;TEST IF OFF
      JP    NZ,TOUT2         ;BRIF NOT
TOUT1 IN    A,(TTY-1)        ;GET STATUS
      RLA                    ;SHIFT LEFT (TEST TXRDY)
      JP    NC,TOUT1         ;LOOP TILL READY
      POP   AF               ;GET CHAR TO OUTPUT
      OUT   (TTY),A          ;WRITE IT
      RET                    ;RETURN
TOUT2 POP   AF               ;RESTORE CHAR
      RET                    ;RETURN
CRLF  XOR   A                ;CLEAR REG A
      LD    (COLUM),A        ;RESET COLUM POINTER
      LD    A,0DH            ;GET CR
      CALL  TESTO            ;WRITE IT
      LD    A,0AH            ;LF
      CALL  TESTO            ;WRITE IT
      PUSH  BC               ;SAVE BC
      LD    B,2              ;DELAY COUNT
DELAY LD    A,0FFH           ;GET RUBOUT
      CALL  TESTO            ;WRITE IT
      DEC   B                ;DECR LOOP CTR
      JP    NZ,DELAY         ;LOOP
      POP   BC               ;RESTORE BC
      RET                    ;RETURN
NOTCR CP    7FH              ;TEST IF RUBOUT
      JP    NZ,NOTBS         ;BRIF NOT
      DEC   HL               ;POINT PRIOR
      LD    A,(HL)           ;LOAD PREV CHAR
      CP    0FFH             ;TEST IF AT BEGIN
      JP    Z,NOTBS          ;BRIF IS
      LD    A,':'            ;BACKSLASH
      CALL  TESTO            ;WRITE IT
      LD    A,(HL)           ;LOAD THE CHAR
      CALL  TESTO            ;WRITE IT
      DEC   HL               ;POINT PRIOR
      LD    A,':'            ;BACKSLASH
      CALL  TESTO            ;WRITE IT
NOTBS INC   HL               ;POINT NEXT BUFFER POSIT
      JP    TREAD            ;LOOP FOR NEXT
;
;
TERMO EQU   $
;
;TTY PRINT ROUTINE
;
;OUTPUT STRING OF CHARS STARTING AT IOBUFF THRU END (00 OR
;FOLLOWING IMBEDDED CHARACTERS ARE INTERPRETED AS CONTROLS:
;X'00' END OF BUFFER, TYPE CR/LF AND RETURN
;X'FE' END OF BUFFER, RETURN (NO CR/LF)
;X'FD' TYPE CR/LF, CONTINUE
;
;
      LD    HL,IOBUF         ;GET ADDR OF BUFFER
OUT1  LD    A,(HL)           ;LOAD A BYTE
      CP    0FEH             ;SEE IF END OF LINE (NO CR/LF)
      RET   Z                ;RETURN IF EQUAL
      CP    0FDH             ;SEE IF EMBEDDED CR/LF
      JP    NZ,OUT2          ;BRIF NOT
      CALL  CRLF             ;LINE FEED
      JP    OUT4             ;CONTINUE
OUT2  OR    A                ;TEST IF END OF OUTPUT
      JP    Z,CRLF           ;BRIF IS
      LD    A,(HL)           ;LOAD THE BYTE
      CALL  TESTO            ;TYPE IT
      LD    A,(COLUM)        ;GET COLUM POINTER
      INC   A                ;ADD ONE
      LD    (COLUM),A        ;RESTORE IT
OUT4  INC   HL               ;POINT NEXT
      JP    OUT1             ;LOOP
;
;
;
LINEO EQU   $
;
;UNPACK LINE NUMBER FROM (HL) TO (DE)
;
;
      CALL  LOUT             ;GO FORMAT 2 BYTES
LOUT  EQU   $
      LD    A,(HL)           ;GET BYTE
      CALL  RIGHT            ;GO SHIFT TO RIGHT
      OR    30H              ;ZONE
      LD    (DE),A           ;PUT TO BUFFER
      INC   DE               ;POINT NEXT
      LD    A,(HL)           ;LOAD BYTE
      AND   0FH              ;MASK
      OR    30H              ;ZONE
      LD    (DE),A           ;PUT TO BUFFER
      INC   DE               ;POINT NEXT
      INC   HL               ;AND NEXT LINE BYTE
      RET                    ;RETURN
;
;
TSTCH EQU   $
;
;TEST IF INPUT CHAR ON KEYBOARD
;IF THERE IS, THEN READ IT
;TERMINATE IF CONTROL-C
;TOGGLE OUTPUT SW IF CONTROL-O
;
      IN    A,(TTY-1)        ;GET STATUS
      AND   40H              ;MASK FOR RXRDY
      RET   Z                ;RETURN IF NOT
GETCH IN    A,(TTY)          ;ELSE, READ THE CHAR
      AND   7FH              ;TURN OFF PARITY
      CP    0FH              ;TEST IF CONTROL-O
      JP    Z,CONTO          ;BRIF IS
      CP    03H              ;TEST IF CONTROL-C
      RET   NZ               ;RETURN IF NOT
      CALL  CRLF             ;PRINT CR/LF
      JP    READY            ;QUIT WHAT YOU WERE DOING
CONTO LD    A,(OUTSW)        ;GET SWITCH
      XOR   01H              ;TOGGLE
      LD    (OUTSW),A        ;RESTORE
      LD    A,0AH            ;GET A LF
      RET                    ;RETURN
;
;
ZEROM EQU   $
;
;MOVE STRING OF ZEROS TO (HL)+...  CNT IN B
;
      LD    (HL),0           ;MOVE ONE ZERO
      INC   HL               ;POINT NEXT
      DEC   B                ;DECR CTR
      JP    NZ,ZEROM         ;LOOP
      RET                    ;RETURN
;
;
COPYH EQU   $
;
;COPY STRING FROM (HL) TO (DE)
;COUNT IN B
;
      LD    A,(HL)           ;GET A CHAR
      LD    (DE),A           ;PUT IT DOWN
      INC   HL               ;POINT NEXT
      INC   DE               ;DITTO
      DEC   B                ;DECR CTR
      JP    NZ,COPYH         ;LOOP
      RET                    ;RETURN
;
;
COPYD EQU   $
;
;COPY STRING FROM (DE) TO (HL)
;COUNT IN B
;
      EX    DE,HL            ;FLIP DE/HL
      CALL  COPYH            ;GO COPY
      EX    DE,HL            ;THEN FLIP BACK
      RET                    ;RETURN
;
;
COMP2 EQU   $
;
;CONTINUE COMP SUBROUTINE (RST RST2)
;
      CP    (HL)             ;COMPARE THE CHAR
      RET   NZ               ;RETURN IF NOT EQUAL
      INC   DE               ;POINT NEXT
      INC   HL               ;DITTO
      JP    RST2             ;LOOP
;
;
ULERR LD    BC,'UL'          ;UNDEFINED LINE NUMBER
      RST   RST3
OVERR LD    BC,'OV'          ;DIV BY ZERO/OVERFLOW/UNDERFLOW
      RST   RST3
STERR LD    BC,'ST'          ;ERROR IN EXPRESSION STACK
      RST   RST3
SNERR LD    BC,'SN'          ;SYNTAX ERROR
      RST   RST3
RTERR LD    BC,'RT'          ;RETURN & NO GOSUB
      RST   RST3
DAERR LD    BC,'DA'          ;OUT OF DATA
      RST   RST3
FOERR LD    BC,'FO'          ;MORE THAN 8 NESTED FOR/NEXT OR
      RST   RST3
NXERR LD    BC,'NX'          ;FOR & NO NEXT / NEXT & NO FOR
      RST   RST3
;
;
;
;
PACK  EQU   $
;
;PACK LINE NUMBER FROM (HL) TO BC
;
;
      RST   RST1             ;SKIP LEADING SPACES
      LD    BC,0             ;CLEAR B AND C
      LD    A,4              ;INIT DIGIT COUNTER
      LD    (PRSW),A         ;SAVE A
PK1   LD    A,(HL)           ;GET CHAR
      CALL  NUMXR            ;TEST FOR NUMERIC
      RET   NZ               ;RETURN IF NOT NUMERIC
      AND   0FH              ;STRIP OFF ZONE
      LD    D,A              ;SAVE IT
      LD    A,(PRSW)         ;GET COUNT
      DEC   A                ;SUBTRACT ONE
      JP    M,SNERR          ;BRIF MORE THAN 4 DIGITS
      LD    (PRSW),A         ;SAVE CTR
      LD    E,4              ;4 BIT SHIFT LOOP
PK3   LD    A,C              ;GET LOW BYTE
      RLA                    ;ROTATE LEFT 1 BIT
      LD    C,A              ;REPLACE
      LD    A,B              ;GET HIGH BYTE
      RLA                    ;ROTATE LEFT 1 BIT
      LD    B,A              ;REPLACE
      DEC   E                ;DECR CTR
      JP    NZ,PK3           ;LOOP
      LD    A,C              ;GET LOW
      OR    D                ;PUT DIGIT IN RIGHT HALF OF BYTE
      LD    C,A              ;REPLACE
      INC   HL               ;POINT NEXT BYTE
      JP    PK1              ;LOOP
;
;
;
SQUIS EQU   $
;
;COMPRESS THE EXPR STACK
;TO ADDR IN HL
;FROM ADDR IN DE
;COUNT IN B
;
SQUI2 INC   DE               ;POINT NEXT SEND
      INC   HL               ;POINT NEXT RECEIVE
      LD    A,(DE)           ;GET A CHAR
      LD    (HL),A           ;PUT IT DOWN
      DEC   B                ;DECR CTR
      JP    NZ,SQUI2         ;LOOP
      RET                    ;RETURN
;
;
GTEMP EQU   $
;
;GETS FOUR BYTE TEMPORARY STORAGE AREA,
;STORES THE FACC THERE,
;PUTS ADDR OF AREA IN EXPR STACK (HL)
;
      EX    DE,HL            ;SAVE HL IN DE
      EX    (SP),HL          ;EXCHANGE 0 AND RET ADDR
      PUSH  HL               ;PUT NEW RET ADDR
      PUSH  HL               ;DO IT AGAIN
      LD    HL,0             ;ZERO HL
      ADD   HL,SP            ;GET SP ADDR IN HL
      INC   HL               ;PLUS ONE
      INC   HL               ;PLUS ONE MORE (POINT TO NEW ARE
      PUSH  BC               ;SAVE CTRS
      PUSH  DE               ;SAVE EXPR ADDR
      PUSH  HL               ;SAVE TEMP ADDR
      LD    A,(SPCTR)        ;GET WORD COUNTER
      INC   A                ;INCR IT
      LD    (SPCTR),A        ;RESTORE IT
      RST   RST6             ;GO STORE FACC
      POP   DE               ;RESTORE TEMP ADDR
      POP   HL               ;RESTORE EXPR ADDR
      POP   BC               ;RESTORE CTRS
SADR  INC   HL               ;POINT NEXT BYTE
      LD    (HL),D           ;HIGH BYTE TO EXPR STACK
      INC   HL               ;POINT NEXT
      LD    (HL),E           ;LOW BYTE TO EXPR STACK
      INC   HL               ;POINT NEXT
      LD    (HL),0E3H        ;CODE = DATA
      RET                    ;RETURN
;
;
ALPHA EQU   $
;
;TESTS THE CHAR AT (HL)
;RETURNS WITH Z SET IF CHAR IS ALPHA (A-Z)
;RETURNS WITH Z OFF IF NOT ALPHA
;CHAR IS LEFT IN REG A
;
      RST   RST1             ;SKIP LEADING SPACES
      CP    'A'              ;TEST IF A OR HIGHER
      RET   C                ;RETURN IF NOT ALPHA (Z IS OFF)
      CP    'Z'+1            ;TEST IF Z OR LESS
      RET   NC               ;RETURN IF NOT < Z (Z OFF)
      CP    A                ;TURN ON Z
      RET                    ;RETURN
;
;
NUMER EQU   $
;
;TESTS THE CHAR AT (HL)
;RETURNS WITH Z SET IF NUMERIC (0-9)
;ELSE, Z IS OFF
;CHAR IS LEFT IN THE A REG
;
      RST   RST1             ;SKIP LEADING SPACES
NUMXR CP    '0'              ;TEST IF ZERO OR GREATER
      RET   C                ;RETURN IF LESS THAN ZERO
      CP    '9'+1            ;TEST IF 9 OR LESS
      RET   NC               ;RETURN IF NOT NUMERIC
      CP    A                ;SET Z
      RET                    ;RETURN
;
;
RIGHT EQU   $
;
;SHIFT THE LEFTMOST 4 BITS OF REG A RIGHT FOUR BITS
;
      AND   0F0H             ;ISOLATE LEFT
      RRA                    ;SHIFT ONCE
      RRA                    ;AGAIN
      RRA                    ;AGAIN
      RRA                    ;ONE LAST TIME
      RET                    ;RETURN
;
;
SEARC EQU   $
;
;SEARCES FOR THE VARIABLE IN DE
;RETURNS WITH ADDR OF DATA AREA FOR VARIABLE
;
      PUSH  HL               ;SAVE HL
      LD    HL,(DATAB)       ;GET ADDR OF DATA POOL
      LD    BC,-6            ;LENGTH OF EACH ENTRY
SCH1  LD    A,(HL)           ;GET THE BYTE
      OR    A                ;TEST IF END
      JP    Z,SCH3           ;BRIF END
      CP    D                ;COMPARE 1ST CHAR
      JP    NZ,SCH2          ;BRIF NOT EQUAL
      DEC   HL               ;POINT NEXT
      LD    A,(HL)           ;LOAD 2ND DIGIT
      INC   HL               ;POINT BACK
      CP    E                ;COMPARE 2ND CHAR
      JP    NZ,SCH2          ;BRIF NOT EQUAL
      ADD   HL,BC            ;POINT NEXT ENTRY
      INC   HL               ;PLUS ONE
      EX    DE,HL            ;FLIP/FLOP
      POP   HL               ;RESTORE HL
      RET                    ;RETURN
SCH2  ADD   HL,BC            ;MINUS SIX
      JP    SCH1             ;LOOP
SCH3  LD    (HL),D           ;PUT 1ST CHAR
      DEC   HL               ;POINT NEXT
      LD    (HL),E           ;PUT 2ND CHAR
      LD    B,4              ;LOOP CTR
SCH4  DEC   HL               ;POINT NEXT
      LD    (HL),0           ;ZERO THE VALUE
      DEC   B                ;DECR CTR
      JP    NZ,SCH4          ;LOOP
      DEC   HL               ;POINT NEXT
      LD    (HL),B           ;MOVE ZERO TO NEW END
      INC   HL               ;POINT ADDR OF VARIABLE
      EX    DE,HL            ;PUT LOCATION TO DE
      POP   HL               ;RESTORE HL
      RET                    ;RETURN
;
;
VAR   EQU   $
;
;
;TEST (HL) FOR A VARIABLE NAME
;PUTS THE NAME IN DE IF FOUND
;
      CALL  ALPHA            ;TEST IF ALPHA
      JP    NZ,SNERR         ;BRIF NOT ALPHA
      LD    D,A              ;FIRST CHAR
      LD    E,' '            ;DEFAULT
      INC   HL               ;POINT NEXT
      CALL  NUMER            ;TEST IF NUMERIC
      RET   NZ               ;RETURN IF NOT NUMERIC
      LD    E,A              ;SAVE 2ND CHAR
      INC   HL               ;POINT NEXT
      RST   RST1             ;SKIP SPACES
      RET                    ;THEN RETURN
;
;
ERROR EQU   $
;
;CONTINUE ERROR ROUTINE (RST RST3)
;
      LD    (HL),C           ;PUT 2ND CHAR
      INC   HL               ;POINT NEXT
      LD    (HL),0FEH        ;MARK END
      CALL  TERMO            ;GO PRINT IT
      LD    HL,ERRXR         ;POINT MESG
      CALL  OUT1             ;GO PRINT IT
      LD    DE,IOBUF         ;POINT BUFFER
      LD    HL,(LINE)        ;GET ADDR OF LINE NUMBER
      CALL  LINEO            ;UNPACK LINE NUMBER
      XOR   A                ;GET END CODE
      LD    (DE),A           ;PUT TO BUFFER
      CALL  TERMO            ;PRINT IT
      JP    GETCM            ;GO GET NEXT COMMAND
*HEADING IMSAI 8080 4K BASIC
LISTL DEFM  'LIS'
      DEFB  0
NEWLI DEFM  'NEW'
      DEFB  0
RUNLI DEFM  'RUN'
      DEFB  0
RNDLI DEFM  'RND'
      DEFB  0
ABSLI DEFM  'ABS'
      DEFB  0
SQRLI DEFM  'SQR'
      DEFB  0
SGNLI DEFM  'SGN'
      DEFB  0
JMPTB EQU   $
IFLIT DEFM  'IF'
      DEFB  0
      DEFW  IF
READL DEFM  'READ'
      DEFB  0
      DEFW  READ
DATAL DEFM  'DATA'
      DEFB  0
      DEFW  RUN
FORLI DEFM  'FOR'
      DEFB  0
      DEFW  FOR
NEXTL DEFM  'NEXT'
      DEFB  0
      DEFW  NEXT
GOSUX DEFM  'GOSUB'
      DEFB  0
      DEFW  GOSUB
RETLI DEFM  'RET'
      DEFB  0
      DEFW  RETUR
INPUX DEFM  'INPUT'
      DEFB  0
      DEFW  INPUT
PRINX DEFM  'PR'
INTLI DEFM  'INT'
      DEFB  0
      DEFW  PRINT
      DEFM  '?'
      DEFB  0
      DEFW  PRINT
GOTOL DEFM  'GO'
TOLIT DEFM  'TO'
      DEFB  0
      DEFW  GOTO
LETLI DEFM  'LET'
      DEFB  0
      DEFW  LET
STOPL DEFM  'STO'
      DEFB  0
      DEFW  READY
ENDLI DEFM  'END'
      DEFB  0
      DEFW  RUN
REMLI DEFM  'REM'
      DEFB  0
      DEFW  RUN
      DEFB  0                ;END OF TABLE
STEPL DEFM  'STEP'
      DEFB  0
THENL DEFM  'THEN'
      DEFB  0
ERRXR DEFM  ' ERR @ '
      DEFB  0FEH
ONE   DEFW  1000H            ;CONSTANT ONE
      DEFW  0
TWO   DEFW  2000H            ;CONSTANT TWO
      DEFW  0
THREE DEFW  3000H            ;CONSTANT THREE
      DEFW  0
RNDX  DEFW  837FH            ;RANDOMIZER
      DEFW  1974H
ROMEN EQU   $                ;END OF READ-ONLY-MEMORY
*HEADING IMSAI 8080 4K BASIC
      ORG   1000H            ;RAM AREA
RAM   EQU   $                ;ALIGN RAM ON 4K BOUNDARY
TTY   EQU   1                ;DEVICE ADDRESS FOR TERMINAL
NULLI DEFS  2
IOBUF DEFS  40               ;INPUT/OUTPUT BUFFER
FACC  DEFS  4
FTEMP DEFS  10
REL   DEFS  1                ;HOLDS THE RELATION IN AN IF STMT
DIVSW DEFS  1                ;0=NORMAL DIVIDE, 1=DIVIDE FOR R
TVAR1 DEFS  4                ;TEMP STORAGE
TVAR2 DEFS  4                ;DITTO
ORIGS DEFS  4                ;HOLDS ORIG NUMBER FOR SQR
TSTSQ DEFS  4                ;HOLDS TRIAL SQUARE ROOT
TST2S DEFS  4                ;HOLDS TRIAL SQUARE ROOT ** 2
SQRX  DEFS  4                ;TEMP STORAGE FOR SQUARE ROOT
EXPRS DEFS  2                ;HOLDS ADDR OF EXPR
PARCT DEFS  1
SPCTR DEFS  1
PRSW  DEFS  1
ADDR1 DEFS  2                ;HOLDS TEMP ADDRESS
ADDR2 DEFS  2                ;HOLDS TEMP ADDRESS
ADDR3 DEFS  2                ;HOLDS STMT ADDRESS DURING EXPR
STMT  DEFS  2                ;HOLDS ADDR OF CURRENT STATEMENT
INDX  DEFS  2                ;HOLDS VARIABLE NAME OF FOR/NEXT
OUTSW DEFS  1                ;OUTPUT SUPPRESS IF ON
RUNSW DEFS  1                ;0=RUN MODE, 1=IMMEDIATE MODE
COLUM DEFS  1                ;CURRENT TTY COLUM
RNDNU DEFS  4
DASTM DEFS  2                ;HOLDS LINE ADDRESS OF CURRENT D
LINE  DEFS  2                ;HOLD ADDR OF PREV LINE NUM
STACK DEFS  2                ;HOLDS ADDR OF START OF RETURN
FORNE DEFS  97
PROMP DEFS  1                ;HOLDS PROMPT CHARACTER
IMMED DEFS  70               ;IMMEDIATE COMMAND STORAGE AREA
DATAP DEFS  2                ;ADDR OF CURRENT DATA STMT
DATAB DEFS  2                ;ADDRESS OF DATA POOL
PROGE DEFS  2                ;ADDR OF PROG POOL END
      DEFS  1                ;THIS HAS LOW VALUE AT RUN TIME
BEGPR EQU   $                ;PROGRAM AREA STARTS HERE
;
;
      END   BASIC
