'
'   File:   eq_10.bas
'   Creation Date:  Thu 15-Jul-2004 15:36:22        Jonathan D. Kirwan
'   Last Modified:  Wed 21-Jul-2004 02:41:38        Initial version.
'
'   Copyright (C) 2004 Jonathan Dale Kirwan, All Rights Reserved
'
'
'   DESCRIPTION
'
'   This is a program demonstrating parsing of mathematical expressions.
'   This version handles algebraic equations of the form:
'
'       unary := SIN | COS | TAN | SEC | CSC | CTN | ATAN | ASIN | ACOS |
'                   ASEC | ACSC | ACTN | ABS | SGN | INT | SQRT | LOG | EXP
'       moreitems := ^ item moreitems | <null>
'       item := name | number | ( expression ) | unary ( expression )
'       morefactors := * factor morefactors | / factor morefactors | <null>
'       factor := item moreitems
'       moreterms := + term moreterms | - term moreterms | <null>
'       term := factor morefactors
'       expression := sign term moreterms
'       statement := expression | name = expression
'       moreexpr := ; expression moreexpr | <null>
'       list := expression moreexpr
'
'   Where a number is:
'
'       digit := 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9
'       digits := digit digits | <null>
'       mantissa := . digit digits | digit . digits | digit digits
'       scaleid := e | E
'       scale := scaleid sign digit digits | <null>
'       sign := + | - | <null>
'       number := sign mantissa scale
'
'   And where a variable name or function name is:
'
'       alpha := A | B | C | D | E | F | G | H | I | J | K | L | M |
'                N | O | P | Q | R | S | T | U | V | W | X | Y | Z |
'                a | b | c | d | e | f | g | h | i | j | k | l | m |
'                n | o | p | q | r | s | t | u | v | w | x | y | z
'       alphanumeric := alpha | digit
'       alphanumerics := alphanumeric alphanumerics | <null>
'       name := alpha alphanumerics
'
'   It also calculates the resulting value and displays it, as well as
'   handling some standard unary functions. It also supports two special
'   values, PI and E, for use in calculating values and allows statements
'   to define new variable values.  Statements can be repeated, if
'   separated by semi-colons, as well.
'
'   See,
'
'       http://users.easystreet.com/jkirwan/new/parsing.html
'
'   for more detailed information on the design.
'
'
'   MODIFICATIONS
'
'   No modifications.
'
'
'   COPYRIGHT NOTICE
'
'   Jonathan Dale Kirwan grants you a non-transferable, non-exclusive,
'   royalty-free worldwide license to use, copy, modify, prepare deriva-
'   tive works of and distribute this software, subject to your agreement
'   that you acquire no ownership right, title, or interest in this soft-
'   ware and your agreement that this software is research work which is
'   provided 'as is', where Jonathan Dale Kirwan disclaims all warranties
'   with regard to this software, including all implied warranties of
'   merchantability and fitness of purpose.  In no event shall Jonathan
'   Dale Kirwan be liable for any direct, indirect, consequential or
'   special damages or any damages whatsoever resulting from loss of use,
'   data or profits, whether in an action of contract, negligence or
'   other tortious action, arising out of or in connection with the use
'   or performance of this software.

CONST TITLE$ = "EQ"
CONST VERSION% = 10

CONST MAXVARS% = 1000
CONST MAXHEAD% = 210

DECLARE FUNCTION Number% (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION IsOverflow% (stk AS STRING)
DECLARE FUNCTION Pop# (stk AS STRING)
DECLARE FUNCTION Expression% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)
DECLARE FUNCTION Statement% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)
DECLARE SUB SList (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

DECLARE FUNCTION Item% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)
DECLARE FUNCTION Factor% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)
DECLARE FUNCTION Term% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

