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

InterpErrHandler:
    ErrorHit(ERR)
    resume next

'======================================================================
'
'   CloseLoadFile - Closes the file used for LOAD
'
'======================================================================
SUB CloseLoadFile

    IF InterpSrc = DEVFILE THEN
        CLOSE #LOADFILENUMBER
        InterpSrc = DEVCONSOLE
    END IF

END SUB

'======================================================================
'
'   DoKeyTrapping - Handles key trapping if enabled
'
'======================================================================
SUB DoKeyTrapping

    DIM ch AS STRING
    DIM c AS STRING
    DIM KeyNum AS INTEGER

    ch = INKEY$

    IF ch <> "" THEN
        IF ASC(ch) = 0 THEN
            c = MID$(ch, 2, 1)
            IF ASC(c) >= 59 AND ASC(c) <= 68 THEN
                KeyNum = ASC(c) - 59 + 1
                IF KeyTrapTargetGet(KeyNum) <> NILPOINTER THEN
                    IF KeyOnGet(KeyNum) THEN
                        Ok = RetStackPush(PgmCur)
                        IF Ok THEN
                            SetPgmCur (KeyTrapTargetGet(KeyNum))
                        END IF
                    END IF
                END IF
            ELSE
                InKeyBufSet LEFT$(InKeyBufGet$, InKeyChars) + ch
                InKeyChars = InKeyChars + LEN(ch)
            END IF
        ELSE
            InKeyBufSet LEFT$(InKeyBufGet$, InKeyChars) + ch
            InKeyChars = InKeyChars + LEN(ch)
        END IF
    END IF

END SUB

'======================================================================
'
'   DoTimerTrapping - Handles timer trapping if enabled
'
'======================================================================
SUB DoTimerTrapping

    DIM Ok AS INTEGER
    DIM Seconds AS LONG

    Seconds = TIMER

    IF (Seconds - TimerStamp) >= TimerInterval THEN
        Ok = RetStackPush(PgmCur)
        IF Ok THEN
            SetPgmCur (TimerTrapTarget)
            TimerStamp = TIMER
        END IF
    END IF

END SUB

'======================================================================
'
'   ErrorDisplay - Displays an error
'
'   Code         -   Error code
'
'======================================================================
SUB ErrorDisplay (Code AS INTEGER)

    DIM s AS STRING

    s = ""

    IF LastErl <> 0 THEN
        s = "Error in line " + STR$(LastErl) + ": "
    END IF

    s = s + ErrorText$(Code)

    PRINT s

END SUB

'======================================================================
'
'   ErrorHit    -   Sets error globals
'
'   Code    -   Error code
'
'======================================================================
SUB ErrorHit (Code AS INTEGER)

    DIM PgmLoc AS PGMLOCTYPE
    DIM Ok AS INTEGER

    LastErr = Code
    LastErt = ErrorText$(Code)
    IF (PgmCur.PgmPtr <> NILPOINTER) AND (PgmCur.PgmPtr <> PgmMemImm) THEN
        IF PgmMemLineNum(PgmCur.PgmPtr) > 0 THEN
            LastErl = PgmMemLineNum(PgmCur.PgmPtr)
        END IF
    END IF

    IF ErrTrapEnabled THEN
        PgmLoc = PgmCur
        PgmLoc.Offset = StmtCur
        ErrTrapEnabled = FALSE
        Ok = RetStackPush(PgmLoc)
        ErrTrapEnabled = TRUE
        IF Ok THEN
            SetPgmCur (ErrTrapTarget)
        ELSE
            ErrTrapEnabled = FALSE
            ErrorHit (ERRORINTERNAL)
        END IF
    END IF

END SUB

