'======================================================================
'   Cheesecake BASIC interpreter
'
'   Copyright (C) 1999  Ramon J. San Andres
'
'   Contact: mnitesoft@aol.com
'            http://members.aol.com/mnitesoft
'
'   This program is free software; you can redistribute it and/or
'   modify it under the terms of the GNU General Public License
'   as published by the Free Software Foundation; either version 2
'   of the License, or (at your option) any later version.
'
'   This program is distributed in the hope that it will be useful,
'   but WITHOUT ANY WARRANTY; without even the implied warranty of
'   MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.  See the
'   GNU General Public License for more details.
'
'   You should have received a copy of the GNU General Public License
'   along with this program; if not, write to the Free Software
'   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
'======================================================================
'$INCLUDE: 'CCBASIC.BI'
'$STATIC

'======================================================================
'
'   ApplyOperator - Applies an operator to two values
'
'   Cmd         -   Cmd flag
'   Tkn         -   Token of operator to appy
'   V1          -   First operand
'   V2          -   Second operand
'   VRes        -   Result
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION ApplyOperator (Cmd AS INTEGER, Tkn AS INTEGER, v1 AS VALUETYPE, v2 AS VALUETYPE, vRes AS VALUETYPE)

    DIM Ok AS INTEGER
    DIM i1 AS INTEGER
    DIM i2 AS INTEGER
    DIM i3 AS INTEGER
    DIM r1 AS SINGLE
    DIM r2 AS SINGLE
    DIM r3 AS SINGLE
    DIM s1 AS STRING
    DIM s2 AS STRING
    DIM s3 AS STRING
    DIM t AS INTEGER

    Ok = TRUE

    IF (v1.DataType = TYPEREAL) OR (v2.DataType = TYPEREAL) THEN
        Ok = CastToReal(v1)
        Ok = Ok AND CastToReal(v2)
        r1 = v1.ValueReal
        r2 = v2.ValueReal
    ELSEIF v1.DataType <> v2.DataType THEN
        ErrorHit (ERRORTYPEMISMATCH)
        Ok = FALSE
    ELSEIF v1.DataType = TYPEINT THEN
        i1 = v1.ValueInt
        i2 = v2.ValueInt
    ELSE
        s1 = LEFT$(v1.ValueStr.StrBuf, v1.ValueStr.StrLen)
        s2 = LEFT$(v2.ValueStr.StrBuf, v2.ValueStr.StrLen)
    END IF

    IF Ok THEN

        SELECT CASE v1.DataType
            CASE TYPEINT
                t = TYPEINT
            CASE TYPEREAL
                SELECT CASE Tkn
                    CASE TOKENOR, TOKENAND, TOKENEQ, TOKENNEQ, TOKENGT
                        t = TYPEINT
                    CASE TOKENLT, TOKENGEQ, TOKENLEQ
                        t = TYPEINT
                    CASE ELSE
                        t = TYPEREAL
                END SELECT
            CASE TYPESTR
                SELECT CASE Tkn
                    CASE TOKENEQ, TOKENNEQ, TOKENGT, TOKENLT, TOKENGEQ, TOKENLEQ
                        t = TYPEINT
                    CASE TOKENPLUS
                        t = TYPESTR
                    CASE ELSE
                        ErrorHit (ERRORSYNTAX)
                        Ok = FALSE
                END SELECT
        END SELECT

        IF Ok AND ((Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC)) THEN

            SELECT CASE v1.DataType
                CASE TYPEINT
                    SELECT CASE Tkn
                        CASE TOKENOR
                            i3 = i1 OR i2
                        CASE TOKENAND
                            i3 = i1 AND i2
                        CASE TOKENEQ
                            i3 = (i1 = i2)
                        CASE TOKENNEQ
                            i3 = (i1 <> i2)
                        CASE TOKENGT
                            i3 = (i1 > i2)
                        CASE TOKENLT
                            i3 = (i1 < i2)
                        CASE TOKENGEQ
                            i3 = (i1 >= i2)
                        CASE TOKENLEQ
                            i3 = (i1 <= i2)
                        CASE TOKENPLUS
                            i3 = i1 + i2
                        CASE TOKENMINUS
                            i3 = i1 - i2
                        CASE TOKENSTAR
                            i3 = i1 * i2
                        CASE TOKENSLASH
                            i3 = i1 / i2
                        CASE TOKENBSLASH
                            i3 = i1 \ i2
                        CASE TOKENMOD
                            i3 = i1 MOD i2
                        CASE TOKENCARET
                            i3 = i1 ^ i2
                    END SELECT

                CASE TYPEREAL
                    SELECT CASE Tkn
                        CASE TOKENOR
                            i3 = r1 OR r2
                        CASE TOKENAND
                            i3 = r1 AND r2
                        CASE TOKENEQ
                            i3 = (r1 = r2)
                        CASE TOKENNEQ
                            i3 = (r1 <> r2)
                        CASE TOKENGT
                            i3 = (r1 > r2)
                        CASE TOKENLT
                            i3 = (r1 < r2)
                        CASE TOKENGEQ
                            i3 = (r1 >= r2)
                        CASE TOKENLEQ
                            i3 = (r1 <= r2)
                        CASE TOKENPLUS
                            r3 = r1 + r2
                        CASE TOKENMINUS
                            r3 = r1 - r2
                        CASE TOKENSTAR
                            r3 = r1 * r2
                        CASE TOKENSLASH
                            r3 = r1 / r2
                        CASE TOKENBSLASH
                            r3 = r1 \ r2
                        CASE TOKENMOD
                            r3 = r1 MOD r2
                        CASE TOKENCARET
                            r3 = r1 ^ r2
                    END SELECT
                CASE TYPESTR
                    t = TYPEINT
                    SELECT CASE Tkn
                        CASE TOKENEQ
                            i3 = (s1 = s2)
                        CASE TOKENNEQ
                            i3 = (s1 <> s2)
                        CASE TOKENGT
                            i3 = (s1 > s2)
                        CASE TOKENLT
                            i3 = (s1 < s2)
                        CASE TOKENGEQ
                            i3 = (s1 >= s2)
                        CASE TOKENLEQ
                            i3 = (s1 <= s2)
                        CASE TOKENPLUS
                            t = TYPESTR
                            s3 = s1 + s2
                        CASE ELSE
                            ErrorHit (ERRORSYNTAX)
                            Ok = FALSE
                    END SELECT
            END SELECT
        END IF

        IF Ok THEN
            vRes.DataType = t
            SELECT CASE t
                CASE TYPEINT
                    vRes.ValueInt = i3
                CASE TYPEREAL
                    vRes.ValueReal = r3
                CASE TYPESTR
                    vRes.ValueStr.StrBuf = s3
                    vRes.ValueStr.StrLen = LEN(s3)
            END SELECT
        END IF

    END IF

    ApplyOperator = Ok