DECLARE FUNCTION Mantissa% (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION ScaleID% (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION Digit% (eqpos AS INTEGER, eq AS STRING)
DECLARE SUB Digits (eqpos AS INTEGER, eq AS STRING)
DECLARE SUB Scale (eqpos AS INTEGER, eq AS STRING)
DECLARE SUB Sign (eqpos AS INTEGER, eq AS STRING)

DECLARE FUNCTION Alpha% (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION AlphaNumeric (eqpos AS INTEGER, eq AS STRING)
DECLARE SUB AlphaNumerics (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION Symbol% (eqpos AS INTEGER, eq AS STRING, token AS STRING)
DECLARE SUB UnaryFunction (token AS STRING, stk AS STRING)

DECLARE SUB Push (value AS DOUBLE, stk AS STRING)

DECLARE SUB Add (stk AS STRING)
DECLARE SUB Subtract (stk AS STRING)
DECLARE SUB Multiply (stk AS STRING)
DECLARE SUB Divide (stk AS STRING)
DECLARE SUB Power (stk AS STRING)

DECLARE SUB SkipSpaces (eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION Match% (charlist AS STRING, eqpos AS INTEGER, eq AS STRING)
DECLARE FUNCTION Overflow# ()

DECLARE SUB InitValues ()
DECLARE SUB SetValue (text AS STRING, value AS DOUBLE)
DECLARE FUNCTION GetValue# (text AS STRING, idx AS INTEGER)

DECLARE FUNCTION Hash& (msg AS STRING)
DECLARE FUNCTION ReHash& (priorhash AS LONG, msg AS STRING)

TYPE SYMBOLENTRY
    hashcode AS LONG
    nextptr AS INTEGER
END TYPE

DECLARE FUNCTION FindEntry% (vname AS STRING, hashtable() AS SYMBOLENTRY)
DECLARE FUNCTION AddEntry% (vname AS STRING, hashtable() AS SYMBOLENTRY)
DECLARE SUB InitEntries (vlimit AS INTEGER, hlimit AS INTEGER, hashtable() AS SYMBOLENTRY)

        CLS

        COLOR 13
        PRINT " "; STRING$(78, "Ä")
        PRINT SPACE$(41 - LEN(TITLE) \ 2); TITLE;
        LOCATE , 71 + (VERSION > 9)
        PRINT "Version"; VERSION
        PRINT " "; STRING$(78, "Ä")
        COLOR 7

        PRINT
        PRINT "This program accepts mathematical expressions in algebraic notation and then"
        PRINT "calculates the values and prints them.  Separate expressions can be entered"
        PRINT "on a single line by using the semi-colon between them.  A number of built-in"
        PRINT "functions are supported (enter ? to get a list.)  The special values PI and E"
        PRINT "are available and you can enter assignment statements to your own variables,"
        PRINT "as well.  This program is intended as a parsing demonstration program."
        PRINT

    REDIM SHARED vartbl(0 TO 0) AS SYMBOLENTRY
    REDIM SHARED varval(1 TO 1) AS DOUBLE

        InitValues
        SetValue "PI", 4# * ATN(1#)
        SetValue "E", EXP(1#)

    DIM eq AS STRING, eqpos AS INTEGER, status AS INTEGER, stk AS STRING

        INPUT "Statement list (? for help): ", eq
        DO WHILE RTRIM$(eq) <> ""
            IF LTRIM$(RTRIM$(eq)) = "?" THEN
                PRINT
                PRINT "  Built-in Variables:"
                PRINT "    PI, E, ANS"
                PRINT
                PRINT "  Built-in Functions:"
                PRINT "    SIN, COS, TAN, SEC, CSC, CTN,"
                PRINT "    ASIN, ACOS, ATAN, ASEC, ACSC, ACTN,"
                PRINT "    SINH, COSH, TANH, SECH, CSCH, COTH,"
                PRINT "    DEG, RAD, EXP, LOG, LN, LOG10, LOG2,"
                PRINT "    SQRT, SQR, ABS, SGN, INT, RND"
                PRINT
                PRINT "  Some Examples:"
                PRINT "    a= SIN(PI/3); b= SIN(PI/4); DEG(ASN(a+b))"
                PRINT "    -(4+13)*8; ANS*2"
                PRINT "    e^2+e^-2"
                PRINT
            ELSE
                LET eqpos = 1
                SList eqpos, eq, stk
            END IF
            INPUT "Statement list (? for help): ", eq
        LOOP
        END

ErrorHandler:

    DIM SHARED ErrNumber AS INTEGER

        LET ErrNumber = ERR
        RESUME NEXT

DATA 2078917053,  143302914, 1027100827, 1953210302,  755253631, 2002600785
DATA 1405390230,   45248011, 1099951567,  433832350, 2018585307,  438263339
DATA  813528929, 1703199216,  618906479,  573714703,  766270699,  275680090
DATA 1510320440, 1583583926, 1723401032, 1965443329, 1098183682, 1636505764
DATA  980071615, 1011597961,  643279273, 1315461275,  157584038, 1069844923
DATA  471560540,   89017443, 1213147837, 1498661368, 2042227746, 1968401469
DATA 1353778505, 1300134328, 2013649480,  306246424, 1733966678, 1884751139
DATA  744509763,  400011959, 1440466707, 1363416242,  973726663,   59253759
DATA 1639096332,  336563455, 1642837685, 1215013716,  154523136,  593537720
DATA  704035832, 1134594751, 1605135681, 1347315106,  302572379, 1762719719
DATA  269676381,  774132919, 1851737163, 1482824219,  125310639, 1746481261
DATA 1303742040, 1479089144,  899131941, 1169907872, 1785335569,  485614972
DATA  907175364,  382361684,  885626931,  200158423, 1745777927, 1859353594
DATA  259412182, 1237390611,   48433401, 1902249868,  304920680,  202956538
DATA  348303940, 1008956512, 1337551289, 1953439621,  208787970, 1640123668
DATA 1568675693,  478464352,  266772940, 1272929208, 1961288571,  392083579
DATA  871926821, 1117546963, 1871172724, 1771058762,  139971187, 1509024645
DATA  109190086, 1047146551, 1891386329,  994817018, 1247304975, 1489680608
DATA  706686964, 1506717157,  579587572,  755120366, 1261483377,  884508252
DATA  958076904, 1609787317, 1893464764,  148144545, 1415743291, 2102252735
DATA 1788268214,  836935336,  433233439, 2055041154, 2109864544,  247038362
DATA  299641085,  834307717, 1364585325,   23330161,  457882831, 1504556512
DATA 1532354806,  567072918,  404219416, 1276257488, 1561889936, 1651524391
DATA  618454448,  121093252, 1010757900, 1198042020,  876213618,  124757630
DATA 2082550272, 1834290522, 1734544947, 1828531389, 1982435068, 1002804590
DATA 1783300476, 1623219634, 1839739926,   69050267, 1530777140, 1802120822
DATA  316088629, 1830418225,  488944891, 1680673954, 1853748387,  946827723
DATA 1037746818, 1238619545, 1513900641, 1441966234,  367393385,  928306929
DATA  946006977,  985847834, 1049400181, 1956764878,   36406206, 1925613800
DATA 2081522508, 2118956479, 1612420674, 1668583807, 1800004220, 1447372094
DATA  523904750, 1435821048,  923108080,  216161028, 1504871315,  306401572
DATA 2018281851, 1820959944, 2136819798,  359743094, 1354150250, 1843084537
DATA 1306570817,  244413420,  934220434,  672987810, 1686379655, 1301613820
DATA 1601294739,  484902984,  139978006,  503211273,  294184214,  176384212
DATA  281341425,  228223074,  147857043, 1893762099, 1896806882, 1947861263
DATA 1193650546,  273227984, 1236198663, 2116758626,  489389012,  593586330
DATA  275676551,  360187215,  267062626,  265012701,  719930310, 1621212876
DATA 2108097238, 2026501127, 1865626297,  894834024,  552005290, 1404522304
DATA   48964196,    5816381, 1889425288,  188942202,  509027654,   36125855
DATA  365326415,  790369079,  264348929,  513183458,  536647531,   13672163
DATA  313561074, 1730298077,  286900147, 1549759737, 1699573055,  776289160
DATA 2143346068, 1975249606, 1136476375,  262925046,   92778659, 1856406685
DATA 1884137923,   53392249, 1735424165, 1602280572,          0

SUB Add (stk AS STRING)

    DIM sum AS DOUBLE, addend1 AS DOUBLE, addend2 AS DOUBLE

        LET addend2 = Pop(stk)
        LET addend1 = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        LET sum = addend1 + addend2
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push sum, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB

FUNCTION AddEntry% (vname AS STRING, hashtable() AS SYMBOLENTRY)

    DIM hashcode AS LONG, idx AS INTEGER, pidx AS INTEGER, hlimit AS INTEGER

        LET hashcode = ReHash(0&, vname)
        LET hlimit = CINT(hashtable(0).hashcode)
        LET idx = hashcode MOD hlimit
        IF idx < 0 THEN
            LET idx = idx + hlimit
        END IF
        LET idx = idx + 1

        IF hashtable(idx).nextptr >= 0 THEN
            DO
                IF hashtable(idx).hashcode = hashcode THEN
                    LET AddEntry = idx
                    EXIT FUNCTION
                END IF
                LET pidx = idx
                LET idx = hashtable(idx).nextptr
            LOOP WHILE idx > 0
            IF hashtable(0).nextptr <= UBOUND(hashtable) THEN
                LET idx = hashtable(0).nextptr
                LET hashtable(0).nextptr = idx + 1
                LET hashtable(pidx).nextptr = idx
            ELSE
                LET AddEntry = 0
                EXIT FUNCTION
            END IF
        END IF

        LET hashtable(idx).hashcode = hashcode
        LET hashtable(idx).nextptr = 0

        LET AddEntry = idx

END FUNCTION

FUNCTION Alpha% (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        LET status = Match("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", eqpos, eq)

    LET Alpha = status

END FUNCTION

FUNCTION AlphaNumeric (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        LET status = Match("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz", eqpos, eq)

    LET AlphaNumeric = status

END FUNCTION

SUB AlphaNumerics (eqpos AS INTEGER, eq AS STRING)

        DO WHILE AlphaNumeric(eqpos, eq)
        LOOP

END SUB

FUNCTION Digit% (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        LET status = Match("0123456789", eqpos, eq)

    LET Digit = status

END FUNCTION

SUB Digits (eqpos AS INTEGER, eq AS STRING)

        DO WHILE Digit(eqpos, eq)
        LOOP

END SUB

SUB Divide (stk AS STRING)

    DIM ratio AS DOUBLE, dividend AS DOUBLE, divisor AS DOUBLE

        LET divisor = Pop(stk)
        LET dividend = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        LET ratio = dividend / divisor
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push ratio, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB

FUNCTION Expression% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER

        IF Match("-", eqpos, eq) THEN
            LET status = Term(eqpos, eq, stk)
            IF status THEN
                Push -1#, stk
                Multiply stk
            END IF
        ELSE
            LET status = Match("+", eqpos, eq)
            LET status = Term(eqpos, eq, stk)
        END IF

        DO WHILE status
            SkipSpaces eqpos, eq
            IF Match("+", eqpos, eq) THEN
                LET status = Term(eqpos, eq, stk)
                IF status THEN
                    Add stk
                END IF
            ELSEIF Match("-", eqpos, eq) THEN
                LET status = Term(eqpos, eq, stk)
                IF status THEN
                    Subtract stk
                END IF
            ELSE
                EXIT DO
            END IF
        LOOP

    LET Expression = status

END FUNCTION

FUNCTION Factor% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER

        LET status = Item(eqpos, eq, stk)
        DO WHILE status
            SkipSpaces eqpos, eq
            IF Match("^", eqpos, eq) THEN
                LET status = Item(eqpos, eq, stk)
                IF status THEN
                    Power stk
                END IF
            ELSE
                EXIT DO
            END IF
        LOOP

    LET Factor = status

END FUNCTION

FUNCTION FindEntry% (vname AS STRING, hashtable() AS SYMBOLENTRY)

    DIM hashcode AS LONG, idx AS INTEGER, hlimit AS INTEGER

        LET hashcode = ReHash(0&, vname)
        LET hlimit = CINT(hashtable(0).hashcode)
        LET idx = hashcode MOD hlimit
        IF idx < 0 THEN
            LET idx = idx + hlimit
        END IF
        LET idx = idx + 1

        IF hashtable(idx).nextptr >= 0 THEN
            DO
                IF hashtable(idx).hashcode = hashcode THEN
                    EXIT DO
                END IF
                LET idx = hashtable(idx).nextptr
            LOOP WHILE idx > 0
        ELSE
            LET idx = 0
        END IF

        LET FindEntry = idx

END FUNCTION

FUNCTION GetValue# (text AS STRING, idx AS INTEGER)

    DIM value AS DOUBLE

        LET idx = FindEntry(text, vartbl())
        IF idx > 0 THEN
            LET value = varval(idx)
        ELSE
            LET value = 0#
        END IF

    LET GetValue = value

END FUNCTION

FUNCTION Hash& (msg AS STRING)

        LET Hash = ReHash(0&, msg)

END FUNCTION

SUB InitEntries (vlimit AS INTEGER, hlimit AS INTEGER, hashtable() AS SYMBOLENTRY)

    DIM i AS INTEGER

        IF hlimit <= vlimit THEN
            IF LBOUND(hashtable) <> 0 OR UBOUND(hashtable) <> vlimit THEN
                REDIM hashtable(0 TO vlimit) AS SYMBOLENTRY
            END IF
            LET hashtable(0).hashcode = CLNG(hlimit)    ' Size of the header.
            LET hashtable(0).nextptr = hlimit + 1       ' Next available entry.
            FOR i = 1 TO hlimit
                LET hashtable(i).nextptr = -1
            NEXT i
        END IF

END SUB

SUB InitValues

        REDIM vartbl(0 TO MAXVARS) AS SYMBOLENTRY
        InitEntries MAXVARS, MAXHEAD, vartbl()
        REDIM varval(1 TO MAXVARS) AS DOUBLE

END SUB

FUNCTION IsOverflow% (stk AS STRING)

    DIM status AS INTEGER

        LET status = (MID$(stk, LEN(stk) - 7) = MKD$(Overflow))

    LET IsOverflow = status

END FUNCTION

FUNCTION Item% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER, savepos AS INTEGER, value AS DOUBLE
    DIM token AS STRING, idx AS INTEGER

        SkipSpaces eqpos, eq
        LET savepos = eqpos
        IF Match("(", eqpos, eq) THEN
            LET status = Expression(eqpos, eq, stk)
            IF status THEN
                SkipSpaces eqpos, eq
                LET status = Match(")", eqpos, eq)
            END IF
        ELSEIF Symbol(eqpos, eq, token) THEN
            SkipSpaces eqpos, eq
            IF NOT Match("(", eqpos, eq) THEN
                LET value = GetValue(UCASE$(token), idx)
                IF idx > 0 THEN
                    Push value, stk
                    LET status = -1
                ELSE
                    LET status = 0
                END IF
            ELSE
                LET status = Expression(eqpos, eq, stk)
                IF status THEN
                    SkipSpaces eqpos, eq
                    LET status = Match(")", eqpos, eq)
                    IF status THEN
                        UnaryFunction token, stk
                    END IF
                END IF
            END IF
        ELSE
            LET status = Number(eqpos, eq)
            IF status THEN
                LET ErrNumber = 0
                ON ERROR GOTO ErrorHandler
                LET value = VAL(MID$(eq, savepos, eqpos - savepos))
                ON ERROR GOTO 0
                IF ErrNumber = 0 THEN
                    Push value, stk
                ELSE
                    Push Overflow, stk
                END IF
            END IF
        END IF

    LET Item = status

END FUNCTION

FUNCTION Mantissa% (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        IF Match(".", eqpos, eq) THEN
            LET status = Digit(eqpos, eq)
            IF status THEN
                Digits eqpos, eq
            END IF
        ELSEIF Digit(eqpos, eq) THEN
            Digits eqpos, eq
            LET status = -1 OR Match(".", eqpos, eq)
            Digits eqpos, eq
        ELSE
            LET status = 0
        END IF

    LET Mantissa = status

END FUNCTION

FUNCTION Match% (charlist AS STRING, eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        IF eqpos <= LEN(eq) THEN
            IF INSTR(charlist, MID$(eq, eqpos, 1)) <> 0 THEN
                LET eqpos = eqpos + 1
                LET status = -1
            END IF
        ELSE
            LET status = 0
        END IF

    LET Match = status

END FUNCTION

SUB Multiply (stk AS STRING)

    DIM product AS DOUBLE, multiplicand1 AS DOUBLE, multiplicand2 AS DOUBLE

        LET multiplicand2 = Pop(stk)
        LET multiplicand1 = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        LET product = multiplicand1 * multiplicand2
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push product, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB

FUNCTION Number% (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER, dummy AS INTEGER

        Sign eqpos, eq
        LET status = Mantissa(eqpos, eq)
        IF status THEN
            Scale eqpos, eq
        END IF

    LET Number = status

END FUNCTION

FUNCTION Overflow#

    DIM value AS DOUBLE

        LET value = CVD(STRING$(8, 255))

    LET Overflow = value

END FUNCTION

FUNCTION Pop# (stk AS STRING)

    DIM slen AS INTEGER, value AS DOUBLE

        LET slen = LEN(stk)
        LET value = CVD(MID$(stk, slen - 7))
        LET stk = LEFT$(stk, slen - 8)

    LET Pop = value

END FUNCTION

SUB Power (stk AS STRING)

    DIM result AS DOUBLE, pow1 AS DOUBLE, pow2 AS DOUBLE

        LET pow2 = Pop(stk)
        LET pow1 = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        LET result = pow1 ^ pow2
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push result, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB

SUB Push (value AS DOUBLE, stk AS STRING)

        LET stk = stk + MKD$(value)

END SUB

FUNCTION ReHash& (priorhash AS LONG, msg AS STRING)

    STATIC IsLoaded AS INTEGER
    STATIC scatter() AS LONG

    DIM i AS INTEGER

        IF NOT IsLoaded THEN
            RESTORE
            DIM scatter(0 TO 255) AS LONG
            FOR i = 0 TO 255
                READ scatter(i)
            NEXT i
            LET IsLoaded = -1
        END IF

    DIM s AS LONG, current AS LONG

        LET current = priorhash
        FOR i = 1 TO LEN(msg)
            SELECT CASE (current AND &HC0000000)
            CASE &H0&
                LET current = current * 2
            CASE &H40000000
                LET current = (current OR &H80000000) * 2
            CASE &H80000000
                LET current = (current AND &H7FFFFFFF) * 2
            CASE &HC0000000
                LET current = current * 2
            END SELECT
            LET s = scatter(ASC(MID$(msg, i, 1)))
            IF current < 0& THEN
                LET current = current + s
            ELSEIF current > &H7FFFFFFF - s THEN
                LET current = (&H7FFFFFFF - current) + (&H7FFFFFFF - s) + 2
            ELSE
                LET current = current + s
            END IF
        NEXT i

        LET ReHash = current

END FUNCTION

SUB Scale (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER, savepos AS INTEGER

        LET savepos = eqpos
        IF ScaleID(eqpos, eq) THEN
            Sign eqpos, eq
            LET status = Digit(eqpos, eq)
            IF status THEN
                Digits eqpos, eq
            ELSE
                LET eqpos = savepos
            END IF
        END IF

END SUB

FUNCTION ScaleID% (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        LET status = Match("eE", eqpos, eq)

    LET ScaleID = status

END FUNCTION

SUB SetValue (text AS STRING, value AS DOUBLE)

    DIM idx AS INTEGER

        LET idx = AddEntry(text, vartbl())
        IF idx > 0 THEN
            LET varval(idx) = value
        END IF

END SUB

SUB Sign (eqpos AS INTEGER, eq AS STRING)

    DIM status AS INTEGER

        LET status = Match("+-", eqpos, eq)

END SUB

SUB SkipSpaces (eqpos AS INTEGER, eq AS STRING)

        DO WHILE eqpos <= LEN(eq)
            IF MID$(eq, eqpos, 1) <> " " THEN
                EXIT DO
            END IF
            LET eqpos = eqpos + 1
        LOOP

END SUB

SUB SList (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER, value AS DOUBLE

        LET status = Statement(eqpos, eq, stk)
        DO WHILE status
            IF LEN(stk) = 0 THEN
                PRINT "<null>"
            ELSEIF IsOverflow(stk) THEN
                PRINT "Overflow!"
            ELSE
                LET value = Pop(stk)
                PRINT value
                SetValue "ANS", value
            END IF
            SkipSpaces eqpos, eq
            IF NOT Match(";", eqpos, eq) THEN
                EXIT DO
            END IF
            LET status = Statement(eqpos, eq, stk)
        LOOP

END SUB

FUNCTION Statement% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER, savepos AS INTEGER, token AS STRING
    DIM value AS DOUBLE

        SkipSpaces eqpos, eq
        LET savepos = eqpos
        IF Symbol(eqpos, eq, token) THEN
            SkipSpaces eqpos, eq
            IF Match("=", eqpos, eq) THEN
                LET status = Expression(eqpos, eq, stk)
                IF status THEN
                    LET value = Pop(stk)
                    SetValue UCASE$(token), value
                    Push value, stk
                END IF
            ELSE
                LET eqpos = savepos
                LET status = Expression(eqpos, eq, stk)
            END IF
        ELSE
            LET status = Expression(eqpos, eq, stk)
        END IF

    LET Statement = status

END FUNCTION

SUB Subtract (stk AS STRING)

    DIM difference AS DOUBLE, minuend AS DOUBLE, subtrahend AS DOUBLE

        LET subtrahend = Pop(stk)
        LET minuend = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        LET difference = minuend - subtrahend
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push difference, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB

FUNCTION Symbol% (eqpos AS INTEGER, eq AS STRING, token AS STRING)

    DIM status AS INTEGER, savepos AS INTEGER

        LET savepos = eqpos
        IF Alpha(eqpos, eq) THEN
            AlphaNumerics eqpos, eq
            LET token = MID$(eq, savepos, eqpos - savepos)
            LET status = -1
        ELSE
            LET status = 0
        END IF

    LET Symbol = status

END FUNCTION

FUNCTION Term% (eqpos AS INTEGER, eq AS STRING, stk AS STRING)

    DIM status AS INTEGER

        LET status = Factor(eqpos, eq, stk)
        DO WHILE status
            SkipSpaces eqpos, eq
            IF Match("*", eqpos, eq) THEN
                LET status = Factor(eqpos, eq, stk)
                IF status THEN
                    Multiply stk
                END IF
            ELSEIF Match("/", eqpos, eq) THEN
                LET status = Factor(eqpos, eq, stk)
                IF status THEN
                    Divide stk
                END IF
            ELSE
                EXIT DO
            END IF
        LOOP

    LET Term = status

END FUNCTION

SUB UnaryFunction (token AS STRING, stk AS STRING)

    DIM value AS DOUBLE, result AS DOUBLE, status AS INTEGER

        LET value = Pop(stk)

        LET ErrNumber = 0
        ON ERROR GOTO ErrorHandler
        SELECT CASE UCASE$(token)
        CASE "SIN"
            LET result = SIN(value)
        CASE "COS"
            LET result = COS(value)
        CASE "TAN"
            LET result = TAN(value)
        CASE "SEC"
            LET result = 1# / SIN(value)
        CASE "CSC"
            LET result = 1# / COS(value)
        CASE "CTN"
            LET result = 1# / TAN(value)
        CASE "ATAN"
            LET result = ATN(value)
        CASE "ASIN"
            LET result = ATN(value / SQR(1# - value * value))
        CASE "ACOS"
            LET result = ATN(SQR(1# / (value * value) - 1#))
        CASE "ASEC"
            LET result = ATN(1# / SQR(value * value - 1#))
        CASE "ACSC"
            LET result = ATN(SQR(value * value - 1#))
        CASE "ACTN"
            LET result = ATN(1# / value)
        CASE "ABS"
            LET result = ABS(value)
        CASE "SGN"
            LET result = SGN(value)
        CASE "INT"
            LET result = INT(value)
        CASE "SQRT", "SQR"
            LET result = SQR(value)
        CASE "LOG", "LN"
            LET result = LOG(value)
        CASE "LOG2"
            LET result = LOG(value) / LOG(2#)
        CASE "LOG10"
            LET result = LOG(value) / LOG(10#)
        CASE "DEG"
            LET result = value * 45# / ATN(1#)
        CASE "RAD"
            LET result = value * ATN(1#) / 45#
        CASE "EXP"
            LET result = EXP(value)
        CASE "SINH"
            LET result = (EXP(value) - EXP(-value)) / 2#
        CASE "COSH"
            LET result = (EXP(value) + EXP(-value)) / 2#
        CASE "TANH"
            LET result = (EXP(value) - EXP(-value)) / (EXP(value) + EXP(-value))
        CASE "SECH"
            LET result = 2# / (EXP(value) - EXP(-value))
        CASE "CSCH"
            LET result = 2# / (EXP(value) + EXP(-value))
        CASE "COTH"
            LET result = (EXP(value) + EXP(-value)) / (EXP(value) - EXP(-value))
        CASE "RND"
            LET result = RND(value)
        CASE ELSE
            LET result = value
        END SELECT
        ON ERROR GOTO 0

        IF ErrNumber = 0 THEN
            Push result, stk
        ELSE
            Push Overflow, stk
        END IF

END SUB