'======================================================================
'
'   ErrorText - Returns the text of a given error code
'
'   Code  =  error code
'
'   Returns the text corresponding to the error code
'
'======================================================================
FUNCTION ErrorText$ (Code AS INTEGER)

    DIM s AS STRING

    SELECT CASE Code
        CASE ERRORINTERNAL
            s = "Internal error"
        CASE ERRORNOMEMORY
            s = "Out of memory"
        CASE ERRORINVALIDMEMACCESS
            s = "Invalid memory access"
        CASE ERRORINVALIDSUBSCRIPT
            s = "Invalid subscript"
        CASE ERRORSUBSCRIPTOUTOFRANGE
            s = "Subscript out of range"
        CASE ERRORSYNTAX
            s = "Syntax error"
        CASE ERRORTYPEMISMATCH
            s = "Type mismatch"
        CASE ERRORUNDEFINEDSYMBOL
            s = "Undefined symbol"
        CASE ERRORLABELNOTFOUND
            s = "Label not found"
        CASE ERRORINVALIDINCREMENT
            s = "Invalid increment value"
        CASE ERRORINVALIDLOOPNESTING
            s = "Invalid loop nesting"
        CASE ERRORINVALIDKEYNUMBER
            s = "Invalid key number"
        CASE ERRORKEYTRAPPINGNOTENABLED
            s = "Key trapping not enabled for specified key"
        CASE ERRORINVALIDFILENUMBER
            s = "Bad file number"
        CASE ERRORFILENOTOPEN
            s = "File not open"
        CASE ERRORINVALIDACCESS
            s = "Invalid operation for file access"
        CASE ERRORTOOMANYINPUT
            s = "Too many variables in input list"
        CASE ERRORINVALIDCOORDINATE
            s = "Invalid coordinate"
        CASE ERRORMAXFIELDS
            s = "Too many fields in a record"
        CASE ERRORBADRECORDLEN
            s = "Bad record length"
        CASE ERRORTOOMANYRECORDS
            s = "Too many records in a file"
        CASE ERRORTOOMANYFIELDS
            s = "Too many fields in a record"
        CASE ERRORBADNUMARG
            s = "Bad number of arguments in function call"
        CASE ERRORSTACKOVERFLOW
            s = "Stack overflow"
        CASE ERRORSTACKEMPTY
            s = "Stack empty"
        CASE ERRORNOMOREDATA
            s = "No more data"
        CASE ERRORNOTIMERTRAP
            s = "TIMER ON without previous ON TIMER"
        CASE ERRORSYMBOLDEFINED
            s = "Symbol already defined"
        CASE ERRORFORNONEXT
            s = "FOR without NEXT"
        CASE ERRORWHILENOWEND
            s = "WHILE without WEND"
        CASE ERRORCANNOTCONT
            s = "Cannot continue"
        CASE ELSE
            s = "Unknown error"
    END SELECT

    s = s + " (Error code " + STR$(Code) + ")"

    ErrorText$ = s
END FUNCTION


'======================================================================
'
'   ListPgm -   Lists a program
'
'   FirstLine   -   First line to list
'   LastLine    -   Last line to list
'
'   All lines in PgmMem >= FistLine and <= LastLine are listed
'
'======================================================================
SUB ListPgm (Dev AS INTEGER, FirstLine AS INTEGER, LastLine AS INTEGER)

    DIM PTR AS INTEGER
    DIM PrevPtr AS INTEGER
    DIM s AS STRING

    PTR = PgmMemFindPos(FirstLine, PrevPtr)

    DO WHILE PTR <> NILPOINTER

        IF PgmMemLineNum(PTR) > LastLine THEN
            EXIT DO
        END IF

        s = LTRIM$(STR$(PgmMemLineNum(PTR))) + " " + PgmMemBuf$(PTR)

        IF Dev = DEVCONSOLE THEN
            PRINT s
        ELSE
            PRINT #SAVEFILENUMBER, s
        END IF

        PTR = PgmMemNext(PTR)
    LOOP

END SUB

'======================================================================
'
'   LoadBrkData -   Re-establishes the data previously saved by
'                   BreakPoint
'
'======================================================================
SUB LoadBrkData
    PgmCur = BrkSaveData.Lc
    ErrTrapEnabled = BrkSaveData.ErrTrapEnabled
    TimerTrapEnabled = BrkSaveData.TimerTrapEnabled
    KeyTrapEnabled = BrkSaveData.KeyTrapEnabled
END SUB

'======================================================================
'
'   SetPgmCur   -   Sets PgmCur to point to the beginning of the buffer
'                   in the PgmMem location indicated by the PgmPtr
'                   argument
'
'======================================================================
SUB SetPgmCur (PgmPtr AS INTEGER)

    PgmCur.PgmPtr = PgmPtr
    PgmCur.Offset = 1
    StmtCur = 1

    IF TraceOn AND (PgmPtr <> NILPOINTER) AND (PgmPtr <> PgmMemImm) THEN
        PRINT "   Trace: "; STR$(PgmMemLineNum(PgmCur.PgmPtr)); " "; PgmMemBuf$(PgmCur.PgmPtr)
    END IF

END SUB

'======================================================================
'
'   SymbolToDataType    -   Returns the data type corresponding to a
'                           given symbol name.
'
'   If the symbol ends with:    The type is:
'   !                           Real
'   $                           String
'   %                           Integer
'   Anything else               Integer
'
'======================================================================
FUNCTION SymbolToDataType% (Symbol AS STRING)

    SELECT CASE RIGHT$(RTRIM$(Symbol), 1)
        CASE "!"
            SymbolToDataType% = TYPEREAL
        CASE "$"
            SymbolToDataType% = TYPESTR
        CASE ELSE
            SymbolToDataType% = TYPEINT
    END SELECT
END FUNCTION

'======================================================================
'
'   LexAdvance  -   Advances the Lex offset a certain number of characters
'
'   Count   -   Number of characters to advance
'
'======================================================================
SUB LexAdvance (Count AS INTEGER)
    PgmCur.Offset = PgmCur.Offset + Count
END SUB

