*
*
*   LET STATEMENT
*
*
LET CALL VAR  CHECK FOR VARIABLE
 PUSH H  SAVE VAR ADDRESS
 PUSH PSW  SAVE VARIABLE FLAG
 LHLD TXA  GET TEXT POINTER
 MOV A,M  NEXT CHR
 CPI EQRW  SHOULD BE AN EQUALS
 JNZ BSERR  ERROR IF NOT
 INX H
 SHLD TXA  EAT THE "="
 POP PSW  GET BACK FLAG FROM VAR
 JNZ LET0  NOT A STRING
*
*   REMEMBER HL ARE ON THE STACK TO STAS1 AND EXPRB
*   FROM ABOVE
*
 POP H
 MVI A,0  FLAG FOR STRING PEOPLE
 CALL STASS  DO STRING ASSIGNMENT
 JMP LET1
*
LET0 CALL EXPRB
 POP D  DESTINATION ADDRESS
 CALL POPA1  COPY EXPR VALUE TO VARIABLE
*
LET1 CALL SCOMA
 RNZ
 JMP LET  MULTI-ASSIGNMENTS PER LET STATEMENT
*
*
*
*
*   FOR STATEMENT
*
*
*
SFOR CALL DIRT
 CALL VAR  CONTROL VARIABLE
 JZ TYERR  STRING TYPE IS ERROR
 PUSH H  CONTROL VARIABLE VALUE ADDRESS
 MVI B,EQRW
 CALL EATC
 CALL EXPRB  INITIAL VALUE
 POP D  CONTROL VARIABLE VALUE ADDRESS
 PUSH D  SAVE FOR LATER
 CALL POPA1  SETS INITIAL VALUE
 MVI B,TORW  RESERVED WORD VALUE FOR 'TO'
 CALL EATC
 CALL EXPRB  LIMIT VALUE COMPUTATION
 MVI A,STEPRW
 CALL SCANC  CHECK NEXT CHARACTER FOR POSSIBLE STEP EXPRES
 JNC FOR1
*
*  USE STEP OF 1
*
 LXI H,FPONE
 CALL PSHAS
 JMP FOR2
*
*  HERE COMPUTE STEP VALUE
*
FOR1 CALL EXPRB  THE STEP VALUE
*
*  HERE THE STEP AND LIMIT ARE ON ARG STACK
*
FOR2 LXI D,-5  ALLOCATE SPACE ON STACK FOR TXA, CONTROL VAR
 CALL PSHCS
 XCHG .  SAVE DE
 CALL JOE  RETURNS TEXT ADDRESS
 JC CSERR  ILLEGAL FOR FOR STATEMENT TO BE LAST IN PROGRAM
 XCHG .   DE NOW HAS LOOP TEXT ADDRESS AND HL HAS CONTROL
 MOV M,D  HIGH ORDER TEXT ADDRESS BYTE
 DCX H
 MOV M,E  LOW ORDER TEXT ADDRESS BYTE
 POP B  CONTROL VARIABLE ADDRESS
 PUSH H   TEXT ADDRESS FOR TEST
 DCX H
 MOV M,B  HIGH ORDER BYTE OF CONTROL VARIABLE ADDRESS
 DCX H
 MOV M,C  LOW ORDER BYTE OF CONTROL VARIABLE ADDRESS
 PUSH B  SAVE VARIABLE ADDRESS FOR TEST
 DCX H
 MVI M,FRTYPE  SET CONTROL STACK ENTRY TYPE TO 'FOR'
 LXI B,FPSIZ-1+4  POINT TO SIGN OF STEP
 DAD B
 PUSH H  SAVE FOR TEST
*
*  NOW SCAN TO THE MATCHING NEXT STATEMENT TO CHECK FOR '0' E
*
 XCHG .  TXA POINTS INTO NEXT STATEMENT, WE MUST BACK IT
 DCX H  BACK UP OVER LINE NUMBER, COUNT AND CARRIAGE RETUR
 DCX H
 DCX H
 DCX H
 SHLD TXA  DO THIS SO LSTAT WORKS
 XRA A  USED BY LSTAT
 MOV B,A  INITIALIZE BALANCE COUNT
*
FOR3 INR B  BUMP 'FOR' COUNT
*
FOR4 PUSH B
 LXI B,FORRW*256+NEXTRW
 CALL LSTAT
 LXI B,'CS'
 JC EOFERR
