'======================================================================
'   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'
clear ,, 24000

'======================================================================
'
'   ChaBasic structures
'
'======================================================================
'$DYNAMIC
'
'   Function stack
'
DIM SHARED FuncStack(MAXSTACKFUNC) AS FUNCSTKTYPE   '   Function stack
DIM SHARED FuncStackTop AS INTEGER                  '   Top of stack
DIM SHARED ArgMem(MAXMEMARG) AS VALUETYPE       '   Argument memory
DIM SHARED ArgMemFree AS INTEGER                '   Free ArgMem starts here
'
'   Key trapping
'
DIM SHARED KeyTrapTarget(LASTKEY) AS INTEGER    '   Line number
DIM SHARED KeyOn(LASTKEY) AS INTEGER            '   Key(j) is on
'
'   INKEY$ support
'
DIM SHARED InKeyBuffer AS STRING * INKEYBUFLEN  '   INKEY$ Buffer
'
'   Factor stack
'
DIM SHARED FactorStack(MAXSTACKFACTOR) AS VALUETYPE '   Factor stack
DIM SHARED FactorStackTop AS INTEGER                '   Top of stack
'
'   Return stack
'
DIM SHARED RetStack(MAXSTACKRET) AS PGMLOCTYPE  '   Return Stack
DIM SHARED RetStackTop AS INTEGER               '   Top of stack
'
'   Loop stack
'
DIM SHARED LoopStack(MAXSTACKLOOP) AS LOOPSTKTYPE       '   Loop stack
DIM SHARED LoopStackTop AS INTEGER                      '   Top of stack
'
'   File table
'
DIM SHARED FieldTable(MAXFIELDS) AS FIELDTYPE   '   Field table
DIM SHARED RecordTable(MAXRECORDS) AS RECTYPE   '   Record table
DIM SHARED FileTable(MAXFILES) AS FILETYPE      '   File table
'
'   Data Memories
'
DIM SHARED IntMem(MAXMEMINT) AS INTEGER         '   Integer memory
DIM SHARED IntMemFree AS INTEGER                '   Free Int memory
DIM SHARED RealMem(MAXMEMREAL) AS SINGLE        '   Real memory
DIM SHARED RealMemFree AS INTEGER               '   Free Real memory
DIM SHARED StrMem(MAXMEMSTR) AS STRTYPE         '   String memory
DIM SHARED StrMemFree AS INTEGER                '   Free Str memory
'
'   Program memory
'
DIM SHARED PgmMem(MAXMEMPGM) AS PGMMEMTYPE      '   Program Memory
DIM SHARED PgmMemFree AS INTEGER                '   Head of free chain
DIM SHARED PgmMemStart AS INTEGER               '   Program start
'
'   Symbol table
'
DIM SHARED SymTable(MAXSYMTABLE) AS SYMTABTYPE  '   Symbol Table
DIM SHARED SymTableBase AS INTEGER              '   Base of Table
DIM SHARED SymTableFree AS INTEGER              '   Start of free


'======================================================================
'
'   The code starts here
'
'======================================================================

ON ERROR GOTO ErrorHandler

Interpreter
END

ErrorHandler:
    ErrorHit (ERR)
    RESUME NEXT

'$STATIC

'======================================================================
'
'   ArgmemAlloc - Allocates ArgMem memory
'
'   Size    -   Number of elements to allocate
'
'   Returns pointer to beginning of block, or NILPOINTER if error
'
'======================================================================
FUNCTION ArgMemAlloc (Size AS INTEGER)
    IF ArgMemFree + Size > MAXMEMARG THEN
        ErrorHit (ERRORNOMEMORY)
        ArgMemAlloc = NILPOINTER
    ELSE
        ArgMemAlloc = ArgMemFree
        ArgMemFree = ArgMemFree + Size
    END IF
END FUNCTION

'======================================================================
'
'   ArgMemDealloc - Frees a block of ArgMem memory
'
'   Size         -   Size of block
'
'   Returns pointer to new ArgMemFree, or NILPOINTER if error
'
'======================================================================
FUNCTION ArgMemDealloc (Size AS INTEGER)
    IF ArgMemFree - Size >= 0 THEN
        ArgMemFree = ArgMemFree - Size
        ArgMemDealloc = ArgMemFree
    ELSE
        ArgMemDealloc = NILPOINTER
    END IF
END FUNCTION

'======================================================================
'
'   ArgMemGet   -   Gets an entry from the ArgMem memory
'
'   Ptr     -   Index into ArgMem
'   Value   -   Returns the entry of ArgMem(Ptr)
'
'======================================================================
SUB ArgMemGet(PTR AS INTEGER, Value AS ValueType)
   Value = ArgMem(PTR)
END SUB

'======================================================================
'
'   ArgMemSet   -   Sets an entry in the ArgMem memory
'
'   Ptr     -   Index into ArgMem
'   Value   -   Value to put in ArgMem(Ptr)
'
'======================================================================
SUB ArgMemSet(PTR AS INTEGER, Value AS ValueType)
   ArgMem(PTR) = Value
END SUB

'======================================================================
'
'   FactorStackInit -   Initializes factor stack
'
'======================================================================
SUB FactorStackInit
   FactorStackTop = -1
END SUB

'======================================================================
'
'   FactorStackPop - Pops value from stack
'
'   Value  =  value popped
'
'======================================================================
FUNCTION FactorStackPop (Value AS VALUETYPE)

    IF FactorStackTop >= 0 THEN
        Value = FactorStack(FactorStackTop)
        FactorStackTop = FactorStackTop - 1
        FactorStackPop = TRUE
    ELSE
        ErrorHit (ERRORSTACKEMPTY)
        FactorStackPop = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   FactorStackPush - Pushes  value in stack
'
'   Value  =  value pushed
'
'======================================================================
FUNCTION FactorStackPush (Value AS VALUETYPE)

    IF FactorStackTop < MAXSTACKFACTOR THEN
        FactorStackTop = FactorStackTop + 1
        FactorStack(FactorStackTop) = Value
        FactorStackPush = TRUE
    ELSE
        ErrorHit (ERRORSTACKOVERFLOW)
        FactorStackPush = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   FuncStackPop - Pops an entry from function stack
'
'   FuncData    -   Function data popped
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FuncStackPop (FuncData AS FUNCSTKTYPE)

    IF FuncStackTop >= 0 THEN
        FuncData = FuncStack(FuncStackTop)
        FuncStackTop = FuncStackTop - 1
        FuncStackPop = TRUE
    ELSE
        ErrorHit (ERRORSTACKEMPTY)
        FuncStackPop = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   FuncStackpush   -   Pushes function data to function stack
'
'   FuncData    -   Function data to push
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FuncStackPush (FuncData AS FUNCSTKTYPE)

    IF FuncStackTop < MAXSTACKFUNC THEN
        FuncStackTop = FuncStackTop + 1
        FuncStack(FuncStackTop) = FuncData
        FuncStackPush = TRUE
    ELSE
        ErrorHit (ERRORSTACKOVERFLOW)
        FuncStackPush = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   FuncStackGet    -   Returns the top-most entry of the Function
'                       stack
'
'   FuncData    -   Returns the entry
'
'======================================================================
FUNCTION FuncStackGet( FuncData AS FUNCSTKTYPE )
    IF FuncStackTop >= 0 THEN
        FuncData = FuncStack(FuncStackTop)
        FuncStackGet = TRUE
    ELSE
        FuncStackGet = FALSE
    END IF
END FUNCTION

'======================================================================
'
'   FuncStackIsEmpty    -   Returns TRUE if the function stack is empty
'
'======================================================================
FUNCTION FuncStackIsEmpty
   FuncStackIsEmpty = (FuncStackTop < 0)
END FUNCTION

'======================================================================
'
'   InKeyBufGet$    -   Returns the InKeyBuffer
'
'======================================================================
FUNCTION InKeyBufGet$
   InKeyBufGet$ = InKeyBuffer
END FUNCTION