END FUNCTION

'======================================================================
'
'   BreakPoint  -   Signals a breakpoint hit and saves breakpoint
'                   information
'
'   s   -   String to display, either "Stop" or "Breakpoint"
'
'======================================================================
SUB BreakPoint (s AS STRING)

    IF PgmCur.PgmPtr <> PgmMemImm THEN
        PRINT s + " at line " + STR$(PgmMemLineNum(PgmCur.PgmPtr))
    END IF

    BrkSaveData.Lc = PgmCur
    BrkSaveData.ErrTrapEnabled = ErrTrapEnabled
    BrkSaveData.TimerTrapEnabled = TimerTrapEnabled
    BrkSaveData.KeyTrapEnabled = KeyTrapEnabled
    ErrTrapEnabled = FALSE
    TimerTrapEnabled = FALSE
    KeyTrapEnabled = FALSE

END SUB

'======================================================================
'
'   CastToReal - Casts a value to a Real
'
'   Value         -   Value to cast
'
'   Returns TRUE if success, FALSE if error.
'
'======================================================================
FUNCTION CastToReal (Value AS VALUETYPE)

    DIM Ok AS INTEGER
    Ok = TRUE

    IF Value.DataType <> TYPEREAL THEN
        IF Value.DataType = TYPEINT THEN
            Value.DataType = TYPEREAL
            Value.ValueReal = Value.ValueInt
        ELSE
            ErrorHit (ERRORTYPEMISMATCH)
            Ok = FALSE
        END IF
    END IF

    CastToReal = Ok

END FUNCTION

'======================================================================
'
'   CorrectOp   -   Return TRUE if the given token is a valid operator
'                   for the specified level (See ParseTerm)
'
'   Level   -   Level
'   Tkn     -   Token
'
'======================================================================
FUNCTION CorrectOp (Level AS INTEGER, Tkn AS INTEGER)

    SELECT CASE Tkn
        CASE TOKENOR
            CorrectOp = (Level = 7)
        CASE TOKENAND
            CorrectOp = (Level = 6)
        CASE TOKENLT, TOKENLEQ, TOKENGT, TOKENGEQ
            CorrectOp = (Level = 5)
        CASE TOKENEQ, TOKENNEQ
            CorrectOp = (Level = 4)
        CASE TOKENPLUS, TOKENMINUS
            CorrectOp = (Level = 3)
        CASE TOKENSTAR, TOKENSLASH, TOKENBSLASH, TOKENMOD
            CorrectOp = (Level = 2)
        CASE TOKENCARET
            CorrectOp = (Level = 1)
        CASE ELSE
            CorrectOp = FALSE
    END SELECT

END FUNCTION