'======================================================================
'
'   LexAlpha    -   Lexes an alphanumeric token
'
'======================================================================
SUB LexAlpha

    DIM Count AS INTEGER

    Count = 0

    DO WHILE (PgmCur.Offset + Count) <= PgmMemBufLen(PgmCur.PgmPtr)

        SELECT CASE LexLookAhead$(Count)
            CASE "A" TO "Z", "0" TO "9", "."
                Count = Count + 1
            CASE "$", "%", "!"
                Count = Count + 1
                EXIT DO
            CASE ELSE
                EXIT DO
        END SELECT
    LOOP

    IF NOT LexError THEN
        LexSymbol (MID$(PgmMemBuf$(PgmCur.PgmPtr), PgmCur.Offset, Count))
        LexAdvance (Count)
    END IF

END SUB

'======================================================================
'
'   LexGetInputToken    -   Gets a token for INPUT statement
'
'   Returns Token
'
'======================================================================
FUNCTION LexGetInputToken

    LexSkipBlanks
    LexToken.Tkn = TOKENUNKNOWN
    LexToken.TokenBegin = PgmCur.Offset

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

        LexToken.Tkn = TOKENEOL

    ELSE

        SELECT CASE LexLookAhead$(0)
            CASE CHR$(34)
                LexLiteral
            CASE "0" TO "9"
                LexNumeric
                LexSkipBlanks
                IF PgmCur.Offset <= PgmMemBufLen(PgmCur.PgmPtr) THEN
                    IF LexLookAhead$(0) <> "," THEN
                        GOTO NotNumber
                    END IF
                END IF
            CASE ELSE
NotNumber:
                DO WHILE PgmCur.Offset <= PgmMemBufLen(PgmCur.PgmPtr)
                    SELECT CASE LexLookAhead$(0)
                        CASE ","
                            EXIT DO
                        CASE ELSE
                            PgmCur.Offset = PgmCur.Offset + 1
                    END SELECT
                LOOP

                LexToken.Tkn = TOKENCONSTANT
                LexToken.Value.DataType = TYPESTR
                LexToken.Value.ValueStr.StrBuf = LexTokenStr$
                LexToken.Value.ValueStr.StrLen = LEN(LexTokenStr$)
        END SELECT
    END IF

    LexGetInputToken = LexToken.Tkn

END FUNCTION

'======================================================================
'
'   LexGetToken -   Gets next token
'
'   Returns token
'
'======================================================================
FUNCTION LexGetToken

    DIM Value AS VALUETYPE

    LexSkipBlanks
    LexToken.TokenBegin = PgmCur.Offset

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

        LexToken.Tkn = TOKENEOL

    ELSE

        LexToken.Tkn = TOKENUNKNOWN

        SELECT CASE LexLookAhead$(0)
            CASE CHR$(34)
                LexLiteral
            CASE "=", "<", ">"
                LexRelop
            CASE "0" TO "9"
                LexNumeric
            CASE "A" TO "Z"
                LexAlpha
            CASE "'"
                LexAdvance (1)
                LexSetToken TOKENREM, Value
            CASE "("
                LexAdvance (1)
                LexSetToken TOKENOPENPAREN, Value
            CASE ")"
                LexAdvance (1)
                LexSetToken TOKENCLOSEPAREN, Value
            CASE "+"
                LexAdvance (1)
                LexSetToken TOKENPLUS, Value
            CASE "-"
                LexAdvance (1)
                LexSetToken TOKENMINUS, Value
            CASE "*"
                LexAdvance (1)
                LexSetToken TOKENSTAR, Value
            CASE "/"
                LexAdvance (1)
                LexSetToken TOKENSLASH, Value
            CASE "\"
                LexAdvance (1)
                LexSetToken TOKENBSLASH, Value
            CASE "^"
                LexAdvance (1)
                LexSetToken TOKENCARET, Value
            CASE ","
                LexAdvance (1)
                LexSetToken TOKENCOMMA, Value
            CASE ";"
                LexAdvance (1)
                LexSetToken TOKENSEMICOLON, Value
            CASE ":"
                LexAdvance (1)
                LexSetToken TOKENSEP, Value
            CASE "#"
                LexAdvance (1)
                LexSetToken TOKENPOUND, Value
            CASE ELSE
                LexAdvance (1)
                LexSetToken TOKENUNKNOWN, Value
        END SELECT
    END IF

    LexGetToken = LexToken.Tkn

END FUNCTION

'======================================================================
'
'   LexLiteral  -   Lexes a quoted literal
'
'======================================================================
SUB LexLiteral

    DIM Count AS INTEGER
    DIM Value AS VALUETYPE

    IF LexLookAhead(0) <> CHR$(34) THEN
        ErrorHit (ERRORINTERNAL)
    END IF

    Count = 1

    DO
        IF (PgmCur.Offset + Count) > PgmMemBufLen(PgmCur.PgmPtr) THEN
            ErrorHit (ERRORSYNTAX)
            EXIT DO
        END IF

        IF LexLookAhead(Count) = CHR$(34) THEN

            Value.DataType = TYPESTR
            Value.ValueStr.StrLen = Count - 1
            Value.ValueStr.StrBuf = MID$(PgmMemBuf$(PgmCur.PgmPtr), PgmCur.Offset + 1, Count - 1)

            LexSetToken TOKENCONSTANT, Value

            PgmCur.Offset = PgmCur.Offset + Count + 1
            EXIT DO

        END IF

        Count = Count + 1

    LOOP