'======================================================================
'
'   InKeyBufSet -   Sets the InKeyBuffer
'
'   s   -   New buffer value
'
'======================================================================
SUB InKeyBufSet(s AS STRING)
   InKeyBuffer = s
END SUB

'======================================================================
'
'   KeyTrapTargetGet    -   Returns the target of a key trap handler
'
'   Ptr -   Index (Key number)
'
'======================================================================
FUNCTION KeyTrapTargetGet(PTR AS INTEGER)
   KeyTrapTargetGet = KeyTrapTarget(PTR)
END FUNCTION

'======================================================================
'
'   KeyTrapTargetSet    -   Sets the target of a key handler
'
'   Ptr     -   Key number
'   Target  -   Pointer into PgmMem of the key handler
'
'======================================================================
SUB KeyTrapTargetSet(PTR AS INTEGER, Target AS INTEGER)
   KeyTrapTarget(PTR) = Target
END SUB

'======================================================================
'
'   KeyOnGet    -   Returns the value of a KeyOn() entry
'
'   Ptr  -  Key number
'
'======================================================================
FUNCTION KeyOnGet(PTR AS INTEGER)
   KeyOnGet = KeyOn(PTR)
END FUNCTION

'======================================================================
'
'   KeyOnSet    -   Sets the value of a KeyOn entry
'
'   Ptr     -   Key number
'   Value   -   TRUE or FALSE
'
'======================================================================
SUB KeyOnSet(PTR AS INTEGER, Value AS INTEGER)
   KeyOn(PTR) = Value
END SUB

'======================================================================
'
'   Init    -   Initializes structures based on a given flag
'
'   InitFlag    -   Flag indicating what structures to initialize
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
SUB Init (InitFlag AS INTEGER)

    DIM j AS INTEGER

    IF (InitFlag AND INITTRAP) THEN
        '
        ' Initialize error trapping
        '
        ErrTrapEnabled = FALSE
        ErrTrapTarget = NILPOINTER
        '
        ' Initialize Key trapping
        '
        KeyTrapEnabled = FALSE
        FOR j = FIRSTKEY TO LASTKEY
            KeyTrapTargetSet j, NILPOINTER
            KeyOnSet j, FALSE
        NEXT j
        InKeyBufSet ""
        InKeyChars = 0
        '
        ' Initialize Timer trapping
        '
        TimerTrapEnabled = FALSE
        TimerTrapTarget = NILPOINTER
    END IF

    IF (InitFlag AND INITFILES) THEN
        FOR j = 1 TO MAXFILES
            Ok = FileClean(j)
        NEXT j
    END IF

    IF (InitFlag AND INITSTACKS) THEN
        RetStackInit
        LoopStackInit
        FactorStackInit
        FuncStackTop = -1
        ArgMemFree = 0
    END IF

    IF (InitFlag AND INITDATA) THEN
        PgmData.PgmPtr = PgmMemProgram
        PgmData.Offset = 1
    END IF

    IF (InitFlag AND INITALLSYM) THEN
        SymTabInit
        MemInit
    ELSEIF InitFlag AND INITSYMTAB THEN
        SymTableFree = SymTableBase
        MemInit
    END IF

    IF (InitFlag AND INITPGM) THEN
        PgmMemInit
        TraceOn = FALSE
    END IF

END SUB

'======================================================================
'
'   LoopStackInit   -   Initializes loop stack
'
'======================================================================
SUB LoopStackInit
   LoopStackTop = -1
END SUB

'======================================================================
'
'   LoopStackPop - Pops loop structure from stack
'
'   Ls  =   Loop structure popped
'
'======================================================================
FUNCTION LoopStackPop (ls AS LOOPSTKTYPE)

    IF LoopStackTop >= 0 THEN
        ls = LoopStack(LoopStackTop)
        LoopStackTop = LoopStackTop - 1
        LoopStackPop = TRUE
    ELSE
        ErrorHit (ERRORSTACKEMPTY)
        LoopStackPop = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   LoopStackPush - Pushes  loop structure in stack
'
'   Ls  =  structure pushed
'
'======================================================================
FUNCTION LoopStackPush (ls AS LOOPSTKTYPE)

    IF LoopStackTop < MAXSTACKLOOP THEN
        LoopStackTop = LoopStackTop + 1
        LoopStack(LoopStackTop) = ls
        LoopStackPush = TRUE
    ELSE
        ErrorHit (ERRORSTACKOVERFLOW)
        LoopStackPush = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   LoopStackTopData    -   Gets the top-most entry of the loop stack
'
'   LoopData    -   Loop data from the top of the stack
'
'======================================================================
FUNCTION LoopStackTopData (LoopData AS LOOPSTKTYPE)
   IF LoopStackTop >= 0 THEN
      LoopData = LoopStack(LoopStackTop)
      LoopStackTopData = TRUE
   ELSE
      LoopStackTopData = FALSE
   END IF
END FUNCTION

'======================================================================
'
'   RetStackInit    -   Initializes return stack
'
'======================================================================
SUB RetStackInit
   RetStackTop = -1
END SUB

'======================================================================
'
'   RetStackPop - Pops PgmLoc structure from stack
'
'   PgmLoc  =   structure popped
'
'======================================================================
FUNCTION RetStackPop (PgmLoc AS PGMLOCTYPE)

    IF RetStackTop >= 0 THEN
        PgmLoc = RetStack(RetStackTop)
        RetStackTop = RetStackTop - 1
        RetStackPop = TRUE
    ELSE
        ErrorHit (ERRORSTACKEMPTY)
        RetStackPop = FALSE
    END IF

END FUNCTION

'======================================================================
'
'   RetStackPush - Pushes  PgmLoc structure in stack
'
'   PgmLoc  =  structure pushed
'
'======================================================================
FUNCTION RetStackPush (PgmLoc AS PGMLOCTYPE)

    IF RetStackTop < MAXSTACKRET THEN
        RetStackTop = RetStackTop + 1
        RetStack(RetStackTop) = PgmLoc
        RetStackPush = TRUE
    ELSE
        ErrorHit (ERRORSTACKOVERFLOW)
        RetStackPush = FALSE
    END IF

END FUNCTION



'======================================================================
'
'   SysDump -   Dumps misc. system stuff
'
'======================================================================
SUB SysDump (FileNum AS INTEGER)

    DIM j AS INTEGER
    DIM s AS STRING

    PRINT #FileNum, ""
    PRINT #FileNum, "Loop Stack"
    PRINT #FileNum, "----------"

    FOR j = LoopStackTop TO 0 STEP -1
        IF LoopStack(j).LoopKind = LOOPKINDFOR THEN
           s = "FOR " + RTRIM$(LoopStack(j).Id) + " =" + STR$(LoopStack(j).FirstValue)
           s = s + " TO" + STR$(LoopStack(j).LastValue)
           s = s + " STEP" + STR$(LoopStack(j).Increment)
           PRINT #FileNum, s
           PRINT #FileNum, "    Body starts at line" + STR$(PgmMemLineNum(LoopStack(j).PgmBegin.PgmPtr))
        ELSE
           s = "WHILE loop at line" + STR$(PgmMemLineNum(LoopStack(j).PgmBegin.PgmPtr))
           PRINT #FileNum, s
        END IF
        PRINT #FileNum, ""
    NEXT j


    PRINT #FileNum, ""
    PRINT #FileNum, "Return Stack"
    PRINT #FileNum, "------------"

    FOR j = RetStackTop TO 0 STEP -1
        s = "Line =" + STR$(PgmMemLineNum(RetStack(j).PgmPtr))
        s = s + " Offset =" + STR$(RetStack(j).Offset)
        PRINT #FileNum, s
    NEXT j
END SUB

