REM file: Whatis1.bas - Public Domain DOS Utility. Module 2 of 2. v3.4a.

' get standard include declarations
REM $INCLUDE: 'WHATIS.INC'

REM For BC7 remove Rem from following line:
REM For VB1 add Rem to following line:
REM Declare Function Format$(a#,b$)

' uses direct keyboard input to get an input line
FUNCTION KeyboardLine$
 Var$ = ""
 DO
    IF KeyIS THEN ' check keyboard
       ' check control-break key
       IF BreakIS THEN
          EXIT DO
       END IF
       Var2$ = KeyboardChar$ ' get character
       SELECT CASE Var2$
       CASE CHR$(0) ' extended character
          ' nul
       CASE CHR$(13) ' return
          EXIT DO
       CASE CHR$(8) ' backspace
          IF LEN(Var$) > 0 THEN
             Var$ = LEFT$(Var$, LEN(Var$) - 1)
             IF POS(0) > 1 THEN ' check cursor location
                LOCATE CSRLIN, POS(0) - 1, 0
                PRINT " ";
                LOCATE CSRLIN, POS(0) - 1, 1
             ELSE ' line-wrap
                LOCATE CSRLIN - 1, 80, 0
                PRINT " ";
                LOCATE CSRLIN - 1, 80, 1
             END IF
          END IF
       CASE ELSE ' store input
          PRINT Var2$;
          LOCATE , , 1
          Var$ = Var$ + Var2$
       END SELECT
    END IF

    ' release time slice.
    InregsX2 = InregsX
    InregsX.AX = &H1680
    InregsX.BX = &H0000
    CALL InterruptX(&H2F, InregsX, OutregsX)
    InregsX = InregsX2
 LOOP

 ' return input line
 KeyboardLine$ = Var$
END FUNCTION

' reads character directly from keyboard
FUNCTION KeyboardChar$
 ' removes keystroke from buffer
 InregsX2 = InregsX
 InregsX.AX = &H0000
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX2
 ' store ascii character, ignoring extended keys
 Key1 = (OutregsX.AX AND &HFF)
 ' return character
 KeyboardChar$ = CHR$(Key1)
END FUNCTION

' checks keyboard buffer
FUNCTION KeyIS
 ' does not remove keystroke from buffer
 InregsX3 = InregsX
 InregsX.AX = &H0100
 CALL InterruptX(&H16, InregsX, OutregsX)
 InregsX = InregsX3
 ' check zero flag
 IF (OutregsX.Flags AND &H40) = &H40 THEN
    KeyIS = False
 ELSE
    KeyIS = True
 END IF
END FUNCTION

' clears Control-Break flag
FUNCTION ClearBreak
 DEF SEG = &H40
 POKE &H71, &H0
 DEF SEG
 ClearBreak = True
END FUNCTION

' checks Control-Break flag
FUNCTION BreakIS
 ' check break flag
 IF Redirected.Input THEN
    DEF SEG = &H40
    X = PEEK(&H71)
    DEF SEG
    IF X = 64 THEN
       Var = True
    END IF
 END IF
 ' check keystroke
 IF KeyIS THEN
    ' control-break returns 0, 0
    IF OutregsX.AX = 0 THEN
       Var = True
       ' set break flag
       DEF SEG = &H40
       POKE &H71, 64
       DEF SEG
    END IF
 END IF
 ' return break flag
 BreakIS = Var
END FUNCTION

' beginning of the command/equation parser
SUB Enter.Equate
 Strng=Nul
 Out2 = LTRIM$(Out2)
 IF Out2 = Nul THEN
    EXIT SUB
 END IF
 Store.Input$ = Out2
 Assign = False
 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
    If Assign Then
       EXIT SUB
    END IF
 END IF
 IF LEFT$(D$, 4) = "LEFT" THEN
    GOSUB Assign.Left.String
    If Assign Then
       EXIT SUB
    END IF
 END IF
 IF LEFT$(D$, 5) = "RIGHT" THEN
    GOSUB Assign.Right.String
    If Assign Then
       EXIT SUB
    END IF
 END IF
 IF LEFT$(D$, 5) = "DEFFN" THEN
    GOSUB Define.Function
    If Assign Then
       EXIT SUB
    END IF
 END IF
 Out2 = Store.Input$
 Last.Token = False
 Out3 = Nul
 Out4 = Nul
 Temp# = False
 Token.Index = 1
 CALL Get.Token
 CALL Parse1(T#)

 ' parse leftover tokens
 WHILE LEN(Strng)
    CALL Parse1(X#)
    ' toss away any unwanted tokens
    IF Last.Token = 3 THEN
       Strng = "<extra token>"
       ERROR 92
    END IF
 WEND

 ' display string result
 IF Last.Token = False THEN
    PRINT Out3
    EXIT SUB
 END IF

 ' check output type
 Var = False
 IF ENVIRON$("WHATOUT") <> Nul THEN
    Var = True
 END IF
 IF Output.Level THEN
    Var = True
 END IF

 ' print standard exponent display
 IF Var = False THEN
    PRINT LTRIM$(STR$(T#))
    EXIT SUB
 END IF

 ' print an integer
 IF T# = INT(T#) THEN
    PRINT Format$(T#,"#,##0;;0")
    EXIT SUB
 END IF

 ' count decimal places
 Var$ = STR$(T#)
 Var = INSTR(Var$, ".")
 Var$ = MID$(Var$, Var + 1)
 Var = LEN(Var$)

 ' format output string
 T$ = "#,##0." + STRING$(Var,"0") + ";;0"

 ' print floating point
 PRINT Format$(T#,T$)
 EXIT SUB

Assignment:
 Assign = False
 Temp1$ = UCASE$(LEFT$(Out2, 1))
 IF Temp1$="?" THEN
    Temp1$ = MID$(Out2,2)
    Temp2$ = LEFT$(Temp1$, 1)
    IF Temp2$ = "=" THEN
       Temp1$ = MID$(Temp1$, 2)
       Out2 = Temp1$
       CALL Equate(Temp4#)
       Assign = True
       EXIT SUB
    END IF
 END IF
 IF Temp1$ >= "A" AND Temp1$ <= "Z" THEN
    Variable = ASC(Temp1$) - 64
    Temp1$ = MID$(Out2, 2)
    Temp1$ = LTRIM$(Temp1$)
    CALL Assignment1(Temp1$, Variable)
    IF Assign THEN
       GOSUB Assign.End
       RETURN
    END IF
    IF LEFT$(Temp1$, 1) = "$" THEN
       Temp1$ = MID$(Temp1$, 2)
       Temp1$ = LTRIM$(Temp1$)
       IF LEFT$(Temp1$, 1) = "(" THEN
          Strng = "<bad string token>"
          ERROR 92
       END IF
       IF LEFT$(Temp1$, 1) = "[" THEN
          Strng = "<bad string token>"
          ERROR 92
       END IF
       IF LEFT$(Temp1$, 1) = "{" THEN
          Strng = "<bad string token>"
          ERROR 92
       END IF
       IF LEFT$(Temp1$, 1) = "=" THEN
	  Out2 = MID$(Temp1$, 2)
          Out2 = LTRIM$(Out2)
          Token.Index = 1
          CALL Get.Token
          CALL Parse1(Temp3#)
          IF Last.Token = False THEN
             Strngs(Variable) = Out3
             Assign = True
             GOSUB Assign.End
             RETURN
          END IF
       END IF
    END IF
    IF LEFT$(Temp1$, 1) = "(" THEN
       Out2 = MID$(Temp1$, 2)
       Out2 = LTRIM$(Out2)
       Last.Token = False
       Token.Index = 1
       CALL Get.Token
       CALL Parse1(Temp3#)
       IF Last.Token = True THEN
          Element = CINT(Temp3#)
          Temp1$ = MID$(Out2, Token.Index)
          Temp1$ = LTRIM$(Temp1$)
          CALL Assignment2(Temp1$, Variable, Element)
          IF Assign THEN
             GOSUB Assign.End
             RETURN
          END IF
       END IF
    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#)
          IF Strng = "," THEN
             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#)
                IF Last.Token = False THEN
                   Assign = True
                   IF Strngs(Variable) = Nul THEN
                      IF Start = 1 THEN
                         IF LEN(Out3) = Length THEN
                            Strngs(Variable) = Out3
                            GOSUB Assign.End
                            RETURN
                         END IF
                      END IF
                      Strng = "<bad string>"
                      ERROR 92
                      RETURN
                   END IF
                   MID$(Strngs(Variable), Start, Length) = Out3
                   GOSUB Assign.End
                   RETURN
                END IF
             END IF
	  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
             Assign = True
	     Out2 = MID$(Out2, 2)
	     Out2 = LTRIM$(Out2)
	     Token.Index = 1
	     CALL Get.Token
             CALL Parse1(T#)
             IF Last.Token = False THEN
                Assign = True
                IF Strngs(Variable) = Nul THEN
                   IF LEN(Out3) = Start THEN
                      Strngs(Variable) = Out3
                      GOSUB Assign.End
                      RETURN
                   END IF
                   Strng = "<bad string>"
                   ERROR 92
                   RETURN
                END IF
                MID$(Strngs(Variable), 1, Start) = Out3
                GOSUB Assign.End
                RETURN
             END IF
	  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
             Assign = True
	     Out2 = MID$(Out2, 2)
	     Out2 = LTRIM$(Out2)
	     Token.Index = 1
	     CALL Get.Token
	     CALL Parse1(T#)
	     Length = LEN(Strngs(Variable)) - Start + 1
             IF Last.Token = False THEN
                Assign = True
                IF Length > False THEN
                   MID$(Strngs(Variable), Length, Start) = Out3
                   GOSUB Assign.End
                   RETURN
                ELSE
                   IF Strngs(Variable) = Nul THEN
                      IF LEN(Out3) = Start THEN
                         Strngs(Variable) = Out3
                         GOSUB Assign.End
                         RETURN
                      END IF
                   END IF
                END IF
	     END IF
	  END IF
       END IF
    END IF
 END IF
 RETURN

Assign.End:
 IF LEN(Strng) THEN
    CALL Parse1(X#)
    Strng = "<extra token>"
    ERROR 92
 END IF
 RETURN

Define.Function:
 Out2 = MID$(Out2, 6)
 Out2 = LTRIM$(Out2)
 Token.Index = 1
 CALL Get.Token3
 CALL Get.Token
 CALL Parse1(Temp4#)
 CALL Get.Token4
 Func% = CINT(Temp4#)
 IF Func% >= 1 AND Func% <= Max.FNs THEN
    Out2 = MID$(Out2, Token.Index)
    Out2 = LTRIM$(Out2)
    IF LEFT$(Out2, 1) = "=" THEN
       Out2 = MID$(Out2, 2)
       Definitions(Func%) = Out2
       Assign = True
       RETURN
    END IF
 END IF
 ERROR 145
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 symbols
 CALL Get.Token2(Token.Exists)
 IF Token.Exists THEN
    EXIT SUB
 END IF
 IF Token.Index > LEN(Out2) THEN
    Strng = Nul
    Token = False
    Token.Index = Token.Index + 1
    EXIT SUB
 END IF
 ' locate expression symbol
 Token.Element$ = MID$(Out2, Token.Index, 1)
 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
 ' 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$ = UCASE$(MID$(Out2, Token.Index, 1))
    LOOP
    Token = 3 ' store token type
    EXIT SUB
 END IF
 Token = False
 Strng = Token.Element$
 Token.Index = Token.Index + 1
END SUB

' gets two-symbol tokens,
' increments pointer to next token.
SUB Get.Token2 (Token.Exists)
 Token.Exists = False
 Stored.Token$ = Out2
 ' locate expression symbols
 Next.Token$ = MID$(Stored.Token$, Token.Index, 2)
 SELECT CASE Next.Token$
 CASE "<<"
    Token = 1 ' store token type
    Strng = "<<" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE ">>"
    Token = 1 ' store token type
    Strng = ">>" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "--"
    Token = 1 ' store token type
    Strng = "--" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "++"
    Token = 1 ' store token type
    Strng = "++" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "**"
    Token = 1 ' store token type
    Strng = "**" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "//"
    Token = 1 ' store token type
    Strng = "//" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE ">=", "=>"
    Token = 1 ' store token type
    Strng = ">=" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "<=", "=<"
    Token = 1 ' store token type
    Strng = "<=" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 CASE "<>", "><"
    Token = 1 ' store token type
    Strng = "<>" ' store token
    Token.Index = Token.Index + 2 ' increment pointer
    Token.Exists = True
 END SELECT
END SUB

' verifies next token is opening parenthesis.
SUB Get.Token3
 Strng = Nul
 Token = False
 IF Token.Index > LEN(Out2) THEN
    Strng = "<missing opening parenthesis>"
    ERROR 92
 END IF
 ' locate parenthesis symbol
 Token.Element$ = MID$(Out2, Token.Index, 1)
 IF Token.Element$ = "(" THEN
    Token = 1 ' store token type
    Strng = Token.Element$ ' store token
    Token.Index = Token.Index + 1 ' increment pointer
    EXIT SUB
 END IF
 Strng = "<missing opening parenthesis>"
 ERROR 92
END SUB

' verifies last token is closing parenthesis.
SUB Get.Token4
 ' locate parenthesis symbol
 IF Strng = ")" THEN
    EXIT SUB
 END IF
 Strng = "<missing closing parenthesis>"
 ERROR 92
END SUB

' process a number
SUB Parse.Numeric (Temp#)
 SELECT CASE RIGHT$(UCASE$(Strng), 1) ' compare character after number
 CASE "Q" ' perfect number suffix
    IF BreakIS2 THEN
       CALL Get.Token
       Last.Token = True
       Temp# = 0#
       EXIT SUB
    END IF
    FOR Digit = 1 TO LEN(Strng) - 1
       OutX$ = UCASE$(MID$(Strng, Digit, 1))
       SELECT CASE OutX$
       CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
          ' nul
       CASE ELSE
          ERROR 130
       END SELECT
    NEXT
    Temp# = CDBL(VAL(LEFT$(Strng, LEN(Strng) - 1)))
    Perfect# = 0#
    Perfect.Number# = INT(Temp#)
    IF ABS(Perfect.Number#) > 7# THEN
       ERROR 130
    END IF
    IF Perfect.Number# > FalseD THEN
       SELECT CASE Perfect.Number#
       CASE 1#
          X# = 1#
       CASE 2#
          X# = 2#
       CASE 3#
          X# = 4#
       CASE 4#
          X# = 6#
       CASE 5#
          X# = 12#
       CASE 6#
          X# = 16#
       CASE 7#
          X# = 18#
       'CASE 8# ' overflows beyond double precision
       '  X# = 30#
       CASE ELSE
          ERROR 130
       END SELECT
       ' equation for perfect number
       Perfect# = 2 ^ X# * (2 ^ (X# + 1) - 1)
    END IF
    Temp# = Perfect#
 CASE "P" ' prime number suffix
    IF BreakIS2 THEN
       CALL Get.Token
       Last.Token = True
       Temp# = 0#
       EXIT SUB
    END IF
    FOR Digit = 1 TO LEN(Strng) - 1
       OutX$ = UCASE$(MID$(Strng, Digit, 1))
       SELECT CASE OutX$
       CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
          ' nul
       CASE ELSE
          ERROR 130
       END SELECT
    NEXT
    Temp# = CDBL(VAL(LEFT$(Strng, LEN(Strng) - 1)))
    Prime.Number# = INT(Temp#)
    Prime# = 1
    IF Prime.Number# > False THEN
       Prime.Counter# = False
       DO
	  Prime# = Prime# + 1
	  Prime.Flag = False
          FOR Factor# = 2# TO INT(SQR(Prime#))
             IF Prime# / Factor# = INT(Prime# / Factor#) 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
          IF BreakIS THEN
             BreakIS2 = True
             Prime# = 0#
             Var2$ = KeyboardChar$
             Var2 = ClearBreak
             EXIT DO
          END IF
       LOOP
    END IF
    Temp# = Prime#
 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
    FOR Decimal.Digit = 1 TO Temp3
       OutX$ = UCASE$(MID$(Strng, Decimal.Digit, 1))
       SELECT CASE OutX$
       CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
          ' nul
       CASE ELSE
          ERROR 130
       END SELECT
    NEXT
    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
       OutX$ = UCASE$(MID$(Strng, Hex.Digit, 1))
       SELECT CASE OutX$
       CASE "0" TO "9", "A" TO "F"
          Hex.Value = VAL("&H" + OutX$)
          Temp# = Temp# + Hex.Value * 16 ^ Hex.Power
          Hex.Power = Hex.Power + 1
       CASE ELSE
          ERROR 130
       END SELECT
    NEXT
 CASE "O" ' octal suffix
    Temp# = False
    Octal.Power = False
    FOR Octal.Digit = LEN(Strng) - 1 TO 1 STEP -1
       OutX$ = MID$(Strng, Octal.Digit, 1)
       IF OutX$ >= "0" AND OutX$ <= "7" THEN
          Octal.Value = VAL(OutX$)
          Temp# = Temp# + Octal.Value * 8 ^ Octal.Power
          Octal.Power = Octal.Power + 1
       ELSE
          ERROR 130
       END IF
    NEXT
 CASE "B" ' binary suffix
    Temp# = False
    Binary.Power = False
    FOR Binary.Digit = LEN(Strng) - 1 TO 1 STEP -1
       OutX$ = MID$(Strng, Binary.Digit, 1)
       SELECT CASE OutX$
       CASE "0"
          ' nul
       CASE "1"
	  Temp# = Temp# + 2 ^ Binary.Power
       CASE ELSE
          ERROR 130
       END SELECT
       Binary.Power = Binary.Power + 1
    NEXT
 CASE "0" TO "9", "D", "E" ' decimal/exponent suffix
    Decimal = False
    Exponent = False
    Number$ = Strng
 Start.Token:
    FOR Decimal.Digit = 1 TO LEN(Number$)
       OutX$ = UCASE$(MID$(Number$, Decimal.Digit, 1))
       SELECT CASE OutX$
       CASE "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", "-", "+"
          ' nul
       CASE "D", "E"
          IF Exponent THEN
             ERROR 140
          END IF
          Exponent = True
          Exponent$ = UCASE$(RIGHT$(Number$, 1))
          IF Exponent$ = "D" OR Exponent$ = "E" THEN
             ' concatenate pre-parsed tokens into exponent
             Unary$ = MID$(Out2, Token.Index, 1)
             IF Unary$ = "+" OR Unary$ = "-" THEN
                Var$ = LEFT$(Out2, Token.Index - 1)
                CALL Get.Token
                Out2 = Var$ + Strng + MID$(Out2, Token.Index)
                CALL Get.Token
                IF Strng = Nul THEN
                   ERROR 140
                END IF
                Number$ = Number$ + Unary$ + Strng
                IF Strng = "-" OR Strng = "+" THEN
                   ERROR 140
                END IF
                IF INSTR(Strng, ".") THEN
                   ERROR 140
                END IF
                DO
                   IF LEFT$(Number$, 1) = "-" THEN
                      Number$ = MID$(Number$, 2)
                   ELSE
                      IF LEFT$(Number$, 1) = "+" THEN
                         Number$ = MID$(Number$, 2)
                      ELSE
                         EXIT DO
                      END IF
                   END IF
                LOOP
                Decimal = False
                Exponent = False
                GOTO Start.Token
             ELSE
                ERROR 140
             END IF
          END IF
       CASE "."
          IF Exponent THEN
             ERROR 140
          END IF
          IF Decimal THEN
             ERROR 140
          END IF
          Decimal = True
       CASE ELSE
          ERROR 130
       END SELECT
    NEXT
    Temp# = CDBL(VAL(Number$))
 CASE ELSE
    ERROR 130
 END SELECT
 CALL Get.Token
 Last.Token = True
END SUB

' parse string in quotes
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
       ERROR 92
       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   <<, >>, --, ++, **, //  Dual unary
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
 ' parse leftover tokens
 WHILE LEN(Strng)
    CALL Parse1(X#)
    ' toss away any unwanted tokens
    IF Last.Token = 3 THEN
       Strng = "<extra token>"
       ERROR 92
    END IF
 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 Parse7a(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 Parse7a(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

 ' dual-unary parser
SUB Parse7a (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 0 ' unknown token
    IF Last.Token = 3 THEN
       Strng = "<extra token>"
       ERROR 92
    END IF
    IF Strng = Nul THEN
       Strng = "<missing token>"
    END IF
    ERROR 92
    Last.Token = False
 CASE 1 ' token is symbol
    Token.Parsed$ = Strng
    SELECT CASE Token.Parsed$ ' determine token
    CASE ",", ";" ' separaters
       Last.Token = 3
    CASE CHR$(34) ' parse string
       CALL Parse.Quoted
       Quotes = True
    CASE "(" ' calculate opening parenthesis
       CALL Get.Token ' read next token value inside parenthesis
       IF Strng = ")" THEN
          Strng = "<empty closing token>"
          ERROR 92
       END IF
       IF Strng <> ")" THEN
          DO ' calculate value
             CALL Parse1(Temp#) ' call parse entry
          LOOP UNTIL Strng = ")" OR Token = False ' check closing parenthesis
       END IF
       IF Token = False THEN
          Strng = "<missing closing token>"
          ERROR 92
       END IF
       CALL Get.Token ' read next token after parenthesis
    CASE "["
       CALL Get.Token
       IF Strng = "]" THEN
          Strng = "<empty closing token>"
          ERROR 92
       END IF
       IF Strng <> "]" THEN
          DO
             CALL Parse1(Temp#)
          LOOP UNTIL Strng = "]" OR Token = False
       END IF
       IF Token = False THEN
          Strng = "<missing closing token>"
          ERROR 92
       END IF
       CALL Get.Token
    CASE "{"
       CALL Get.Token
       IF Strng = "}" THEN
          Strng = "<empty closing token>"
          ERROR 92
       END IF
       IF Strng <> "}" THEN
          DO
             CALL Parse1(Temp#)
          LOOP UNTIL Strng = "}" OR Token = False
       END IF
       IF Token = False THEN
          Strng = "<missing closing token>"
          ERROR 92
       END IF
       CALL Get.Token
    CASE ")", "]", "}" ' check token is closing parenthesis
       Strng = "<extra closing token>"
       ERROR 92
    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

' remove all white spaces, skip white spaces in quotes.
SUB Remove.Spaces
 Var$ = Out2
 Temp = False
 DO
    Temp = Temp + 1
    IF Temp > LEN(Var$) THEN
       EXIT DO
    END IF
    IF MID$(Var$, Temp, 1) = CHR$(34) THEN
       DO
          Temp = Temp + 1
          IF Temp > LEN(Var$) THEN
             EXIT DO
          END IF
          IF MID$(Var$, Temp, 1) = CHR$(34) THEN
             EXIT DO
          END IF
       LOOP
    END IF
    FOR Blanks = 1 TO LEN(White.Space)
       IF MID$(Var$, Temp, 1) = MID$(White.Space, Blanks, 1) THEN
          Var$ = LEFT$(Var$, Temp - 1) + MID$(Var$, Temp + 1)
          Temp = Temp - 1
          EXIT FOR
       END IF
    NEXT
 LOOP
 Out2 = Var$
END SUB