END SUB

'======================================================================
'
'   LexLookAhead$   -   Returns the character Count positions ahead of
'                       the lex offset.
'
'   Count   -   Number of positions after the current offset
'
'   Returns character or "" if end of buffer
'
'======================================================================
FUNCTION LexLookAhead$ (Count AS INTEGER)

    DIM Offset AS INTEGER

    Offset = PgmCur.Offset + Count

    IF Offset > PgmMemBufLen(PgmCur.PgmPtr) THEN
        LexLookAhead$ = ""
    ELSE
        LexLookAhead$ = MID$(PgmMemBuf$(PgmCur.PgmPtr), Offset, 1)
    END IF

END FUNCTION

'======================================================================
'
'   LexNumeric  -   Lexes a numeric token
'
'   Returns token
'
'======================================================================
SUB LexNumeric

    DIM Value AS VALUETYPE
    DIM Decimal AS INTEGER
    DIM Count AS INTEGER

    Decimal = FALSE
    Count = 0

    DO WHILE (PgmCur.Offset + Count) <= PgmMemBufLen(PgmCur.PgmPtr)

        SELECT CASE LexLookAhead$(Count)
            CASE "0" TO "9"
                Count = Count + 1
            CASE "A" TO "Z"
                ErrorHit (ERRORSYNTAX)
                LexError = TRUE
                EXIT DO
            CASE "."
                IF Decimal THEN
                    ErrorHit (ERRORSYNTAX)
                    LexError = TRUE
                    EXIT DO
                ELSE
                    Count = Count + 1
                    Decimal = TRUE
                END IF
            CASE ELSE
                EXIT DO
        END SELECT
    LOOP

    IF NOT LexError THEN

        IF Decimal THEN
            Value.DataType = TYPEREAL
            Value.ValueReal = VAL(MID$(PgmMemBuf$(PgmCur.PgmPtr), PgmCur.Offset, Count))
        ELSE
            Value.DataType = TYPEINT
            Value.ValueInt = VAL(MID$(PgmMemBuf$(PgmCur.PgmPtr), PgmCur.Offset, Count))
        END IF

        LexAdvance (Count)
        LexSetToken TOKENCONSTANT, Value
    END IF

END SUB

'======================================================================
'
'   LexPreLex   -   Prepares a buffer for lexing: uppercases everything
'                   not in quotes and reduces all blank space to a single
'                   space.
'
'======================================================================
SUB LexPreLex

    DIM ch AS STRING
    DIM InQuotes AS INTEGER
    DIM InBlanks AS INTEGER
    DIM j AS INTEGER
    DIM BufIn AS STRING
    DIM BufOut AS STRING
    DIM PgmM AS PGMMEMTYPE


    BufIn = PgmMemBuf$(PgmCur.PgmPtr)
    BufOut = ""
    InQuotes = FALSE
    InBlanks = FALSE

    FOR j = 1 TO LEN(BufIn)
        ch = MID$(BufIn, j, 1)

        IF ch = CHR$(13) THEN
            EXIT FOR
        END IF

        IF ((ch = "'") AND NOT InQuotes) THEN
            BufOut = BufOut + RIGHT$(BufIn, LEN(BufIn) - j + 1)
            EXIT FOR
        END IF

        IF ch = CHR$(34) THEN
            InQuotes = NOT InQuotes
        END IF

        IF InQuotes THEN

            BufOut = BufOut + ch

        ELSE

            IF ch = CHR$(32) OR ch = CHR$(9) THEN

                IF NOT InBlanks THEN
                    InBlanks = TRUE
                    BufOut = BufOut + " "
                END IF

            ELSE

                InBlanks = FALSE

                IF ch >= "a" AND ch <= "z" THEN
                    ch = UCASE$(ch)
                END IF

                BufOut = BufOut + ch
            END IF
        END IF
    NEXT j

    PgmMemGet PgmCur.PgmPtr, PgmM
    PgmM.Buffer = BufOut
    PgmM.BufLen = LEN(BufOut) - 1
    PgmMemSet PgmCur.PgmPtr, PgmM
    PgmCur.Offset = 1

END SUB