'======================================================================
'
'   FileAddFields - Adds fields to a file structure
'
'   FileNumber  -   File number
'   cFields     -   Number of fields
'   FieldSizes  -   Array of field sizes
'   FieldNames  -   Array of field names
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FileAddFields (FileNumber AS INTEGER, cFields AS INTEGER, FieldSizes() AS INTEGER, FieldNames() AS STRING)

    DIM Ok AS INTEGER
    DIM RecordLen AS INTEGER
    DIM j AS INTEGER
    DIM k AS INTEGER
    DIM PrevPtr AS INTEGER
    DIM NextPtr AS INTEGER
    DIM Count AS INTEGER
    DIM RecordPtr AS INTEGER
    DIM FieldPtr AS INTEGER
    DIM Offset AS INTEGER

    Ok = TRUE
    RecordLen = 0

    FOR j = 0 TO cFields - 1
        RecordLen = RecordLen + FieldSizes(j)
    NEXT j

    IF FileIsOpen(FileNumber) THEN
        IF RecordLen <= FileTable(FileNumber).RecordLen THEN

            PrevPtr = NILPOINTER
            NextPtr = FileTable(FileNumber).RecordPtr
            Count = 0

            DO WHILE NextPtr <> NILPOINTER
                PrevPtr = NextPtr
                NextPtr = RecordTable(NextPtr).NextPtr
                Count = Count + 1
            LOOP

            IF Count < MAXFILEREC THEN

                FOR j = 0 TO MAXRECORDS
                    IF RecordTable(j).RecordLen = 0 THEN
                        RecordPtr = j
                        EXIT FOR
                    END IF
                NEXT j

                IF PrevPtr = NILPOINTER THEN
                    FileTable(FileNumber).RecordPtr = RecordPtr
                ELSE
                    RecordTable(PrevPtr).NextPtr = RecordPtr
                END IF
                RecordTable(RecordPtr).NextPtr = NILPOINTER
                RecordTable(RecordPtr).RecordLen = RecordLen
                RecordTable(RecordPtr).FieldPtr = NILPOINTER


                PrevPtr = NILPOINTER
                Offset = 1

                FOR j = 0 TO cFields - 1

                    FOR k = 0 TO MAXFIELDS
                        IF FieldTable(k).FieldLen = 0 THEN
                            FieldPtr = k
                            EXIT FOR
                         END IF
                    NEXT k

                    IF PrevPtr = NILPOINTER THEN
                        RecordTable(RecordPtr).FieldPtr = FieldPtr
                    ELSE
                        FieldTable(PrevPtr).NextPtr = FieldPtr
                    END IF

                    PrevPtr = FieldPtr

                    FieldTable(FieldPtr).FieldId = FieldNames(j)
                    FieldTable(FieldPtr).FieldLen = FieldSizes(j)
                    FieldTable(FieldPtr).NextPtr = NILPOINTER

                    Ok = SymTabAddField(FieldNames(j), FileNumber, Offset, FieldSizes(j))

                    Offset = Offset + FieldSizes(j)
                NEXT j

            ELSE
                ErrorHit (ERRORTOOMANYRECORDS)
                Ok = FALSE
            END IF
        ELSE
            ErrorHit (ERRORBADRECORDLEN)
            Ok = FALSE
        END IF
    ELSE
        ErrorHit (ERRORFILENOTOPEN)
        Ok = FALSE
    END IF

    FileAddFields = Ok

END FUNCTION

'======================================================================
'
'   FileClean - Closes a file and deallocates resources if in use
'
'   FileNumber         -   File number
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FileClean (FileNumber AS INTEGER)

    DIM Ok AS INTEGER
    DIM RecPtr AS INTEGER
    DIM FldPtr AS INTEGER
    DIM TmpPtr AS INTEGER

    Ok = TRUE

    IF FileIsOpen(FileNumber) THEN
        CLOSE #FileNumber
        IF ERR <> 0 THEN
            Ok = FALSE
        END IF
    END IF

    FileTable(FileNumber).FileName = ""
    RecPtr = FileTable(FileNumber).RecordPtr
    FileTable(FileNumber).RecordPtr = NILPOINTER

    DO WHILE RecPtr <> NILPOINTER
        '
        '   Clean record
        '
        RecordTable(RecPtr).RecordLen = 0
        FldPtr = RecordTable(RecPtr).FieldPtr
        TmpPtr = RecordTable(RecPtr).NextPtr
        RecordTable(RecPtr).FieldPtr = NILPOINTER
        RecordTable(RecPtr).NextPtr = NILPOINTER
        RecPtr = TmpPtr
        '
        '   Clean the record's field list
        '
        DO WHILE FldPtr <> NILPOINTER
            '
            ' BUGBUG: Should remove symbol from symbol table
            '
            FieldTable(FldPtr).FieldId = ""
            FieldTable(FldPtr).FieldLen = 0
            TmpPtr = FieldTable(FldPtr).NextPtr
            FieldTable(FldPtr).NextPtr = NILPOINTER
            FldPtr = TmpPtr
        LOOP
    LOOP

    FileClean = Ok

END FUNCTION

'======================================================================
'
'   FileFieldGet - Gets the value of a field
'
'   FileNumber      -   File number
'   Offset          -   Offset within buffer
'   Length          -   Length of field
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FileFieldGet (FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER, Value AS VALUETYPE)

    DIM Ok AS INTEGER

    Ok = TRUE

    IF FileIsOpen(FileNumber) THEN
        Value.DataType = TYPESTR
        Value.ValueStr.StrBuf = MID$(FileTable(FileNumber).Buffer, Offset, Length)
        Value.ValueStr.StrLen = Length
    ELSE
        ErrorHit (ERRORFILENOTOPEN)
        Ok = FALSE
    END IF

    FileFieldGet = Ok

END FUNCTION

'======================================================================
'
'   FileFieldSet - Sets the value of a field
'
'   FileNumber      -   File number
'   Offset          -   Offset within buffer
'   Length          -   Length of field
'
'   Returns TRUE if success, FALSE if error
'
'======================================================================
FUNCTION FileFieldSet (FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER, Value AS VALUETYPE)

    DIM Ok AS INTEGER

    Ok = TRUE

    IF FileIsOpen(FileNumber) THEN
        IF Value.DataType = TYPESTR THEN
            MID$(FileTable(FileNumber).Buffer, Offset, Length) = LEFT$(Value.ValueStr.StrBuf, Length)
        ELSE
            ErrorHit (ERRORTYPEMISMATCH)
            Ok = FALSE
        END IF
    ELSE
        ErrorHit (ERRORFILENOTOPEN)
        Ok = FALSE
    END IF

    FileFieldSet = Ok

END FUNCTION

'======================================================================
'
'   FileIsOpen  -   Returns TRUE if a file is open
'
'   FileNumber  -   File number
'
'======================================================================
FUNCTION FileIsOpen (FileNumber AS INTEGER)
   FileIsOpen = (RTRIM$(FileTable(FileNumber).FileName) <> "")
END FUNCTION