*
*  HERE IF WE FIND A FOR, BUMP COUNT AND CONTINUE SEARCH
*
 CPI FORRW
 POP B
 JZ FOR3  FOUND ANOTHER FOR
*
*  HERE WE FOUND A NEXT, SEE IF IT IS THE ONE WE NEED
*
 DCR B
 JNZ FOR4  JUMP IF NEED MORE
*
*   FOUND THE MATCHING NEXT
*
 CALL NAME1  LOOK AT VARIABLE NAME (IF ANY)
 JMP NEX1A
*
*
*
*
*   NEXT STATEMENT
*
*
*
NEXT CALL DIRT
 LHLD TSTKA  CONTROL STACK ADDRESS
 INX H
 MOV A,M  STACK ENTRY TYPE BYTE
 DCR A  MUST BE FOR TYPE (=1) ELSE ERROR
 JNZ CSERR  IMPROPER NESTING ERROR
 INX H  CONTROL STACK POINTER TO CONTROL VARIABLE ADDRESS
 PUSH H
 CALL NAME1  CHECK VARIABLE, IN CASE USER WANTS CHECK
 XCHG
 POP H  ADDRESS OF CONTROL VARIABLE ADDRESS
 JC NEXT1  NO VARIABLE
 CALL DCMP  COMPARE ADDRESSES
 JNZ CSERR  IMPROPER NESTING IF NOT THE SAME
*
NEXT1 MOV C,M  ADDRESS OF CONTROL VARIABLE ADDRESS
 INX H
 MOV B,M
 INX H
 PUSH H  TEXT ADDRESS
 PUSH B  VARIABLE ADDRESS
 LXI D,FPSIZ-2+2  LEAVE THIS AS IS
 DAD D  POINT TO SIGN OF STEP VALUE
 PUSH H  AND SAVE FOR LATER
 INX H
 MOV D,B  HIGH ORDER BYTE OF VAR ADDRES
 MOV E,C
*
*     BC=DE+HL
*
 CALL FADD  DO INCREMENT
*
NEX1A POP H  SIGN OF STEP VALUE
 MOV A,M  SIGN (1=NEG)
 LXI D,FPSIZ+1
 DAD D  PUTS LIMIT ADDRESS IN HL
 POP D  ADDRESS OF VAR ADDRESS
 ORA A  SET CONDITIONS BASED ON SIGN OF STEP VALUE  STILL
 JZ NEXT2
 XCHG .  IF POS STEP, SWITCH TEST ORDER
*
NEXT2 CALL RELOP  SET CONDITIONS (CARRY SET MEANS STOP LOOP)
 POP H  ADDRESS TEXT ADDRESS
 JNC NEXT3  JUMP IF MUST CONTINUE LOOP
*
*  HERE TEMINATE LOOP
*
 DCX H
 MOV D,M
 DCX H
 MOV E,M  DE HAS CONTROL VARIABLE ADDRESS
 LXI B,2*FPSIZ+3
 DAD B
 SHLD TSTKA  UNDO THE LOOP FROM THE STACK!!
 JMP VCOPY  MAKE CTRL-VAR EQU TO LIMIT ALSO RETURN
*
*
NEXT3 MOV E,M
 INX H
 MOV D,M
*
*  PREPARE TO ITERATE, SKIPPING NORMAL JUNK ON END TEST AT IL
*
NEXT4 XCHG .  GET BACK REAL TEXT ADDRESS
 SHLD TXA   NOTE-----  COMMENTS ALLOWED AFTER NEXT STATEMENT
 POP H  EAT RETURN LINK
 JMP ILOOP  RETURN TO DISPATCHER SKIPPING JOE CALL THERE
*
*
*
*
*   IF STATEMENT
*
*
*
SIF CALL STEST  RETURNS Z SET IF STRING EXPRESSION NEXT
 JZ SIF3
*
*  NUMERIC IF CASE
 CALL EXPRB
 CALL POPFP  REMOVE VALUE FROM ARG STACK TO FPSINK
*
SIF0 MVI B,THENRW
 CALL EATC
 MVI B,1  COUNT TO USE IF CONDITION FALSE
 LDA FPSINK  CHECK FOR NON-ZERO VALUE
 ORA A
 JZ SIF9  GOT TO LOOK FOR ELSE