'======================================================================
'
'   LexRelop    -   Lexes a relational operator
'
'======================================================================
SUB LexRelop

    DIM Value AS VALUETYPE

    SELECT CASE LexLookAhead$(0)

        CASE "="
            LexAdvance (1)
            LexSetToken TOKENEQ, Value
        CASE ">"
            SELECT CASE LexLookAhead$(1)
                CASE "="
                    LexAdvance (2)
                    LexSetToken TOKENGEQ, Value
                CASE ELSE
                    LexAdvance (1)
                    LexSetToken TOKENGT, Value
            END SELECT
        CASE "<"
            SELECT CASE LexLookAhead$(1)
                CASE "="
                    LexAdvance (2)
                    LexSetToken TOKENLEQ, Value
                CASE ">"
                    LexAdvance (2)
                    LexSetToken TOKENNEQ, Value
                CASE ELSE
                    LexAdvance (1)
                    LexSetToken TOKENLT, Value
            END SELECT
        CASE ELSE
            ErrorHit (ERRORINTERNAL)
            LexError = TRUE
    END SELECT

END SUB

'======================================================================
'
'   LexSetToken -   Sets the global token variable
'
'   Tkn     -   Token
'   Value   -   Token value
'
'======================================================================
SUB LexSetToken (Tkn AS INTEGER, Value AS VALUETYPE)
    LexToken.Tkn = Tkn
    LexToken.Value = Value
END SUB

'======================================================================
'
'   LexSkipBlanks   -   Skips blanks
'
'======================================================================
SUB LexSkipBlanks

    DO WHILE PgmCur.Offset < PgmMemBufLen(PgmCur.PgmPtr)

        IF LexLookAhead$(0) <> " " THEN
            EXIT DO
        END IF

        PgmCur.Offset = PgmCur.Offset + 1

    LOOP

END SUB

'======================================================================
'
'   LexSymbol   -   Lexes a symbol
'
'======================================================================
SUB LexSymbol (Symbol AS STRING)

    DIM Value AS VALUETYPE
    DIM PTR AS INTEGER
    DIM SymData AS SYMTABTYPE

    PTR = SymTabFind(Symbol)

    IF PTR = NILPOINTER THEN

        SELECT CASE RIGHT$(Symbol, 1)
            CASE "$"
                Value.DataType = TYPESTR
            CASE "!"
                Value.DataType = TYPEREAL
            CASE ELSE
                Value.DataType = TYPEINT
        END SELECT

        LexSetToken TOKENVARIABLE, Value

    ELSE

        SymTabEntry PTR, SymData
        Value.DataType = SymData.DataType
        LexSetToken SymData.SymbolType, Value

    END IF

END SUB

'======================================================================
'
'   LexTokenStr$    -   returns the string in the buffer for the
'                       current token
'
'======================================================================
FUNCTION LexTokenStr$
    LexTokenStr$ = MID$(PgmMemBuf$(PgmCur.PgmPtr), LexToken.TokenBegin, PgmCur.Offset - LexToken.TokenBegin)
END FUNCTION

'======================================================================
'
'   LexUngetToken   -   "Ungets" the current token. I.e. the current
'                       offset is set to the starting offset of the
'                       current token. The next LexGetToken will
'                       return the current token again.
'
'======================================================================
SUB LexUngetToken
    PgmCur.Offset = LexToken.TokenBegin
END SUB

'======================================================================
'
'   InterpBrk   -   Interprets BRK and CBRK commands
'
'======================================================================
SUB InterpBrk (Tkn AS INTEGER)

    DIM LineNum AS INTEGER
    DIM PTR AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    IF ParseIntExp(CMDINTERPRET, LineNum) THEN

        PTR = PgmMemFind(LineNum)

        IF PTR <> NILPOINTER THEN
            PgmMemGet PTR, PgmM
            IF Tkn = TOKENBRK THEN
                PgmM.Flags = (PgmM.Flags OR PGMFLAGBRK)
            ELSE
                PgmM.Flags = (PgmM.Flags AND (NOT PGMFLAGBRK))
            END IF
            PgmMemSet PTR, PgmM
            EXIT SUB
        ELSE
            ErrorDisplay (ERRORLABELNOTFOUND)
        END IF
    ELSE
        IF Tkn = TOKENBRK THEN
            ErrorDisplay (ERRORSYNTAX)
            EXIT SUB
        END IF
    END IF

    PTR = PgmMemProgram
    DO WHILE PTR <> NILPOINTER
        PgmMemGet PTR, PgmM
        PgmM.Flags = (PgmM.Flags AND (NOT PGMFLAGBRK))
        PgmMemSet PTR, PgmM
        PTR = PgmM.NextPtr
    LOOP

END SUB


'======================================================================
'
'   InterpDebug -   Interprets DEBUG command
'
'======================================================================
SUB InterpDebug

END SUB