'======================================================================
'
'   FileReadBuf -   Reads the file buffer for RANDOM file
'
'   FileNumber  -   File number
'
'======================================================================
FUNCTION FileReadBuf (FileNumber AS INTEGER)
    FileTable(FileNumber).Buffer = INPUT$(FileTable(FileNumber).RecordLen, #FileNumber)
    IF (LastErr = 0) THEN
        FileTable(FileNumber).SeekPos = FileTable(FileNumber).SeekPos + 1
    END IF
    FileReadBuf = (LastErr = 0)
END FUNCTION

'======================================================================
'
'   FileSeek    -   Seeks to a specified record in RANDOM file
'
'   FileNumber  -   File number
'   RecNum      -   Record number
'
'======================================================================
FUNCTION FileSeek (FileNumber AS INTEGER, RecNum AS INTEGER)
    SEEK #FileNumber, (FileTable(FileNumber).RecordLen * (RecNum - 1)) + 1
    IF (LastErr = 0) THEN
        FileTable(FileNumber).SeekPos = RecNum
    END IF
    FileSeek = (LastErr = 0)
END FUNCTION

'======================================================================
'
'   FileValidateAccess  -   Validates access to a file
'
'   FileNumber  -   File number
'   Mode        -   Access desired
'
'   Return TRUE if the file is open for the required mode, FALSE
'   otherwise
'
'======================================================================
FUNCTION FileValidateAccess (FileNumber AS INTEGER, Mode AS INTEGER)
    DIM Ok AS INTEGER

    Ok = TRUE

    IF (FileNumber >= FIRSTFILENUMBER) AND (FileNumber <= (FIRSTFILENUMBER + MAXFILES)) THEN

        IF FileIsOpen(FileNumber) THEN
            IF Mode <> FileTable(FileNumber).FileAccess THEN
                ErrorHit (ERRORINVALIDACCESS)
                Ok = FALSE
            END IF
        ELSE
            ErrorHit (ERRORFILENOTOPEN)
            Ok = FALSE
        END IF
    ELSE
        ErrorHit (ERRORINVALIDFILENUMBER)
        Ok = FALSE
    END IF

    FileValidateAccess = Ok
END FUNCTION

'======================================================================
'
'   FileSet -   Sets the value of a file entry in file table
'
'   FileNumber  -   File number
'   FileData    -   Value to set in file table
'
'======================================================================
FUNCTION FileSet(FileNumber AS INTEGER, FileData AS FILETYPE)
    FileTable(FileNumber) = FileData
    FileSet = TRUE
END FUNCTION

'======================================================================
'
'   FileWriteBuf    -   Writes the file buffer for a RANDOM file
'
'   FileNumber  -   File number
'
'======================================================================
FUNCTION FileWriteBuf (FileNumber AS INTEGER)
    DIM s AS STRING
    s = LEFT$(FileTable(FileNumber).Buffer, FileTable(FileNumber).RecordLen)
    PUT #FileNumber, , s
    IF (LastErr = 0) THEN
        FileTable(FileNumber).SeekPos = FileTable(FileNumber).SeekPos + 1
    END IF
    FileWriteBuf = (LastErr = 0)
END FUNCTION

'======================================================================
'
'   MemAlloc - Allocates memory
'
'   DataType    =   Type of elements to allocate
'   Size        =   Number of elements to allocate
'
'   Returns pointer to the first of <Size> elements of type <DataType>
'
'======================================================================
FUNCTION MemAlloc (DataType AS INTEGER, Size AS INTEGER)

    DIM MemPtr AS INTEGER

    MemPtr = NILPOINTER

    SELECT CASE DataType
        CASE TYPEINT
            IF (IntMemFree + Size) > MAXMEMINT THEN
                ErrorHit (ERRORNOMEMORY)
            ELSE
                MemPtr = IntMemFree
                IntMemFree = IntMemFree + Size
            END IF
        CASE TYPEREAL
            IF (RealMemFree + Size) > MAXMEMREAL THEN
                ErrorHit (ERRORNOMEMORY)
            ELSE
                MemPtr = RealMemFree
                RealMemFree = RealMemFree + Size
            END IF
        CASE TYPESTR
            IF (StrMemFree + Size) > MAXMEMSTR THEN
                ErrorHit (ERRORNOMEMORY)
            ELSE
                MemPtr = StrMemFree
                StrMemFree = StrMemFree + Size
            END IF
        CASE ELSE
            ErrorHit (ERRORINTERNAL)
    END SELECT

    MemAlloc = MemPtr

END FUNCTION

'======================================================================
'
'   MemDump -   Dumps memory
'
'======================================================================
SUB MemDump (FileNum AS INTEGER)

    DIM j AS INTEGER
    DIM s AS STRING

    PRINT #FileNum,""
    PRINT #FileNum, "Int Memory Dump"
    PRINT #FileNum, "---------------"

    FOR j = 0 TO IntMemFree - 1
        s = STR$(j) + "   = " + STR$(IntMem(j))
        PRINT #FileNum, s
    NEXT j

    PRINT #FileNum,""
    PRINT #FileNum, "Real Memory Dump"
    PRINT #FileNum, "---------------"

    FOR j = 0 TO RealMemFree - 1
        s = STR$(j) + "   = " + STR$(RealMem(j))
        PRINT #FileNum, s
    NEXT j

    PRINT #FileNum,""
    PRINT #FileNum, "Str Memory Dump"
    PRINT #FileNum, "---------------"

    FOR j = 0 TO StrMemFree - 1
        s = STR$(j) + "   = " + LEFT$(StrMem(j).StrBuf, StrMem(j).StrLen)
        PRINT #FileNum, s
    NEXT j
END SUB

'======================================================================
'
'   MemGet - Retrieves memory element
'
'   DataType    =   Type of element
'   MemPtr      =   Pointer to memory
'   Value       =   Where to put the element
'
'   Returns TRUE if success, FALSE if invalid memory
'
'======================================================================
FUNCTION MemGet (DataType AS INTEGER, MemPtr AS INTEGER, Value AS VALUETYPE)
    DIM Ret AS INTEGER

    Ret = FALSE

    SELECT CASE DataType
        CASE TYPEINT
            IF MemPtr >= IntMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                Value.DataType = TYPEINT
                Value.ValueInt = IntMem(MemPtr)
                Ret = TRUE
            END IF
        CASE TYPEREAL
            IF MemPtr >= RealMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                Value.DataType = TYPEREAL
                Value.ValueReal = RealMem(MemPtr)
                Ret = TRUE
            END IF
        CASE TYPESTR
            IF MemPtr >= StrMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                Value.DataType = TYPESTR
                Value.ValueStr = StrMem(MemPtr)
                Ret = TRUE
            END IF
        CASE ELSE
            ErrorHit (ERRORINTERNAL)
    END SELECT

    MemGet = Ret

END FUNCTION

'======================================================================
'
'   MemInit - Initializes Int, Real and Str Memory
'
'======================================================================
SUB MemInit

    IntMemFree = 0
    RealMemFree = 0
    StrMemFree = 0
END SUB

'======================================================================
'
'   MemSet - Sets memory element
'
'   MemPtr      =   Pointer to memory
'   Value       =   value of the element
'
'   Returns TRUE if success, FALSE if invalid memory
'
'======================================================================
FUNCTION MemSet (MemPtr AS INTEGER, Value AS VALUETYPE)

    DIM Ret AS INTEGER

    Ret = FALSE

    SELECT CASE Value.DataType
        CASE TYPEINT
            IF MemPtr >= IntMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                IntMem(MemPtr) = Value.ValueInt
                Ret = TRUE
            END IF
        CASE TYPEREAL
            IF MemPtr >= RealMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                RealMem(MemPtr) = Value.ValueReal
                Ret = TRUE
            END IF
        CASE TYPESTR
            IF MemPtr >= StrMemFree THEN
                ErrorHit (ERRORINVALIDMEMACCESS)
            ELSE
                StrMem(MemPtr) = Value.ValueStr
                Ret = TRUE
            END IF
        CASE ELSE
            ErrorHit (ERRORINTERNAL)
    END SELECT

    MemSet = Ret

END FUNCTION

'======================================================================
'
'   PgmMemAlloc -   Allocates an element from PgmMem
'
'======================================================================
FUNCTION PgmMemAlloc

    DIM PTR AS INTEGER
    DIM NextPtr AS INTEGER

    PTR = NILPOINTER

    IF PgmMemFree = NILPOINTER THEN
        ErrorHit (ERRORNOMEMORY)
    ELSE
        PTR = PgmMemFree
        NextPtr = PgmMem(PTR).NextPtr

        IF NextPtr <> NILPOINTER THEN
            PgmMem(NextPtr).PrevPtr = NILPOINTER
        END IF

        PgmMemFree = NextPtr

        PgmMem(PTR).PrevPtr = NILPOINTER
        PgmMem(PTR).NextPtr = NILPOINTER
        PgmMem(PTR).Buffer = ""
        PgmMem(PTR).BufLen = 0

    END IF

    PgmMemAlloc = PTR

END FUNCTION

'======================================================================
'
'   PgmMemBuf$  -   Returns the buffer of a PgmMem entry
'
'   Ptr -   Index of PgmMem entry
'
'======================================================================
FUNCTION PgmMemBuf$ (PTR AS INTEGER)
    PgmMemBuf$ = LEFT$(PgmMem(PTR).Buffer, PgmMem(PTR).BufLen)
END FUNCTION

'======================================================================
'
'   PgmMemBufLen    -   Returns the length of the buffer in a
'                       PgmMem entry
'
'   Ptr -   Index of PgmMem entry
'
'======================================================================
FUNCTION PgmMemBufLen (PTR AS INTEGER)
    PgmMemBufLen = PgmMem(PTR).BufLen
END FUNCTION

'======================================================================
'
'   PgmMemDealloc   -   Deallocates an element from PgmMem
'
'   Ptr -   Pointer to element to deallocate. The element is added
'           to the free list.
'
'======================================================================
SUB PgmMemDealloc (PTR AS INTEGER)

    PgmMem(PTR).PrevPtr = NILPOINTER
    PgmMem(PTR).NextPtr = PgmMemFree

    IF PgmMemFree <> NILPOINTER THEN
        PgmMem(PgmMemFree).PrevPtr = PTR
    END IF

    PgmMemFree = PTR

END SUB

'======================================================================
'
'   PgmMemDelete    -   Deletes a program line. Removes the line from
'                       the program list and deallocates it (which
'                       adds it to the free list)
'
'======================================================================
SUB PgmMemDelete (PTR AS INTEGER)

    DIM PrevPtr AS INTEGER
    DIM NextPtr AS INTEGER

    PrevPtr = PgmMem(PTR).PrevPtr
    NextPtr = PgmMem(PTR).NextPtr

    IF PrevPtr = NILPOINTER THEN
        PgmMemStart = NextPtr
    ELSE
        PgmMem(PrevPtr).NextPtr = NextPtr
    END IF

    IF NextPtr <> NILPOINTER THEN
        PgmMem(NextPtr).PrevPtr = PrevPtr
    END IF

    PgmMemDealloc (PTR)

END SUB

'======================================================================
'
'   PgmMemFind  -   Finds a specific program line
'
'   LineNumber  -   Line number to look for
'
'   Returns pointer to PgmMem for the line requested or NILPOINTER if
'   line not found.
'
'======================================================================
FUNCTION PgmMemFind (LineNumber AS INTEGER)

    DIM PTR AS INTEGER
    DIM PrevPtr AS INTEGER

    PTR = PgmMemFindPos(LineNumber, PrevPtr)

    IF PTR <> NILPOINTER THEN
        IF PgmMem(PTR).LineNumber <> LineNumber THEN
            PTR = NILPOINTER
        END IF
    END IF

    PgmMemFind = PTR

END FUNCTION

'======================================================================
'
'   PgmMemFindPos   -   Finds the insertion position for a specific line
'                       number
'
'   LineNumber  -   Line number that will be inserted
'   PrevPtr     -   Returns the PrevPtr of the insertion position
'
'   Returns the pointer to the insertion position. If the value
'   returned is NILPOINTER, then the line is to be inserted at the end
'   of the program list. In that case PrevPtr points to the end of the
'   list
'
'======================================================================
FUNCTION PgmMemFindPos (LineNumber AS INTEGER, PrevPtr AS INTEGER)

    DIM PTR AS INTEGER

    PTR = PgmMemStart
    PrevPtr = NILPOINTER

    DO WHILE PTR <> NILPOINTER

        IF PgmMem(PTR).LineNumber >= LineNumber THEN
            EXIT DO
        END IF

        PrevPtr = PTR
        PTR = PgmMem(PTR).NextPtr
    LOOP

    PgmMemFindPos = PTR

END FUNCTION

'======================================================================
'
'   PgmMemSet   -   Sets the value of a PgmMem entry
'
'   Ptr     -   Index of PgmMem entry
'   PgmData -   New value of PgmMem entry
'
'======================================================================
SUB PgmMemGet (PTR AS INTEGER, PgmData AS PGMMEMTYPE)
   PgmData = PgmMem(PTR)
END SUB

'======================================================================
'
'   PgmMemInit  -   Initializes PgmMem
'
'======================================================================
SUB PgmMemInit

    DIM j AS INTEGER

    FOR j = 0 TO MAXMEMPGM
        PgmMem(j).PrevPtr = j - 1
        PgmMem(j).NextPtr = j + 1
    NEXT j

    PgmMem(0).PrevPtr = NILPOINTER
    PgmMem(MAXMEMPGM).NextPtr = NILPOINTER

    PgmMemFree = 0
    PgmMemStart = NILPOINTER
    PgmMemImm = PgmMemAlloc
    PgmMemInp = PgmMemAlloc

END SUB

'======================================================================
'
'   PgmMemInsert    -   Inserts a line into the program list
'
'   Ptr -   Pointer to the line to be inserted
'
'======================================================================
SUB PgmMemInsert (PTR AS INTEGER)

    DIM PrevPtr AS INTEGER
    DIM InsPtr AS INTEGER

    InsPtr = PgmMemFindPos(PgmMem(PTR).LineNumber, PrevPtr)

    PgmMem(PTR).PrevPtr = PrevPtr
    PgmMem(PTR).NextPtr = InsPtr

    IF InsPtr <> NILPOINTER THEN
        PgmMem(InsPtr).PrevPtr = PTR
    END IF

    IF PrevPtr <> NILPOINTER THEN
        PgmMem(PrevPtr).NextPtr = PTR
    ELSE
        PgmMemStart = PTR
    END IF

END SUB

'======================================================================
'
'   PgmMemLineNum   -   Returns line number of a PgmMem entry
'
'   Ptr -   Index of PgmMem entry
'
'======================================================================
FUNCTION PgmMemLineNum (PTR AS INTEGER)
    PgmMemLineNum = PgmMem(PTR).LineNumber
END FUNCTION

'======================================================================
'
'   PgmMemNext  -   Returns NextPtr value for a PgmMem entry
'
'   Ptr -   Index of PgmMem entry
'
'======================================================================
FUNCTION PgmMemNext (PTR AS INTEGER)
    PgmMemNext = PgmMem(PTR).NextPtr
END FUNCTION

'======================================================================
'
'   PgmMemProgram   -   Returns starting point of program in PgmMem
'
'======================================================================
FUNCTION PgmMemProgram
   PgmMemProgram = PgmMemStart
END FUNCTION

'======================================================================
'
'   PgmMemSet   -   Sets the value of a PgmMem entry
'
'   Ptr     -   Index of PgmMem entry
'   PgmData -   New value of PgmMem entry
'
'======================================================================
SUB PgmMemSet (PTR AS INTEGER, PgmData AS PGMMEMTYPE)
   PgmMem(PTR) = PgmData
END SUB

'======================================================================
'
'   SymTabAdd -   Adds a symbol to the symbol table
'
'   Symbol      =   Symbol to add
'   SymbolType  =   Type of symbol
'   Flags       =   Symbol flags
'
'   Returns Pointer to symbol table entry
'
'======================================================================
FUNCTION SymTabAdd (Symbol AS STRING, SymbolType AS INTEGER, Flags AS INTEGER)

    DIM PTR AS INTEGER

    PTR = NILPOINTER

    IF SymTabValidateSymbol(Symbol) THEN

        PTR = SymTabAlloc

        IF PTR = NILPOINTER THEN
            ErrorHit (ERRORNOMEMORY)
        ELSE
            SymTable(PTR).Symbol = RTRIM$(Symbol)
            SymTable(PTR).SymbolType = SymbolType
            SymTable(PTR).Flags = Flags
        END IF
    END IF

    SymTabAdd = PTR

END FUNCTION

'======================================================================
'
'   SymTabAddField  -   Adds a file field to the symbol table
'
'   Symbol      -   Field name
'   FileNumber  -   File number
'   Offset      -   Offset within the file buffer
'   Length      -   Length of field
'
'======================================================================
FUNCTION SymTabAddField (Symbol AS STRING, FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER)

    DIM PTR AS INTEGER

    PTR = NILPOINTER

    MemPtr = FileNumber

    PTR = SymTabFind(Symbol)

    IF PTR = NILPOINTER THEN
        PTR = SymTabAdd(Symbol, TOKENVARIABLE, SYMFLAGFIELD)
    END IF

    IF PTR <> NILPOINTER THEN
        SymTable(PTR).Dimensions = 0
        SymTable(PTR).DataType = TYPESTR
        SymTable(PTR).MemPtr = FileNumber
        SymTable(PTR).Offset = Offset
        SymTable(PTR).Length = Length
    END IF

    SymTabAddField = PTR

END FUNCTION

'======================================================================
'
'   SymTabAddFunc   -   Adds a user-defined function to the symbol table
'
'   Symbol      -   Name of function
'   FuncType    -   Type of result returned by function
'   cParam      -   Number of parameters
'   Param       -   List of parameter names
'   FuncExp     -   string containing the function expression
'
'======================================================================
FUNCTION SymTabAddFunc (Symbol AS STRING, FuncType AS INTEGER, cParam AS INTEGER, Param() AS STRING, FuncExp AS STRING)

    DIM PTR AS INTEGER
    DIM MemPtr AS INTEGER
    DIM Size AS INTEGER
    DIM j AS INTEGER
    DIM Value AS VALUETYPE

    PTR = NILPOINTER

    Size = 1

    MemPtr = MemAlloc(TYPESTR, cParam + 1)

    IF MemPtr = NILPOINTER THEN
        ErrorHit (ERRORNOMEMORY)
    ELSE

        PTR = SymTabAdd(Symbol, TOKENFUSERDEF, SYMFLAGFUNC)

        IF PTR <> NILPOINTER THEN

            SymTable(PTR).Dimensions = cParam
            SymTable(PTR).DataType = FuncType
            SymTable(PTR).MemPtr = MemPtr

            Value.DataType = TYPESTR
            Value.ValueStr.StrBuf = FuncExp
            Value.ValueStr.StrLen = LEN(FuncExp)
            Ok = MemSet(MemPtr, Value)

            IF Ok THEN
                FOR j = 0 TO cParam - 1
                    Value.ValueStr.StrBuf = Param(j)
                    Value.ValueStr.StrLen = LEN(Param(j))
                    Ok = MemSet(MemPtr + j + 1, Value)
                    IF NOT Ok THEN
                        EXIT FOR
                    END IF
                NEXT j
            END IF
        END IF
    END IF

    SymTabAddFunc = PTR

END FUNCTION

'======================================================================
'
'   SymTabAddVar -  Adds a variable symbol to the symbol table and
'                   allocates space from memory for the value
'
'   Symbol      =   Symbol to add
'   SymbolType  =   Type of symbol
'   Flags       =   Symbol flags
'   DataType    =   Data type
'   Dimensions  =   Number of dimensions
'   Sizes()     =   Size of each dimension
'
'
'   Returns Pointer to symbol table entry
'
'======================================================================
FUNCTION SymTabAddVar (Symbol AS STRING, SymbolType AS INTEGER, Flags AS INTEGER, DataType AS INTEGER, Dimensions AS INTEGER, Sizes() AS INTEGER)

    DIM PTR AS INTEGER
    DIM MemPtr AS INTEGER
    DIM Size AS INTEGER
    DIM j AS INTEGER

    PTR = NILPOINTER

    Size = 1
    IF (Flags AND SYMFLAGARRAY) THEN
        FOR j = 0 TO Dimensions - 1
            Size = Size * Sizes(j)
        NEXT j
    END IF

    MemPtr = MemAlloc(DataType, Size)

    IF MemPtr = NILPOINTER THEN
        ErrorHit (ERRORNOMEMORY)
    ELSE

        PTR = SymTabAdd(Symbol, SymbolType, Flags)
        IF PTR <> NILPOINTER THEN
            SymTable(PTR).Dimensions = Dimensions
            SymTable(PTR).Size1 = Sizes(0)
            SymTable(PTR).Size2 = Sizes(1)
            SymTable(PTR).Size3 = Sizes(2)
            SymTable(PTR).DataType = DataType
            SymTable(PTR).MemPtr = MemPtr
        END IF
    END IF

    SymTabAddVar = PTR

END FUNCTION

'======================================================================
'
'   SymTabAlloc - Allocates an entry from the symbol table
'
'   Return index of allocated slot
'
'======================================================================
FUNCTION SymTabAlloc

    IF SymTableFree < MAXSYMTABLE THEN
        SymTabAlloc = SymTableFree
        SymTableFree = SymTableFree + 1
    ELSE
        SymTabAlloc = NILPOINTER
    END IF

END FUNCTION

'======================================================================
'
'   SymTabDump  -   Dumps symbol table
'
'======================================================================
SUB SymTabDump (FileNum AS INTEGER)

    DIM PTR AS INTEGER
    DIM s AS STRING
    DIM Size(MAXDIMENSIONS) AS INTEGER
    DIM Num AS INTEGER
    DIM j AS INTEGER
    DIM pPtr AS INTEGER
    DIM Param AS STRING
    DIM Value AS VALUETYPE
    DIM Ok AS INTEGER

    PRINT #FileNum,""
    PRINT #FileNum, "Symbol Table Dump"
    PRINT #FileNum, "-----------------"

    PTR = SymTableBase

    DO WHILE PTR < SymTableFree

        Size(0) = SymTable(PTR).Size1
        Size(1) = SymTable(PTR).Size2
        Size(2) = SymTable(PTR).Size3

        Num = 1
        FOR j = 0 TO MAXDIMENSIONS - 1
            IF Size(j) > 0 THEN
                Num = Num * Size(j)
            END IF
        NEXT j

        s = RTRIM$(SymTable(PTR).Symbol)

        IF (SymTable(PTR).Flags AND SYMFLAGFIELD) THEN

            s = s + " Field" + " Offset=" + STR$(SymTable(PTR).Offset) + " Len=" + STR$(SymTable(PTR).Length)

        ELSEIF (SymTable(PTR).Flags AND SYMFLAGFUNC) THEN

            IF SymTable(PTR).Dimensions > 0 THEN
                s = s + "("
                FOR j = 0 TO SymTable(PTR).Dimensions - 1
                    pPtr = SymTable(PTR).MemPtr + j + 1
                    Ok = MemGet(TYPESTR, pPtr, Value)
                    Param = LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen)
                    s = s + Param
                    IF j < SymTable(PTR).Dimensions - 1 THEN
                        s = s + ","
                    END IF
                NEXT j
                Ok = MemGet(TYPESTR, SymTable(PTR).MemPtr, Value)
                s = s + ") = " + LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen)
            END IF

        ELSE

            IF (SymTable(PTR).Flags AND SYMFLAGARRAY) THEN
                s = s + "("
                FOR j = 0 TO MAXDIMENSIONS - 1
                    IF Size(j) > 0 THEN
                        s = s + LTRIM$(STR$(Size(j) - 1))
                        IF j < MAXDIMENSIONS - 1 THEN
                            IF Size(j + 1) > 0 THEN
                                s = s + ","
                            END IF
                        END IF
                    END IF
                NEXT j
                s = s + ")"
            END IF

            s = s + "   "

            SELECT CASE SymTable(PTR).DataType
                CASE TYPEINT
                    s = s + "Int"
                CASE TYPEREAL
                    s = s + "Real"
                CASE TYPESTR
                    s = s + "Str"
            END SELECT

            IF (SymTable(PTR).Flags AND SYMFLAGARRAY) THEN
                s = s + STR$(Num) + " elements"
            ELSE
                s = s + " 1 element"
            END IF

            s = s + " MemPtr=" + STR$(SymTable(PTR).MemPtr)

            s = s + " Value: "
            SELECT CASE SymTable(PTR).DataType
                CASE TYPEINT
                    Ok = MemGet(TYPEINT, SymTable(PTR).MemPtr, Value)
                    s = s + STR$(Value.ValueInt)
                CASE TYPEREAL
                    Ok = MemGet(TYPEREAL, SymTable(PTR).MemPtr, Value)
                    s = s + STR$(Value.ValueReal)
                CASE TYPESTR
                    Ok = MemGet(TYPESTR, SymTable(PTR).MemPtr, Value)
                    s = s + CHR$(34) + LEFT$(Value.ValueStr.StrBuf, Value.ValueStr.StrLen) + CHR$(34)
            END SELECT
        END IF

        PRINT #FileNum, s

        PTR = PTR + 1
    LOOP
