REM file: Whatis - Public Domain DOS Utility
REM Version 1.0a created 01/15/1996
REM Version 1.1a created 11/26/1998

REM Compiling with Microsoft BASIC Professional Development System 7.1:
REM    BC WHATIS/FS/X/O;
REM    LINK WHATIS,,,QBX/E;

DEFINT A-Z
REM $DYNAMIC

' constant declarations
CONST FalseD = 0#
CONST TrueD = -1#
CONST False = 0
CONST True = -1
CONST Nul = ""

' define color values
CONST Black = 0
CONST Plain = 7
CONST White = 15
CONST Yellow = 14

' get include files
REM $INCLUDE: 'qbx.bi'
REM $INCLUDE: 'dta.bi'

' declare registers
COMMON SHARED InregsX AS RegtypeX, OutregsX AS RegtypeX

' declare program dta
COMMON SHARED BASIC.DTA.SEG AS INTEGER, BASIC.DTA.OFF AS INTEGER

' global variables
COMMON SHARED Assign AS INTEGER
COMMON SHARED ASCIZ AS STRING * 260
COMMON SHARED Data.Error AS INTEGER
COMMON SHARED Last.Token AS INTEGER
COMMON SHARED Out2 AS STRING
COMMON SHARED Out3 AS STRING
COMMON SHARED Out4 AS STRING
COMMON SHARED Strng AS STRING
COMMON SHARED Token AS INTEGER
COMMON SHARED Token.Index AS INTEGER
COMMON SHARED Token.List AS STRING
COMMON SHARED White.Space AS STRING

' data areas
COMMON SHARED Arrays() AS DOUBLE ' variable arrays A() to Z()
COMMON SHARED Strngs() AS STRING ' string variables A$ to Z$
COMMON SHARED Variables() AS DOUBLE ' variables A to Z