*
*   SUCCESSFUL IF STATEMENT
SIF00 MVI A,ELSERW
 STA IFTERM  A LEGAL TERMINAFOR FOR NEXT STATEMENT
*
*  TEST SUCCEEDED
*
 CALL LNUM  CHECK IF LINE NUMBER IS DESIRED ACTION
 JNC GOTO1  DO A GOTO
 JMP ISTA0  INTERPRET REST OF STATEMENT AS NEW STATEMENT
*
*
*  STRING IF CASE
*
SIF3  LHLD TSTKA
 PUSH H  SAVE TEMP STACK POINTER
*
*   GET LEFT STRING TO TEMP STACK
*
 SHLD LHSBA  BASE ADDR OF LEFT STRING
 CALL SEXPG
 PUSH H  SIZE OF LEFT STRING
*
*   GET RELATIONAL OPERATOR
*
 CALL GCI
 CPI GTRW+1  CHECK IF LEGAL RELATIONAL
 JNC BSERR
 CPI GERW
 JC BSERR
*
*   COMPUTE RELOP ACTION ROUTINE ADDRESS
 LXI H,OPTAB
 SUI TOKCM
 CALL OPADR
 INX H
 CALL LHLI
 INX H
 INX H
 INX H
 POP D  LHS SIZE
 PUSH H  ACTION ROUTINE ADDR
 PUSH D  SIZE OF LHS
*
*   GET RIGHT HAND STRING
*
 LHLD TSTKA
 SHLD RHSBA  RHS BASE ADDR
 CALL SEXPG
 XCHG .  DE HAS RHS SIZE
 POP B  LHS SIZE
*
*  COMPARE
*
 CALL SCOMP
*
*  CONDITION CODES ARE SET, NOW DISPATCH TO ACTION ROUTINE
*
SIF6 LXI H,SIF7  ACTION ROUTINE RETURN LINK
 XTHL
 PUSH H  PUSH BACK ACTION ROUTINE ADDR
 LXI B,FPSINK  ADDR OF TEMP
 RET .  CALL ACTION ROUTINE
*
*
*    RETURN HERE FROM ACTION ROUTINE WITH FPSINK
*    SET ACCORDING
*
SIF7 POP H  ORIGINAL VALUE OF TSTKA
 SHLD TSTKA
 JMP SIF0
*
*
*
*      COME HERE IF TEST FAILED, LOOK FOR POSSIBLE
*    MATCHING ELSE
*
SIF90 INR B  IF-ELSE BALANCE COUNTER
*
SIF9 LHLD TXA
SIF14 MOV A,M
 CPI LNRW  SKIP LN'S
 JNZ SIF13
 INX H  SKIP LN
 INX H  SKIP LOW
 INX H  SKIP HIGH
 SHLD TXA
 JMP SIF14
*
*
SIF13 CPI CR
 RZ .   WAS NO MATCHING ELSE CLAUSE
 INX H  EAT THE CHAR, NOW THAT IT ISN'T A CR
 SHLD TXA
 CPI IFRW
 JZ SIF90
 CPI ELSERW
 JNZ SIF14
 DCR B
 JNZ SIF14
 JMP SIF00  MATCHING ELSE FOUND
*
*
*
*
*
*   GOTO STATEMENT
*
*
*
GOTO CALL LNUM  RETURNS INTEGER IN HL IF LINE NUMBER PRESE
 JC BSERR  SYNTAX ERROR IF NO LINE NUMBER
*
GOTO1 CALL DIRT
 XCHG .  FINDLN WANTS LN IN DE
GOTO3 CALL FNEQLN  RETURNS TEXT ADDRESS  POINTS TO COUNT VALUE
*
GOTO2 INX H
 INX H
 INX H  ADVANCE TEXT POINTER PAST LINE NUMBER AND COUNT
 SHLD TXA
 POP H  EAT RETURN LINK
 JMP ILOOP  INTERPRET NEXT STATEMENT
*
*
*     ERRCLR
*
SERRC LXI H,0
 SHLD ERRLN
 RET
*
*
*     ERRSET
*
SERRS CALL LNUM  GET THE LINE NUMBER
 JC BSERR  MUST HAVE LINE NUMBER
 XCHG
