*
*
*
*     EVALUATE AN EXPRESSION FROM TEXT
*     HL TAKE OP TABLE ADDR OF PREVIOUS OPERATOR
*     HL LEFT UNCHANGED
*     RESULT VALUE LEFT ON TOP OF ARG STACK, ARGF LEFT TRUE
*
*
EXPRB LXI H,OPBOL
*
EXPR PUSH H  PUSH OPTBA
 LXI H,-CMNDSP+SSIZE-10  CAUSE ERROR IF WITHIN 10 OF END O
 DAD SP
 JNC ISERR  INTERNAL STACK TOO BIG
 XRA A
 STA ARGF
 JMP EXP1A
*
EXPR1 LDA ARGF
 ORA A
 JNZ EXPR2
*
EXP1A CALL NAME1   LOOK FOR POSSIBLE VARIABLE NAME
 JC EXPR0  WASN'T VARIABLE
 CALL PSHAS  PUT ON STACK
 JMP EXPR2
*
EXPR0 CALL CONST
 JNC EXPR2
 MVI A,NFTYPE
 CALL FUNC
 JNC EXPR2
 LHLD TXA
 MOV A,M
 CPI LENRW
 JZ FLEN
 CPI CALLRW
 JZ FCALL
 CPI ASCRW
 JZ FASC
 CPI VALRW
 JZ FVAL
 CPI LPARRW
 LXI H,OPLPAR
 JZ XLPAR
*
*     ISN'T OR SHOULDN'T BE AN ARGUMENT
*
EXPR2 LHLD TXA
 MOV A,M
 CPI TOKCM
 JC EXPR8
 CPI TOKOP
 JC XOP
 CPI TOKFU
 JC XBILT
*
*   ILLEGAL EXPRESSION CHARACTER
*
EXPR8 POP H  GET OPTABA
 LDA ARGF
 ORA A
 RNZ
 JMP BSERR
*
*
XOP LDA ARGF  TEST FOR ARGF TRUE
 DCR A
 MOV A,M  GET BACK TOKEN
 JZ XOP1
*
*   ARGF WAS FALSE, UNARY OPS ONLY POSSIBILITY
*
 CPI MINRW
 JZ XOPM
*
 CPI NOTRW
 JZ XOP1
*
 CPI PLSRW
 JNZ BSERR
*
 INX H
 SHLD TXA  EAT THE '+'
 JMP EXPR1
*
XOPM MVI A,UMINUS
XOP1 LXI H,OPTAB
 SUI TOKCM
 CALL OPADR
 POP D  PREVIOUS OPTBA
 LDAX D
 CMP M
 RNC
*
*     INCREASING PRECEDENCE CASE
*
 PUSH D
 XCHG
 LHLD TXA
 INX H
 SHLD TXA
 XCHG .  GET IT BACK
 PUSH H
 CALL EXPR
 POP H
*
*     HL HAS OPTBA ADDRESS
*     SET UP ARGS AND PERFORM OPERATION ACTION
*
XOP2 PUSH H
 MOV A,M
 CALL TOPFP
 MOV B,D
 MOV C,E
*
* AT THIS POINT: DE= # DE  FOR UNARY OPS
*
 ANI 1
 JNZ XOP21
*
*     DECREMENT STACK POINTER BY ONE VALUE, BINARY CASE
*
 SHLD TSTKA
 LXI B,FPSIZ
 DAD B
 MOV B,H
 MOV C,L
*
XOP21 LXI H,EXPR1
 XTHL .  CHANGE RETURN LINK
 INX H  SKIP OVER PRECEDENCE
 MOV A,M
 INX H
 MOV H,M
 MOV L,A
 PUSH H
 XCHG .  DE TO HL
 MOV D,B
 MOV E,C
*
*       AT THIS POINT: BC=DE # HL
*
FLPAR RET .  BRANCH TO ACTION ROUTINE
*
*           BUILT IN FUNCTION PROCESSING
*
XBILT INX H  EAT TOKEN
 SHLD TXA
 SUI TOKOP
 MOV C,A
 LDA ARGF  BUILT IN FUNCTION MUST COME AFTER AN OPERATOR
 DCR A
 JZ BSERR
 LXI H,OPBOL  DISPATCH TABLE FOR BUILT IN FUNCTIONS
 CALL OPAD1  OPTBA TO HL
*
XLPAR PUSH H
 CALL EATLP
 CALL EXPRB
 CALL EATRP
 POP H  CODE FOR BUILT-IN FUNTION
 JMP XOP2
*
*          COMPUTE OPTABLE ADDRESS FOR OPERATOR IN ACC
*
OPADR MOV C,A
OPAD1 MVI B,0
 DAD B
 DAD B
 DAD B  OPTAB ENTRY ADDR IS 3*     OP+BASE
 RET