'======================================================================
'
'   InterpDump  -   Interprets DUMP command
'
'======================================================================
SUB InterpDump

    DIM TknObject AS INTEGER
    DIM Ok AS INTEGER
    DIM FileName AS STRING
    DIM FileNum AS INTEGER

    Ok = TRUE
    FileName = ""

    SELECT CASE LexGetToken
        CASE TOKENSYM, TOKENMEM, TOKENSYS
            TknObject = LexToken.Tkn
        CASE ELSE
            TknObject = 0
            LexUngetToken
    END SELECT

    IF LexGetToken = TOKENTO THEN
        Ok = ParseStrExp(CMDINTERPRET, FileName)
    ELSEIF LexToken.Tkn <> TOKENEOL THEN
        ErrorHit (ERRORSYNTAX)
        Ok = FALSE
    END IF

    IF Ok THEN

        IF FileName = "" THEN
           FileName = "CONS:"
        END IF

        OPEN FileName FOR OUTPUT AS #DUMPFILENUMBER
        IF LastErr = 0 THEN
            FileNum = DUMPFILENUMBER
        ELSE
            ErrorDisplay (LastErr)
        END IF

        IF Ok THEN
            SELECT CASE TknObject
                CASE TOKENSYM
                    SymTabDump (FileNum)
                CASE TOKENMEM
                    MemDump (FileNum)
                CASE TOKENSYS
                    SysDump (FileNum)
                CASE 0
                    SymTabDump (FileNum)
                    MemDump (FileNum)
                    SysDump (FileNum)
                CASE ELSE
                    ErrorDisplay (ERRORSYNTAX)
                    Ok = FALSE
            END SELECT

            CLOSE #FileNum
        END IF
    END IF
END SUB

'======================================================================
'
'   InterpGetLine   -   Gets a line for the interpreter to execute
'
'   The resulting line is always in the PgmMem entry pointed by
'   PgmMemImm
'
'======================================================================
SUB InterpGetLine

    DIM s AS STRING
    DIM PgmM AS PGMMEMTYPE

    PgmM.Flags = 0
    PgmM.Offset = 0
    PgmM.Buffer = ""
    PgmM.BufLen = 0

    IF InterpSrc = DEVFILE THEN
        IF (LastErr <> 0) OR EOF(LOADFILENUMBER) THEN
            CLOSE #LOADFILENUMBER
            InterpSrc = DEVCONSOLE
        ELSE
            LINE INPUT #LOADFILENUMBER, s
            PgmM.Buffer = s
            PgmM.BufLen = LEN(s) + 1
            ' PRINT "  < "; s
            PgmMemSet PgmMemImm, PgmM
            LexPreLex
        END IF
    END IF

    IF InterpSrc = DEVCONSOLE THEN
        PRINT "READY"

        SetPgmCur (PgmMemImm)

        LINE INPUT s
        PgmM.Buffer = s
        PgmM.BufLen = LEN(s) + 1
        PgmMemSet PgmMemImm, PgmM
        LexPreLex
    END IF

END SUB

'======================================================================
'
'   InterpLine  -   Executed when the user enters a positive integer
'                   at the beginning of a line. It is assumed that
'                   this number is a line number.
'
'======================================================================
SUB InterpLine

    DIM LineNumber AS INTEGER
    DIM AddLine AS INTEGER
    DIM PTR AS INTEGER
    DIM BufLen AS INTEGER
    DIM Buffer AS STRING
    DIM Offset AS INTEGER
    DIM Ok AS INTEGER
    DIM PgmM AS PGMMEMTYPE
    DIM PgmMCur AS PGMMEMTYPE

    Ok = TRUE

    LineNumber = LexToken.Value.ValueInt

    LexSkipBlanks

    IF LexLookAhead$(0) = "" THEN
        AddLine = FALSE
    ELSE
        AddLine = TRUE
        Offset = PgmCur.Offset
    END IF

    IF AddLine THEN
        IF NOT ParseBlock(CMDPARSE) THEN
            CloseLoadFile
            Ok = FALSE
        END IF
    END IF

    IF Ok THEN
        PTR = PgmMemFind(LineNumber)

        IF PTR = NILPOINTER THEN

            IF AddLine THEN
                PTR = PgmMemAlloc
                IF PTR <> NILPOINTER THEN
                    PgmMemGet PgmCur.PgmPtr, PgmMCur
                    PgmM.LineNumber = LineNumber
                    BufLen = PgmMCur.BufLen - Offset + 1
                    Buffer = MID$(PgmMCur.Buffer, Offset, BufLen)
                    PgmM.BufLen = BufLen
                    PgmM.Buffer = Buffer
                    PgmM.Flags = PgmMCur.Flags
                    PgmM.Offset = PgmMCur.Offset
                    PgmMemSet PTR, PgmM
                    PgmMemInsert (PTR)
                END IF
            END IF

        ELSE
            IF BrkSaveData.Lc.PgmPtr = PTR THEN
                BrkSaveData.Lc.PgmPtr = NILPOINTER
            END IF
            IF AddLine THEN
                PgmMemGet PTR, PgmM
                PgmMemGet PgmCur.PgmPtr, PgmMCur
                BufLen = PgmMCur.BufLen - Offset + 1
                Buffer = MID$(PgmMCur.Buffer, Offset, BufLen)
                PgmM.BufLen = BufLen
                PgmM.Buffer = Buffer
                PgmM.Flags = PgmMCur.Flags
                PgmM.Offset = PgmMCur.Offset
                PgmMemSet PTR, PgmM
            ELSE
                PgmMemDelete (PTR)
            END IF
        END IF
    END IF