END SUB

'======================================================================
'
'   SymTabEntry -   Gets the value of a SymTab entry
'
'   Ptr     -   Index of SymTab entry
'   SymData -   Returns value of SymTab entry
'
'======================================================================
SUB SymTabEntry (PTR AS INTEGER, SymData AS SYMTABTYPE)
   SymData = SymTable(PTR)
END SUB

'======================================================================
'
'   SymTabFind  -   Finds a symbol in the symbol table
'
'   Symbol  =   Symbol to look for
'
'   Returns pointer to symbol table or NILPOINTER if not found
'
'======================================================================
FUNCTION SymTabFind (Symbol AS STRING)
    DIM PTR AS INTEGER
    DIM j AS INTEGER

    PTR = NILPOINTER

    FOR j = 0 TO SymTableFree - 1
        IF RTRIM$(SymTable(j).Symbol) = Symbol THEN
            PTR = j
            EXIT FOR
        END IF
    NEXT j

    SymTabFind = PTR
END FUNCTION

'======================================================================
'
'   SymTabGet -  Gets a value for a given symbol
'
'   Symbol      =   Symbol
'   Dimensions  =   Number of dimensions
'   Index()     =   Index for each dimension
'   Value       =   Where the value is returned
'
'   Returns TRUE if value returned, FALSE otherwise
'
'======================================================================
FUNCTION SymTabGet (Symbol AS STRING, cArgs AS INTEGER, vArgs() AS VALUETYPE, Value AS VALUETYPE)

    DIM PTR AS INTEGER
    DIM Ok AS INTEGER
    DIM Offset AS INTEGER

    Ok = TRUE

    PTR = SymTabFind(RTRIM$(Symbol))

    IF PTR = NILPOINTER THEN
        IF cArgs = 0 THEN
            SELECT CASE SymbolToDataType(RTRIM$(Symbol))
                CASE TYPEINT
                    Value.DataType = TYPEINT
                    Value.ValueInt = 0
                CASE TYPEREAL
                    Value.DataType = TYPEREAL
                    Value.ValueReal = 0
                CASE TYPESTR
                    Value.DataType = TYPESTR
                    Value.ValueStr.StrBuf = ""
                    Value.ValueStr.StrLen = 0
            END SELECT
        ELSE
            ErrorHit (ERRORUNDEFINEDSYMBOL)
            Ok = FALSE
        END IF
    ELSE
        IF (SymTable(PTR).Flags AND SYMFLAGFIELD) THEN
            '
            '   This is a field, get the value from the file buffer
            '
            Ok = FileFieldGet(SymTable(PTR).MemPtr, SymTable(PTR).Offset, SymTable(PTR).Length, Value)
        ELSE
            '
            '   Get the value from memory
            '
            Offset = SymTabOffset(PTR, cArgs, vArgs())
            IF Offset >= 0 THEN
                Ok = MemGet(SymTable(PTR).DataType, SymTable(PTR).MemPtr + Offset, Value)
            ELSE
                Ok = FALSE
            END IF
        END IF
    END IF

    SymTabGet = Ok