*
*
*
*
*     EVALUATE FUNCTION, AND LEAVE VALUE ON STACK
*     SET CARRY IF NO FUNCTION CALL FOUND
*
*
FUNC EQU $  ACCA SEPARATES NUMERIC FROM STRING
 MOV D,A  SAVE FLAG
 MVI A,FNRW
 CALL SCANC
 RC .  RETURN IF NO FN RW FOUND
 CALL DIRT
 PUSH D  STRING\NUMERIC FLAG
 CALL FNAME
 POP D  STRING NUMERIC FLAG
 PUSH D
 MOV A,C
 ANI 7*16
 CMP D
 JNZ TYERR
 CALL STLK
 JC FDERR  USE OF UNDEFINED FUNCTION
 MOV E,M
 INX H
 MOV D,M
 PUSH D
 CALL EATLP
*
*  LOOP TO ASSIGN ARGS TO FORMALS
*
 LXI D,-1
 CALL PSHCS  PUSH MARKER
 MVI M,EFTYPE
 CALL FTXA  TXA TO DEFINITION
*
FUNC1 CALL VAR
 CALL FTXA  TXA TO CALL
 JZ FUNC3  JUMP IF STRING CASE
*
*  NUMERIC CASE
*
 PUSH H  SYM TAB PTR
 CALL PSHAS  SAVE OLD VALUE OF PARAMETER ON STACK
 LXI D,-3
 CALL PSHCS
 POP D
 PUSH D  SYMTAB PTR
 MOV M,D  SAVE SYMTAB PTR ON CSTACK
 DCX H
 MOV M,E
 DCX H
 MVI M,ANTYPE
 CALL EXPRB  GET NEW ARG VALUE
 POP D  SYMTAB PTR
 CALL POPA1  STORE ARG VALUE IN SYMTAB
*
FUNC2 CALL GCI
 CPI ','
 JNZ FUNC9  MUST BE END OF LIST
 CALL FTXA  TXA TO DEF
 CALL SCOMA  SHOULD BE COMMA IN DEF NOW
 JC FUNC6
 JMP FUNC1
*
*
*  STRING ARGUMENT CASE
*
FUNC3 MVI A,0
 CALL STASS
 JMP FUNC2
*
*
*     FOUND NON COMMA IN CALL
*
FUNC9 CPI ')'
 JNZ BSERR
 CALL FTXA  TXA TO DEF
 MVI A,')'
 CALL SCANC
 JC FUNC6
 LXI D,-3
 CALL PSHCS
 POP D  TEXT PTR TO CALL (AFTER ')')
 MOV M,D
 DCX H
 MOV M,E
 DCX H
 POP PSW  TYPE OF FUNCTION CALL
 MOV M,A
*
*  NOW COPY STACK BLOCK TO TEMP STACK
*
 LXI H,-CMNDSP-3
 DAD SP
 XCHG
 CALL PSHCS
 LXI B,CSPM1
 INR E
 INR E
 INR E
 MOV D,E
*
FUNC8 LDAX B
 MOV M,A
 DCX B
 DCX H
 INR E
 JNZ FUNC8
*
 MOV M,D
 DCX H
*
 LDA IFTERM
 MOV M,A  SAVE IFTERM
 DCX H
*
 MVI M,SBTYPE  PUT TYPE ON STACK
 LXI SP,CMNDSP  SET UP INTERNAL STACK AGAIN
*
*  NOW DECIDE IF IT WAS A ONE-LINER OR MULTI-LINE FUNCTION
*  NOTE: THE RETURN STATEMENT WILL RETURN TO OUR CALLER
*
 MVI A,EQRW
 CALL SCANC
 JNZ IL1  GO EXECUTE FIRST STATEMENT OF FUNCTION
 JMP RETRN  GO COMPUTE VALUE TO RETURN
*
*
*  COME HERE WHEN A  EXPECTED ')' WAS NOT FOUND IN DEF
*
FUNC6 CALL FTXA  TXA TO CALL
 JMP AMERR  ARLIST MISMATCH
*
*
*     STRING EXPRESSION EVALUATION
*     ACC IS STRING CONST TERMINATION CHAR, 0=SAME AS DOUBLE QUO
*     IF ACC=0 THEN GENERAL STRING EXPR'S FOUND, ELSE ONLY SINGL
*     LEAVES STRING ON ARG STACK
*     RETURN LENGTH IN HL
*
SEXPG XRA A  USE THIS ENTRY POINT FOR GENERAL EXPRESSIONS
*
SEXPR LXI B,0  INITIAL SIZE OF RESULT STRING
 PUSH B  ACCUMULATING LENGTH OF RESULT
 ORA A  SET Z CONDITION FROM ACCUMULATOR
 PUSH PSW  STRING TERMINATION CHAR
*
SEXP0 POP PSW
 PUSH PSW  GET ARG FOR SCONS
 CALL SCONS
 JNC SEXP1  JMP IF STRING CONSTANT FOUND
*
 POP PSW
 PUSH PSW
 JNZ BSERR  EXPRESSION MUST BE SINGLE STRING CONST
*
 CALL GC
 CPI CHRRW
 JZ ACHR  CHR FUNCTION
*
 CPI STRRW
 JZ ASTR
*
 CPI ERRRW
 JZ AERR
*
 MVI A,SFTYPE
 CALL FUNC
 JNC SEXP3