END SUB

'======================================================================
'
'   InterpList  -   Interprets LIST command
'
'======================================================================
SUB InterpList

    DIM FirstLine AS INTEGER
    DIM LastLine AS INTEGER

    FirstLine = -1
    LastLine = 32767

    SELECT CASE LexGetToken
        CASE TOKENCONSTANT
            IF (LexToken.Value.DataType = TYPEINT) AND (LexToken.Value.ValueInt > 0) THEN
                FirstLine = LexToken.Value.ValueInt
            ELSE
                ErrorDisplay (ERRORSYNTAX)
            END IF

            SELECT CASE LexGetToken
                CASE TOKENMINUS
                    SELECT CASE LexGetToken
                        CASE TOKENCONSTANT
                            IF (LexToken.Value.DataType = TYPEINT) AND (LexToken.Value.ValueInt > 0) THEN
                                LastLine = LexToken.Value.ValueInt
                            ELSE
                                ErrorDisplay (ERRORSYNTAX)
                            END IF
                        CASE ELSE
                            ErrorDisplay (ERRORSYNTAX)
                    END SELECT
                CASE TOKENEOL
                    LastLine = FirstLine
                CASE ELSE
                    ErrorDisplay (ERRORSYNTAX)
            END SELECT
        CASE TOKENEOL
        CASE ELSE
            ErrorDisplay (ERRORSYNTAX)
    END SELECT

    IF FirstLine <= LastLine THEN
        ListPgm DEVCONSOLE, FirstLine, LastLine
    END IF

END SUB

'======================================================================
'
'   InterpLoad  -   Interprets LOAD command
'
'======================================================================
SUB InterpLoad

    DIM Path AS STRING

    on error goto InterpErrHandler

    IF LexGetToken <> TOKENCONSTANT THEN
        ErrorDisplay (ERRORSYNTAX)
    ELSEIF LexToken.Value.DataType <> TYPESTR THEN
        ErrorDisplay (ERRORSYNTAX)
    ELSE
        Path = LEFT$(LexToken.Value.ValueStr.StrBuf, LexToken.Value.ValueStr.StrLen)
        OPEN Path FOR INPUT AS #LOADFILENUMBER
        IF LastErr = 0 THEN
            Init (INITNEW)
            InterpSrc = DEVFILE
        ELSE
            ErrorDisplay (LastErr)
        END IF
    END IF

END SUB

'======================================================================
'
'   InterpNew   -   Interprets NEW command
'
'======================================================================
SUB InterpNew
    Init (INITNEW)
END SUB

'======================================================================
'
'   InterpRenum -   Interprets RENUM command
'
'======================================================================
SUB InterpRenum

    DIM Ok AS INTEGER
    DIM Increment AS INTEGER
    DIM LineNum AS INTEGER
    DIM PTR AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    Ok = TRUE

    Init(INITCLEAR)

    IF LexGetToken = TOKENEOL THEN
        Increment = 10
    ELSE
        LexUngetToken
        Ok = ParseIntExp(CMDINTERPRET, Increment)
    END IF

    '
    '   Pass 1: Assign new line numbers
    '
    LineNum = Increment
    IF LineNum > 0 THEN
        PTR = PgmMemProgram
        DO WHILE (PTR <> NILPOINTER)
            PgmMemGet PTR, PgmM
            PgmM.Renum = LineNum
            PgmMemSet PTR, PgmM
            PTR = PgmM.NextPtr
            LineNum = LineNum + Increment
        LOOP
    ELSE
        ErrorHit (ERRORINVALIDINCREMENT)
        Ok = FALSE
    END IF
    '
    '   Pass 2: Patch line references in program
    '
    SetPgmCur (PgmMemProgram)
    DO WHILE Ok AND (PgmCur.PgmPtr <> NILPOINTER)
        IF PgmCur.Offset >= PgmMemBufLen(PgmCur.PgmPtr) THEN
            SetPgmCur (PgmMemNext(PgmCur.PgmPtr))
        ELSE
            Ok = ParseBlock(CMDRENUM)
        END IF
    LOOP
    '
    '   Pass 3: Renumber lines
    '
    PTR = PgmMemProgram
    DO WHILE Ok AND (PTR <> NILPOINTER)
        PgmMemGet PTR, PgmM
        PgmM.LineNumber = PgmM.Renum
        PgmMemSet PTR, PgmM
        PTR = PgmM.NextPtr
    LOOP

    IF NOT Ok THEN
        ErrorDisplay (LastErr)
    END IF

END SUB