'======================================================================
'
'   EvalFunc - Evaluates a user-defined function
'
'   SymPtr  -   Pointer to function entry in symbol table
'   vArgs   -   Array of arguments
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION EvalFunc (SymPtr AS INTEGER, vArgs() AS VALUETYPE)

    DIM Ok AS INTEGER
    DIM ParamPtr AS INTEGER
    DIM cParam AS INTEGER
    DIM strExp AS STRING
    DIM Value AS VALUETYPE
    DIM PgmLoc AS PGMLOCTYPE
    DIM PgmSav AS PGMLOCTYPE
    DIM FuncData AS FUNCSTKTYPE
    DIM Ret AS INTEGER
    DIM j AS INTEGER
    DIM SymData AS SYMTABTYPE
    DIM PgmM AS PGMMEMTYPE

    Ok = TRUE

    SymTabEntry SymPtr, SymData

    ParamPtr = SymData.MemPtr + 1
    cParam = SymData.Dimensions
    Ok = MemGet(TYPESTR, SymData.MemPtr, Value)

    IF Ok THEN
        strExp = LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen)

        '
        ' Borrow a PgmMem entry
        '
        PgmLoc.PgmPtr = PgmMemAlloc
        IF PgmLoc.PgmPtr <> NILPOINTER THEN

            PgmLoc.Offset = 1

            PgmM.Buffer = strExp
            PgmM.BufLen = LEN(strExp)
            PgmMemSet PgmLoc.PgmPtr, PgmM
            '
            '   Make the PgmMem entry with the expression the PgmCur
            PgmSav = PgmCur
            PgmCur = PgmLoc

            FuncData.cParam = cParam
            FuncData.ParamPtr = ParamPtr
            FuncData.ArgPtr = ArgMemAlloc(cParam)

            IF FuncData.ArgPtr <> NILPOINTER THEN

                FOR j = 0 TO cParam - 1
                    ArgMemSet FuncData.ArgPtr + j, vArgs(j)
                NEXT j

                Ok = FuncStackPush(FuncData)

                IF Ok THEN
                    '
                    '   Now evaluate the expression
                    '
                    Ok = ParseExp(CMDEVALFUNC)

                    Ok = FuncStackPop(FuncData) AND Ok

                END IF

                FuncData.ArgPtr = ArgMemDealloc(cParam)
                IF Ok THEN
                    IF FuncData.ArgPtr = NILPOINTER THEN
                        ErrorHit (ERRORINTERNAL)
                        Ok = FALSE
                    END IF
                END IF

            ELSE
                ErrorHit (ERRORNOMEMORY)
                Ok = FALSE
            END IF
            '
            ' Resore original PgmCur and delete the borrowed PgmMem entry
            '
            PgmCur = PgmSav
            PgmMemDealloc (PgmLoc.PgmPtr)

        ELSE
            Ok = FALSE
        END IF

    ELSE
        Ok = FALSE
    END IF


    EvalFunc = Ok

END FUNCTION

'======================================================================
'
'   EvalLoopCondition - Evaluates a FOR loop condition
'
'   Execute         -   returned TRUE if loop must be executed,
'                       FALSE otherwise
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION EvalLoopCondition (Execute AS INTEGER)

    DIM Ok AS INTEGER
    DIM LoopData AS LOOPSTKTYPE
    DIM Value AS VALUETYPE
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE

    Ok = TRUE
    IF LoopStackPop(LoopData) THEN
        Ok = LoopStackPush(LoopData)
        SELECT CASE LoopData.LoopKind
            CASE LOOPKINDFOR
                Ok = SymTabGet(LoopData.Id, 0, vArgs(), Value)
                IF Ok THEN
                    IF Value.DataType <> TYPEINT THEN
                        ErrorHit (ERRORINTERNAL)
                        Ok = FALSE
                    ELSEIF LoopData.FirstValue = LoopData.LastValue THEN
                        Execute = (Value.ValueInt = LoopData.FirstValue)
                    ELSEIF LoopData.FirstValue < LoopData.LastValue THEN
                        IF LoopData.Increment > 0 THEN
                            Execute = (Value.ValueInt <= LoopData.LastValue)
                        ELSE
                            Execute = FALSE
                        END IF
                    ELSE
                        IF LoopData.Increment < 0 THEN
                            Execute = (Value.ValueInt >= LoopData.LastValue)
                        ELSE
                            Execute = FALSE
                        END IF
                    END IF
                END IF
        END SELECT
    END IF

    EvalLoopCondition = Ok

END FUNCTION

'======================================================================
'
'   ExecGoSub - GOSUB code
'
'   LineNumber         -   Line number
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION ExecGoSub (LineNumber AS INTEGER)

    DIM Ok AS INTEGER
    DIM PgmPtr AS INTEGER
    DIM PgmLoc AS PGMLOCTYPE

    Ok = TRUE

    PgmPtr = PgmMemFind(LineNumber)
    IF PgmPtr = NILPOINTER THEN
        ErrorHit (ERRORLABELNOTFOUND)
        Ok = FALSE
    ELSE
        PgmLoc.PgmPtr = PgmCur.PgmPtr
        PgmLoc.Offset = PgmCur.Offset
        Ok = RetStackPush(PgmLoc)
        IF Ok THEN
            SetPgmCur (PgmPtr)
        END IF
    END IF

    ExecGoSub = Ok

END FUNCTION

'======================================================================
'
'   ExecGoTo - GOTO code
'
'   LineNumber         -   Line number
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION ExecGoTo (LineNumber AS INTEGER)

    DIM Ok AS INTEGER
    DIM PgmPtr AS INTEGER

    Ok = TRUE
    PgmPtr = PgmMemFind(LineNumber)
    IF PgmPtr = NILPOINTER THEN
        ErrorHit (ERRORLABELNOTFOUND)
        Ok = FALSE
    ELSE
        SetPgmCur (PgmPtr)
    END IF

    ExecGoTo = Ok