*
 CALL VAR
 JNZ TYERR
*
*  CONCATENATE STRING TO STACK
*
SEXP1 MOV A,D
 ORA E
 JZ SEXP3  STRING WAS ZERO LENGTH
 LHLD TSTKA
 MOV B,H
 MOV C,L  SAVE BEGINNING OF NEW STRING AREA IN BC
 CALL DSUB
 CALL STOV  WILL STRING FIT
 SHLD TSTKA  ALLOCATE NEW STRING IN TEMP AREA
 PUSH D  SIZE
 LHLD STRBA
*
*  COPY STRING TO TEMP STACK
*
SEXP2 MOV A,M
 STAX B
 DCX B
 INX H
 DCX D
 MOV A,D
 ORA E
 JNZ SEXP2
 POP D  SEXP3 EXPEXTS SIZE IN D
*
*   STRING COPIED TO STACK, NOW SEE IF MORE TO DO
*
SEXP3 POP PSW  TEST THAT  SINGLE STRING CONST
 POP H  ACCUMULATING SIZE
 DAD D
 PUSH H
 JNZ SEXP4  IF ONLY STR CONST ALLOWED
 PUSH PSW
 MVI A,PLSRW
 CALL SCANC
 JNC SEXP0
 POP H  GET RID OF SCONS ARG
SEXP4 POP H  RETURN LENGTH IN HL
 RET
*
*     HANDLES THE CHR$ FUNCTION FOR SEXPR
*
ACHR CALL EATL0  EAT THE CHR$ RW AND THE LEFT PAREN
 CALL PFIXE
 PUSH D
 LXI D,-1
 CALL PSHCS
 POP D
 MOV M,E  PUT THE SINGLE CHARACTER ON STACK
 CALL EATRP
 LXI D,1  SET UP FOR SEXPR3
 JMP SEXP3
*
*     HANDLES THE STR$ FUNCTION
*
ASTR CALL EATL0
 CALL EXPRB
 CALL EATRP
*
 CALL POPFP  POP THE VALUE
 LHLD TSTKA  ADDR OF WHERE ARG WAS ON STACK
 CALL FPOUT
*
 LDA CFORM
 CPI '#'  FREE FORMAT?
 JNZ ASTR1  NO
*
ASTR0 MOV A,M
 INX H
 DCR B
 CPI ' '
 JZ ASTR0  EAT SPACES
 DCX H
 INR B
*
*  SIZE IS IN B, ADDRESS OF FIRST CHAR IN HL
*
ASTR1 MOV E,B
 MVI D,0
 SHLD STRBA
 JMP SEXP1
*
*  ERR FUNCTION
*
AERR CALL EATL0
 CALL PFIXE
 MOV A,D
 ORA E
 JNZ OBERR
 CALL EATRP
*
 LXI D,22  LENGTH OF ERRBUF
 LXI H,SHORT
 MVI A,' '
 CMP M
 JZ AERR0
 LXI D,8
AERR0 LXI H,ERRBUF  ADDR OF SAME
 SHLD STRBA
 JMP SEXP1
*
*
*     STRING ASSIGNMENT SUBROUTINE
*     ACC=0 IF GENERAL EXPRESSION OK, ELSE ACCUMULATOR CONTAINS
*      TERMINATION CHARACTER FOR A CONSTANT STRING
*     THE REGISTERS AND PSW ARE SET UP AS BY A VAR RETURN
*
*
STASS PUSH H  BASE ADDRESS--"LET" ENTERS AT STAS1 W/ HL ON STACK
STAS1 PUSH PSW  TERMINATION CHARACTER AND SUBSTRING FLAG
 PUSH B  SYMTAB PTR TO LG
 LHLD STRMX
 PUSH H
 CALL SEXPR  ACC STILL HAS TERMINATION FLAG
 XCHG .  SOURCE LENGTH TO DE
 LHLD TSTKA
 DAD D
 SHLD TSTKA
 LXI H,1
 DAD SP  PUTS ADDRESS OF STRMX(ON STACK) IN HL
 CALL DCMP1
 POP H  REMOVE STRMX FROM STACK
 JC STAS2
 XCHG
*
* THE SMALLER OF SOURCE LENGTH AND DESTINATION MAX IS IN DE
*
STAS2 POP H  SYMTAB PTR TO LOG SIZE IN DESTINATION
 POP PSW  GET C CONDITION FOR SUBSTRING TEST
 CNC DSTOR  MODIFY LOGICAL LENGTH ONLY IF NOT SUBSTRING
 POP B  BASE ADDRESS OF RESULT
 LHLD TSTKA
*
* HL HAS FIRST CHAR ON ARG STACK (IF ANY)
* DE HAS COUNT (POSSIBLY 0)
* BC HAS BASE ADDRESS OF DEST
*
STAS4 MOV A,D  FASTER LOOP IF WE TEST FIRST
 ORA E
 RZ
*
STA4A MOV A,M
 STAX B
 DCX H
 INX B
 DCX D
 MOV A,D
 ORA E
 JNZ STA4A  LOOP
 RET .
*
*