'======================================================================
'
'   Interpreter -   The ChaBasic interpreter
'
'======================================================================
SUB Interpreter

    DIM LoopData AS LOOPSTKTYPE

    Init (INITNEW)
    InterpSrc = DEVCONSOLE
    SetPgmCur (PgmMemImm)

    CLS
    PRINT MyName + " V" + LTRIM$(STR$(MyVersionMajor)) + "." + LTRIM$(STR$(MyVersionMinor)) + "." + LTRIM$(STR$(MyVersionRev)) + " (" + MySource + ")"
    PRINT "Copyright (C) 1999 " + MyAuthor + "   ( " + MyWeb + " )"
    PRINT

    DO
        InterpGetLine
        LastErr = 0

        SELECT CASE LexGetToken

            CASE TOKENBYE
                EXIT DO
            CASE TOKENDEBUG
                InterpDebug
            CASE TOKENDUMP
                InterpDump
            CASE TOKENLIST
                InterpList
            CASE TOKENLOAD
                InterpLoad
            CASE TOKENNEW
                InterpNew
            CASE TOKENRENUM
                InterpRenum
            CASE TOKENRUN
                InterpRun (RUNSTART)
            CASE TOKENSAVE
                InterpSave
            CASE TOKENTRACE
                InterpTrace
            CASE TOKENBRK, TOKENCBRK
                InterpBrk (LexToken.Tkn)
            CASE TOKENCONT
                InterpRun (RUNCONT)
            CASE TOKENCONSTANT
                IF LexToken.Value.DataType = TYPEINT THEN
                    IF LexToken.Value.ValueInt > 0 THEN
                        InterpLine
                        IF LastErr <> 0 THEN
                            ErrorDisplay (LastErr)
                        END IF
                    ELSE
                        ErrorDisplay (ERRORSYNTAX)
                    END IF
                ELSE
                    ErrorDisplay (ERRORSYNTAX)
                END IF
            CASE TOKENEOL
            CASE ELSE
                IF LexError THEN
                    ErrorDisplay (LastErr)
                ELSE
                    LexUngetToken
                    IF ParseBlock(CMDINTERPRET) THEN
                        IF LoopStackTopData(LoopData) THEN
                            SELECT CASE LoopData.LoopKind
                                CASE LOOPKINDFOR
                                    ErrorDisplay (ERRORFORNONEXT)
                                CASE LOOPKINDWHILE
                                    ErrorDisplay (ERRORWHILENOWEND)
                            END SELECT
                        END IF
                        Init (INITRUN)
                    ELSE
                        ErrorDisplay (LastErr)
                    END IF
                END IF
        END SELECT
    LOOP
END SUB

'======================================================================
'
'   InterpRun   -   Interprets RUN command
'
'======================================================================
SUB InterpRun (Flag AS INTEGER)

    DIM Ok AS INTEGER
    DIM j AS INTEGER
    DIM Brk AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    Brk = FALSE

    IF Flag = RUNSTART THEN
        Init (INITRUN)
        SetPgmCur (PgmMemProgram)
    ELSE
        IF BrkSaveData.Lc.PgmPtr = NILPOINTER THEN
            ErrorDisplay (ERRORCANNOTCONT)
            EXIT SUB
        ELSE
            LoadBrkData
            BrkSaveData.Lc.PgmPtr = NILPOINTER
        END IF
    END IF

    DO WHILE PgmCur.PgmPtr <> NILPOINTER

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

            SetPgmCur (PgmMemNext(PgmCur.PgmPtr))

            IF PgmCur.PgmPtr <> NILPOINTER THEN

                PgmMemGet PgmCur.PgmPtr, PgmM

                IF (PgmM.Flags AND PGMFLAGBRK) THEN
                    BreakPoint ("Breakpoint")
                    EXIT DO
                END IF
            END IF

        ELSE

            Ok = ParseBlock(CMDINTERPRET)

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

    IF BrkSaveData.Lc.PgmPtr = NILPOINTER THEN
        Init (INITRUN)
    END IF

END SUB

'======================================================================
'
'   InterpSave  -   Interprets SAVE command
'
'======================================================================
SUB InterpSave

    DIM Path AS STRING

    on error goto InterpErrHandler

    IF LexGetToken <> TOKENCONSTANT THEN
        ErrorDisplay (ERRORSYNTAX)
    ELSEIF LexToken.Value.DataType <> TYPESTR THEN
        ErrorDisplay (ERRORSYNTAX)
    ELSE
        Path = LEFT$(LexToken.Value.ValueStr.StrBuf, LexToken.Value.ValueStr.StrLen)
        OPEN Path FOR OUTPUT AS #SAVEFILENUMBER
        IF ERR = 0 THEN
            ListPgm DEVFILE, 0, 32767
            CLOSE #SAVEFILENUMBER
        ELSE
            ErrorDisplay (ERR)
        END IF
    END IF

END SUB

'======================================================================
'
'   InterpretTrace  -   Interprets TRACE command
'
'======================================================================
SUB InterpTrace

    SELECT CASE LexGetToken
        CASE TOKENON
            TraceOn = TRUE
        CASE TOKENOFF
            TraceOn = FALSE
        CASE ELSE
            ErrorDisplay (ERRORSYNTAX)
    END SELECT
END SUB











                                  