END FUNCTION

'======================================================================
'
'   GetReadData -   Gets data buffer for READ statement
'
'   Buffer      -   The complete DATA statement buffer
'   Offset      -   offset within the buffer where the DATA statement
'                   starts
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION GetReadData (Buffer AS STRING, Offset AS INTEGER)

    DIM Ok AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    Ok = TRUE

    DO
        IF PgmData.PgmPtr = NILPOINTER THEN
            Ok = FALSE
            EXIT DO
        END IF

        PgmMemGet PgmData.PgmPtr, PgmM

        IF (PgmM.Flags AND PGMFLAGDATA) THEN
            IF PgmData.Offset = 0 THEN
                PgmData.Offset = PgmM.Offset
            END IF
            IF PgmData.Offset <= PgmM.BufLen THEN
                EXIT DO
            END IF
        END IF

        PgmData.PgmPtr = PgmM.NextPtr
        PgmData.Offset = 0
    LOOP

    IF Ok THEN
        Buffer = PgmMemBuf$(PgmData.PgmPtr)
        Offset = PgmData.Offset
    ELSE
        ErrorHit (ERRORNOMOREDATA)
    END IF

    GetReadData = Ok

END FUNCTION


'======================================================================
'
'   ParseArgList    -   Parses an argument list. The opening parenthesis
'                       must have already been lexed
'
'   CMD         -   CMD flag
'   MaxArg      -   Max number of arguments allowed
'   cArgs       -   Returns number of arguments in list
'   vArgs       -   Returns list of arguments
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION ParseArgList (Cmd AS INTEGER, MaxArg AS INTEGER, cArgs AS INTEGER, vArgs() AS VALUETYPE)

    DIM Count AS INTEGER
    DIM Value AS VALUETYPE

    Count = 0

    DO WHILE (LastErr = 0)
        IF ParseExp(Cmd) THEN
            IF Count <= MaxArg THEN
                IF FactorStackPop(Value) THEN

                    vArgs(Count) = Value
                    Count = Count + 1

                    SELECT CASE LexGetToken
                        CASE TOKENCOMMA
                        CASE TOKENCLOSEPAREN
                            IF Count = 0 THEN
                                ErrorHit (ERRORSYNTAX)
                            END IF
                            cArgs = Count
                            EXIT DO
                        CASE ELSE
                            ErrorHit (ERRORSYNTAX)
                    END SELECT
                END IF
            ELSE
                ErrorHit (ERRORBADNUMARG)
            END IF
        END IF
    LOOP

    ParseArgList = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseBlock  -   Parses block
'
'   block = block : statement | statement
'
'======================================================================
FUNCTION ParseBlock (Cmd AS INTEGER)

    DIM Ok AS INTEGER

    DO WHILE (LastErr = 0)

        IF (PgmCur.PgmPtr = NILPOINTER) THEN
            EXIT DO
        END IF

        IF (Cmd = CMDSKIPLOOP) AND (LoopCount = 0) THEN
            EXIT DO
        END IF

        IF (Cmd = CMDINTERPRET) AND KeyTrapEnabled THEN
            DoKeyTrapping
        END IF

        IF (Cmd = CMDINTERPRET) AND TimerTrapEnabled THEN
            DoTimerTrapping
        END IF

        SELECT CASE LexGetToken
            CASE TOKENSEP
                Ok = ParseStatement(Cmd)
            CASE TOKENEOL
                EXIT DO
            CASE TOKENELSE
                IF Cmd = CMDIFBLOCK THEN
                    LexUngetToken
                ELSE
                    Ok = ParseBlock(CMDPARSE)
                END IF
                EXIT DO
            CASE ELSE
                LexUngetToken
                Ok = ParseStatement(Cmd)
        END SELECT
    LOOP

    ParseBlock = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseClose  -   Parses CLOSE #exp