END FUNCTION

'======================================================================
'
'   SymTabInit - Initializes Symbol table
'
'======================================================================
SUB SymTabInit

    SymTableBase = 0
    SymTableFree = 0

    Ret = SymTabAdd("BYE", TOKENBYE, 0)
    Ret = SymTabAdd("DEBUG", TOKENDEBUG, 0)
    Ret = SymTabAdd("DUMP", TOKENDUMP, 0)
    Ret = SymTabAdd("LIST", TOKENLIST, 0)
    Ret = SymTabAdd("LOAD", TOKENLOAD, 0)
    Ret = SymTabAdd("NEW", TOKENNEW, 0)
    Ret = SymTabAdd("RENUM", TOKENRENUM, 0)
    Ret = SymTabAdd("RUN", TOKENRUN, 0)
    Ret = SymTabAdd("SAVE", TOKENSAVE, 0)
    Ret = SymTabAdd("TRACE", TOKENTRACE, 0)
    Ret = SymTabAdd("BRK", TOKENBRK, 0)
    Ret = SymTabAdd("CBRK", TOKENCBRK, 0)
    Ret = SymTabAdd("CONT", TOKENCONT, 0)
    Ret = SymTabAdd("AS", TOKENAS, 0)
    Ret = SymTabAdd("BEEP", TOKENBEEP, 0)
    Ret = SymTabAdd("CHDIR", TOKENCHDIR, 0)
    Ret = SymTabAdd("CLOSE", TOKENCLOSE, 0)
    Ret = SymTabAdd("CLS", TOKENCLS, 0)
    Ret = SymTabAdd("COLOR", TOKENCOLOR, 0)
    Ret = SymTabAdd("DATA", TOKENDATA, 0)
    Ret = SymTabAdd("DEF", TOKENDEF, 0)
    Ret = SymTabAdd("DIM", TOKENDIM, 0)
    Ret = SymTabAdd("ELSE", TOKENELSE, 0)
    Ret = SymTabAdd("END", TOKENEND, 0)
    Ret = SymTabAdd("ERROR", TOKENERROR, 0)
    Ret = SymTabAdd("FIELD", TOKENFIELD, 0)
    Ret = SymTabAdd("FOR", TOKENFOR, 0)
    Ret = SymTabAdd("GET", TOKENGET, 0)
    Ret = SymTabAdd("GOSUB", TOKENGOSUB, 0)
    Ret = SymTabAdd("GOTO", TOKENGOTO, 0)
    Ret = SymTabAdd("IF", TOKENIF, 0)
    Ret = SymTabAdd("INPUT", TOKENINPUT, 0)
    Ret = SymTabAdd("KEY", TOKENKEY, 0)
    Ret = SymTabAdd("LET", TOKENLET, 0)
    Ret = SymTabAdd("LSET", TOKENLSET, 0)
    Ret = SymTabAdd("RSET", TOKENRSET, 0)
    Ret = SymTabAdd("LINE", TOKENLINE, 0)
    Ret = SymTabAdd("LOCATE", TOKENLOCATE, 0)
    Ret = SymTabAdd("NEXT", TOKENNEXT, 0)
    Ret = SymTabAdd("ON", TOKENON, 0)
    Ret = SymTabAdd("OFF", TOKENOFF, 0)
    Ret = SymTabAdd("OPEN", TOKENOPEN, 0)
    Ret = SymTabAdd("PRINT", TOKENPRINT, 0)
    Ret = SymTabAdd("PUT", TOKENPUT, 0)
    Ret = SymTabAdd("RANDOMIZE", TOKENRANDOMIZE, 0)
    Ret = SymTabAdd("READ", TOKENREAD, 0)
    Ret = SymTabAdd("REM", TOKENREM, 0)
    Ret = SymTabAdd("RESTORE", TOKENRESTORE, 0)
    Ret = SymTabAdd("RESUME", TOKENRESUME, 0)
    Ret = SymTabAdd("RETURN", TOKENRETURN, 0)
    Ret = SymTabAdd("SEEK", TOKENSEEK, 0)
    Ret = SymTabAdd("SHELL", TOKENSHELL, 0)
    Ret = SymTabAdd("SLEEP", TOKENSLEEP, 0)
    Ret = SymTabAdd("STEP", TOKENSTEP, 0)
    Ret = SymTabAdd("STOP", TOKENSTOP, 0)
    Ret = SymTabAdd("THEN", TOKENTHEN, 0)
    Ret = SymTabAdd("TIMER", TOKENTIMER, 0)
    Ret = SymTabAdd("TO", TOKENTO, 0)
    Ret = SymTabAdd("WEND", TOKENWEND, 0)
    Ret = SymTabAdd("WHILE", TOKENWHILE, 0)
    Ret = SymTabAdd("AND", TOKENAND, 0)
    Ret = SymTabAdd("OR", TOKENOR, 0)
    Ret = SymTabAdd("NOT", TOKENNOT, 0)
    Ret = SymTabAdd("OUTPUT", TOKENOUTPUT, 0)
    Ret = SymTabAdd("APPEND", TOKENAPPEND, 0)
    Ret = SymTabAdd("RANDOM", TOKENRANDOM, 0)
    Ret = SymTabAdd("ABS", TOKENFABS, 0)
    Ret = SymTabAdd("ASC", TOKENFASC, 0)
    Ret = SymTabAdd("ATN", TOKENFATN, 0)
    Ret = SymTabAdd("CHR$", TOKENFCHR, 0)
    Ret = SymTabAdd("CINT", TOKENFCINT, 0)
    Ret = SymTabAdd("COS", TOKENFCOS, 0)
    Ret = SymTabAdd("CVI", TOKENFCVI, 0)
    Ret = SymTabAdd("CVS", TOKENFCVS, 0)
    Ret = SymTabAdd("DATE$", TOKENFDATE, 0)
    Ret = SymTabAdd("EOF", TOKENFEOF, 0)
    Ret = SymTabAdd("ERL", TOKENFERL, 0)
    Ret = SymTabAdd("ERR", TOKENFERR, 0)
    Ret = SymTabAdd("ERT", TOKENFERT, 0)
    Ret = SymTabAdd("EXP", TOKENFEXP, 0)
    Ret = SymTabAdd("FIX", TOKENFFIX, 0)
    Ret = SymTabAdd("INKEY$", TOKENFINKEY, 0)
    Ret = SymTabAdd("INSTR", TOKENFINSTR, 0)
    Ret = SymTabAdd("INT", TOKENFINT, 0)
    Ret = SymTabAdd("LCASE$", TOKENFLCASE, 0)
    Ret = SymTabAdd("LEFT$", TOKENFLEFT, 0)
    Ret = SymTabAdd("LEN", TOKENFLEN, 0)
    Ret = SymTabAdd("LOC", TOKENFLOC, 0)
    Ret = SymTabAdd("LOF", TOKENFLOF, 0)
    Ret = SymTabAdd("LOG", TOKENFLOG, 0)
    Ret = SymTabAdd("LTRIM$", TOKENFLTRIM, 0)
    Ret = SymTabAdd("MID$", TOKENFMID, 0)
    Ret = SymTabAdd("MKI$", TOKENFMKI, 0)
    Ret = SymTabAdd("MKS$", TOKENFMKS, 0)
    Ret = SymTabAdd("RIGHT$", TOKENFRIGHT, 0)
    Ret = SymTabAdd("RND", TOKENFRND, 0)
    Ret = SymTabAdd("RTRIM$", TOKENFRTRIM, 0)
    Ret = SymTabAdd("SEEK", TOKENFSEEK, 0)
    Ret = SymTabAdd("SIN", TOKENFSIN, 0)
    Ret = SymTabAdd("SQR", TOKENFSQR, 0)
    Ret = SymTabAdd("STR$", TOKENFSTR, 0)
    Ret = SymTabAdd("TIME$", TOKENFTIME, 0)
    Ret = SymTabAdd("UCASE$", TOKENFUCASE, 0)
    Ret = SymTabAdd("VAL", TOKENFVAL, 0)
    Ret = SymTabAdd("CURSORY", TOKENFCURSORY, 0)
    Ret = SymTabAdd("CURSORX", TOKENFCURSORX, 0)
    Ret = SymTabAdd("SYM", TOKENSYM, 0)
    Ret = SymTabAdd("MEM", TOKENMEM, 0)
    Ret = SymTabAdd("SYS", TOKENSYS, 0)
    Ret = SymTabAdd("MOD", TOKENMOD, 0)

    SymTableBase = SymTableFree

