; > Evaluate ; BASIC expression evaluator ; 30-Aug-2008: Recursive Expression Evaluator and binary operator dispatch written ; 01-Sep-2008: Hex values, double quotes, octal values ; Octal numbers not working ; 03-Mar-2009: 31-bit decimal numbers working ; 12-Nov-2009: EnsureString00 and EnsureStringCR copy to string buffer if needed ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; Check for syntax character and evaluate following expression ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Check for and step past ',' ; =========================== .CheckComma jsr pc,SkipSpaces .CheckComma1 inc r5 .CheckComma2 cmpb r0,#ASC"," bne errMissingComma rts pc .errMissingComma jsr pc,Error equb 5,tknMissing,44,0 align ; Check for ',' evaluate and return following integer ; =================================================== .EvalComma jsr pc,CheckComma br EvalInteger ; Check for and step past '=' ; =========================== .CheckEqual jsr pc,SkipSpaces .CheckEqual1 cmpb r0,#ASC"=" bne errMissingEqual inc r5 rts pc .errMissingEqual jsr pc,Error equb 4,tknMissing,"=",0 align ; Check for '=', evaluate and return following integer ; ==================================================== .EvalEqual jsr pc,CheckEqual br EvalInteger ; Check for '#', evaluate and return following integer expression ; =============================================================== .EvalHash jsr pc,SkipSpaces cmpb r0,#ASC"#" beq EvalInteger1 .errMissingHash jsr pc,Error equb 45,tknMissing,"#",0 align ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; Evaluate expression and check for expected returned type ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; EvalInteger - Evaluate numeric expression and return integer ; ============================================================ .EvalInteger1 inc r5 ; Step past prefix character .EvalInteger jsr pc,EvalNumeric ; Call expression evaluator ; Fall through to convert float to integer ; EnsureInteger - If float, demormalise into an integer ; ===================================================== ; On entry, r2/r3/r3=value ; On exit, r2/r3/r4=integer value, flags set ; .EnsureInteger tst r2 ; Check if float beq EnsureIntDone ; Already an integer ; .EnsureIntDone rts pc ; EvalNumeric - Evaluate numeric expression ; ========================================= .EvalNumeric jsr pc,Evaluate ; Call expression evaluator bmi errTypeMismatch ; Returned string, we wanted a number rts pc ; EvalString - Evaluate string expression ; ======================================= .EvalString jsr pc,Evaluate ; Call expression evaluator bpl errTypeMismatch ; Returned number, we wanted a string rts pc ;; ; EnsureString00 - Ensure string is zero-terminated ;; ; ================================================= ;; .EnsureString00 ;; bit #&0200,r2 ; Is type &82xx ? ;; bne EnsStrDone ; Already 00-string ;; mov #&8200,r2 ; Want 00-string ;; br EnsString ; EvalStringCR - Evaluate string expression and return CR-terminated ; ================================================================== .EvalStringCR jsr pc,EvalString ; Call expression evaluator ; If not fixed string, need to copy to string buffer ; Not safe to assume a string will already be in string buffer ; Could be $$ string or var$ string ; EnsureStringCR - Ensure string is CR-terminated ; =============================================== .EnsureStringCR bit #&0100,r2 ; Is type &81xx ? bne EnsStrDone ; Already CR-string mov #&810D,r2 ; Want CR-string .EnsString adr SV_STRING,r1 ; r1=>string buffer tst r3 beq EnsStrZero ; Zero-length string .EnsStrLp movb (r4)+,(r1)+ ; Copy to string buffer dec r3 bne EnsStrLp .EnsStrZero movb r2,(r1) ; Put terminator in adr SV_STRING,r4 ; r4=>string sub r4,r1 mov r1,r3 ; r3=length .EnsStrDone bic #&00FF,r2 ; Clear b0-b7 of type, set flags rts pc .errTypeMismatch jsr pc,Error equb 6,"Type mismatch",0 align ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; Evaluate value and check for expected returned type ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; Check for '#', evaluate and return following integer value ; ========================================================== .EvalHashVal jsr pc,SkipSpaces cmpb r0,#ASC"#" bne errMissingHash inc r5 ; EvalIntVal - Evaluate integer value ; =================================== .fnINT .EvalIntVal jsr pc,EvalNumVal ; Call level 1 expression evaluator br EnsureInteger ; If float, convert to integer ; EvalNumVal - Evaluate numeric value ; ==================================== .EvalNumVal jsr pc,EvalLevel1 ; Call level 1 expression evaluator bmi errTypeMismatch ; Returned string, we wanted a number rts pc ; EvalStrVal - Evaluate string value ; ================================== .EvalStrVal jsr pc,EvalLevel1 ; Call level 1 expression evaluator bpl errTypeMismatch ; Returned number, we wanted a string rts pc ; EvalStrValCR - Evaluate string value and return CR-terminated ; ============================================================= .EvalStrValCR jsr pc,EvalLevel1 ; Call level 1 expression evaluator bpl errTypeMismatch ; Returned number, we wanted a string ; if not fixed string, should copy to string buffer ; safe to assume a string will already be in string buffer add r4,r3 ; r3=>end of string mov #13,(r3) ; Put terminating CR in rts pc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; ;; EXPRESSION EVALUATOR ;; ;; -------------------- ;; ;; Recursively calls seven expression levels, evaluating expressions at ;; ;; each level, looping within each level until all operators at that ;; ;; level are exhausted. ;; ;; ;; ;; On entry, r5=>start of expression to evaluate ;; ;; On exit, r5=>first character after evaluated expression ;; ;; r4/r3/r2=returned value, flags set from r2 ;; ;; MI, r2=&80xx - string, r3=length, r4=start ;; ;; PL, r2=&00xx - number ;; ;; PL, EQ, r2=&0000 - integer, r3=b16-b31, b4=b0-b15 ;; ;; PL, NE, r2=&00xx - real, r2=exponent, ;; ;; r3=mantissa b16-b31, r4=mantissa b0-b15 ;; ;; ;; ;; Within the evaluator, (r5)=next matched character ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; .Evaluate ; Evaluator Level 7 - OR, EOR ; =========================== .EvalLevel7 jsr pc,EvalLevel6 ; Call level 6 - AND .EvalLevel7More movb (r5),r0 cmpb r0,#tknOR beq EvalOR cmpb r0,#tknEOR beq EvalEOR tst r2 ; Set flags from result type rts pc .EvalOR .EvalEOR inc r5 ; Step past current character jsr pc,StackIntAndOp jsr pc,EvalLevel6 ; Evaluate RHS parameter jsr pc,UnstackIntAndCallOp br EvalLevel7More ; Loop to check for more OR/EOR ; Evaluator Level 6 - AND ; ======================= .EvalLevel6 jsr pc,EvalLevel5 ; Call level 5 - < <= = >= > <> .EvalLevel6More movb (r5),r0 cmpb r0,#tknAND beq EvalAND rts pc .EvalAND inc r5 ; Step past current character jsr pc,StackIntAndOp jsr pc,EvalLevel5 ; Evaluate RHS parameter jsr pc,UnstackIntAndCallOp br EvalLevel6More ; Loop to check for more AND ; Evaluator Level 5 - < <= = >= > <> ; ================================== .EvalLevel5 ;jsr pc,EvalLevel4 ; Check for +, - ; Evaluator Level 4 - + - ; ======================= .EvalLevel4 jsr pc,EvalLevel3 ; Call level 3 - * / DIV MOD .EvalLevel4More movb (r5),r0 ; get current character cmpb r0,#ASC"+" beq EvalPlus cmpb r0,#ASC"-" beq EvalMinus rts pc ; Return .EvalPlus .EvalMinus inc r5 ; Step past current character jsr pc,StackValAndOp jsr pc,EvalLevel3 ; Evaluate RHS parameter jsr pc,UnstackValAndCallOp br EvalLevel4More ; Loop to check for more + - ; Evaluator Level 3 - * / DIV MOD ; =============================== .EvalLevel3 jsr pc,EvalLevel2 ; Call level 2 - ^ .EvalLevel3More movb (r5),r0 ; Get current character cmpb r0,#ASC"*" beq EvalTimes cmpb r0,#ASC"/" beq EvalDivide cmpb r0,#tknDIV beq EvalDIV cmpb r0,#tknMOD beq EvalMOD rts pc ; Return .EvalTimes .EvalDivide .EvalDIV .EvalMOD inc r5 ; Step past current character jsr pc,StackValAndOp jsr pc,EvalLevel2 ; Evaluate RHS parameter jsr pc,UnstackValAndCallOp br EvalLevel3More ; Loop to check for more * / DIV MOD ; Evaluator Level 2 - ^ ; ===================== .EvalLevel2 jsr pc,EvalLevel1 ; Call level 1 - eveything else .EvalLevel2More movb (r5)+,r0 ; Get current character cmpb r0,#32 beq EvalLevel2More ; Skip spaces cmpb r0,#ASC"^" beq EvalPower dec r5 rts pc .EvalPower jsr pc,StackValAndOp jsr pc,EvalLevel1 ; Evaluate RHS parameter jsr pc,UnstackValAndCallOp br EvalLevel2More ; Loop to check for more ^ .errMissingQuote jsr pc,Error equb 9,tknMissing,34,0 align ; EvalBracket - bracketed expression ; ---------------------------------- .EvalBracket jsr pc,Evaluate ; Evalute everything within brackets jsr pc,CheckClose ; Check closing bracket tst r2 ; Set flags from returned type rts pc ; EvalUnaryPlus - + ; ------------------------ .EvalUnaryPlus jmp EvalNumVal ; Get numeric value ; EvalUnaryMinus - - ; ------------------------- .EvalUnaryMinus jsr pc,EvalNumVal ; Get numeric value .NegateNumber tst r2 ; Check if integer or float bne EvalUnaryMinusFloat mov r2,r1 ; r2=r1=0 sub r4,r2 ; r2=r2-r4, r2=0-r4 sbc r1 sub r3,r1 ; r1=r1-r3, r1=0-r3 mov r1,r3 mov r2,r4 clr r2 rts pc .EvalUnaryMinusFloat mov #&800,r1 xor r1,r3 ; Toggle mantissa sign bit tst r2 rts pc ; EvalQuote - an immediate string ; ------------------------------- .EvalQuote adr SV_STRING,r4 ; Point to string buffer clr r3 ; Length=0 .EvalQuoteLp movb (r5)+,r0 ; Get character cmpb r0,#13 beq errMissingQuote movb r0,(r4)+ ; Store in string buffer inc r3 ; Increment length cmpb r0,#34 ; Is this a quote? bne EvalQuoteLp ; Loop until terminating quote movb (r5)+,r0 cmpb r0,#34 ; Double quote? beq EvalQuoteLp dec r5 adr SV_STRING,r4 ; Point to string buffer dec r3 ; Balance final inc mov #&8000,r2 ; Type=string, set flags rts pc ; EvalBinary - % ; ---------------------- .EvalBinary movb (r5)+,r0 cmp r0,#ASC"0" bcs EvalBinDone cmp r0,#ASC"2" bcc EvalBinDone inc r2 ror r0 rol r4 rol r3 bcc EvalBinary jmp errTooBig .EvalBinDone tst r2 beq errBadOct dec r5 .EvalBinOk clr r2 rts pc ; ^ - address of identifier ; ----------------------------------- ; NB, does ^PROCname/^FNname due to VarFind also looking for FN/PROCs .EvalAddrOf jsr pc,VarFindVariable ; Search, ignoring indirections clr r3 bcc EvalBinOk jmp errNoSuchVar ; Evaluator Level 1 - & - + () " ? ! | $ function variable ; ======================================================== ; Called by other functions, so must set flags on exit ; .EvalLevel1 ; Need to check for free memory clr r4 ; Set initial accumulator to 0 clr r3 clr r2 .EvalLevel1Spc movb (r5)+,r0 ; Get current character cmp r0,#32 beq EvalLevel1Spc ; Skip spaces bic #&FF00,r0 ; Ensure 8-bit value cmp r0,#ASC"(" beq EvalBracket cmp r0,#ASC"^" beq EvalAddrOf cmp r0,#ASC"+" beq EvalUnaryPlus cmp r0,#ASC"-" beq EvalUnaryMinus cmp r0,#ASC"%" beq EvalBinary cmp r0,#ASC"&" beq EvalHex cmp r0,#&22 beq EvalQuote mov r0,r2 ; r2=operator for function routines cmp r0,#&8D bcc EvalFunction ; Token, jump via dispatch table cmp r0,#ASC"9"+1 bcc EvalVariable ; Not number, must be a variable cmp r0,#ASC"0" bcc EvalDecimalDigit ; '0'..'9', decimal number cmp r0,#ASC"." bne EvalVariable dec r5 ; Point to '.' ; EvalDecimal - read decimal number ; --------------------------------- ; Reads 31-bit decimal number to r4:r3 ; Returns CC if number too big ; .EvalDecimal clr r4 clr r3 ; Clear accumulator .EvalDecimalLp movb (r5)+,r0 jsr pc,CheckDigit bcs EvalDecimalOk ; CS=no more digits jsr pc,EvalTimes10 ; r3:r4=r3:r4*10 .EvalDecimalDigit bic #&FFF0,r0 add r0,r4 adc r3 ; r3:r4=r3:r4*10+n bit #&8000,r3 beq EvalDecimalLp ; Decimal number only up to b30 clc ; CC=Number too bit .EvalDecimalOk .EvalDecimalDone .EvalHexDone dec r5 ; Point to terminating non-digit clr r2 ; Type=integer, set flags rts pc .EvalTimes10 ; r3:r4=r3:r4*10 mov r4,r2 mov r3,r1 clc rol r4 rol r3 ; r3:r4=*2 rol r4 rol r3 ; r3:r4=*4 add r2,r4 adc r3 add r1,r3 ; r3:r4=*5 rol r4 rol r3 ; r3:r4=*10 .EvalTimes10Over rts pc ; CC=number ok, CS=too big ; EvalHex - & ; ---------------------- .EvalHex mov #4,r1 ; Set to Hex movb (r5),r0 bic #&20,r0 ; Force upper case cmp r0,#ASC"O" bne EvalNotOct ; Scan hex value dec r1 ; Set flag to Oct inc r5 ; Step past 'o' movb (r5)+,r0 ; Get first octal digit jsr pc,CheckDigit bcs errBadOct bcc EvalHexGo .EvalNotOct movb (r5)+,r0 ; Get first hex digit jsr pc,CheckHexDigit bcc EvalHexGo .errBadOct jsr pc,Error equb 28,"Bad HEX, OCT or BIN",0 align .EvalHexLp1 movb (r5)+,r0 jsr pc,CheckHexDigit bcs EvalHexDone bit #4,r1 ; Hex or Oct? bne EvalHexGo ; Jump for Hex cmp r0,#ASC"8" bcc EvalHexDone ; No more octal digits bic #&FFF8,r0 ; Convert to octal digit .EvalHexGo cmp r0,#ASC"A" bcs EvalHexDigit ; 0-9, add digit sub #ASC"A"-ASC"9"-1,r0 .EvalHexDigit bic #&FFF0,r0 ; Convert to hex digit mov r1,-(sp) ; Save hex/oct flag .EvalHexLp2 asl r4 ; Multiply current value by 16 rol r3 bcc EvalHex3 jmp errTooBig ; Overflowed out of b31 .EvalHex3 dec r1 bne EvalHexLp2 mov (sp)+,r1 ; get hex/oct flag back bis r0,r4 ; Add in new digit br EvalHexLp1 ; Must be !, $, ?, |, variable, variable!offset or variable?offset ; ---------------------------------------------------------------- .EvalVariable dec r5 ; Point to first character of variable jmp VarFindVal ;; bcc EvalVarOk ; Variable found, return with it ;; mov SV_INT_P,r4 ; Use P% if variable not found ;; clr r3 ;; clr r2 ;; movb SV_OPTIONS,r0 ; Check assembler options ;; bic #&FFFD,r0 ;; beq EvalVarOk ; OPT 0,1, return with P% ;; jmp errNoSuchVar ;; .EvalVarOk ;; tst r2 ;; rts pc