'
'======================================================================
FUNCTION ParseClose (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM FileNumber AS INTEGER

    IF LexGetToken = TOKENPOUND THEN
        IF ParseIntExp(Cmd, FileNumber) THEN
            IF (Cmd = CMDINTERPRET) THEN
                IF (FileNumber >= FIRSTFILENUMBER) AND (FileNumber <= (FIRSTFILENUMBER + MAXFILES)) THEN
                    IF FileIsOpen(FileNumber) THEN
                        Ok = FileClean(FileNumber)
                    ELSE
                        ErrorHit (ERRORFILENOTOPEN)
                    END IF
                ELSE
                    ErrorHit (ERRORINVALIDFILENUMBER)
                END IF
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseClose = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseCoLoc  -   Parses  COLOR exp [, exp]
'                           LOCATE exp, exp
'
'======================================================================
FUNCTION ParseCoLoc (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM v1 AS INTEGER
    DIM v2 AS INTEGER
    DIM v2Ok AS INTEGER

    v2Ok = FALSE

    IF ParseIntExp(Cmd, v1) THEN
        IF LexGetToken = TOKENCOMMA THEN
            IF ParseIntExp(Cmd, v2) THEN
                v2Ok = TRUE
            END IF
        ELSEIF Tkn = TOKENLOCATE THEN
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            SELECT CASE Tkn
                CASE TOKENCOLOR
                    IF v2Ok THEN
                        COLOR v1, v2
                    ELSE
                        COLOR v1
                    END IF
                CASE TOKENLOCATE
                    LOCATE v1, v2
            END SELECT
        END IF
    END IF

    ParseCoLoc = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseData   -   Parses DATA constant [, constant ]*
'
'======================================================================
FUNCTION ParseData (Cmd AS INTEGER)

    DIM Offset AS INTEGER
    DIM Tkn AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    LexUngetToken
    Offset = PgmCur.Offset
    Tkn = LexGetToken

    PgmMemGet PgmCur.PgmPtr, PgmM
    PgmM.Flags = (PgmM.Flags OR PGMFLAGDATA)
    PgmM.Offset = PgmCur.Offset - Offset + 1
    PgmCur.Offset = PgmM.BufLen + 1
    PgmMemSet PgmCur.PgmPtr, PgmM

    ParseData = TRUE

END FUNCTION

'======================================================================
'
'   ParseDef    Parses DEF id [( id [, id]* ) ] = exp
'
'======================================================================
FUNCTION ParseDef (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM FuncName AS STRING
    DIM FuncType AS INTEGER
    DIM FuncExp AS STRING
    DIM cParam AS INTEGER
    DIM Param(MAXDEFPARAM) AS STRING
    DIM Offset AS INTEGER
    DIM Value AS VALUETYPE

    Ok = TRUE
    cParam = 0

    IF LexGetToken = TOKENVARIABLE THEN

        FuncName = LexTokenStr$

        IF LexGetToken = TOKENOPENPAREN THEN
            DO WHILE (LastErr = 0)
                IF LexGetToken = TOKENVARIABLE THEN
                    Param(cParam) = LexTokenStr$
                    cParam = cParam + 1
                    SELECT CASE LexGetToken
                        CASE TOKENCOMMA
                        CASE TOKENCLOSEPAREN
                            EXIT DO
                        CASE ELSE
                            ErrorHit (ERRORSYNTAX)
                    END SELECT
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            LOOP
        END IF

        IF LexGetToken = TOKENEQ THEN

            Offset = PgmCur.Offset

            IF ParseExp(CMDPARSE) THEN

                IF FactorStackPop(Value) THEN

                    FuncType = SymbolToDataType(FuncName)
                    IF FuncType <> Value.DataType THEN
                        IF NOT ((FuncType = TYPEREAL) AND (Value.DataType = TYPEINT)) THEN
                            ErrorHit (ERRORTYPEMISMATCH)
                        END IF
                    END IF

                    IF (LastErr = 0) THEN
                        IF Cmd = CMDINTERPRET THEN
                            FuncExp = RTRIM$(MID$(PgmMemBuf$(PgmCur.PgmPtr), Offset))
                            Ok = (SymTabAddFunc(FuncName, FuncType, cParam, Param(), FuncExp) <> NILPOINTER)
                        END IF
                    END IF
                END IF
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
            Ok = FALSE
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseDef = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseDim    -   Parses DIM var [, var ]*
'
'======================================================================
FUNCTION ParseDim (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM Symbol AS STRING
    DIM cArgs AS INTEGER
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE
    DIM Sizes(MAXDIMENSIONS) AS INTEGER
    DIM j AS INTEGER
    DIM PTR AS INTEGER

    Ok = TRUE

    DO WHILE Ok
        IF LexGetToken = TOKENVARIABLE THEN
            Symbol = LexTokenStr$
            IF LexGetToken = TOKENOPENPAREN THEN
                Ok = ParseArgList(Cmd, MAXDIMENSIONS, cArgs, vArgs())
                IF Ok AND (Cmd = CMDINTERPRET) THEN
                    FOR j = 0 TO cArgs - 1
                        IF (vArgs(j).DataType = TYPEINT) AND (vArgs(j).ValueInt > 0) THEN
                            Sizes(j) = vArgs(j).ValueInt + 1
                        ELSE
                            ErrorHit (ERRORINVALIDSUBSCRIPT)
                            Ok = FALSE
                            EXIT FOR
                        END IF
                    NEXT j
                    IF Ok THEN
                        PTR = SymTabFind(Symbol)
                        IF PTR = NILPOINTER THEN
                            PTR = SymTabAddVar(Symbol, TOKENVARIABLE, SYMFLAGARRAY, SymbolToDataType(Symbol), cArgs, Sizes())
                            Ok = (PTR <> NILPOINTER)
                        ELSE
                            ErrorHit (ERRORSYMBOLDEFINED)
                            Ok = FALSE
                        END IF
                    END IF
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
                Ok = FALSE
            END IF

            IF LexGetToken <> TOKENCOMMA THEN
                LexUngetToken
                EXIT DO
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
            Ok = FALSE
        END IF
    LOOP

    ParseDim = Ok

END FUNCTION

'======================================================================
'
'   ParseExp    -   Parses exp
'
'   exp = boolterm
'
'======================================================================
FUNCTION ParseExp (Cmd AS INTEGER)
    ParseExp = ParseTerm(Cmd, 7)
END FUNCTION

'======================================================================
'
'   ParseFactor -   Parses factor
'
'   factor = absnum | literal | oid | var | functioncall | (exp)
'
'======================================================================
FUNCTION ParseFactor (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE

    SELECT CASE LexGetToken

        CASE TOKENFABS
            Ok = ParseNumFNum(Cmd, (LexToken.Tkn))
        CASE TOKENFERL, TOKENFERR, TOKENFCURSORY, TOKENFCURSORX
            Ok = ParseIntF(Cmd, (LexToken.Tkn))
        CASE TOKENFEOF, TOKENFLOC, TOKENFLOF, TOKENFINT, TOKENFCINT, TOKENFSEEK, TOKENFFIX, TOKENFVAL
            Ok = ParseIntFNum(Cmd, (LexToken.Tkn))
        CASE TOKENFASC, TOKENFCVI, TOKENFLEN
            Ok = ParseIntFStr(Cmd, (LexToken.Tkn))
        CASE TOKENFRND, TOKENTIMER
            Ok = ParseRealF(Cmd, (LexToken.Tkn))
        CASE TOKENFATN, TOKENFCOS, TOKENFEXP, TOKENFLOG, TOKENFSIN, TOKENFSQR, TOKENFVAL
            Ok = ParseRealFNum(Cmd, (LexToken.Tkn))
        CASE TOKENFERT, TOKENFDATE, TOKENFTIME, TOKENFINKEY
            Ok = ParseStrF(Cmd, (LexToken.Tkn))
        CASE TOKENFCHR, TOKENFMKI, TOKENFMKS, TOKENFSTR
            Ok = ParseStrFNum(Cmd, (LexToken.Tkn))
        CASE TOKENFLCASE, TOKENFLTRIM, TOKENFRTRIM, TOKENFUCASE, TOKENFLEFT, TOKENFRIGHT
            Ok = ParseStrFStr(Cmd, (LexToken.Tkn))
        CASE TOKENFINSTR
            Ok = ParseFInstr(Cmd)
        CASE TOKENFMID
            Ok = ParseFMid(Cmd)
        CASE TOKENCONSTANT
            Ok = FactorStackPush(LexToken.Value)
        CASE TOKENVARIABLE, TOKENFIELD
            Ok = ParseRValue(Cmd, LexTokenStr$)
        CASE TOKENFUSERDEF
            Ok = ParseFunc(Cmd, LexTokenStr$)
        CASE TOKENOPENPAREN
            IF ParseExp(Cmd) THEN
                IF LexGetToken <> TOKENCLOSEPAREN THEN
                    ErrorHit (ERRORSYNTAX)
                END IF
            END IF
        CASE ELSE
            ErrorHit (ERRORSYNTAX)
    END SELECT

    ParseFactor = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseField  -   Parses FIELD #exp, integer as id [, integer as id]*
'
'======================================================================
FUNCTION ParseField (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM FileNumber AS INTEGER
    DIM cFields AS INTEGER
    DIM FieldNames(MAXFIELDS) AS STRING
    DIM FieldSizes(MAXFIELDS) AS INTEGER

    cFields = 0

    IF LexGetToken = TOKENPOUND THEN
        IF ParseIntExp(Cmd, FileNumber) THEN
            IF LexGetToken = TOKENCOMMA THEN
                DO WHILE (LastErr = 0)
                    SELECT CASE LexGetToken
                        CASE TOKENEOL, TOKENSEP, TOKENELSE
                            LexUngetToken
                            EXIT DO
                        CASE ELSE
                            LexUngetToken
                            IF cFields <= MAXFIELDS THEN
                                IF ParseIntExp(Cmd, FieldSizes(cFields)) THEN
                                    IF LexGetToken = TOKENAS THEN
                                        IF LexGetToken = TOKENVARIABLE THEN
                                            FieldNames(cFields) = LexTokenStr$
                                            cFields = cFields + 1
                                            IF LexGetToken <> TOKENCOMMA THEN
                                                LexUngetToken
                                                EXIT DO
                                            END IF
                                        ELSE
                                            ErrorHit (ERRORSYNTAX)
                                        END IF
                                    ELSE
                                        ErrorHit (ERRORSYNTAX)
                                    END IF
                                END IF
                            ELSE
                                ErrorHit (ERRORMAXFIELDS)
                            END IF
                    END SELECT
                LOOP
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            Ok = (FileAddFields(FileNumber, cFields, FieldSizes(), FieldNames()) <> NILPOINTER)
        END IF
    END IF

    ParseField = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseFInstr -   Parses INSTR( [numexp, ] strexp, strexp )
'
'======================================================================
FUNCTION ParseFInstr (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM strIn AS STRING
    DIM strSub AS STRING
    DIM Start AS INTEGER
    DIM UseStart AS INTEGER
    DIM Value AS VALUETYPE
    DIM OffsetSaved AS INTEGER

    IF LexGetToken = TOKENOPENPAREN THEN
        OffsetSaved = PgmCur.Offset
        IF ParseExp(Cmd) THEN
            IF FactorStackPop(Value) THEN
                IF Value.DataType = TYPEINT THEN
                    Start = Value.ValueInt
                    UseStart = TRUE
                    IF LexGetToken <> TOKENCOMMA THEN
                        ErrorHit (ERRORSYNTAX)
                    END IF
                ELSE
                    PgmCur.Offset = OffsetSaved
                    UseStart = FALSE
                END IF
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    IF (LastErr = 0) THEN
        IF ParseStrExp(Cmd, strIn) THEN
            IF LexGetToken = TOKENCOMMA THEN
                IF ParseStrExp(Cmd, strSub) THEN
                    IF LexGetToken <> TOKENCLOSEPAREN THEN
                        ErrorHit (ERRORSYNTAX)
                    END IF
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    END IF

    IF (LastErr = 0) THEN

        Value.DataType = TYPEINT

        IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
            IF UseStart THEN
                Value.ValueInt = INSTR(Start, strIn, strSub)
            ELSE
                Value.ValueInt = INSTR(strIn, strSub)
            END IF
        END IF

        Ok = FactorStackPush(Value)

    END IF

    ParseFInstr = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseFMid   -   Parses MID$( strexp, numexp [, numexp ] )
'
'======================================================================
FUNCTION ParseFMid (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE
    DIM strIn AS STRING
    DIM strOut AS STRING
    DIM Offset AS INTEGER
    DIM StrLen AS INTEGER
    DIM UseLen AS INTEGER

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseStrExp(Cmd, strIn) THEN
            IF LexGetToken = TOKENCOMMA THEN
                IF ParseIntExp(Cmd, Offset) THEN
                    IF LexGetToken = TOKENCOMMA THEN
                        Ok = ParseIntExp(Cmd, StrLen)
                        UseLen = TRUE
                    ELSE
                        LexUngetToken
                        UseLen = FALSE
                    END IF

                    IF (LastErr = 0) THEN
                        IF LexGetToken <> TOKENCLOSEPAREN THEN
                            ErrorHit (ERRORSYNTAX)
                        END IF
                    END IF
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    IF (LastErr = 0) THEN
        Value.DataType = TYPESTR

        IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN

            IF UseLen THEN
                strOut = MID$(strIn, Offset, StrLen)
            ELSE
                strOut = MID$(strIn, Offset)
            END IF

            Value.ValueStr.StrBuf = strOut
            Value.ValueStr.StrLen = LEN(strOut)

        END IF

        Ok = FactorStackPush(Value)
    END IF

    ParseFMid = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseFor    -   Parses FOR id = integer to integer [ step integer ]
'
'======================================================================
FUNCTION ParseFor (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE
    DIM Symbol AS STRING
    DIM FirstValue AS INTEGER
    DIM LastValue AS INTEGER
    DIM Increment AS INTEGER
    DIM LoopData AS LOOPSTKTYPE
    DIM Execute AS INTEGER
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE

    IF LexGetToken = TOKENVARIABLE THEN
        IF LexToken.Value.DataType = TYPEINT THEN
            Symbol = LexTokenStr$
            IF LexGetToken = TOKENEQ THEN
                IF ParseIntExp(Cmd, FirstValue) THEN
                    IF LexGetToken = TOKENTO THEN
                        IF ParseIntExp(Cmd, LastValue) THEN
                            IF LexGetToken = TOKENSTEP THEN
                                Ok = ParseIntExp(Cmd, Increment)
                            ELSE
                                LexUngetToken
                                Increment = 1
                            END IF
                        END IF
                    ELSE
                        ErrorHit (ERRORSYNTAX)
                    END IF
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            IF FirstValue <> LastValue THEN
                IF Increment = 0 THEN
                    ErrorHit (ERRORINVALIDINCREMENT)
                END IF
            END IF

            IF (LastErr = 0) THEN

                LoopData.LoopKind = LOOPKINDFOR
                LoopData.Flags = 0
                LoopData.Id = Symbol
                LoopData.FirstValue = FirstValue
                LoopData.LastValue = LastValue
                LoopData.Increment = Increment
                LoopData.PgmBegin.PgmPtr = PgmCur.PgmPtr
                LoopData.PgmBegin.Offset = PgmCur.Offset

                Value.DataType = TYPEINT
                Value.ValueInt = FirstValue

                IF SymTabSet(Symbol, 0, vArgs(), Value) THEN
                    IF LoopStackPush(LoopData) THEN
                        IF EvalLoopCondition(Execute) THEN
                            IF Execute THEN
                            ELSE
                                Ok = LoopStackPop(LoopData)
                                Ok = SkipLoopBlock
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        ELSEIF Cmd = CMDSKIPLOOP THEN
            LoopCount = LoopCount + 1
        END IF
    END IF

    ParseFor = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseFunc   -   Parses a call to a user-defined function
'
'   FuncName    -   Name of function
'
'======================================================================
FUNCTION ParseFunc (Cmd AS INTEGER, FuncName AS STRING)

    DIM Ok AS INTEGER
    DIM cArgs AS INTEGER
    DIM vArgs(MAXDEFPARAM) AS VALUETYPE
    DIM FuncPtr AS INTEGER
    DIM j AS INTEGER
    DIM ParamPtr AS INTEGER
    DIM ParamValue AS VALUETYPE
    DIM ParamType AS INTEGER
    DIM Value AS VALUETYPE
    DIM SymData AS SYMTABTYPE

    Ok = TRUE
    cArgs = 0

    IF LexGetToken = TOKENOPENPAREN THEN
        Ok = ParseArgList(Cmd, MAXDEFPARAM, cArgs, vArgs())
    END IF

    IF Ok THEN
        IF (Cmd = CMDINTERPRET OR Cmd = CMDEVALFUNC) THEN
            FuncPtr = SymTabFind(FuncName)
            IF FuncPtr <> NILPOINTER THEN
                SymTabEntry FuncPtr, SymData
                IF cArgs = SymData.Dimensions THEN
                    '
                    '   Validate arguments
                    '
                    FOR j = 0 TO cArgs - 1
                        ParamPtr = SymData.MemPtr + j + 1
                        Ok = MemGet(TYPESTR, ParamPtr, ParamValue)
                        IF Ok THEN
                            ParamType = SymbolToDataType(LEFT$(ParamValue.ValueStr.StrBuf, ParamValue.ValueStr.StrLen))
                            IF vArgs(j).DataType <> ParamType THEN
                                IF (ParamType = TYPEREAL) AND (vArgs(j).DataType = TYPEINT) THEN
                                    vArgs(j).DataType = TYPEREAL
                                    vArgs(j).ValueReal = vArgs(j).ValueInt
                                ELSE
                                    ErrorHit (ERRORTYPEMISMATCH)
                                    Ok = FALSE
                                    EXIT FOR
                                END IF
                            END IF
                        ELSE
                            EXIT FOR
                        END IF
                    NEXT j

                    IF Ok THEN
                        Ok = EvalFunc(FuncPtr, vArgs())
                    END IF
                ELSE
                    ErrorHit (ERRORBADNUMARG)
                    Ok = FALSE
                END IF
            ELSE
                ErrorHit (ERRORUNDEFINEDSYMBOL)
                Ok = FALSE
            END IF
        ELSE
            Value.DataType = SymbolToDataType(FuncName)
            Ok = FactorStackPush(Value)
        END IF
    END IF

    ParseFunc = Ok

END FUNCTION

'======================================================================
'
'   ParseGetPut    -   Parses   GET #exp [,exp]
'                               PUT #exp
'                               SEEK #exp, exp
'
'======================================================================
FUNCTION ParseGetPutSeek (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM FileNumber AS INTEGER
    DIM RecNum AS INTEGER
    DIM HaveRecNum AS INTEGER
    DIM Ok AS INTEGER

    HaveRecNum = FALSE

    IF LexGetToken = TOKENPOUND THEN
        IF ParseIntExp(Cmd, FileNumber) THEN
            IF Tkn <> TOKENPUT THEN
                IF LexGetToken = TOKENCOMMA THEN
                    IF ParseIntExp(Cmd, RecNum) THEN
                        HaveRecNum = TRUE
                    END IF
                ELSE
                    IF (Tkn = TOKENSEEK) THEN
                        ErrorHit (ERRORSYNTAX)
                    ELSE
                        LexUngetToken
                    END IF
                END IF
            END IF

            IF (LastErr = 0) AND (Cmd = CMDINTERPRET) THEN

                IF FileValidateAccess(FileNumber, FILEACCESSRANDOM) THEN
                    SELECT CASE Tkn
                        CASE TOKENGET
                            IF HaveRecNum THEN
                                Ok = FileSeek(FileNumber, RecNum)
                            else
                                Ok = TRUE
                            end if
                            if Ok then
                                Ok = FileReadBuf(FileNumber)
                            END IF
                        CASE TOKENPUT
                            Ok = FileWriteBuf(FileNumber)
                        CASE TOKENSEEK
                            Ok = FileSeek(FileNumber, RecNum)
                    END SELECT
                END IF
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseGetPutSeek = (LastErr = 0)

END FUNCTION

FUNCTION ParseGo (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM LineNumber AS INTEGER
    DIM LineNumOffset AS INTEGER

    LineNumOffset = PgmCur.Offset

    IF ParseIntExp(Cmd, LineNumber) THEN
        IF Cmd = CMDINTERPRET THEN
            IF Tkn = TOKENGOSUB THEN
                Ok = ExecGoSub(LineNumber)
            ELSE
                Ok = ExecGoTo(LineNumber)
            END IF
        ELSEIF Cmd = CMDRENUM THEN
            Ok = RenumPatch(LineNumOffset)
        END IF
    END IF

    ParseGo = (LastErr = 0)

END FUNCTION
