'======================================================================
'   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

'======================================================================
'
'   ParseIf -   Parses IF exp then block [ else block ]
'
'======================================================================
FUNCTION ParseIf (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM Cond AS INTEGER
    DIM LineNum AS INTEGER

    IF ParseIntExp(Cmd, Cond) THEN
        IF LexGetToken = TOKENTHEN THEN
            IF LexGetToken = TOKENCONSTANT THEN
                IF LexToken.Value.DataType = TYPEINT THEN
                    LineNum = LexToken.Value.ValueInt
                    IF LineNum > 0 THEN
                        IF (Cmd = CMDINTERPRET) AND Cond THEN
                            Ok = ExecGoTo(LineNum)
                        END IF
                    ELSE
                        ErrorHit (ERRORSYNTAX)
                    END IF
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            ELSE
                LexUngetToken
                IF Cmd = CMDINTERPRET THEN
                    IF Cond THEN
                        Ok = ParseBlock(Cmd)
                    ELSE
                        Ok = ParseBlock(CMDIFBLOCK)
                    END IF
                ELSE
                    Ok = ParseBlock(Cmd)
                END IF
            END IF

            IF (LastErr = 0) THEN
                IF LexGetToken = TOKENELSE THEN
                    IF LexGetToken = TOKENCONSTANT THEN
                        IF LexToken.Value.DataType = TYPEINT THEN
                            LineNum = LexToken.Value.ValueInt
                            IF LineNum > 0 THEN
                                IF (Cmd = CMDINTERPRET) AND (NOT Cond) THEN
                                    Ok = ExecGoTo(LineNum)
                                END IF
                            ELSE
                                ErrorHit (ERRORSYNTAX)
                            END IF
                        ELSE
                            ErrorHit (ERRORSYNTAX)
                        END IF
                    ELSE
                        LexUngetToken
                        IF Cmd = CMDINTERPRET THEN
                            IF Cond THEN
                                Ok = ParseBlock(CMDIFBLOCK)
                            ELSE
                                Ok = ParseBlock(Cmd)
                            END IF
                        ELSE
                            Ok = ParseBlock(Cmd)
                        END IF
                    END IF
                ELSE
                    LexUngetToken
                END IF
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

    ParseIf = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseInput  -   Parses the following:
'
'   input [#exp,] [literal {,|;}] var [, var]*
'   line input [#exp,] [literal {,|;} ] var
'   read var [, var]*
'
'   The input, line input and read have already been lexed
'
'   Mode    -   Indicates the kind of input (Input, Line Input or Read)
'
'======================================================================
FUNCTION ParseInput (Cmd AS INTEGER, Mode AS INTEGER)

    DIM Ok AS INTEGER
    DIM FileNumber AS INTEGER
    DIM Prompt AS STRING
    DIM cInput AS INTEGER
    DIM PgmC AS PGMLOCTYPE
    DIM PgmI AS PGMLOCTYPE
    DIM Buffer AS STRING
    DIM Symbol AS STRING
    DIM cArgs AS INTEGER
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE
    DIM Value AS VALUETYPE
    DIM PgmM AS PGMMEMTYPE

    FileNumber = 0
    Prompt = "? "
    cInput = 0

    IF Mode <> INPUTREAD THEN
        IF LexGetToken = TOKENPOUND THEN
            IF ParseIntExp(Cmd, FileNumber) THEN
                IF Cmd = CMDINTERPRET THEN
                    Ok = FileValidateAccess(FileNumber, FILEACCESSINPUT)
                END IF
                IF (LastErr = 0) THEN
                    IF LexGetToken <> TOKENCOMMA THEN
                        ErrorHit (ERRORSYNTAX)
                    END IF
                END IF
            END IF
        ELSE
            LexUngetToken
        END IF

        IF (LastErr = 0) THEN
            '
            '   See if there is a prompt
            '
            IF LexGetToken = TOKENCONSTANT THEN
                IF LexToken.Value.DataType = TYPESTR THEN
                    Prompt = LEFT$(LexToken.Value.ValueStr.StrBuf, LexToken.Value.ValueStr.StrLen)
                    IF LexGetToken <> TOKENCOMMA THEN
                        ErrorHit (ERRORSYNTAX)
                    END IF
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            ELSE
                LexUngetToken
            END IF
        END IF
    END IF

    IF (LastErr = 0) AND (Cmd = CMDINTERPRET) THEN
        '
        '   Get the data
        '
        IF Mode = INPUTREAD THEN
            Ok = GetReadData(Buffer, PgmI.Offset)
        ELSE
            IF FileNumber = 0 THEN
                PRINT Prompt;
                LINE INPUT Buffer
            ELSE
                LINE INPUT #FileNumber, Buffer
            END IF

            PgmI.Offset = 1
        END IF

        IF (LastErr = 0) THEN
            PgmMemGet PgmMemInp, PgmM
            PgmM.Buffer = Buffer
            PgmM.BufLen = LEN(Buffer)
            PgmMemSet PgmMemInp, PgmM
            PgmI.PgmPtr = PgmMemInp
        END IF
    END IF

    DO WHILE (LastErr = 0)
        '
        '   Set the variable list
        '
        SELECT CASE LexGetToken

            CASE TOKENVARIABLE
                Symbol = LexTokenStr$
                IF LexGetToken = TOKENOPENPAREN THEN
                    Ok = ParseArgList(Cmd, MAXDIMENSIONS, cArgs, vArgs())
                ELSE
                    LexUngetToken
                    cArgs = 0
                END IF

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

                    IF Mode = INPUTLINE THEN
                        Value.DataType = TYPESTR
                        Value.ValueStr.StrBuf = PgmMemBuf$(PgmMemInp)
                        Value.ValueStr.StrLen = PgmMemBufLen(PgmMemInp)
                    ELSE
                        PgmC = PgmCur
                        PgmCur = PgmI
TryAgain:
                        SELECT CASE LexGetInputToken
                            CASE TOKENCONSTANT
                                SELECT CASE SymbolToDataType(Symbol)
                                    CASE TYPEINT
                                        IF LexToken.Value.DataType = TYPEINT THEN
                                            Value = LexToken.Value
                                        ELSE
                                            ErrorHit (ERRORTYPEMISMATCH)
                                        END IF
                                    CASE TYPEREAL
                                        IF CastToReal(LexToken.Value) THEN
                                            Value = LexToken.Value
                                        END IF
                                    CASE TYPESTR
                                        IF LexToken.Value.DataType = TYPESTR THEN
                                            Value = LexToken.Value
                                         ELSE
                                            ErrorHit (ERRORTYPEMISMATCH)
                                        END IF
                                END SELECT
                            CASE TOKENEOL
                                IF GetReadData(Buffer, PgmI.Offset) THEN
                                    PgmMemGet PgmMemInp, PgmM
                                    PgmM.Buffer = Buffer
                                    PgmM.BufLen = LEN(Buffer)
                                    PgmMemSet PgmMemInp, PgmM
                                    PgmI.PgmPtr = PgmMemInp
                                    PgmCur = PgmI
                                    GOTO TryAgain
                                END IF
                            CASE ELSE
                                ErrorHit (ERRORSYNTAX)
                        END SELECT

                        PgmI = PgmCur
                        PgmCur = PgmC
                    END IF

                    IF (LastErr = 0) THEN
                        IF (Mode = INPUTLINE) AND (cInput > 0) THEN
                            ErrorHit (ERRORSYNTAX)
                        ELSE
                            Ok = SymTabSet(Symbol, cArgs, vArgs(), Value)
                            cInput = cInput + 1
                        END IF
                    END IF

                    IF Mode = INPUTREAD THEN
                        PgmData.Offset = PgmCur.Offset
                    END IF

                END IF

                IF (LastErr = 0) THEN

                    IF (Cmd = CMDINTERPRET) AND (Mode = INPUTREAD) THEN
                        PgmC = PgmCur
                        PgmCur = PgmI
                        IF LexGetToken = TOKENCOMMA THEN
                            PgmData.Offset = PgmCur.Offset
                        END IF
                        PgmI = PgmCur
                        PgmCur = PgmC
                    END IF

                    SELECT CASE LexGetToken
                        CASE TOKENCOMMA
                            IF (Cmd = CMDINTERPRET) AND (Mode <> INPUTREAD) THEN
                                PgmC = PgmCur
                                PgmCur = PgmI
                                IF LexGetToken <> TOKENCOMMA THEN
                                    ErrorHit (ERRORSYNTAX)
                                END IF
                                PgmI = PgmCur
                                PgmCur = PgmC
                            END IF
                        CASE TOKENSEP, TOKENELSE
                            LexUngetToken
                            EXIT DO
                        CASE TOKENEOL
                            EXIT DO
                        CASE ELSE
                            ErrorHit (ERRORSYNTAX)
                    END SELECT
                END IF

            CASE TOKENSEP, TOKENELSE
                LexUngetToken
                EXIT DO

            CASE TOKENEOL
                EXIT DO
            CASE ELSE
                ErrorHit (ERRORSYNTAX)
        END SELECT
    LOOP

    ParseInput = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseIntExp -   Parses an expression of type TYPEINT
'
'   IntValue    -   Integer value returned
'
'======================================================================
FUNCTION ParseIntExp (Cmd AS INTEGER, IntValue AS INTEGER)

    DIM Value AS VALUETYPE

    IF ParseExp(Cmd) THEN
        IF FactorStackPop(Value) THEN
            IF Value.DataType = TYPEINT THEN
                IntValue = Value.ValueInt
            ELSE
                ErrorHit (ERRORTYPEMISMATCH)
            END IF
        END IF
    END IF

    ParseIntExp = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseIntF   -   Parses an integer function
'
'   ERL
'   ERR
'   CURSORX
'   CURSORY
'
'======================================================================
FUNCTION ParseIntF (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Value AS VALUETYPE

    Value.DataType = TYPEINT

    IF Cmd = CMDINTERPRET THEN
        SELECT CASE Tkn
            CASE TOKENFERL
                Value.ValueInt = LastErl
            CASE TOKENFERR
                Value.ValueInt = LastErr
            CASE TOKENFCURSORY
                Value.ValueInt = CSRLIN
            CASE TOKENFCURSORX
                Value.ValueInt = POS(0)
        END SELECT
    END IF

    ParseIntF = FactorStackPush(Value)

END FUNCTION

'======================================================================
'
'   ParseIntFNum    -   Parses integer function with numeric arguments
'
'   EOF( numexp )
'   LOC( numexp )
'   LOF( numexp )
'   INT( numexp )
'   CINT( numexp )
'   FIX( numexp )
'   SEEK( numexp )
'
'======================================================================
FUNCTION ParseIntFNum (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM v AS SINGLE
    DIM Value AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseRealExp(Cmd, v) THEN
            IF LexGetToken = TOKENCLOSEPAREN THEN
                Value.DataType = TYPEINT
                IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                    SELECT CASE Tkn
                        CASE TOKENFEOF
                            Value.ValueInt = EOF(v)
                        CASE TOKENFLOC
                            Value.ValueInt = LOC(v)
                        CASE TOKENFLOF
                            Value.ValueInt = LOF(v)
                        CASE TOKENFINT
                            Value.ValueInt = INT(v)
                        CASE TOKENFCINT
                            Value.ValueInt = CINT(v)
                        CASE TOKENFSEEK
                            Value.ValueInt = SEEK(v)
                        CASE TOKENFFIX
                            Value.ValueInt = FIX(v)
                    END SELECT
                END IF
                Ok = FactorStackPush(Value)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseIntFNum = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseIntFStr    -   Parses integer functions with string arguments
'
'   ASC( strexp )
'   CVI( strexp )
'   CVS( strexp )
'   LEN( strexp )
'   VAL( strexp )
'
'======================================================================
FUNCTION ParseIntFStr (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM strIn AS STRING
    DIM Value AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseStrExp(Cmd, strIn) THEN
            IF LexGetToken = TOKENCLOSEPAREN THEN
                Value.DataType = TYPEINT
                IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                    SELECT CASE Tkn
                        CASE TOKENFASC
                            Value.ValueInt = ASC(strIn)
                        CASE TOKENFCVI
                            Value.ValueInt = CVI(strIn)
                        CASE TOKENFCVS
                            Value.DataType = TYPEREAL
                            Value.ValueReal = CVS(strIn)
                        CASE TOKENFLEN
                            Value.ValueInt = LEN(strIn)
                        CASE TOKENFVAL
                            IF INSTR(strIn, ".") = 0 THEN
                                Value.ValueInt = VAL(strIn)
                            ELSE
                                Value.DataType = TYPEREAL
                                Value.ValueReal = VAL(strIn)
                            END IF
                    END SELECT
                END IF
                Ok = FactorStackPush(Value)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseIntFStr = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseKey Timer   -   Parses KEY (exp) {on | off}
'                               TIMER {on | off}
'
'======================================================================
FUNCTION ParseKeyTimer (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM KeyNum AS INTEGER
    DIM Enabled AS INTEGER

    IF Tkn = TOKENKEY THEN
        IF LexGetToken = TOKENOPENPAREN THEN
            IF ParseIntExp(Cmd, KeyNum) THEN
                IF LexGetToken <> TOKENCLOSEPAREN THEN
                    ErrorHit (ERRORSYNTAX)
                END IF
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

    IF (LastErr = 0) THEN
        SELECT CASE LexGetToken
            CASE TOKENON
                Enabled = TRUE
            CASE TOKENOFF
                Enabled = FALSE
        END SELECT
    END IF

    IF (LastErr = 0) AND (Cmd = CMDINTERPRET) THEN
        SELECT CASE Tkn
            CASE TOKENKEY
                IF KeyTrapEnabled AND (KeyTrapTargetGet(KeyNum) <> NILPOINTER) THEN
                    KeyOnSet KeyNum, Enabled
                ELSE
                    ErrorHit (ERRORKEYTRAPPINGNOTENABLED)
                END IF
            CASE TOKENTIMER
                IF Enabled THEN
                    IF TimerTrapTarget <> NILPOINTER THEN
                        TimerTrapEnabled = TRUE
                    ELSE
                        ErrorHit (ERRORNOTIMERTRAP)
                    END IF
                ELSE
                    TimerTrapEnabled = FALSE
                END IF
        END SELECT
    END IF

    ParseKeyTimer = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseLet    Parses [LET | LSET | RSET ] var = exp
'
'======================================================================
FUNCTION ParseLet (Cmd AS INTEGER, Token AS INTEGER)

    DIM Ok AS INTEGER
    DIM Tkn AS INTEGER
    DIM Symbol AS STRING
    DIM cArgs AS INTEGER
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE
    DIM Value AS VALUETYPE

    Symbol = LexTokenStr$

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

    IF (LastErr = 0) THEN

        IF Tkn = TOKENEQ THEN

            IF ParseExp(Cmd) THEN

                IF FactorStackPop(Value) THEN
                    IF Cmd = CMDINTERPRET THEN
                        IF (Token = TOKENLSET) OR (Token = TOKENRSET) THEN
                            IF Value.DataType <> TYPESTR THEN
                                ErrorHit (ERRORTYPEMISMATCH)
                            END IF
                        END IF
                        IF (LastErr = 0) THEN
                            SELECT CASE Token
                                CASE TOKENLET
                                CASE TOKENLSET
                                    LSET Value.ValueStr.StrBuf = Value.ValueStr.StrBuf
                                CASE TOKENRSET
                                    RSET Value.ValueStr.StrBuf = Value.ValueStr.StrBuf
                            END SELECT
                            Ok = SymTabSet(Symbol, cArgs, vArgs(), Value)
                        END IF
                    END IF
                END IF
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

    ParseLet = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseNext   -   Parses NEXT [id]
'
'======================================================================
FUNCTION ParseNext (Cmd AS INTEGER)

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

    Symbol = ""

    SELECT CASE LexGetToken
        CASE TOKENVARIABLE
            Symbol = LexTokenStr$
        CASE TOKENEOL, TOKENSEP
            LexUngetToken
        CASE ELSE
            ErrorHit (ERRORSYNTAX)
    END SELECT

    IF (LastErr = 0) THEN

        IF Cmd = CMDINTERPRET THEN
            IF NOT LoopStackTopData(LoopData) THEN
                ErrorHit (ERRORINTERNAL)
            END IF
            IF (LastErr = 0) THEN
                IF LoopData.LoopKind <> LOOPKINDFOR THEN
                    ErrorHit (ERRORINVALIDLOOPNESTING)
                ELSEIF Symbol <> "" THEN
                    IF RTRIM$(Symbol) <> RTRIM$(LoopData.Id) THEN
                        ErrorHit (ERRORINTERNAL)
                    END IF
                END IF

                IF (LastErr = 0) THEN
                    IF SymTabGet(LoopData.Id, 0, vArgs(), Value) THEN
                        Value.ValueInt = Value.ValueInt + LoopData.Increment
                        IF SymTabSet(LoopData.Id, 0, vArgs(), Value) THEN
                            IF EvalLoopCondition(Execute) THEN
                                IF Execute THEN
                                    PgmCur = LoopData.PgmBegin
                                ELSE
                                    Ok = LoopStackPop(LoopData)
                                END IF
                            END IF
                        END IF
                    END IF
                END IF
            END IF
        ELSEIF Cmd = CMDSKIPLOOP THEN
            LoopCount = LoopCount - 1
        END IF
    END IF

    ParseNext = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseNumFNum    -   Parses numeric functions with numeric arguments
'
'   ABS( numexp )
'
'======================================================================
FUNCTION ParseNumFNum (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseExp(Cmd) THEN
            IF FactorStackPop(Value) THEN
                IF Value.DataType = TYPESTR THEN
                    ErrorHit (ERRORTYPEMISMATCH)
                ELSEIF LexGetToken = TOKENCLOSEPAREN THEN
                    IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                        SELECT CASE Tkn
                            CASE TOKENFABS
                                IF Value.DataType = TYPEINT THEN
                                    Value.ValueInt = ABS(Value.ValueInt)
                                ELSE
                                    Value.ValueReal = ABS(Value.ValueReal)
                                END IF
                        END SELECT
                    END IF
                    Ok = FactorStackPush(Value)
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseNumFNum = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseOn -   Parses ON ERROR, ON KEY, ON TIMER and ON exp
'
'======================================================================
FUNCTION ParseOn (Cmd AS INTEGER)

    DIM Ok AS INTEGER

    SELECT CASE LexGetToken
        CASE TOKENERROR
            Ok = ParseOnError(Cmd)
        CASE TOKENKEY, TOKENTIMER
            Ok = ParseOnKeyTimer(Cmd, (LexToken.Tkn))
        CASE ELSE
            LexUngetToken
            Ok = ParseOnExp(Cmd)
    END SELECT

    ParseOn = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseOnError    -   Parses  ON ERROR goto linenumber
'
'======================================================================
FUNCTION ParseOnError (Cmd AS INTEGER)

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

    Ok = TRUE

    IF LexGetToken = TOKENGOTO THEN

        LineNumOffset = PgmCur.Offset

        IF ParseIntExp(Cmd, LineNumber) THEN
            IF Cmd = CMDINTERPRET THEN
                PTR = PgmMemFind(LineNumber)
                IF PTR = NILPOINTER THEN
                    ErrorHit (ERRORLABELNOTFOUND)
                ELSE
                    ErrTrapEnabled = TRUE
                    ErrTrapTarget = PTR
                END IF
            ELSEIF Cmd = CMDRENUM THEN
                Ok = RenumPatch(LineNumOffset)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseOnError = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseOnExp  -   Parses ON exp {goto | gosub} linenumber [, linenumber ]*
'
'======================================================================
FUNCTION ParseOnExp (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM TknGo AS INTEGER
    DIM Index AS INTEGER
    DIM Count AS INTEGER
    DIM LineNumOffset AS INTEGER
    DIM LineNumber AS INTEGER
    DIM Target AS INTEGER
    DIM HaveTarget AS INTEGER

    Count = 0
    HaveTarget = FALSE

    IF ParseIntExp(Cmd, Index) THEN
        TknGo = LexGetToken
        IF (TknGo = TOKENGOTO) OR (TknGo = TOKENGOSUB) THEN
            DO
                Count = Count + 1
                SELECT CASE LexGetToken
                    CASE TOKENEOL, TOKENSEP, TOKENELSE
                        LexUngetToken
                        EXIT DO
                    CASE ELSE
                        LexUngetToken
                        LineNumOffset = PgmCur.Offset
                        IF ParseIntExp(Cmd, LineNumber) THEN
                            IF Cmd = CMDINTERPRET THEN
                                IF Count = Index THEN
                                    Target = LineNumber
                                    HaveTarget = TRUE
                                END IF
                            ELSEIF Cmd = CMDRENUM THEN
                                Ok = RenumPatch(LineNumOffset)
                            END IF
                            IF LexGetToken <> TOKENCOMMA THEN
                                LexUngetToken
                                EXIT DO
                            END IF
                        END IF
                END SELECT
            LOOP
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

    IF (LastErr = 0) AND (Cmd = CMDINTERPRET) THEN
        IF HaveTarget THEN
            IF Target > 0 THEN
                SELECT CASE TknGo
                    CASE TOKENGOTO
                        Ok = ExecGoTo(Target)
                    CASE TOKENGOSUB
                        Ok = ExecGoSub(Target)
                END SELECT
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    END IF

    ParseOnExp = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseOnKey  -   Parses  ON KEY(exp) gosub linenumber
'                           ON TIMER(exp) gosub linenumber
'
'======================================================================
FUNCTION ParseOnKeyTimer (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM Arg AS INTEGER
    DIM LineNumOffset AS INTEGER
    DIM LineNumber AS INTEGER
    DIM PTR AS INTEGER

    IF LexGetToken = TOKENOPENPAREN THEN

        IF ParseIntExp(Cmd, Arg) THEN

            IF LexGetToken = TOKENCLOSEPAREN THEN

                IF LexGetToken = TOKENGOSUB THEN

                    LineNumOffset = PgmCur.Offset
                    Ok = ParseIntExp(Cmd, LineNumber)

                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

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

        IF Tkn = TOKENKEY THEN
            IF (Arg < FIRSTKEY) OR (Arg > LASTKEY) THEN
                ErrorHit (ERRORINVALIDKEYNUMBER)
            END IF
        END IF

        IF (LastErr = 0) THEN

            PTR = PgmMemFind(LineNumber)

            IF PTR <> NILPOINTER THEN

                SELECT CASE Tkn
                    CASE TOKENKEY
                        KeyTrapEnabled = TRUE
                        KeyTrapTargetSet Arg, PTR
                    CASE TOKENTIMER
                        TimerTrapTarget = PTR
                        TimerInterval = Arg
                        TimerStamp = TIMER
                END SELECT
            ELSE
                ErrorHit (ERRORLABELNOTFOUND)
            END IF
        ELSE
            ErrorHit (ERRORINVALIDKEYNUMBER)
        END IF
    ELSEIF Cmd = CMDRENUM THEN
        Ok = RenumPatch(LineNumOffset)
    END IF

    ParseOnKeyTimer = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseOpen   -   Parses OPEN:
'
'   OPEN filename [ for {input|output|random} ] as #exp [len=exp]
'
'======================================================================
FUNCTION ParseOpen (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM FileName AS STRING
    DIM Mode AS INTEGER
    DIM FileNumber AS INTEGER
    DIM RecordLen AS INTEGER
    DIM FileData AS FILETYPE

    IF ParseStrExp(Cmd, FileName) THEN
        IF LexGetToken = TOKENFOR THEN
            SELECT CASE LexGetToken
                CASE TOKENINPUT
                    Mode = FILEACCESSINPUT
                CASE TOKENOUTPUT
                    Mode = FILEACCESSOUTPUT
                CASE TOKENRANDOM
                    Mode = FILEACCESSRANDOM
                CASE ELSE
                    ErrorHit (ERRORSYNTAX)
            END SELECT
        ELSE
            LexUngetToken
            Mode = FILEACCESSINPUT
        END IF
    END IF

    IF (LastErr = 0) THEN
        IF LexGetToken = TOKENAS THEN
            IF LexGetToken = TOKENPOUND THEN
                IF ParseIntExp(Cmd, FileNumber) THEN
                    IF LexGetToken = TOKENFLEN THEN
                        IF LexGetToken = TOKENEQ THEN
                            Ok = ParseIntExp(Cmd, RecordLen)
                        ELSE
                            ErrorHit (ERRORSYNTAX)
                        END IF
                    ELSE
                        LexUngetToken
                        RecordLen = DEFAULTRECORDLEN
                    END IF
                END IF
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        ELSE
            ErrorHit (ERRORSYNTAX)
        END IF
    END IF

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

        IF (FileNumber >= FIRSTFILENUMBER) AND (FileNumber <= (FIRSTFILENUMBER + MAXFILES)) THEN
            IF (NOT FileIsOpen(FileNumber)) THEN
                SELECT CASE Mode
                    CASE FILEACCESSINPUT
                        OPEN FileName FOR INPUT AS #FileNumber
                    CASE FILEACCESSOUTPUT
                        OPEN FileName FOR OUTPUT AS #FileNumber
                    CASE FILEACCESSRANDOM
                        IF RecordLen <= MAXFILEBUFLEN THEN
                            OPEN FileName FOR BINARY AS #FileNumber LEN = RecordLen
                        ELSE
                            ErrorHit (ERRORBADRECORDLEN)
                        END IF
                END SELECT
                IF LastErr = 0 THEN
                    FileData.FileName = FileName
                    FileData.FileAccess = Mode
                    FileData.RecordLen = RecordLen
                    FileData.RecordPtr = NILPOINTER
                    FileData.SeekPos = 1
                    Ok = FileSet(FileNumber, FileData)
                END IF
            ELSE
                ErrorHit (ERRORINVALIDFILENUMBER)
            END IF
        ELSE
            ErrorHit (ERRORINVALIDFILENUMBER)
        END IF
    END IF

    ParseOpen = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParsePrint  -   Parses PRINT [#exp,] [exp [{,|;} exp ]*
'
'======================================================================
FUNCTION ParsePrint (Cmd AS INTEGER)

    CONST SEPNONE = 0
    CONST SEPCOMMA = 1
    CONST SEPSEMICOLON = 2

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE
    DIM s AS STRING
    DIM Tkn AS INTEGER
    DIM FileNumber AS INTEGER
    DIM LastSep AS INTEGER

    FileNumber = 0
    s = ""
    LastSep = SEPNONE

    IF LexGetToken = TOKENPOUND THEN
        IF ParseIntExp(Cmd, FileNumber) THEN
            IF LexGetToken <> TOKENCOMMA THEN
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        LexUngetToken
    END IF

    DO WHILE (LastErr = 0)
        Tkn = LexGetToken

        SELECT CASE Tkn
            CASE TOKENSEP
                LexUngetToken
                EXIT DO
            CASE TOKENCOMMA
                LastSep = SEPCOMMA
            CASE TOKENSEMICOLON
                LastSep = SEPSEMICOLON
            CASE TOKENEOL, TOKENSEP
                EXIT DO
            CASE TOKENELSE
                LexUngetToken
                EXIT DO
            CASE ELSE
                LexUngetToken
                IF ParseExp(Cmd) THEN
                    IF FactorStackPop(Value) THEN
                        IF (Cmd = CMDINTERPRET) THEN
                            SELECT CASE LastSep
                                CASE SEPNONE
                                CASE SEPSEMICOLON
                                CASE SEPCOMMA
                                    s = s + "    "
                            END SELECT
                            SELECT CASE Value.DataType
                                CASE TYPEINT
                                    s = s + STR$(Value.ValueInt)
                                CASE TYPEREAL
                                    s = s + STR$(Value.ValueReal)
                                CASE TYPESTR
                                    s = s + LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen)
                            END SELECT
                        END IF
                        LastSep = SEPNONE
                    END IF
                END IF
        END SELECT
    LOOP

    IF (LastErr = 0) AND (Cmd = CMDINTERPRET) THEN
        IF FileNumber > 0 THEN
            Ok = FileValidateAccess(FileNumber, FILEACCESSOUTPUT)
        END IF
        IF (LastErr = 0) THEN
            IF FileNumber = 0 THEN
                SELECT CASE LastSep
                    CASE SEPNONE
                        PRINT s
                    CASE SEPCOMMA
                        PRINT s,
                    CASE SEPSEMICOLON
                        PRINT s;
                END SELECT
            ELSE
                PRINT #FileNumber, s
            END IF
        END IF
    END IF

    ParsePrint = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseRandomize  -   Parses RANDOMIZE [exp]
'
'======================================================================
FUNCTION ParseRandomize (Cmd AS INTEGER)

    DIM Num AS SINGLE
    DIM UseNum AS INTEGER

    UseNum = FALSE

    SELECT CASE LexGetToken
        CASE TOKENEOL, TOKENSEP, TOKENELSE
            LexUngetToken
        CASE ELSE
            IF ParseRealExp(Cmd, Num) THEN
                UseNum = TRUE
            END IF
    END SELECT

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            IF UseNum THEN
                RANDOMIZE Num
            ELSE
                RANDOMIZE
            END IF
        END IF
    END IF

    ParseRandomize = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseRealExp    -   Parses a real exp
'
'   RealValue   -   Returned real value
'
'======================================================================
FUNCTION ParseRealExp (Cmd AS INTEGER, RealValue AS SINGLE)

    DIM Value AS VALUETYPE

    IF ParseExp(Cmd) THEN
        IF FactorStackPop(Value) THEN
            IF Value.DataType = TYPEREAL THEN
                RealValue = Value.ValueReal
            ELSEIF Value.DataType = TYPEINT THEN
                RealValue = Value.ValueInt
            ELSE
                ErrorHit (ERRORTYPEMISMATCH)
            END IF
        END IF
    END IF

    ParseRealExp = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseRealF  -   Parses Real functions
'
'   RND
'   TIMER
'
'======================================================================
FUNCTION ParseRealF (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Value AS VALUETYPE

    Value.DataType = TYPEREAL

    IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
        SELECT CASE Tkn
            CASE TOKENFRND
                Value.ValueReal = RND
            CASE TOKENTIMER
                Value.ValueReal = TIMER
        END SELECT
    END IF

    ParseRealF = FactorStackPush(Value)

END FUNCTION

'======================================================================
'
'   ParseRealFNum   -   Parses real functions with numeric arguments
'
'   ATN( numexp )
'   COS( numexp )
'   EXP( numexp )
'   LOG( numexp )
'   SIN( numexp )
'   SQR( numexp )
'
'======================================================================
FUNCTION ParseRealFNum (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM v AS SINGLE
    DIM Value AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseRealExp(Cmd, v) THEN
            IF LexGetToken = TOKENCLOSEPAREN THEN
                Value.DataType = TYPEREAL
                IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                    SELECT CASE Tkn
                        CASE TOKENFATN
                            Value.ValueReal = ATN(v)
                        CASE TOKENFCOS
                            Value.ValueReal = COS(v)
                        CASE TOKENFEXP
                            Value.ValueReal = EXP(v)
                        CASE TOKENFLOG
                            Value.ValueReal = LOG(v)
                        CASE TOKENFSIN
                            Value.ValueReal = SIN(v)
                        CASE TOKENFSQR
                            Value.ValueReal = SQR(v)
                    END SELECT
                END IF
                Ok = FactorStackPush(Value)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseRealFNum = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseResRet -   Parses    RESUME [next | linenumber]
'                                   RETURN [ linenumber ]
'
'======================================================================
FUNCTION ParseResRet (Cmd AS INTEGER, Tkn AS INTEGER)

    CONST RESUMECUR = 0
    CONST RESUMENEXT = 1
    CONST RESUMELINE = 2

    DIM Ok AS INTEGER
    DIM LineNumOffset AS INTEGER
    DIM LineNumber AS INTEGER
    DIM ResumeTo AS INTEGER
    DIM PgmLoc AS PGMLOCTYPE
    DIM PTR AS INTEGER

    SELECT CASE LexGetToken
        CASE TOKENNEXT
            IF Tkn = TOKENRETURN THEN
                ErrorHit (ERRORSYNTAX)
            ELSE
                ResumeTo = RESUMENEXT
            END IF
        CASE TOKENSEP, TOKENELSE, TOKENEOL
            LexUngetToken
            ResumeTo = RESUMECUR
        CASE ELSE
            LexUngetToken
            LineNumOffset = PgmCur.Offset
            IF ParseIntExp(Cmd, LineNumber) THEN
                ResumeTo = RESUMELINE
            END IF
    END SELECT

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            IF RetStackPop(PgmLoc) THEN
                SELECT CASE ResumeTo
                    CASE RESUMECUR
                        PgmCur = PgmLoc
                    CASE RESUMENEXT
                        PgmCur = PgmLoc
                        Ok = ParseStatement(CMDPARSE)
                    CASE RESUMELINE
                        PTR = PgmMemFind(LineNumber)
                        IF PTR = NILPOINTER THEN
                            ErrorHit (ERRORLABELNOTFOUND)
                        ELSE
                            SetPgmCur (PTR)
                        END IF
                END SELECT
            END IF
        ELSEIF Cmd = CMDRENUM THEN
            IF ResumeTo = RESUMELINE THEN
                Ok = RenumPatch(LineNumOffset)
            END IF
        END IF
    END IF

    ParseResRet = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseRestore    -   Parses RESTORE [linenumber]
'
'======================================================================
FUNCTION ParseRestore (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM LineNumOffset AS INTEGER
    DIM LineNumber AS INTEGER
    DIM PTR AS INTEGER
    DIM HaveLine AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    SELECT CASE LexGetToken
        CASE TOKENEOL, TOKENSEP, TOKENELSE
            LexUngetToken
            HaveLine = FALSE
        CASE ELSE
            LexUngetToken
            LineNumOffset = PgmCur.Offset
            HaveLine = ParseIntExp(Cmd, LineNumber)
    END SELECT

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            IF HaveLine THEN
                PTR = PgmMemFind(LineNumber)
                IF PTR = NILPOINTER THEN
                    ErrorHit (ERRORLABELNOTFOUND)
                END IF
            ELSE
                PTR = PgmMemProgram
            END IF

            IF (LastErr = 0) THEN
                PgmMemGet PTR, PgmM
                PgmData.PgmPtr = PTR
                PgmData.Offset = PgmM.Offset
            END IF
        ELSEIF Cmd = CMDRENUM THEN
            IF HaveLine THEN
                Ok = RenumPatch(LineNumOffset)
            END IF
        END IF
    END IF

    ParseRestore = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseRValue -   Parses the RValue of a symbol
'
'======================================================================
FUNCTION ParseRValue (Cmd AS INTEGER, Symbol AS STRING)

    DIM Ok AS INTEGER
    DIM cArgs AS INTEGER
    DIM vArgs(MAXDIMENSIONS) AS VALUETYPE
    DIM Value AS VALUETYPE
    DIM FuncData AS FUNCSTKTYPE
    DIM j AS INTEGER
    DIM FoundArg AS INTEGER
    DIM ParamName AS STRING
    DIM pVal AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        Ok = ParseArgList(Cmd, MAXDIMENSIONS, cArgs, vArgs())
    ELSE
        cArgs = 0
        LexUngetToken
    END IF

    IF (LastErr = 0) THEN
        IF Cmd = CMDINTERPRET THEN
            Ok = SymTabGet(Symbol, cArgs, vArgs(), Value)
        ELSEIF Cmd = CMDEVALFUNC THEN
            Ok = FuncStackGet(FuncData)
            FoundArg = FALSE
            FOR j = 0 TO FuncData.cParam - 1
                Ok = MemGet(TYPESTR, FuncData.ParamPtr + j, pVal)
                ParamName = LEFT$(pVal.ValueStr.StrBuf, pVal.ValueStr.StrLen)
                IF Symbol = ParamName THEN
                    IF cArgs = 0 THEN
                        ArgMemGet FuncData.ArgPtr + j, Value
                        FoundArg = TRUE
                    ELSE
                        ErrorHit (ERRORBADNUMARG)
                    END IF
                    EXIT FOR
                END IF
            NEXT j
            IF NOT FoundArg THEN
                Ok = SymTabGet(Symbol, cArgs, vArgs(), Value)
            END IF
        ELSE
            Value.DataType = SymbolToDataType(Symbol)
        END IF
        IF (LastErr = 0) THEN
            Ok = FactorStackPush(Value)
        END IF
    END IF

    ParseRValue = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseShell  -   Parses SHELL strexp and CHDIR strexp
'
'======================================================================
FUNCTION ParseShell (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM str AS STRING

    IF ParseStrExp(Cmd, str) THEN
        IF Cmd = CMDINTERPRET THEN
            SELECT CASE Tkn
                CASE TOKENSHELL
                    SHELL str
                CASE TOKENCHDIR
                    CHDIR str
            END SELECT
        END IF
    END IF

    ParseShell = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseSimple -   Parses BEEP, CLS, REM
'
'======================================================================
FUNCTION ParseSimple (Cmd AS INTEGER, Tkn AS INTEGER)

    IF Tkn = TOKENREM THEN
        PgmCur.Offset = PgmMemBufLen(PgmCur.PgmPtr) + 1
    ELSEIF (Cmd = CMDINTERPRET) THEN
        SELECT CASE Tkn
            CASE TOKENBEEP
                BEEP
            CASE TOKENCLS
                CLS
        END SELECT
    END IF

    ParseSimple = TRUE

END FUNCTION

'======================================================================
'
'   ParseStatement  -   Parses a statement
'
'======================================================================
FUNCTION ParseStatement (Cmd AS INTEGER)

    DIM Tkn AS INTEGER
    DIM Ok AS INTEGER

    StmtCur = PgmCur.Offset

    Tkn = LexGetToken

    SELECT CASE Tkn

        CASE TOKENBEEP, TOKENCLS, TOKENREM
            Ok = ParseSimple(Cmd, Tkn)
        CASE TOKENCHDIR, TOKENSHELL
            Ok = ParseShell(Cmd, Tkn)
        CASE TOKENCLOSE
            Ok = ParseClose(Cmd)
        CASE TOKENCOLOR, TOKENLOCATE
            Ok = ParseCoLoc(Cmd, Tkn)
        CASE TOKENDATA
            Ok = ParseData(Cmd)
        CASE TOKENDEF
            Ok = ParseDef(Cmd)
        CASE TOKENDIM
            Ok = ParseDim(Cmd)
        CASE TOKENEND, TOKENSTOP
            Ok = ParseStop(Cmd, Tkn)
        CASE TOKENERROR, TOKENSLEEP
            Ok = ParseStmt1Arg(Cmd, Tkn)
        CASE TOKENFIELD
            Ok = ParseField(Cmd)
        CASE TOKENFOR
            Ok = ParseFor(Cmd)
        CASE TOKENGET, TOKENPUT, TOKENSEEK
            Ok = ParseGetPutSeek(Cmd, Tkn)
        CASE TOKENGOSUB, TOKENGOTO
            Ok = ParseGo(Cmd, Tkn)
        CASE TOKENIF
            Ok = ParseIf(Cmd)
        CASE TOKENINPUT
            Ok = ParseInput(Cmd, INPUTNORMAL)
        CASE TOKENKEY, TOKENTIMER
            Ok = ParseKeyTimer(Cmd, Tkn)
        CASE TOKENLET, TOKENLSET, TOKENRSET
            IF LexGetToken = TOKENVARIABLE THEN
                Ok = ParseLet(Cmd, Tkn)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        CASE TOKENLINE
            IF LexGetToken = TOKENINPUT THEN
                Ok = ParseInput(Cmd, INPUTLINE)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        CASE TOKENNEXT
            Ok = ParseNext(Cmd)
        CASE TOKENON
            Ok = ParseOn(Cmd)
        CASE TOKENOPEN
            Ok = ParseOpen(Cmd)
        CASE TOKENPRINT
            Ok = ParsePrint(Cmd)
        CASE TOKENRANDOMIZE
            Ok = ParseRandomize(Cmd)
        CASE TOKENREAD
            Ok = ParseInput(Cmd, INPUTREAD)
        CASE TOKENRESTORE
            Ok = ParseRestore(Cmd)
        CASE TOKENRESUME, TOKENRETURN
            Ok = ParseResRet(Cmd, Tkn)
        CASE TOKENWEND
            Ok = ParseWend(Cmd)
        CASE TOKENWHILE
            Ok = ParseWhile(Cmd)
        CASE TOKENVARIABLE
            Ok = ParseLet(Cmd, TOKENLET)
        CASE ELSE
            ErrorHit (ERRORSYNTAX)
    END SELECT

    ParseStatement = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseStmt1Arg  -   Parses   ERROR exp
'                               SLEEP exp
'
'======================================================================
FUNCTION ParseStmt1Arg (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM Arg AS INTEGER

    IF ParseIntExp(Cmd, Arg) THEN
        IF Cmd = CMDINTERPRET THEN
            SELECT CASE Tkn
                CASE TOKENERROR
                    ErrorHit (Arg)
                CASE TOKENSLEEP
                    SLEEP Arg
            END SELECT
        END IF
    END IF

    ParseStmt1Arg = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseStop   -   Parses  STOP
'                           END
'
'======================================================================
FUNCTION ParseStop (Cmd AS INTEGER, Tkn AS INTEGER)

    IF Cmd = CMDINTERPRET THEN
        IF PgmCur.PgmPtr <> NILPOINTER THEN
            IF Tkn = TOKENSTOP THEN
                BreakPoint ("STOP")
            END IF
            PgmCur.PgmPtr = NILPOINTER
        END IF
    END IF

    ParseStop = TRUE

END FUNCTION

'======================================================================
'
'   ParseStrExp -   Parses a string expression
'
'   str -   resulting string value
'
'======================================================================
FUNCTION ParseStrExp (Cmd AS INTEGER, str AS STRING)

    DIM Value AS VALUETYPE

    IF ParseExp(Cmd) THEN
        IF FactorStackPop(Value) THEN
            IF Value.DataType = TYPESTR THEN
                str = LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen)
            ELSE
                ErrorHit (ERRORTYPEMISMATCH)
            END IF
        END IF
    END IF

    ParseStrExp = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseStrF   -   Parses string functions
'
'   DATE$
'   ERT$
'   TIME$
'   INKEY$
'
'======================================================================
FUNCTION ParseStrF (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Value AS VALUETYPE
    DIM s AS STRING

    Value.DataType = TYPESTR

    IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
        SELECT CASE Tkn
            CASE TOKENFDATE
                s = DATE$
            CASE TOKENFERT
                s = LastErt
            CASE TOKENFTIME
                s = TIME$
            CASE TOKENFINKEY
                IF InKeyChars > 0 THEN
                    InKeyChars = InKeyChars - 1
                    s = LEFT$(InKeyBufGet$, 1)
                    InKeyBufSet MID$(InKeyBufGet$, 2, InKeyChars)
                    IF ASC(s) = 0 THEN
                        IF InKeyChars > 0 THEN
                            InKeyChars = InKeyChars - 1
                            s = s + LEFT$(InKeyBufGet$, 1)
                            InKeyBufSet MID$(InKeyBufGet$, 2, InKeyChars)
                        END IF
                    END IF
                ELSE
                    s = INKEY$
                END IF
        END SELECT

        Value.ValueStr.StrBuf = s
        Value.ValueStr.StrLen = LEN(s)
    END IF

    ParseStrF = FactorStackPush(Value)

END FUNCTION

'======================================================================
'
'   ParseStrFNum    -   Parses string functions with numeric arguments
'
'   CHR$( numexp )
'   MKI$( numexp )
'   MKS$( numexp )
'   STR$( numexp )
'
'======================================================================
FUNCTION ParseStrFNum (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM v AS SINGLE
    DIM sOut AS STRING
    DIM Value AS VALUETYPE

    IF LexGetToken = TOKENOPENPAREN THEN
        IF ParseRealExp(Cmd, v) THEN
            IF LexGetToken = TOKENCLOSEPAREN THEN
                Value.DataType = TYPESTR
                IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                    SELECT CASE Tkn
                        CASE TOKENFCHR
                            sOut = CHR$(v)
                            Value.ValueStr.StrLen = LEN(sOut)
                        CASE TOKENFMKI
                            sOut = MKI$(v)
                            Value.ValueStr.StrLen = 2
                        CASE TOKENFMKS
                            sOut = MKS$(v)
                            Value.ValueStr.StrLen = 4
                        CASE TOKENFSTR
                            sOut = STR$(v)
                            Value.ValueStr.StrLen = LEN(sOut)
                    END SELECT
                    Value.ValueStr.StrBuf = sOut
                END IF
                Ok = FactorStackPush(Value)
            ELSE
                ErrorHit (ERRORSYNTAX)
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseStrFNum = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseStrFStr    -   Parses string functions with string arguments
'
'   LCASE$( strexp )
'   LTRIM$( strexp )
'   RTRIM$( strexp )
'   UCASE$( strexp )
'   LEFT$( strexp, numexp )
'   RIGHT$( strexp, numexp )
'
'======================================================================
FUNCTION ParseStrFStr (Cmd AS INTEGER, Tkn AS INTEGER)

    DIM Ok AS INTEGER
    DIM strIn AS STRING
    DIM strOut AS STRING
    DIM Value AS VALUETYPE
    DIM Num AS INTEGER

    IF LexGetToken = TOKENOPENPAREN THEN

        IF ParseStrExp(Cmd, strIn) THEN

            IF (Tkn = TOKENFLEFT) OR (Tkn = TOKENFRIGHT) THEN
                IF LexGetToken = TOKENCOMMA THEN
                    Ok = ParseIntExp(Cmd, Num)
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            END IF

            IF (LastErr = 0) THEN
                IF LexGetToken = TOKENCLOSEPAREN THEN
                    Value.DataType = TYPESTR
                    IF (Cmd = CMDINTERPRET) OR (Cmd = CMDEVALFUNC) THEN
                        SELECT CASE Tkn
                            CASE TOKENFLCASE
                                strOut = LCASE$(strIn)
                            CASE TOKENFLTRIM
                                strOut = LTRIM$(strIn)
                            CASE TOKENFRTRIM
                                strOut = RTRIM$(strIn)
                            CASE TOKENFUCASE
                                strOut = UCASE$(strIn)
                            CASE TOKENFLEFT
                                strOut = LEFT$(strIn, Num)
                            CASE TOKENFRIGHT
                                strOut = RIGHT$(strIn, Num)
                        END SELECT
                        Value.ValueStr.StrBuf = strOut
                        Value.ValueStr.StrLen = LEN(strOut)
                    END IF
                    Ok = FactorStackPush(Value)
                ELSE
                    ErrorHit (ERRORSYNTAX)
                END IF
            END IF
        END IF
    ELSE
        ErrorHit (ERRORSYNTAX)
    END IF

    ParseStrFStr = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseTerm   -   Parses expression terms. The term is indicated by
'                   a level.
'
'   Level       Term
'   7           boolterm    =   boolterm or boolterm1 | boolterm1
'   6           boolterm1   =   boolterm1 and relterm | relterm
'   5           relterm     =   relterm {<|<=|>|>=} relterm1 | relterm1
'   4           relterm1    =   relterm1 {=|<>} arithterm | arithterm
'   3           arithterm   =   arithterm {+|-} arithterm1 | arithterm1
'   2           arithterm1  =   arithterm1 {*|/|\|mod} arithterm2 | arithterm2
'   1           arithterm2  =   arithterm2 ^ unaryterm | unaryterm
'   0           unaryterm   =   {+|-|not} factor | factor
'
'======================================================================
FUNCTION ParseTerm (Cmd AS INTEGER, Level AS INTEGER)

    DIM Ok AS INTEGER
    DIM Tkn AS INTEGER
    DIM v1 AS VALUETYPE
    DIM v2 AS VALUETYPE
    DIM vRes AS VALUETYPE

    IF Level = 0 THEN

        Tkn = LexGetToken

        SELECT CASE Tkn
            CASE TOKENPLUS, TOKENMINUS, TOKENNOT
                Ok = TRUE
            CASE ELSE
                Ok = FALSE
                LexUngetToken
        END SELECT

        IF ParseFactor(Cmd) THEN
            IF FactorStackPop(v1) THEN
                IF Ok THEN
                    IF (v1.DataType = TYPESTR) THEN
                        ErrorHit (ERRORTYPEMISMATCH)
                    ELSE
                        IF Cmd = CMDINTERPRET THEN
                            SELECT CASE Tkn
                                CASE TOKENMINUS
                                    IF v1.DataType = TYPEINT THEN
                                        v1.ValueInt = -v1.ValueInt
                                    ELSE
                                        v1.ValueReal = -v1.ValueReal
                                    END IF
                                CASE TOKENNOT
                                    IF v1.DataType = TYPEINT THEN
                                        v1.ValueInt = NOT (v1.ValueInt)
                                    ELSE
                                        ErrorHit (ERRORTYPEMISMATCH)
                                    END IF
                                CASE ELSE
                            END SELECT
                        END IF
                    END IF
                END IF
                Ok = FactorStackPush(v1)
            END IF
        END IF
    ELSE
        IF ParseTerm(Cmd, Level - 1) THEN
            DO
                Tkn = LexGetToken
                IF CorrectOp(Level, Tkn) THEN
                    IF ParseTerm(Cmd, Level - 1) THEN
                        IF FactorStackPop(v2) THEN
                            IF FactorStackPop(v1) THEN
                                IF ApplyOperator(Cmd, Tkn, v1, v2, vRes) THEN
                                    Ok = FactorStackPush(vRes)
                                END IF
                            END IF
                        END IF
                    END IF
                ELSE
                    LexUngetToken
                    EXIT DO
                END IF
            LOOP
        END IF
    END IF

    ParseTerm = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseWend   -   Parses WEND
'
'======================================================================
FUNCTION ParseWend (Cmd AS INTEGER)

    DIM LoopData AS LOOPSTKTYPE

    IF Cmd = CMDINTERPRET THEN
        IF LoopStackPop(LoopData) THEN
            IF LoopData.LoopKind <> LOOPKINDWHILE THEN
                ErrorHit (ERRORINVALIDLOOPNESTING)
            ELSE
                PgmCur = LoopData.PgmBegin
            END IF
        END IF
    ELSEIF Cmd = CMDSKIPLOOP THEN
        LoopCount = LoopCount - 1
    END IF

    ParseWend = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   ParseWhile  -   Parses WHILE exp
'
'======================================================================
FUNCTION ParseWhile (Cmd AS INTEGER)

    DIM Ok AS INTEGER
    DIM PgmLoc AS PGMLOCTYPE
    DIM Cond AS INTEGER
    DIM LoopData AS LOOPSTKTYPE
    DIM Tkn AS INTEGER

    '
    '   Remember where the WHILE starts
    '
    LexUngetToken
    PgmLoc = PgmCur
    Tkn = LexGetToken

    IF ParseIntExp(Cmd, Cond) THEN

        IF Cmd = CMDINTERPRET THEN

            IF Cond THEN

                LoopData.LoopKind = LOOPKINDWHILE
                LoopData.Flags = 0
                LoopData.PgmBegin = PgmLoc

                Ok = LoopStackPush(LoopData)
            ELSE
                '
                '   Skip the body of the loop
                '
                Ok = SkipLoopBlock
            END IF

        ELSEIF Cmd = CMDSKIPLOOP THEN
            LoopCount = LoopCount + 1
        END IF
    END IF

    ParseWhile = (LastErr = 0)

END FUNCTION

'======================================================================
'
'   RenumPatch  -   Penumbers the line number in the current buffer
'                   (pointed by PgmCur) at the specified offset.
'
'   Offset  -   Offset where the line number begins
'
'======================================================================
FUNCTION RenumPatch (Offset AS INTEGER)

    DIM Ok AS INTEGER
    DIM OffsetBegin AS INTEGER
    DIM OffsetEnd AS INTEGER
    DIM j AS INTEGER
    DIM ch AS STRING
    DIM IsNumber AS INTEGER
    DIM LineNumber AS INTEGER
    DIM PTR AS INTEGER
    DIM s1 AS STRING
    DIM s2 AS STRING
    DIM s3 AS STRING
    DIM PgmM AS PGMMEMTYPE

    Ok = TRUE
    OffsetBegin = Offset
    OffsetEnd = PgmCur.Offset
    IsNumber = TRUE

    FOR j = OffsetBegin TO OffsetEnd - 1
        ch = MID$(PgmMemBuf$(PgmCur.PgmPtr), j, 1)
        IF ch = " " THEN
            OffsetBegin = OffsetBegin + 1
        ELSE
            EXIT FOR
        END IF
    NEXT j

    FOR j = OffsetEnd - 1 TO OffsetBegin STEP -1
        ch = MID$(PgmMemBuf$(PgmCur.PgmPtr), j, 1)
        IF ch = " " THEN
            OffsetEnd = OffsetEnd - 1
        ELSE
            EXIT FOR
        END IF

    NEXT j

    FOR j = OffsetBegin TO OffsetEnd - 1
        ch = MID$(PgmMemBuf$(PgmCur.PgmPtr), j, 1)
        SELECT CASE ch
            CASE ".", "0" TO "9"
            CASE ELSE
                IsNumber = FALSE
                EXIT FOR
        END SELECT
    NEXT j

    IF IsNumber THEN
        LineNumber = VAL(MID$(PgmMemBuf$(PgmCur.PgmPtr), OffsetBegin, OffsetEnd - OffsetBegin))
        PTR = PgmMemFind(LineNumber)
        IF PTR <> NILPOINTER THEN
            PgmMemGet PTR, PgmM
            LineNumber = PgmM.Renum
            s1 = LEFT$(PgmMemBuf$(PgmCur.PgmPtr), OffsetBegin - 1)
            s2 = LTRIM$(STR$(LineNumber))
            IF OffsetEnd > PgmMemBufLen(PgmCur.PgmPtr) THEN
                s3 = ""
            ELSE
                s3 = LEFT$(PgmMemBuf$(PgmCur.PgmPtr), PgmMemBufLen(PgmCur.PgmPtr))
                s3 = RIGHT$(s3, PgmMemBufLen(PgmCur.PgmPtr) - OffsetEnd + 1)
            END IF

            PgmMemGet PgmCur.PgmPtr, PgmM
            PgmM.Buffer = s1 + s2 + s3
            PgmM.BufLen = LEN(s1 + s2 + s3)
            PgmMemSet PgmCur.PgmPtr, PgmM
            PgmCur.Offset = LEN(s1) + LEN(s2) + 1
        END IF
    END IF

    IF NOT Ok THEN
        PgmCur.Offset = OffsetEnd
    END IF

    RenumPatch = Ok

END FUNCTION

'======================================================================
'
'   SkipLoopBlock   -   Skips a FOR or WHILE block until the corresponding
'                       NEXT or WEND is reached
'
'======================================================================
FUNCTION SkipLoopBlock

    DIM Ok AS INTEGER

    Ok = TRUE
    LoopCount = 1

    DO WHILE (LoopCount > 0) AND (PgmCur.PgmPtr <> NILPOINTER)

        IF PgmCur.Offset >= PgmMemBufLen(PgmCur.PgmPtr) THEN

            SetPgmCur (PgmMemNext(PgmCur.PgmPtr))

        ELSE

            Ok = ParseBlock(CMDSKIPLOOP)

            IF NOT Ok THEN
                ErrorDisplay (LastErr)
                EXIT DO
            END IF
        END IF
    LOOP

    IF LoopCount > 0 THEN
        ErrorHit (ERRORINVALIDLOOPNESTING)
        Ok = FALSE
    END IF

    SkipLoopBlock = Ok

END FUNCTION




                                    