END SUB

'======================================================================
'
'   SymTabOffset    -   Calculates an offset for an array
'
'   Ptr         =   Symbol Table pointer
'   Dimensions  =   Number of dimensions
'   Index       =   Array of indices
'
'   Returns Offset for the element, or -1 of error
'
'======================================================================
FUNCTION SymTabOffset (PTR AS INTEGER, cArgs AS INTEGER, vArgs() AS VALUETYPE)

    DIM Offset AS INTEGER
    DIM Size(3) AS INTEGER
    DIM j AS INTEGER

    Offset = -1

    IF cArgs = SymTable(PTR).Dimensions THEN

        Size(0) = SymTable(PTR).Size1
        Size(1) = SymTable(PTR).Size2
        Size(2) = SymTable(PTR).Size3

        Offset = 0
        FOR j = 0 TO cArgs - 1
            IF vArgs(j).DataType <> TYPEINT THEN
                ErrorHit (ERRORTYPEMISMATCH)
                Offset = -1
                EXIT FOR
            END IF
            IF vArgs(j).ValueInt >= Size(j) THEN
                ErrorHit (ERRORSUBSCRIPTOUTOFRANGE)
                Offset = -1
                EXIT FOR
            END IF
            Offset = vArgs(j).ValueInt + (Offset * Size(j))
        NEXT j
    ELSE
        ErrorHit (ERRORINVALIDSUBSCRIPT)
    END IF

    SymTabOffset = Offset

