100 ! ! EVALUATE.BAS -- routine to evaluate floating numeric strings. ! FUNCTION STRING EVALUATE( LONG ACCURACY, & STRING EXPRESSION) OPTION TYPE = EXPLICIT, & SIZE = ( REAL HFLOAT) DECLARE STRING CHARACTER, & CURRENT_NUMBER, & FORMAT_STRING, & OPERATOR( 100%), & OPERAND( 100%), & SUBEXPRESSION DECLARE HFLOAT RESULT DECLARE LONG BEGIN_SUBEXPRESSION, & ILLEGAL_ARGUMENT, & INDEX, & L, & PAREN_LEVEL, & RECURSION_ACCURACY DECLARE LONG CONSTANT TRUE = -1%, & FALSE = 0% ON ERROR GO TO ERROR_ROUTINE RANDOMIZE ! ! Build list of operators and their locations. ! ILLEGAL_ARGUMENT = FALSE INDEX = 1% L = 1% WHILE L <= LEN( EXPRESSION) CHARACTER = SEG$( EXPRESSION, L, L) SELECT CHARACTER CASE " ", ",", "$" ! ! Ignore spaces, commas, and dollar signs, ! even inside numbers. ! CASE "0" TO "9", "." ! ! A digit or period. Build up the number until ! we encounter either an operator or the end of ! the string. ! CURRENT_NUMBER = CURRENT_NUMBER + CHARACTER CASE "+", "-", "*", "/", "^", & "=", ">", "<", "~", & "&", "|", "\" ! ! A binary operator. Push it on the stack. ! OPERAND( INDEX - 1%) = NUM1$( VAL( CURRENT_NUMBER)) CURRENT_NUMBER = "" OPERATOR( INDEX) = CHARACTER INDEX = INDEX + 1% CASE "(" ! ! A parenthesized expression. Find matching right ! parenthesis and make a recursive call to this ! function to evaluate whatever is between ! parentheses. ! GO SUB PROCESS_PARENTHESES CASE "A", "a" ! ! Check for invocation of ABS function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "ABS" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( ABS( VAL( CURRENT_NUMBER))) ELSE ! ! Check for invocation of ATN function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "ATN" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( ATN( VAL(CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF END IF CASE "C", "c" ! ! Check for invocation of COS function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "COS" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( COS( VAL( CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE "E", "e" ! ! Check for invocation of E. ! CURRENT_NUMBER = NUM1$( EXP( 1)) CASE "I", "i" ! ! Check for invocation of INT function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "INT" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( INT( VAL( CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE "L", "l" ! ! Check for invocation of LOG10 function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 4%), 32%) = "LOG10" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( LOG10( VAL( CURRENT_NUMBER))) ELSE ! ! Check for invocation of LOG function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "LOG" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( LOG( VAL(CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF END IF CASE "N", "n" ! ! Check for invocation of NOT function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "NOT" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER & = NUM1$( NOT( INTEGER( VAL( CURRENT_NUMBER)))) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE "P", "p" ! ! Check for invocation of PI. ! IF EDIT$( SEG$( EXPRESSION, L, L + 1%), 32%) = "PI" THEN L = L + 1% CURRENT_NUMBER = NUM1$( PI) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE "R", "r" ! ! Check for invocation of RND function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "RND" THEN L = L + 2% CURRENT_NUMBER = NUM1$( RND) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE "S", "s" ! ! Check for invocation of SIN function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "SIN" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( SIN( VAL( CURRENT_NUMBER))) ELSE ! ! Check for invocation of SGN function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "SGN" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( SGN( VAL(CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF END IF CASE "T", "t" ! ! Check for invocation of TAN function. ! IF EDIT$( SEG$( EXPRESSION, L, L + 2%), 32%) = "TAN" THEN L = L + 1% UNTIL SEG$( EXPRESSION, L, L) = "(" GO SUB PROCESS_PARENTHESES CURRENT_NUMBER = NUM1$( TAN( VAL( CURRENT_NUMBER))) ELSE ILLEGAL_ARGUMENT = TRUE END IF CASE ELSE ILLEGAL_ARGUMENT = TRUE END SELECT L = L + 1% NEXT INDEX = INDEX - 1% OPERAND( INDEX) = NUM1$( VAL( CURRENT_NUMBER)) RESULT = VAL( OPERAND( 0%)) FOR L = 1% TO INDEX SELECT OPERATOR( L) CASE "+" RESULT = RESULT + VAL( OPERAND( L)) CASE "-" RESULT = RESULT - VAL( OPERAND( L)) CASE "*" RESULT = RESULT * VAL( OPERAND( L)) CASE "/" RESULT = RESULT / VAL( OPERAND( L)) CASE "^" RESULT = RESULT ^ VAL( OPERAND( L)) CASE "=" RESULT = RESULT = VAL( OPERAND( L)) CASE "~" RESULT = RESULT <> VAL( OPERAND( L)) CASE "<" RESULT = RESULT < VAL( OPERAND( L)) CASE ">" RESULT = RESULT > VAL( OPERAND( L)) CASE "&" RESULT = INTEGER( RESULT) & AND INTEGER( VAL( OPERAND( L))) CASE "|" RESULT = INTEGER( RESULT) & OR INTEGER( VAL( OPERAND( L))) CASE "\" RESULT = INTEGER( RESULT) & XOR INTEGER( VAL( OPERAND( L))) CASE ELSE RESULT = 0 ILLEGAL_ARGUMENT = TRUE END SELECT NEXT L IF ILLEGAL_ARGUMENT THEN EVALUATE = "Illegal expression" EXIT FUNCTION ELSE ! ! Build output string format ! SELECT ACCURACY CASE -1% ! ! Special case -- money. Include floating dollar, ! commas, and two decimal places. ! FORMAT_STRING = "$$############,.##" CASE 0% ! ! No decimal point desired. ! FORMAT_STRING = STRING$( 40%, ASCII( "#")) CASE > 0% FORMAT_STRING = STRING$( 40%, ASCII( "#")) + "." & + STRING$( ACCURACY, ASCII( "#")) CASE ELSE FORMAT_STRING = "#" END SELECT ! ! Return formatted result. ! EVALUATE = EDIT$( FORMAT$( RESULT, FORMAT_STRING), 6%) EXIT FUNCTION END IF PROCESS_PARENTHESES: PAREN_LEVEL = 1% BEGIN_SUBEXPRESSION, L = L + 1% WHILE PAREN_LEVEL > 0 AND L <= LEN( EXPRESSION) SELECT SEG$( EXPRESSION, L, L) CASE "(" PAREN_LEVEL = PAREN_LEVEL + 1 CASE ")" PAREN_LEVEL = PAREN_LEVEL - 1 END SELECT L = L + 1% NEXT IF PAREN_LEVEL ! Test for non-zero, which is bad. THEN ! ! L must be greater than the length of the string, which is a ! very bad thing -- unmatched parentheses. ! ILLEGAL_ARGUMENT = TRUE ELSE ! ! Found the match. Let's evaluate what's between ! the parentheses. ! SUBEXPRESSION = SEG$( EXPRESSION, BEGIN_SUBEXPRESSION, L - 2%) L = L - 1% ! Point to matched right paren. END IF IF NOT( ILLEGAL_ARGUMENT) THEN IF ACCURACY = -1% THEN ! ! Prevent commas, etc. for money mask. ! RECURSION_ACCURACY = 2% ELSE ! ! Nothing to prevent. ! RECURSION_ACCURACY = ACCURACY END IF CURRENT_NUMBER = EVALUATE( RECURSION_ACCURACY, SUBEXPRESSION) END IF RETURN ERROR_ROUTINE: ! ! Since we want to return something useful to TPU, we'll ! return the word "Error" followed by the error number. ! EVALUATE = "EVAL: ERR=" + NUM1$( ERR) RESUME BLOW_UP BLOW_UP: END FUNCTION