' subroutine declarations
DECLARE SUB Arith (T$, T1#, T2#)
DECLARE SUB Assignment1 (T$, T%)
DECLARE SUB Assignment2 (T$, T1%, T2%)
DECLARE SUB Enter.Equate ()
DECLARE SUB Equate (T#)
DECLARE SUB Get.Token ()
DECLARE SUB Get.Token2 (V%)
DECLARE SUB Parse.Alphabetic1 (T#)
DECLARE SUB Parse.Alphabetic2 (T#)
DECLARE SUB Parse.Alphabetic3 (T#)
DECLARE SUB Parse.Numeric (T#)
DECLARE SUB Parse.Quoted ()
DECLARE SUB Parse1 (T#)
DECLARE SUB Parse2 (T#)
DECLARE SUB Parse3 (T#)
DECLARE SUB Parse4 (T#)
DECLARE SUB Parse5 (T#)
DECLARE SUB Parse6 (T#)
DECLARE SUB Parse7 (T#)
DECLARE SUB Parse8 (T#)
DECLARE SUB Parse9 (T#)

' function declarations
DECLARE FUNCTION FORMATD$ (BYVAL S#, B$)

' declare global error routine
ON ERROR GOTO Error.Routine

' program variables
REDIM Arrays(0 TO 26, 0 TO 128) AS DOUBLE
REDIM Strngs(0 TO 26) AS STRING
REDIM Variables(0 TO 26) AS DOUBLE

' increase stack for recursion
STACK STACK

' initialize some variables
Token.List = " -+*/\^()[]{}<>=|&!%~?:#@`;," + CHR$(34)
White.Space = CHR$(32) + CHR$(9)

' store basic dta
InregsX.AX = &H2F00
CALL InterruptX(&H21, InregsX, OutregsX)
BASIC.DTA.SEG = OutregsX.ES
BASIC.DTA.OFF = OutregsX.BX

COLOR White, Black
PRINT "Whatis v1.1a: Expression parser;"
IF COMMAND$ <> NUL THEN
   Data.Error = False
   Out2 = RTRIM$(COMMAND$)
   Out2 = LTRIM$(Out2)
   PRINT Out2; " Equals: ";
   CALL Enter.Equate
Error.Resume1:
   COLOR Plain, Black
   END
END IF
Data.Error = True
PRINT "Enter 'quit' to return to system."
Error.Resume2:
DO ' loop until quit entered
   COLOR Yellow, Black
   LINE INPUT ">", Out2 ' get user input
   SELECT CASE UCASE$(Out2)
   CASE "QUIT"
      EXIT DO
   CASE ELSE
      CALL Enter.Equate
   END SELECT
LOOP
COLOR White, Black
PRINT "Press <enter> to return to DOS:";
WHILE INKEY$ = NUL
WEND
PRINT
COLOR Plain, Black
END

Error.Routine:
 IF Data.Error = False THEN
    PRINT
 END IF
 SELECT CASE ERR
 CASE 53
    Print "File not found."
 CASE 57
    Print "Media error."
 CASE 61
    Print "Disk full."
 CASE 70
    Print "Permission denied."
 CASE 71
    Print "Disk not ready."
 CASE 5
    PRINT "Error #001: Illegal function call."
 CASE 6
    PRINT "Error #002: Overflow."
 CASE 9
    PRINT "Error #003: Subscript out of range."
 CASE 11
    PRINT "Error #004: Division by zero."
 CASE 92
    PRINT "Error #005: Whatis: "; Strng
 CASE ELSE
    PRINT "Error #000: Error "; ERR
 END SELECT
 IF Data.Error = False THEN
    RESUME Error.Resume1
 ELSE
    RESUME Error.Resume2
 END IF

' routine accepts an operation and performs on two values, string or numeric
SUB Arith (Token.Parsed$, Temp#, Temp2#)
 IF Last.Token THEN
    SELECT CASE Token.Parsed$
    CASE "-"
       Temp# = Temp# - Temp2#
    CASE "+"
       Temp# = Temp# + Temp2#
    CASE "/"
       Temp# = Temp# / Temp2#
    CASE "\"
       Temp# = Temp# \ Temp2#
    CASE "*"
       Temp# = Temp# * Temp2#
    CASE "^"
       Temp# = Temp# ^ Temp2#
    CASE "<"
       Temp# = (Temp# < Temp2#)
    CASE ">"
       Temp# = (Temp# > Temp2#)
    CASE "="
       Temp# = (Temp# = Temp2#)
    CASE "<="
       Temp# = (Temp# <= Temp2#)
    CASE ">="
       Temp# = (Temp# >= Temp2#)
    CASE "<>"
       Temp# = (Temp# <> Temp2#)
    CASE "|"
       Temp# = Temp# OR Temp2#
    CASE "&"
       Temp# = Temp# AND Temp2#
    CASE "%"
       Temp# = Temp# MOD Temp2#
    CASE "~"
       Temp# = Temp# XOR Temp2#
    CASE "?"
       Temp# = Temp# IMP Temp2#
    CASE ":"
       Temp# = Temp# EQV Temp2#
    CASE "#"
       Temp# = NOT (Temp# OR Temp2#)
    CASE "@"
       Temp# = NOT (Temp# IMP Temp2#)
    CASE "`"
       Temp# = NOT (Temp# AND Temp2#)
    END SELECT
    EXIT SUB
 END IF
 SELECT CASE Token.Parsed$
 CASE "-"
    IF RIGHT$(Out3, LEN(Out4)) = Out4 THEN
       Out3 = LEFT$(Out3, LEN(Out3) - LEN(Out4))
    END IF
 CASE "+"
    Out3 = Out3 + Out4
 CASE "/", "\"
    IF LEN(Out3) AND LEN(Out4) THEN
       Imbedded = INSTR(Out3, Out4)
       WHILE Imbedded
	  Out3 = LEFT$(Out3, Imbedded - 1) + MID$(Out3, Imbedded + LEN(Out4))
	  Imbedded = INSTR(Out3, Out4)
       WEND
    END IF
 CASE "<"
    Last.Token = True
    Temp# = Out3 < Out4
 CASE ">"
    Last.Token = True
    Temp# = Out3 > Out4
 CASE "="
    Last.Token = True
    Temp# = Out3 = Out4
 CASE "<="
    Last.Token = True
    Temp# = Out3 <= Out4
 CASE ">="
    Last.Token = True
    Temp# = Out3 >= Out4
 CASE "<>"
    Last.Token = True
    Temp# = Out3 <> Out4
 END SELECT
END SUB

SUB Assignment1 (S$, S%)
 IF LEFT$(S$, 2) = "--" THEN
    Assign = True
    Variables(S%) = Variables(S%) - 1#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "++" THEN
    Assign = True
    Variables(S%) = Variables(S%) + 1#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "**" THEN
    Assign = True
    Variables(S%) = Variables(S%) ^ 2#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "//" THEN
    Assign = True
    Variables(S%) = SQR(Variables(S%))
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "-=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) - T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "+=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) + T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "/=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) / T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "\=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) \ T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "*=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) * T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "^=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) ^ T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "^-=" THEN
    Assign = True
    Out2 = MID$(S$, 4)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) ^ (-T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "%=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) MOD T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "|=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) OR T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "&=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) AND T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "~=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) XOR T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "?=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) IMP T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = ":=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = Variables(S%) EQV T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "#=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = NOT (Variables(S%) OR T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "@=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = NOT (Variables(S%) IMP T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "`=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = NOT (Variables(S%) AND T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 1) = "=" THEN
    Assign = True
    Out2 = MID$(S$, 2)
    Out2 = LTRIM$(Out2)
    CALL Equate(T#)
    Variables(S%) = T#
    EXIT SUB
 END IF
END SUB

SUB Assignment2 (S$, S1%, S2%)
 IF LEFT$(S$, 2) = "--" THEN
    Assign = True
    Arrays(S1%, S2%) = Arrays(S1%, S2%) - 1#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "++" THEN
    Assign = True
    Arrays(S1%, S2%) = Arrays(S1%, S2%) + 1#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "**" THEN
    Assign = True
    Arrays(S1%, S2%) = Arrays(S1%, S2%) ^ 2#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "//" THEN
    Assign = True
    Arrays(S1%, S2%) = SQR(Arrays(S1%, S2%))
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "-=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) - T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "+=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) + T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "/=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) / T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "\=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) \ T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "*=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) * T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "^=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) ^ T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "^-=" THEN
    Assign = True
    Out2 = MID$(S$, 4)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) ^ (-T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "%=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) MOD T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "|=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) OR T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "&=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) AND T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "~=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) XOR T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "?=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) IMP T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = ":=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = Arrays(S1%, S2%) EQV T#
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "#=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = NOT (Arrays(S1%, S2%) OR T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "@=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = NOT (Arrays(S1%, S2%) IMP T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 2) = "`=" THEN
    Assign = True
    Out2 = MID$(S$, 3)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = NOT (Arrays(S1%, S2%) AND T#)
    EXIT SUB
 END IF
 IF LEFT$(S$, 1) = "=" THEN
    Assign = True
    Out2 = MID$(S$, 2)
    Out2 = LTRIM$(Out2)
    Token.Index = 1
    CALL Get.Token
    CALL Parse1(T#)
    Arrays(S1%, S2%) = T#
    EXIT SUB
 END IF
END SUB

SUB Enter.Equate
 Out2 = LTRIM$(Out2)
 IF Out2 = Nul THEN
    EXIT SUB
 END IF
 Store.Input$ = Out2
 GOSUB Assignment
 IF Assign THEN
    EXIT SUB
 END IF
 Out2 = Store.Input$
 D$ = UCASE$(Out2)
 IF LEFT$(D$, 3) = "MID" THEN
    GOSUB Assign.Mid.String
    EXIT SUB
 END IF
 IF LEFT$(D$, 4) = "LEFT" THEN
    GOSUB Assign.Left.String
    EXIT SUB
 END IF
 IF LEFT$(D$, 5) = "RIGHT" THEN
    GOSUB Assign.Right.String
    EXIT SUB
 END IF
 Last.Token = False
 Out3 = Nul
 Out4 = Nul
 Temp# = False
 Token.Index = 1
 CALL Get.Token
 CALL Parse1(T#)
 IF Last.Token THEN
    PRINT LTRIM$(STR$(T#))
 ELSE
    PRINT Out3
 END IF
 EXIT SUB

Assignment:
 Assign = False
 V$ = UCASE$(LEFT$(Out2, 1))
 IF V$ >= "A" AND V$ <= "Z" THEN
    Variable = ASC(V$) - 64
    V$ = MID$(Out2, 2)
    V$ = LTRIM$(V$)
    CALL Assignment1(V$, Variable)
    IF Assign THEN
       RETURN
    END IF
    IF LEFT$(V$, 1) = "$" THEN
       V$ = MID$(V$, 2)
       V$ = LTRIM$(V$)
       IF LEFT$(V$, 1) = "=" THEN
	  Assign = True
	  Out2 = MID$(V$, 2)
	  Out2 = LTRIM$(Out2)
	  CALL Equate(T#)
	  Strngs(Variable) = Out3
       END IF
       RETURN
    END IF
    IF LEFT$(V$, 1) = "(" THEN
       Out2 = MID$(V$, 2)
       Out2 = LTRIM$(Out2)
       Last.Token = False
       Token.Index = 1
       CALL Get.Token
       CALL Parse1(T#)
       Element = CINT(T#)
       V$ = MID$(Out2, Token.Index)
       V$ = LTRIM$(V$)
       CALL Assignment2(V$, Variable, Element)
    END IF
 END IF
 RETURN

Assign.Mid.String:
 Out2 = MID$(Out2, 4)
 IF LEN(Out2) THEN
    Out2 = LTRIM$(Out2)
    Out2 = MID$(Out2, 3)
    V$ = UCASE$(LEFT$(Out2, 1))
    IF V$ >= "A" AND V$ <= "Z" THEN
       Variable = ASC(V$) - 64
       IF MID$(Out2, 2, 1) = "$" THEN
	  Out2 = MID$(Out2, 4)
	  Last.Token = False
	  Token.Index = 1
	  CALL Get.Token
	  CALL Parse1(T#)
	  Start = CINT(T#)
	  CALL Get.Token
	  CALL Parse1(T#)
	  Length = CINT(T#)
	  Out2 = MID$(Out2, Token.Index)
	  Out2 = LTRIM$(Out2)
	  IF LEFT$(Out2, 1) = "=" THEN
	     Out2 = MID$(Out2, 2)
	     Out2 = LTRIM$(Out2)
	     Token.Index = 1
	     CALL Get.Token
	     CALL Parse1(T#)
	     MID$(Strngs(Variable), Start, Length) = Out3
	  END IF
       END IF
    END IF
 END IF
 RETURN

Assign.Left.String:
 Out2 = MID$(Out2, 5)
 IF LEN(Out2) THEN
    Out2 = LTRIM$(Out2)
    Out2 = MID$(Out2, 3)
    V$ = UCASE$(LEFT$(Out2, 1))
    IF V$ >= "A" AND V$ <= "Z" THEN
       Variable = ASC(V$) - 64
       IF MID$(Out2, 2, 1) = "$" THEN
	  Out2 = MID$(Out2, 4)
	  Last.Token = False
	  Token.Index = 1
	  CALL Get.Token
	  CALL Parse1(T#)
	  Start = CINT(T#)
	  Out2 = MID$(Out2, Token.Index)
	  Out2 = LTRIM$(Out2)
	  IF LEFT$(Out2, 1) = "=" THEN
	     Out2 = MID$(Out2, 2)
	     Out2 = LTRIM$(Out2)
	     Token.Index = 1
	     CALL Get.Token
	     CALL Parse1(T#)
	     MID$(Strngs(Variable), 1, Start) = Out3
	  END IF
       END IF
    END IF
 END IF
 RETURN

Assign.Right.String:
 Out2 = MID$(Out2, 6)
 IF LEN(Out2) THEN
    Out2 = LTRIM$(Out2)
    Out2 = MID$(Out2, 3)
    V$ = UCASE$(LEFT$(Out2, 1))
    IF V$ >= "A" AND V$ <= "Z" THEN
       Variable = ASC(V$) - 64
       IF MID$(Out2, 2, 1) = "$" THEN
	  Out2 = MID$(Out2, 4)
	  Last.Token = False
	  Token.Index = 1
	  CALL Get.Token
	  CALL Parse1(T#)
	  Start = CINT(T#)
	  Out2 = MID$(Out2, Token.Index)
	  Out2 = LTRIM$(Out2)
	  IF LEFT$(Out2, 1) = "=" THEN
	     Out2 = MID$(Out2, 2)
	     Out2 = LTRIM$(Out2)
	     Token.Index = 1
	     CALL Get.Token
	     CALL Parse1(T#)
	     Length = LEN(Strngs(Variable)) - Start + 1
             IF Length > False THEN
		MID$(Strngs(Variable), Length, Start) = Out3
	     END IF
	  END IF
       END IF
    END IF
 END IF
 RETURN
END SUB

 ' returns next token in string form,
 ' increments pointer to next token,
 ' determines token type.
SUB Get.Token
 Strng = Nul ' reset token
 Token = False ' reset token type
 ' locate space
 FOR Blanks = 1 TO LEN(White.Space)
    WHILE MID$(Out2, Token.Index, 1) = MID$(White.Space, Blanks, 1)
       Token.Index = Token.Index + 1
    WEND
 NEXT
 ' locate symbols
 CALL Get.Token2(Token.Exists)
 IF Token.Exists THEN
    EXIT SUB
 END IF
 ' locate expression symbol
 Token.Element$ = MID$(Out2, Token.Index, 1)
 IF LEN(Token.Element$) THEN
    IF INSTR(Token.List, Token.Element$) THEN
       Token = 1 ' store token type
       Strng = Token.Element$ ' store token
       Token.Index = Token.Index + 1 ' increment pointer
       EXIT SUB
    END IF
 END IF
 ' locate expression is number
 Token.Element$ = MID$(Out2, Token.Index, 1)
 IF Token.Element$ >= "0" AND Token.Element$ <= "9" THEN
    ' increment token until token is other than number
    DO
       IF LEN(Token.Element$) = False THEN
          EXIT DO
       END IF
       IF INSTR(Token.List, Token.Element$) THEN
          EXIT DO
       END IF
       Strng = Strng + Token.Element$
       Token.Index = Token.Index + 1
       Token.Element$ = MID$(Out2, Token.Index, 1)
    LOOP
    Token = 2 ' store token type
    EXIT SUB
 END IF
 ' locate expression is number beginning with decimal
 Token.Element$ = MID$(Out2, Token.Index, 1)
 IF Token.Element$ = "." THEN
    ' increment token until token is other than number
    DO
       IF LEN(Token.Element$) = False THEN
          EXIT DO
       END IF
       IF INSTR(Token.List, Token.Element$) THEN
          EXIT DO
       END IF
       Strng = Strng + Token.Element$
       Token.Index = Token.Index + 1
       Token.Element$ = MID$(Out2, Token.Index, 1)
    LOOP
    Token = 2 ' store token type
    EXIT SUB
 END IF
 ' locate expression is alphabetic
 Token.Element$ = UCASE$(MID$(Out2, Token.Index, 1))
 IF Token.Element$ >= "A" AND Token.Element$ <= "Z" THEN
    ' increment token until token is other than alphabetic
    DO
       IF LEN(Token.Element$) = False THEN
          EXIT DO
       END IF
       IF INSTR(Token.List, Token.Element$) THEN
          EXIT DO
       END IF
       Strng = Strng + Token.Element$
       Token.Index = Token.Index + 1
       Token.Element$ = MID$(Out2, Token.Index, 1)
    LOOP
    Token = 3 ' store token type
    EXIT SUB
 END IF
 Token.Index = Token.Index + 1
END SUB

SUB Get.Token2 (Token.Exists)
 Token.Exists = False
 Stored.Token$ = Out2
 ' locate space
 FOR Blanks = 1 TO LEN(White.Space)
    WHILE MID$(Stored.Token$, Token.Index + 1, 1) = MID$(White.Space, Blanks, 1)
       Stored.Token$ = LEFT$(Stored.Token$, Token.Index) + MID$(Stored.Token$, Token.Index + 2)
    WEND
 NEXT
 ' locate expression symbols
 Next.Token$ = MID$(Stored.Token$, Token.Index, 2)
 SELECT CASE Next.Token$
 CASE ">=", "=>"
    GOSUB Remove.Spaces
    Token = 1 ' store token type
    Strng = ">=" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "<=", "=<"
    GOSUB Remove.Spaces
    Token = 1 ' store token type
    Strng = "<=" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "<>", "><"
    GOSUB Remove.Spaces
    Token = 1 ' store token type
    Strng = "<>" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 END SELECT
 EXIT SUB
Remove.Spaces:
 ' locate space
 FOR Blanks = 1 TO LEN(White.Space)
    WHILE MID$(Out2, Token.Index + 1, 1) = MID$(White.Space, Blanks, 1)
       Out2 = LEFT$(Out2, Token.Index) + MID$(Out2, Token.Index + 2)
    WEND
 NEXT
 RETURN
END SUB

SUB Parse.Alphabetic1 (Temp#)
 SELECT CASE UCASE$(Strng) ' test variable symbol
 CASE "A" TO "Z"
    Element = ASC(UCASE$(Strng)) - 64
    Element.Type$ = MID$(Out2, Token.Index, 1)
    IF Element.Type$ = "(" OR Element.Type$ = "[" OR Element.Type$ = "{" THEN
       CALL Get.Token
       CALL Get.Token
       CALL Parse1(Temp#)
       Temp# = Arrays(Element, CINT(Temp#))
       Last.Token = True
    ELSE
       Temp# = Variables(Element) ' get variable value
       Last.Token = True
    END IF
 CASE ELSE
    ERROR 92
 END SELECT
END SUB

SUB Parse.Alphabetic2 (Temp#)
 SELECT CASE UCASE$(Strng)
 ' functions w/o parameters
 CASE "PI" ' calculate PI
    Temp# = ATN(1#) * 4#
    Last.Token = True
 CASE "EX" ' calculate E
    Temp# = EXP(1#)
    Last.Token = True
 ' special case functions
 CASE "OR"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# OR Temp#
    Last.Token = True
 CASE ELSE
    IF MID$(Strng, 2, 1) = "$" THEN
       SELECT CASE UCASE$(LEFT$(Strng, 1))
       CASE "A" TO "Z"
	  Element = ASC(UCASE$(LEFT$(Strng, 1))) - 64
	  Out3 = Strngs(Element)
	  Last.Token = False
       END SELECT
    ELSE
       ERROR 92
    END IF
 END SELECT
END SUB

SUB Parse.Alphabetic3 (Temp#)
 DIM DTAfile AS DTAtype
 SELECT CASE UCASE$(Strng)
 ' functions w/o parameters
 CASE "FALSE"
    Temp# = FalseD
    Last.Token = True
 CASE "TRUE"
    Temp# = TrueD
    Last.Token = True
 CASE "TIMER"
    Temp# = TIMER
    Last.Token = True
 CASE "RND"
    Temp# = RND
    Last.Token = True
 ' boolean functions
 CASE "AND"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# AND Temp#
    Last.Token = True
 CASE "MOD"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# MOD Temp#
    Last.Token = True
 CASE "NOR"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = NOT (Number# OR Temp#)
    Last.Token = True
 CASE "NON"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = NOT (Number# IMP Temp#)
    Last.Token = True
 CASE "XAN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = NOT (Number# AND Temp#)
    Last.Token = True
 CASE "XOR"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# XOR Temp#
    Last.Token = True
 CASE "IMP"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# IMP Temp#
    Last.Token = True
 CASE "EQV"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = Number# EQV Temp#
    Last.Token = True
 CASE "NOT"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = NOT Temp#
    Last.Token = True
 ' date/time functions
 CASE "CLOCK"
    Temp# = Timer
    Last.Token = True
 CASE "DATE$"
    Out3 = DATE$
    Last.Token = False
 CASE "TIME$"
    Out3 = TIME$
    Last.Token = False
 ' conversion/calculation functions
 CASE "BIN$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = Nul
    IF Temp# >= FalseD THEN
       Digits = False
       DO
	  IF 2 ^ (Digits + 1) > Temp# THEN
	     EXIT DO
	  END IF
	  Digits = Digits + 1
       LOOP
       FOR Power = Digits TO 0 STEP -1
	  IF Temp# - 2 ^ Power >= 0 THEN
	     Temp# = Temp# - 2 ^ Power
	     Out3 = Out3 + "1"
	  ELSE
	     Out3 = Out3 + "0"
	  END IF
       NEXT
    END IF
    Last.Token = False
 CASE "CHR$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = CHR$(CINT(Temp#))
    Last.Token = False
 CASE "HEX$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = HEX$(CINT(Temp#))
    Last.Token = False
 CASE "OCT$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = OCT$(CINT(Temp#))
    Last.Token = False
 CASE "STR$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = STR$(Temp#)
    Last.Token = False
 CASE "LCASE$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = LCASE$(Out3)
    Last.Token = False
 CASE "UCASE$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = UCASE$(Out3)
    Last.Token = False
 CASE "RTRIM$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = RTRIM$(Out3)
    Last.Token = False
 CASE "LTRIM$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = LTRIM$(Out3)
    Last.Token = False
 CASE "TRIM$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = LTRIM$(RTRIM$(Out3))
    Last.Token = False
 CASE "SPACE$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = STRING$(Temp#, " ")
    Last.Token = False
 CASE "MID$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    CALL Get.Token
    CALL Parse1(Temp#)
    Start# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Length# = Temp#
    Out3 = MID$(Out3, Start#, Length#)
    Last.Token = False
 CASE "REMID$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    CALL Get.Token
    CALL Parse1(Temp#)
    Start# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Length# = Temp#
    Out3 = LEFT$(Out3, Start# - 1) + MID$(Out3, Start# + Length#)
    Last.Token = False
 CASE "DEMID$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    String1$ = Out3
    CALL Get.Token
    CALL Parse1(Temp#)
    IF LEN(String1$) AND LEN(Out3) THEN
       Imbedded = INSTR(String1$, Out3)
       WHILE Imbedded
	  String1$ = LEFT$(String1$, Imbedded - 1) + MID$(String1$, Imbedded + 1)
	  Imbedded = INSTR(String1$, Out3)
       WEND
    END IF
    Out3 = String1$
    Last.Token = False
 CASE "REPLACE$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    String1$ = Out3
    CALL Get.Token
    CALL Parse1(Temp#)
    String2$ = Out3
    CALL Get.Token
    CALL Parse1(Temp#)
    String3$ = Out3
    IF String1$ = Nul OR String2$ = Nul OR String2$ = String3$ THEN
       Out3 = String1$
       EXIT SUB
    END IF
    Temp1 = 1
    DO
       IF String1$ = Nul THEN
	  EXIT DO
       END IF
       Var1 = INSTR(Temp1, String1$, String2$)
       IF Var1 = False THEN
	  EXIT DO
       END IF
       String1$ = LEFT$(String1$, Var1 - 1) + String3$ + MID$(String1$, Var1 + LEN(String2$))
       Temp1 = Temp1 + LEN(String3$)
    LOOP
    Out3 = String1$
    Last.Token = False
 CASE "LEFT$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = LEFT$(Out3, Temp#)
    Last.Token = False
 CASE "RIGHT$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = RIGHT$(Out3, Temp#)
    Last.Token = False
 CASE "STRING$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Number# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    IF Last.Token THEN
       Out3 = STRING$(Number#, Temp#)
    ELSE
       Out3 = STRING$(Number#, Out3)
    END IF
    Last.Token = False
 CASE "ABS"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = ABS(Temp#)
    Last.Token = True
 CASE "ASC"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = ASC(Out3)
    Last.Token = True
 CASE "ATN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = ATN(Temp#)
    Last.Token = True
 CASE "COS"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = COS(Temp#)
    Last.Token = True
 CASE "COT"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = COS(Temp#) / SIN(Temp#)
    Last.Token = True
 CASE "CSC"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = 1 / SIN(Temp#)
    Last.Token = True
 CASE "EXP"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = EXP(Temp#)
    Last.Token = True
 CASE "FBN" ' calculate xth fibonachi value
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Fibo.A# = 1
    Fibo.B# = 1
    IF Temp# >= 1 THEN
       FOR Fibo.Number# = 1 TO Temp# - 1
	   Fibo.Temp# = Fibo.B#
	   Fibo.B# = Fibo.A# + Fibo.B#
	   Fibo.A# = Fibo.Temp#
	NEXT
     END IF
     Temp# = Fibo.B#
     Last.Token = True
 CASE "FCT"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Factorial# = 1
    Factorial.Count# = INT(Temp#)
    IF Factorial.Count# >= 1 THEN
       FOR Factorial.Count# = 1 TO Temp#
	  Factorial# = Factorial# * Factorial.Count#
       NEXT
    END IF
    Temp# = Factorial#
    Last.Token = True
 CASE "FIX"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = FIX(Temp#)
    Last.Token = True
 CASE "INSTR"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    IF Last.Token THEN
       Start# = Temp#
       CALL Get.Token
       CALL Parse1(Temp#)
       Stored.String$ = Out3
       CALL Get.Token
       CALL Parse1(Temp#)
    ELSE
       Start# = 1#
       Stored.String$ = Out3
       CALL Get.Token
       CALL Parse1(Temp#)
    END IF
    Temp# = INSTR(Start#, Stored.String$, Out3)
    Last.Token = True
 CASE "FRE"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    IF Last.Token THEN
       Value# = Temp#
       Temp# = FRE(Value#)
    ELSE
       Temp# = FRE(Out3)
    END IF
    Last.Token = True
 CASE "INT"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = INT(Temp#)
    Last.Token = True
 CASE "LEN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = LEN(Out3)
    Last.Token = True
 CASE "LOG"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = LOG(Temp#)
    Last.Token = True
 CASE "PRM" ' calculate xth prime
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Prime.Number# = INT(Temp#)
    Prime# = 1
    IF Prime.Number# > FalseD THEN
       Prime.Counter# = False
       DO
	  Prime# = Prime# + 1
	  Prime.Flag = False
	  FOR L# = 2 TO INT(SQR(Prime#))
	     IF Prime# / L# = INT(Prime# / L#) THEN
		Prime.Flag = True
		EXIT FOR
	     END IF
	  NEXT
	  IF Prime.Flag = False THEN
	     Prime.Counter# = Prime.Counter# + 1
	  END IF
	  IF Prime.Counter# = Prime.Number# THEN
	     EXIT DO
	  END IF
       LOOP
    END IF
    Temp# = Prime#
    Last.Token = True
 CASE "SEC"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = 1 / COS(Temp#)
    Last.Token = True
 CASE "SGN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = SGN(Temp#)
    Last.Token = True
 CASE "SIN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = SIN(Temp#)
    Last.Token = True
 CASE "SQR"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = SQR(Temp#)
    Last.Token = True
 CASE "TAN"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = TAN(Temp#)
    Last.Token = True
 CASE "VAL"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = VAL(Out3)
    Last.Token = True
 ' misc. functions
 CASE "FORMAT$"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    value# = Temp#
    CALL Get.Token
    CALL Parse1(Temp#)
    Out3 = FORMATD$(value#, Out3)
    Last.Token = False
 CASE "DRV"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    IF Last.Token THEN
       Drive.Number% = CINT(Temp#)
    ELSE
       Drive.Number% = CINT(ASC(UCASE$(Out3))-64)
    END IF
    Last.Token = True
    InregsX.AX = &H3600
    InregsX.DX = Drive.Number%
    CALL InterruptX(&H21, InregsX, OutregsX)
    Temp# = 0#
    IF OutregsX.AX = &HFFFF THEN
       EXIT SUB
    END IF
    IF OutregsX.AX < False THEN
       Sectors# = CDBL(OutregsX.AX + 65536)
    ELSE
       Sectors# = CDBL(OutregsX.AX)
    END IF
    IF OutregsX.BX < False THEN
       Clusters# = CDBL(OutregsX.BX + 65536)
    ELSE
       Clusters# = CDBL(OutregsX.BX)
    END IF
    IF OutregsX.CX < False THEN
       Bytes# = CDBL(OutregsX.CX + 65536)
    ELSE
       Bytes# = CDBL(OutregsX.CX)
    END IF
    Temp# = Sectors# * Clusters# * Bytes#
 CASE "SIZE"
    CALL Get.Token
    CALL Get.Token
    CALL Parse1(Temp#)
    Temp# = 0#
    IF Last.Token = False THEN
       IF LEN(Out3) THEN
          Last.Token = True
          ASCIZ = Out3 + CHR$(0)
          ' restore directory search dta
          InregsX.AX = &H1A00
          InregsX.DS = VARSEG(DTAfile)
          InregsX.DX = VARPTR(DTAfile)
          CALL InterruptX(&H21, InregsX, OutregsX)
          ' find first filename
          InregsX.AX = &H4E00
          InregsX.CX = &H27
          InregsX.DS = VARSEG(ASCIZ)
          InregsX.DX = VARPTR(ASCIZ)
          CALL InterruptX(&H21, InregsX, OutregsX)
          ' check findfirst error
          IF (OutregsX.Flags AND &H1) = &H0 THEN
             ' store file size
             Temp# = Dfalse
             Temp# = Temp# + ASC(MID$(DTAfile.FileSize, 4, 1))
             Temp# = Temp# * &H100 + ASC(MID$(DTAfile.FileSize, 3, 1))
             Temp# = Temp# * &H100 + ASC(MID$(DTAfile.FileSize, 2, 1))
             Temp# = Temp# * &H100 + ASC(MID$(DTAfile.FileSize, 1, 1))
          END IF
          ' restore basic dta
          InregsX.AX = &H1A00
          InregsX.DS = BASIC.DTA.SEG
          InregsX.DX = BASIC.DTA.OFF
          CALL InterruptX(&H21, InregsX, OutregsX)
       END IF
    END IF
 CASE ELSE
    ERROR 92
 END SELECT
END SUB

SUB Parse.Numeric (Temp#)
 SELECT CASE RIGHT$(UCASE$(Strng), 1) ' compare character after number
 CASE "F" ' factorial
    Temp2 = False
    Temp3 = LEN(Strng)
    DO
       IF UCASE$(MID$(Strng, Temp3, 1)) <> "F" THEN
          EXIT DO
       END IF
       Temp2 = Temp2 + 1
       Temp3 = Temp3 - 1
    LOOP
    Temp4# = VAL(LEFT$(Strng, Temp3))
    FOR Number = 1 TO Temp2
       Temp# = 1#
       FOR Factorial# = 2# TO Temp4#
          Temp# = Temp# * Factorial#
       NEXT
       Temp4# = Temp#
    NEXT
 CASE "H" ' hexidecimal suffix
    Temp# = False
    Hex.Power = False
    FOR Hex.Digit = LEN(Strng) - 1 TO 1 STEP -1
       Hex.Value = VAL("&H" + MID$(Strng, Hex.Digit, 1))
       Temp# = Temp# + Hex.Value * 16 ^ Hex.Power
       Hex.Power = Hex.Power + 1
    NEXT
 CASE "O" ' octal suffix
    Temp# = False
    Octal.Power = False
    FOR Octal.Digit = LEN(Strng) - 1 TO 1 STEP -1
       Octal.Value = VAL(MID$(Strng, Octal.Digit, 1))
       Temp# = Temp# + Octal.Value * 8 ^ Octal.Power
       Octal.Power = Octal.Power + 1
    NEXT
 CASE "B" ' binary suffix
    Temp# = False
    Binary.Power = False
    FOR Binary.Digit = LEN(Strng) - 1 TO 1 STEP -1
       IF MID$(Strng, Binary.Digit, 1) = "1" THEN
	  Temp# = Temp# + 2 ^ Binary.Power
       END IF
       Binary.Power = Binary.Power + 1
    NEXT
 CASE ELSE
    Temp# = VAL(Strng)
 END SELECT
 CALL Get.Token
 Last.Token = True
END SUB

SUB Parse.Quoted
 Out3 = Nul
 DO UNTIL MID$(Out2, Token.Index, 1) = CHR$(34)
    Out3 = Out3 + MID$(Out2, Token.Index, 1)
    Token.Index = Token.Index + 1
    IF Token.Index > LEN(Out2) THEN
       EXIT DO
    END IF
 LOOP
 CALL Get.Token
 CALL Get.Token
 Last.Token = False
END SUB

REM entry to expression parser, each following parser is higher precedence,
REM this routine called by higher precedence routines recursively.

REM precedence of operators:
REM   !, +, -  Not, Unary plus, Unary minus
REM   ^        Power
REM   *, /     Multiplication, Division
REM   \        Integer Division
REM   %        Modulo
REM   +, -     Addition, Subtraction
REM   =, <, >, <>, >=, <=   Relational
REM   |, &, ~, ?, :, #, @, `  Logical (or, and, xor, imp, eqv, nor, non, xan)

SUB Equate (Temp#)
 Last.Token = False
 Out3 = Nul ' reset string storage
 Out4 = Nul ' reset string concatenate storage
 Temp# = False ' reset result
 Token.Index = 1 ' reset pointer to expression token
 CALL Get.Token ' read next token
 CALL Parse1(Temp#) ' entry to parse the expression
 WHILE LEN(Strng)
    CALL Parse1(X#) ' parse leftover tokens
 WEND
END SUB

 ' logical parser
SUB Parse1 (Temp#)
 CALL Parse2(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "|", "&", "~", "?", ":", "#", "@", "`"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse2(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' relational parser
SUB Parse2 (Temp#)
 CALL Parse3(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "<", ">", "=", ">=", "<=", "<>"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse3(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' addition/subtraction parser
SUB Parse3 (Temp#)
 CALL Parse4(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "+", "-"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse4(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' modulo parser
SUB Parse4 (Temp#)
 CALL Parse5(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "%"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse5(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' integer division parser
SUB Parse5 (Temp#)
 CALL Parse6(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "\"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse6(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' multiplication/division parser
SUB Parse6 (Temp#)
 CALL Parse7(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "*", "/"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse7(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' power parser
SUB Parse7 (Temp#)
 CALL Parse8(Temp#) ' get next operator precedence
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "^"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    Token.Stored$ = Out3 ' store current token
    CALL Get.Token ' read next token
    CALL Parse8(Temp2#) ' get next operator
    Out4 = Out3 ' reset current string
    Out3 = Token.Stored$ ' restore previous string
    CALL Arith(Token.Parsed$, Temp#, Temp2#) ' calculate expression
    Token.Parsed$ = Strng ' store next token
 LOOP
END SUB

 ' not/unary plus/unary negative parser
SUB Parse8 (Temp#)
 Token.Negate$ = Nul ' reset not/unary tokens
 Token.Parsed$ = Strng ' store token
 ' process token
 DO
    SELECT CASE Token.Parsed$
    CASE "!", "-", "+"
       ' Nul
    CASE ELSE
       EXIT DO
    END SELECT
    CALL Get.Token ' read next token
    ' store combined not/unary tokens
    Token.Negate$ = Token.Negate$ + Token.Parsed$
    Token.Parsed$ = Strng
 LOOP
 CALL Parse9(Temp#) ' get next operator precedence
 ' process the combined operators in reverse
 FOR Token.Type = LEN(Token.Negate$) TO 1 STEP -1
    SELECT CASE MID$(Token.Negate$, Token.Type, 1)
    CASE "+"
       ' nul calculation for unary plus
    CASE "-"
       Temp# = -Temp# ' perform negate
    CASE "!" ' not
       Temp# = NOT Temp# ' perform not calculation
    END SELECT
 NEXT
END SUB

 ' string/numeric expression parser,
 ' routine returns calculated expression string/value,
 ' calls Parse1 recursively for values inside parenthesis/functions.
SUB Parse9 (Temp#)
 SELECT CASE Token ' determine token type
 CASE 1 ' token is symbol
    SELECT CASE Strng ' determine token
    CASE ",", ";" ' separaters
       ' null action
    CASE CHR$(34) ' parse string
       CALL Parse.Quoted
    CASE "(" ' calculate opening parenthesis
       CALL Get.Token ' read next token value inside parenthesis
       IF Strng <> ")" THEN
          DO ' calculate value
             CALL Parse1(Temp#) ' call parse entry
          LOOP UNTIL Strng = ")" OR Token = False ' check closing parenthesis
       END IF
       CALL Get.Token ' read next token after parenthesis
    CASE "["
       CALL Get.Token
       IF Strng <> "]" THEN
          DO
             CALL Parse1(Temp#)
          LOOP UNTIL Strng = "]" OR Token = False
       END IF
       CALL Get.Token
    CASE "{"
       CALL Get.Token
       IF Strng <> "}" THEN
          DO
             CALL Parse1(Temp#)
          LOOP UNTIL Strng = "}" OR Token = False
       END IF
       CALL Get.Token
    CASE ")", "]", "}" ' check token is closing parenthesis
       CALL Get.Token ' read next token after parenthesis
    END SELECT
 CASE 2 ' token is numeric value
    CALL Parse.Numeric(Temp#)
 CASE 3 ' token type is alphabetic
    SELECT CASE LEN(Strng) ' check variable type
    CASE 1
       CALL Parse.Alphabetic1(Temp#)
    CASE 2
       CALL Parse.Alphabetic2(Temp#)
    CASE ELSE
       CALL Parse.Alphabetic3(Temp#)
    END SELECT
    CALL Get.Token
 END SELECT
END SUB