END FUNCTION

'======================================================================
'
'   SymTabSet -  Sets a value for a given symbol
'
'   Symbol      =   Symbol
'   Dimensions  =   Number of dimensions
'   Index()     =   Index for each dimension
'   Value       =   Value to set
'
'   Returns TRUE if Success, FALSE otherwise
'
'======================================================================
FUNCTION SymTabSet (Symbol AS STRING, cArgs AS INTEGER, vArgs() AS VALUETYPE, Value AS VALUETYPE)

    DIM PTR AS INTEGER
    DIM Ok AS INTEGER
    DIM Offset AS INTEGER
    DIM Size(MAXDIMENSIONS) AS INTEGER

    Ok = TRUE

    PTR = SymTabFind(RTRIM$(Symbol))

    IF PTR = NILPOINTER THEN
        IF cArgs = 0 THEN
            PTR = SymTabAddVar(RTRIM$(Symbol), TOKENVARIABLE, 0, SymbolToDataType(Symbol), 0, Size())
            IF PTR = NILPOINTER THEN
                Ok = FALSE
            END IF
        ELSE
            ErrorHit (ERRORUNDEFINEDSYMBOL)
        END IF
    END IF

    IF Ok THEN
        IF SymTable(PTR).DataType <> Value.DataType THEN
            IF (SymTable(PTR).DataType = TYPEREAL) THEN
                Ok = CastToReal(Value)
            ELSE
                ErrorHit (ERRORTYPEMISMATCH)
                Ok = FALSE
            END IF
        END IF
    END IF

    IF Ok THEN
        IF (SymTable(PTR).Flags AND SYMFLAGFIELD) THEN
            '
            '   This is a field, set the value in the file buffer
            '
            Ok = FileFieldSet(SymTable(PTR).MemPtr, SymTable(PTR).Offset, SymTable(PTR).Length, Value)
        ELSE
            '
            '   Set the value in memory
            '
            Offset = SymTabOffset(PTR, cArgs, vArgs())
            IF Offset >= 0 THEN
                Ok = MemSet(SymTable(PTR).MemPtr + Offset, Value)
            ELSE
                Ok = FALSE
            END IF
        END IF
    END IF

    SymTabSet = Ok

END FUNCTION

'======================================================================
'
'   SymTabValidateSymbol    -   Checks the validity of a symbol
'
'   Symbol      =   Symbol
'
'   Returns TRUE if symbol valid, FALSE otherwise
'
'======================================================================
FUNCTION SymTabValidateSymbol (Symbol AS STRING)
    '
    '    Note: Here we only validate length, not syntax
    '
    SymTabValidateSymbol = (LEN(Symbol) < MAXSYMLEN)
END FUNCTION





















                        
