*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