SES0 CALL FNEQLN  THIS ENTRY USED BY "ON2"
 SHLD ERRLN  SAVE UNTIL AN ERROR OCCURS
 RET .  ALL DONE
*
ERRLN DS 2
*
*
*     ON STATEMENT
*
ON CALL NFIXE  GET VAL OF EXPR (DIRT IS CALLED LATER)
 MOV A,B  B#0 ==> NEG RESULT
 ORA A
 JNZ NEXTS  FALL TRU TO NEXT STATEMENT FOR NEG NUMBERS
 ORA D  NOTE: A IS ZERO
 JNZ NEXTS  TOO BIG, FALL THRU TO NEXT STATEMENT
*
 CALL GCI  GET STATEMENT AFTER THE EXPRESSION (GOTO, GOSUB, ETC)
 PUSH PSW  SAVE FOR ON2
 PUSH D  SELECTOR
*
ON1 CALL LNUM
 JC BSERR
 POP B  SELECTOR
 DCR C  LOW PART
 JZ ON2  THIS IS THE ONE WE WANT
 PUSH B  SAVE FOR NEXT TIME'ROUND
 CALL GC  TEST FOR CR
 CPI CR
 JZ ON9  FALL THRU
 CPI EOSRW  OR EOS
 JNZ ON1
*
*  NO LINE NUMBER SELECTED, FALL THRU TO NEXT STATEMENT
ON9 POP B
 POP B  CLEAN STACK
 JMP NEXTS  FALL THROUGH TO NEXT STATEMENT
*
*
*   HAVE DESTINATION LINE NUMBER IN HL
*
ON2 XCHG .  DEST LN TO DE
 CALL DIRT
 CALL NEXTS  POINT TO NEXT LINE (FOR THOSE WHO CARE, LIKE GOSUB)
*
 POP PSW  GET STATEMENT CODE
 CPI GOTORW  GOTO?
 JZ GOTO3
 CPI GOSURW  GOSUB?
 JZ GOSU0
 CPI ERSRW  ERRSET?
 JZ SES0
 CPI RESTRW  RESTORE?
 JZ REST0
 CPI EXITRW  EXIT?
 JNZ BSERR  **  NOT ANY  **
 PUSH D
 JMP EXIT0
*
*
*     EXIT STATEMENT
*
*   SAME AS GOTO EXCEPT TERMINATES CURRENT FOR/NEXT
*
EXIT CALL DIRT
 CALL LNUM  ADDR OF NEW LINE NUM
 PUSH H  IN HL, SAVE IT
EXIT0 LHLD TSTKA
*
EXIT1 INX H
 MOV A,M
 CPI FRTYPE  CHECK FOR FOR LOOP ENTRY ON CONTROL STACK
 JNZ EXIT2  IF NONE, THEN DO A GOTO
 LXI D,FORSZ-1
 DAD D
 SHLD TSTKA
*
*  NOW GOTO THE LINE (TXA IN TOS)
EXIT2 POP D
 JMP GOTO3
*
*
*  GOSUB STATEMENT
*
GOSUB CALL DIRT
 CALL LNUM  WHERE TO GO IN HL (LINE NUMBER)
 JC BSERR
 XCHG .   LINE NUMBER TO DE
GOSU0 CALL JOE  SKIP TO NEXT LINE, ALSO...
 MOV B,H  JOE GIVES US THE RETURN ADDRESS IN HL
 MOV C,L
 PUSH D  SAVE LN
 LXI D,-3
 CALL PSHCS
 MOV M,B  STACK RETURN ADDRESS
 DCX H
 MOV M,C
 DCX H
 MVI M,GTYPE  MAKE CONTROL STACK ENTRY TYPE 'GOSUB'
 POP D  GET LN
 JMP GOTO3  LINE NUM IS IN DE
*
*
*
*
*     RETURN STATEMENT
*
*
*
RETRN CALL DIRT
 LHLD TSTKA
 INX H
*
RET1  MOV A,M
 CPI ETYPE  CHECK FOR STACK EMPTY
 JZ CSERR
 CPI GTYPE  CHECK FOR GOSUB TYPE
 JZ RET2
 CPI SBTYPE  STACK BLOCK TYPE (INDICATING A FUNCTION CALL)
 JZ RET3
*
*  MUST HAVE BEEN FOR TYPE ENTRY, REMOVE IT
 LXI D,FORSZ
 DAD D
 JMP RET1
*
*  FOUND A GTYPE STACK ENTRY
RET2 INX H
 MOV E,M  LOW ORDER RETURN TEXT ADDRESS
 INX H
 MOV D,M  HIGH ORDER RETURN TXT ADDRESS
 SHLD TSTKA
 LDAX D
 DCR A
 JNZ NEXT4
 JMP END
*
*  STACK BLOCK ENTRY FOUND ON STACK, REMOVE IT THEN SEE WHAT
*
RET3 INX H  ADVANCE POINTER TO IFTERM
 MOV C,M  SAVE IN C
*
 INX H  ADVANCE PTR TO -SIZE OF STACK BLOCK
 MOV A,M
 MOV B,A  SAVE IT IN B
*
 ADI CMNDSP-SPCMND  DOES AN 8 BIT ADD
 MOV E,A
 MVI A,CMNDSP/256
 ACI 377Q  COMPLETE THE DBLE PRECISION ADD
 MOV D,A  DE NOW HAS ADDRESS OF TOP OF NEW (I.E. OLD) 8080
*
 XCHG
 SPHL .  SET THE STACK PTR (WE HAVEN'T PUT THE STACK BACK YET)
 PUSH B  SAVE IFTERM (IN C)
*
RET31 INX D  COPY STACK BLOCK TO STACK
 LDAX D
 MOV M,A
 INX H
 INR B
 JNZ RET31
*
 XCHG
 SHLD TSTKA  WE ARE DONE WITH THE STACK BLOCK
*
 INX H  ADVANCE PTR TO TYPE OF FUNCTION STACK ENTRY
 MOV A,M
 CPI FNTYPE
 JZ RET4  JMP IF NUMERIC FUNCTION TYPE
*
*  STRING TYPE FUNCTION ENTRY FOUND ON STACK
*
 PUSH H  REMEMBER TSTKA FOR RETURNING RESULT STRING
 CALL SEXPG
 POP D
 PUSH D
 PUSH H
 CALL JOE
 CALL POPRG  POP THE ARGS
 POP B
 LHLD TSTKA
 POP D
 DCX D
 PUSH B  SIZE OF RESULT
 CALL RMOV  MOV THE RETURN VALUE 'DOWN' TO TOP OF STACK
 SHLD TSTKA
 POP D  SIZE MUST BE RETURNED IN DE
*
*  RESTORE IFTERM AND RETURN FROM FUNC TO ITS CALLER
*
RETRET POP B  GET IFTERM
 MOV A,C
 STA IFTERM  RESTORE IFTERM
 RET .  THIS SHOULD TAKE US BACK TO FUNC
*
*  FOUND A NUMERIC FUNCTION TYPE ENTRY
*
RET4 DCX H
 PUSH H  PTR TO RESULT VALUE
 INX H
 PUSH H  TSTKA PTR TO FNTYPE ENTRY
 CALL EXPRB
 CALL JOE
 POP D
 CALL POPRG
 POP H
 CALL PSHAS
 JMP RETRET
*
*  SUBROUTINE ONLY USED BY RET, FOR POPPING OFF AND RESTORING
*  ORIGINAL VALUES FOR THE FORMALS TO FUNCTION CALL
*  ALSO RESTORES TXA TO CALLING ENVIRONMENT AND RETURNS
*  TSTKA IN HL
*  EXPECTS PTR TO FUNCTION TYPE ENTRY IN DE
*
POPRG XCHG
 INX H
 MOV E,M
 INX H
 MOV D,M
 XCHG
 SHLD TXA
 XCHG
*
POPR1 INX H  MOVE TO NEXT TYPE BYTE
 MOV A,M
 CPI EFTYPE  LOOK FOR END OF FUNCTION MARKER
 SHLD TSTKA
 RZ
*
*  MUST HAVE BEEN NUMERIC ARG (NO NEED TO CHECK)
 INX H
 MOV E,M  LOW ORDER BYTE OF SYMTAB PTR
 INX H
 MOV D,M  HIGH ORDER BYTE OF SYMTAB PTR
 SHLD TSTKA
 CALL POPA1
 LHLD TSTKA
 JMP POPR1
*
*