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

'======================================================================
'
'   Constants
'
'======================================================================

%FALSE = 0
%TRUE = NOT %FALSE
%NILPOINTER = -1           ' Invalid pseudo-pointer
'
' Version Information
'
$MyName = "Cheesecake BASIC"
$MyAuthor = "Ramon San Andres"
$MyEmail = "mnitesoft@aol.com"
$MyWeb = "http://members.aol.com/mnitesoft"
$MySource = "PBCC 2.0"
%MyVersionMajor = 0
%MyVersionMinor = 1
%MyVersionRev = 0
'
' Supported data types
'
%TYPEINT = 1               '   Integer
%TYPEREAL = 2              '   Real (Single in QuickBasic)
%TYPESTR = 3               '   String
'
'   Interpreter limits
'
%MAXMEMINT = 10000           '   Size of Integer memory
%MAXMEMREAL = 10000          '   Size of Real memory
%MAXMEMSTR = 10000           '   Size of String memory
%MAXSTRLEN = 128           '   Maximum string length
%MAXMEMPGM = 5000           '   Size of Program memory
%MAXPGMBUFLEN = 168        '   Maximum size of Program memory buffer
%MAXSTACKRET = 100          '   Size of return stack
%MAXSTACKLOOP = 50          '   Size of loop stack
%MAXSTACKFACTOR = 100       '   Size of factor stack
%MAXFILES = 3              '   Maximum number of files
%MAXFILEREC = 3            '   Maximum record structures per file
%MAXFILEFIELD = 5          '   Maximum fields per record structure
%MAXFILEBUFLEN = 256       '   Maximum size of file buffer
%MAXRECORDS = (%MAXFILES * %MAXFILEREC)      ' Total number of records
%MAXFIELDS = (%MAXRECORDS * %MAXFILEFIELD)   ' Total number of fields
%MAXDIMENSIONS = 3         '   Maximum dimensions in array
%MAXSYMTABLE = 1000         '   Size of symbol table
%MAXSYMLEN = 16            '   Maximum length of a symbol
%INKEYBUFLEN = 128         '   Size of INKEY$ Buffer
%MAXDEFPARAM = 4           '   Max parameters in a user function
%MAXSTACKFUNC = 10          '   Maximum nesting of user functions
%MAXMEMARG = (%MAXSTACKFUNC * %MAXDEFPARAM)    ' Total number of arguments
'
'   Errors
'
%ERRORINTERNAL = 100
%ERRORNOMEMORY = 101
%ERRORINVALIDMEMACCESS = 102
%ERRORINVALIDSUBSCRIPT = 103
%ERRORSUBSCRIPTOUTOFRANGE = 104
%ERRORSYNTAX = 105
%ERRORTYPEMISMATCH = 106
%ERRORUNDEFINEDSYMBOL = 107
%ERRORLABELNOTFOUND = 108
%ERRORINVALIDINCREMENT = 109
%ERRORINVALIDLOOPNESTING = 110
%ERRORINVALIDKEYNUMBER = 111
%ERRORKEYTRAPPINGNOTENABLED = 112
%ERRORINVALIDFILENUMBER = 113
%ERRORFILENOTOPEN = 114
%ERRORINVALIDACCESS = 115
%ERRORTOOMANYINPUT = 116
%ERRORINVALIDCOORDINATE = 117
%ERRORMAXFIELDS = 118
%ERRORBADRECORDLEN = 119
%ERRORTOOMANYRECORDS = 120
%ERRORTOOMANYFIELDS = 121
%ERRORBADNUMARG = 122
%ERRORSTACKOVERFLOW = 123
%ERRORSTACKEMPTY = 124
%ERRORNOMOREDATA = 125
%ERRORNOTIMERTRAP = 126
%ERRORSYMBOLDEFINED = 127
%ERRORFORNONEXT = 128
%ERRORWHILENOWEND = 129
%ERRORCANNOTCONT = 130
'
'   %TOKENS
'
%TOKENBYE = 100            '   BYE
%TOKENDEBUG = 101          '   DEBUG
%TOKENDUMP = 102           '   DUMP
%TOKENLIST = 103           '   LIST
%TOKENLOAD = 104           '   LOAD
%TOKENNEW = 105            '   NEW
%TOKENRENUM = 106          '   RENUM
%TOKENRUN = 107            '   RUN
%TOKENSAVE = 108           '   SAVE
%TOKENTRACE = 109          '   TRACE
%TOKENBRK = 120            '   BRK
%TOKENCBRK = 121           '   CBRK
%TOKENCONT = 122           '   CONT

%TOKENAS = 200             '   AS
%TOKENBEEP = 201           '   BEEP
%TOKENCHDIR = 202          '   CHDIR
%TOKENCLOSE = 203          '   CLOSE
%TOKENCLS = 204            '   CLS
%TOKENCOLOR = 205          '   COLOR
%TOKENDATA = 206           '   DATA
%TOKENDEF = 207            '   DEF
%TOKENDIM = 208            '   DIF
%TOKENELSE = 209           '   ELSE
%TOKENEND = 220            '   %TOKENEND
%TOKENERROR = 221          '   %ERROR
%TOKENFIELD = 222          '   FIELD
%TOKENFOR = 223            '   FOR
%TOKENGET = 224            '   GET
%TOKENGOSUB = 225          '   GOSUB
%TOKENGOTO = 226           '   GOTO
%TOKENIF = 227             '   IF
%TOKENINPUT = 228          '   INPUT
%TOKENKEY = 229            '   KEY
%TOKENLET = 240            '   LET
%TOKENLSET = 241           '   LSET
%TOKENRSET = 242           '   RSET
%TOKENLINE = 243           '   LINE
%TOKENLOCATE = 244         '   LOCATE
%TOKENNEXT = 245           '   NEXT
%TOKENON = 246             '   ON
%TOKENOFF = 247            '   OFF
%TOKENOPEN = 248           '   OPEN
%TOKENPRINT = 249          '   PRINT
%TOKENPUT = 260            '   PUT
%TOKENRANDOMIZE = 261      '   RANDOMIZE
%TOKENREAD = 262           '   READ
%TOKENREM = 263            '   REM
%TOKENRESTORE = 264        '   RESTORE
%TOKENRESUME = 265         '   RESUME
%TOKENRETURN = 266         '   RETURN
%TOKENSEEK = 267           '   SEEK
%TOKENSHELL = 268          '   SHELL
%TOKENSLEEP = 269          '   SLEEP
%TOKENSTEP = 280           '   STEP
%TOKENSTOP = 281           '   STOP
%TOKENTHEN = 282           '   THEN
%TOKENTIMER = 283          '   TIMER
%TOKENTO = 284             '   TO
%TOKENWEND = 285           '   WEND
%TOKENWHILE = 286          '   WHILE
%TOKENCONSTANT = 287       '   Constant
%TOKENVARIABLE = 288       '   Variable
%TOKENSYM = 289            '   SYM
%TOKENMEM = 290            '   MEM
%TOKENSYS = 291            '   SYS

%TOKENAND = 300            '   AND
%TOKENOR = 301             '   OR
%TOKENNOT = 302            '   NOT
%TOKENPLUS = 303           '   +
%TOKENMINUS = 304          '   -
%TOKENSTAR = 305           '   *
%TOKENSLASH = 306          '   /
%TOKENBSLASH = 307         '   \
%TOKENCARET = 308          '   ^
%TOKENEQ = 309             '   =
%TOKENNEQ = 310            '   <>
%TOKENLT = 311             '   <
%TOKENGT = 312             '   >
%TOKENLEQ = 313            '   <=
%TOKENGEQ = 314            '   >=
%TOKENMOD = 315            '   MOD

%TOKENOPENPAREN = 400      '   (
%TOKENCLOSEPAREN = 401     '   )
%TOKENPOUND = 402          '   #
%TOKENSEP = 403            '   :
%TOKENQUOTE = 404          '   "
%TOKENCOMMA = 405          '   ,
%TOKENSEMICOLON = 406      '   ;
%TOKENEOL = 450            '   End of line

%TOKENOUTPUT = 500         '   OUTPUT
%TOKENAPPEND = 501         '   APPEND
%TOKENRANDOM = 502         '   RANDOM

%TOKENFABS = 600           '   ABS
%TOKENFASC = 601           '   ASC
%TOKENFATN = 602           '   ATN
%TOKENFCHR = 603           '   CHR$
%TOKENFCINT = 604          '   CINT
%TOKENFCOS = 605           '   COS
%TOKENFCVI = 606           '   CVI
%TOKENFCVS = 607           '   CVS
%TOKENFDATE = 608          '   DATE$
%TOKENFEOF = 609           '   EOF
%TOKENFERL = 620           '   ERL
%TOKENFERR = 621           '   ERR
%TOKENFERT = 622           '   ERT
%TOKENFEXP = 623           '   EXP
%TOKENFFIX = 624           '   FIX
%TOKENFINKEY = 625         '   INKEY$
%TOKENFINSTR = 626         '   INSTR
%TOKENFINT = 627           '   INT
%TOKENFLCASE = 628         '   LCASE$
%TOKENFLEFT = 629          '   LEFT$
%TOKENFLEN = 640           '   LEN
%TOKENFLOC = 641           '   LOC
%TOKENFLOF = 642           '   LOF
%TOKENFLOG = 643           '   LOG
%TOKENFLTRIM = 644         '   LTRIM$
%TOKENFMID = 645           '   MID$
%TOKENFMKI = 646           '   MKI$
%TOKENFMKS = 647           '   MKS$
%TOKENFRIGHT = 648         '   RIGHT$
%TOKENFRND = 649           '   RND
%TOKENFRTRIM = 660         '   RTRIM$
%TOKENFSEEK = 661          '   SEEK
%TOKENFSIN = 662           '   SIN
%TOKENFSQR = 663           '   SQR
%TOKENFSTR = 664           '   STR$
%TOKENFTIME = 665          '   TIME
%TOKENFUCASE = 667         '   UCASE$
%TOKENFVAL = 668           '   VAL
%TOKENFUSERDEF = 669       '   User-defined function
%TOKENFCURSORY = 670       '   CURSORY
%TOKENFCURSORX = 671       '   CURSORX
%TOKENFSPACE = 672         '   SPACE$

%TOKENUNKNOWN = 1000       '   Unknown
'
'   Init flags
'
%INITFILES = 1
%INITSTACKS = 2
%INITTRAP = 4
%INITDATA = 8
%INITSYMTAB = 16
%INITALLSYM = 32
%INITPGM = 64
%INITRUN = (%INITFILES + %INITSTACKS + %INITTRAP + %INITDATA)
%INITCLEAR = (%INITRUN + %INITSYMTAB)
%INITNEW = (%INITCLEAR + %INITALLSYM + %INITPGM)
'
'   PGM Flags
'
%PGMFLAGDATA = 1                           '   Line has DATA
%PGMFLAGBRK = 2                            '   Line has breakpoint
'
'   Symbol table flags
'
%SYMFLAGARRAY = 1                          '   Symbol is an array
%SYMFLAGFIELD = 2                          '   Symbol is a file field
                                                '       NOTE:   If symbol is a file field, then
                                                '               MemPtr has the file number
%SYMFLAGFUNC = 4                           '   User-defined function
'
'   Loop Flags
'
%LOOPKINDFOR = 1                           '   FOR loop
%LOOPKINDWHILE = 2                         '   While loop
'
'   File constants
'
%FIRSTFILENUMBER = 1                           '   First file #
%LOADFILENUMBER = %FIRSTFILENUMBER + %MAXFILES   '   File # for LOAD
%SAVEFILENUMBER = %LOADFILENUMBER               '   File # for SAVE
%DUMPFILENUMBER = %LOADFILENUMBER               '   File # for DUMP
'
'   File access
'
%FILEACCESSINPUT = 1                       '   Input
%FILEACCESSOUTPUT = 2                      '   Output
%FILEACCESSAPPEND = 3                      '   Append
%FILEACCESSRANDOM = 4                      '   Random
'
'   Default file record length
'
%DEFAULTRECORDLEN = 128                    '   Default record length
'
'   Parser execution indicators
'
%CMDPARSE = 0                              '   Parse - do not execute
%CMDINTERPRET = 1                          '   Execute
%CMDSKIPLOOP = 2                           '   Skip LoopCount loop bodies
%CMDIFBLOCK = 3                            '   Skip IF block
%CMDEVALFUNC = 4                           '   Evaluate User-defined function
%CMDRENUM = 5                              '   Renumber
'
'   Interpreter: InterpSrc values
'
%DEVCONSOLE = 1                            '   Read commands from console
%DEVFILE = 2                               '   Read commands from file
'
'   Input modes
'
%INPUTNORMAL = 1                           '   INPUT
%INPUTLINE = 2                             '   LINE INPUT
%INPUTREAD = 3                             '   READ
'
'   Run modes
'
%RUNSTART = 1                              '   RUN from start
%RUNCONT = 2                               '   RUN continue after STOP/BRK
'
'   Key trapping
'
%FIRSTKEY = 1
%LASTKEY = 12



'======================================================================
'
'   Types
'
'======================================================================

'
'   String Type
'
TYPE STRTYPE
    StrLen AS INTEGER               ' Length of string
    StrBuf AS STRING * %MAXSTRLEN    ' String buffer
END TYPE
'
'   Value type
'
TYPE VALUETYPE
    DataType AS INTEGER             '   Data type
    ValueInt AS INTEGER             '   Value if type is %TYPEINT
    ValueReal AS SINGLE             '   Value if type is %TYPEREAL
    ValueStr AS STRTYPE             '   Value if type is %TYPESTR
END TYPE
'
'   Program Location
'
TYPE PGMLOCTYPE
    PgmPtr AS INTEGER               '   Pointer into PgmMem
    Offset AS INTEGER               '   Offset within buffer
END TYPE
'
'   Program Memory
'
TYPE PGMMEMTYPE
    LineNumber AS INTEGER                       '   Line number
    Flags AS INTEGER                            '   Flags
    Renum AS INTEGER                            '   RENUM number
    PrevPtr AS INTEGER                          '   Previous in chain
    NextPtr AS INTEGER                          '   Next in chain
    Offset AS INTEGER                           '   For misc. uses
    BufLen AS INTEGER                           '   Length of buffer
    Buffer AS STRING * %MAXPGMBUFLEN             '   Buffer
END TYPE
'
'   Symbol Table
'
TYPE SYMTABTYPE
    Symbol AS STRING * %MAXSYMLEN                '   Symbol
    SymbolType AS INTEGER                       '   Symbol type
    Flags AS INTEGER                            '   Flags
    Dimensions AS INTEGER                       '   Dimensions
    Size1 AS INTEGER                            '   Dimension 1
    Size2 AS INTEGER                            '   Dimension 2
    Size3 AS INTEGER                            '   Dimension 3
    DataType AS INTEGER                         '   data type
    MemPtr AS INTEGER                           '   Pointer to value
    Offset AS INTEGER                           '   Offset if field
    Length AS INTEGER                           '   Length if field
END TYPE
'
'   Loop stack
'
'
TYPE LOOPSTKTYPE
    LoopKind AS INTEGER                         '   Kind of loop
    Flags AS INTEGER                            '   Flags
    Id AS STRING * %MAXSYMLEN                    '   Counter
    FirstValue AS INTEGER                       '   First value
    LastValue AS INTEGER                        '   Last value
    Increment AS INTEGER                        '   Increment
    PgmBegin AS PGMLOCTYPE                      '   Loop begins
    PgmEnd AS PGMLOCTYPE                        '   Loop ends
END TYPE
'
' Function evaluation stack
'
TYPE FUNCSTKTYPE
    cParam AS INTEGER                           '   Number of parameters
    ParamPtr AS INTEGER                         '   Pointer into StrMem
    ArgPtr AS INTEGER                           '   pointer into ArgMem
END TYPE
'
'   File structures
'
TYPE FIELDTYPE
    FieldId AS STRING * %MAXSYMLEN               '   ID
    FieldLen AS INTEGER                         '   Length
    NextPtr AS INTEGER                          '   Next in chain
END TYPE

TYPE RECTYPE
    RecordLen AS INTEGER                        '   Record length
    FieldPtr AS INTEGER                         '   Field list
    NextPtr AS INTEGER                          '   Next in chain
END TYPE

TYPE FILETYPE
    FileName AS STRING * %MAXSTRLEN              '   File name
    FileAccess AS INTEGER                       '   Access
    RecordLen AS INTEGER                        '   Record length
    RecordPtr AS INTEGER                        '   Record list
    SeekPos AS INTEGER                          '   Seek position
    Buffer AS STRING * %MAXFILEBUFLEN            '   Buffer
END TYPE
'
'   Lexer
'
TYPE TOKENTYPE
    Tkn AS INTEGER                              '   The Token
    Value AS VALUETYPE                          '   Value
    TokenBegin AS INTEGER                       '   Token begins
END TYPE
'
'   Information saved after a STOP/BREAK
'
TYPE BRKSAVETYPE
    Lc AS PGMLOCTYPE
    ErrTrapEnabled AS INTEGER
    TimerTrapEnabled AS INTEGER
    KeyTrapEnabled AS INTEGER
END TYPE

'======================================================================
'
'   Function prototypes
'
'======================================================================

DECLARE SUB ArgMemGet(PTR AS INTEGER, Value AS VALUETYPE)
DECLARE SUB ArgMemSet(PTR AS INTEGER, Value AS VALUETYPE)
DECLARE SUB FactorStackInit()
DECLARE FUNCTION FactorStackPop (Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION FactorStackPush (Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION FuncStackGet( FuncData AS FUNCSTKTYPE )AS INTEGER
DECLARE FUNCTION FuncStackIsEmpty()AS INTEGER
DECLARE FUNCTION FuncStackPop (FuncData AS FUNCSTKTYPE)AS INTEGER
DECLARE FUNCTION FuncStackPush (FuncData AS FUNCSTKTYPE)AS INTEGER
DECLARE FUNCTION InKeyBufGet$()
DECLARE SUB InKeyBufSet(s AS STRING)
DECLARE FUNCTION KeyTrapTargetGet(PTR AS INTEGER)AS INTEGER
DECLARE SUB KeyTrapTargetSet(PTR AS INTEGER, Target AS INTEGER)
DECLARE FUNCTION KeyOnGet(PTR AS INTEGER)AS INTEGER
DECLARE SUB KeyOnSet(PTR AS INTEGER, Value AS INTEGER)
DECLARE SUB Init (InitFlag AS INTEGER)
DECLARE SUB LoopStackInit()
DECLARE FUNCTION LoopStackPop (ls AS LOOPSTKTYPE)AS INTEGER
DECLARE FUNCTION LoopStackPush (ls AS LOOPSTKTYPE)AS INTEGER
DECLARE FUNCTION LoopStackTopData( LoopData AS LOOPSTKTYPE)AS INTEGER
DECLARE SUB RetStackInit()
DECLARE FUNCTION RetStackPop (PgmLoc AS PGMLOCTYPE)AS INTEGER
DECLARE FUNCTION RetStackPush (PgmLoc AS PGMLOCTYPE)AS INTEGER
DECLARE SUB SetPgmCur (PgmPtr AS INTEGER)
DECLARE FUNCTION SymbolToDataType (Symbol AS STRING)AS INTEGER
DECLARE SUB SysDump (FileNum AS INTEGER)
'
'   Misc
'
DECLARE SUB CloseLoadFile ()
DECLARE SUB DoKeyTrapping ()
DECLARE SUB DoTimerTrapping ()
DECLARE SUB ErrorDisplay (Code AS INTEGER)
DECLARE SUB ErrorHit (Code AS INTEGER)
DECLARE FUNCTION ErrorText$ (Code AS INTEGER)
DECLARE SUB ListPgm (Dev AS INTEGER, FirstLine AS INTEGER, LastLine AS INTEGER)
DECLARE SUB LoadBrkData ()
'
'   Interpreter
'
DECLARE SUB InterpBrk (Tkn AS INTEGER)
DECLARE SUB InterpDebug ()
DECLARE SUB InterpDump ()
DECLARE SUB InterpGetLine ()
DECLARE SUB InterpLine ()
DECLARE SUB InterpList ()
DECLARE SUB InterpLoad ()
DECLARE SUB InterpNew ()
DECLARE SUB InterpRenum ()
DECLARE SUB Interpreter ()
DECLARE SUB InterpRun (Flag AS INTEGER)
DECLARE SUB InterpSave ()
DECLARE SUB InterpTrace ()
'
'   Lexer
'
DECLARE SUB LexAdvance (Count AS INTEGER)
DECLARE SUB LexAlpha ()
DECLARE FUNCTION LexGetInputToken ()AS INTEGER
DECLARE FUNCTION LexGetToken ()AS INTEGER
DECLARE SUB LexLiteral ()
DECLARE FUNCTION LexLookAhead$ (Count AS INTEGER)
DECLARE SUB LexNumeric ()
DECLARE SUB LexPreLex ()
DECLARE SUB LexRelop ()
DECLARE SUB LexSetToken (Tkn AS INTEGER, Value AS VALUETYPE)
DECLARE SUB LexSkipBlanks ()
DECLARE SUB LexSymbol (Symbol AS STRING)
DECLARE FUNCTION LexTokenStr$ ()
DECLARE SUB LexUngetToken ()
'
'   Parser
'
DECLARE FUNCTION ApplyOperator (Cmd AS INTEGER, Tkn AS INTEGER, v1 AS VALUETYPE, v2 AS VALUETYPE, vRes AS VALUETYPE)AS INTEGER
DECLARE FUNCTION ArgMemAlloc(Size AS INTEGER)AS INTEGER
DECLARE FUNCTION ArgMemDealloc(Size AS INTEGER)AS INTEGER
DECLARE SUB BreakPoint (s AS STRING)
DECLARE FUNCTION CastToReal(Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION CorrectOp(Level AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION EvalFunc(SymPtr AS INTEGER, vArgs() AS VALUETYPE)AS INTEGER
DECLARE FUNCTION EvalLoopCondition(Execute AS INTEGER)AS INTEGER
DECLARE FUNCTION ExecGoSub(LineNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION ExecGoTo(LineNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION GetReadData(Buffer AS STRING, Offset AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseArgList(Cmd AS INTEGER, MaxArg AS INTEGER, cArgs AS INTEGER, vArgs() AS VALUETYPE)AS INTEGER
DECLARE FUNCTION ParseBlock(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseClose(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseCoLoc(Cmd AS INTEGER, Token AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseColor(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseData(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseDef(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseDim(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseExp(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseFactor(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseField(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseFInstr(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseFMid(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseFor(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseFunc(Cmd AS INTEGER, FuncName AS STRING)AS INTEGER
DECLARE FUNCTION ParseGetPutSeek(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseGo(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseIf(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseInput(Cmd AS INTEGER, Mode AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseIntExp(Cmd AS INTEGER, IntValue AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseIntFStr(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseIntF(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseIntFNum(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseKeyTimer(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseLet(Cmd AS INTEGER, Token AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseNext(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseNumFNum(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseOn(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseOnError(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseOnExp(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseOnKeyTimer(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseOpen(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParsePrint(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseRandomize(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseRealExp(Cmd AS INTEGER, RealValue AS SINGLE)AS INTEGER
DECLARE FUNCTION ParseRealF(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseRealFNum(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseResRet(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseRestore(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseRValue(Cmd AS INTEGER, Symbol AS STRING)AS INTEGER
DECLARE FUNCTION ParseShell(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseSimple(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStatement(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStmt1Arg(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStop(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStrExp(Cmd AS INTEGER, s AS STRING) AS INTEGER
DECLARE FUNCTION ParseStrF(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStrFNum(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseStrFStr(Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseTerm(Cmd AS INTEGER, Level AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseWend(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION ParseWhile(Cmd AS INTEGER)AS INTEGER
DECLARE FUNCTION RenumPatch(Offset AS INTEGER)AS INTEGER
DECLARE FUNCTION SkipLoopBlock()AS INTEGER
'
'   Memory
'
DECLARE FUNCTION MemAlloc (DataType AS INTEGER, Size AS INTEGER)AS INTEGER
DECLARE SUB MemDump (FileNum AS INTEGER)
DECLARE FUNCTION MemGet (DataType AS INTEGER, MemPtr AS INTEGER, Value AS VALUETYPE)AS INTEGER
DECLARE SUB MemInit ()
DECLARE FUNCTION MemSet (MemPtr AS INTEGER, Value AS VALUETYPE)AS INTEGER
'
'   Symbol Table
'
DECLARE FUNCTION SymTabAdd(Symbol AS STRING, SymbolType AS INTEGER, Flags AS INTEGER)AS INTEGER
DECLARE FUNCTION SymTabAddField(Symbol AS STRING, FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER)AS INTEGER
DECLARE FUNCTION SymTabAddFunc(Symbol AS STRING, FuncType AS INTEGER, cParam AS INTEGER, Param() AS STRING, FuncExp AS STRING)AS INTEGER
DECLARE FUNCTION SymTabAddVar (Symbol AS STRING, SymbolType AS INTEGER, Flags AS INTEGER, DataType AS INTEGER, Dimensions AS INTEGER, Sizes() AS INTEGER)AS INTEGER
DECLARE FUNCTION SymTabAlloc()AS INTEGER
DECLARE SUB SymTabDump (FileNum AS INTEGER)
DECLARE SUB SymTabEntry(PTR AS INTEGER, SymData AS SYMTABTYPE)
DECLARE FUNCTION SymTabFind(Symbol AS STRING)AS INTEGER
DECLARE FUNCTION SymTabGet(Symbol AS STRING, cArgs AS INTEGER, vArgs() AS VALUETYPE, Value AS VALUETYPE)AS INTEGER
DECLARE SUB SymTabInit ()
DECLARE FUNCTION SymTabOffset(PTR AS INTEGER, cArgs AS INTEGER, vArgs() AS VALUETYPE)AS INTEGER
DECLARE FUNCTION SymTabSet(Symbol AS STRING, cArgs AS INTEGER, vArgs() AS VALUETYPE, Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION SymTabValidateSymbol(Symbol AS STRING)AS INTEGER
'
'   File handling
'
DECLARE FUNCTION FileAddFields(FileNumber AS INTEGER, cFields AS INTEGER, FieldSizes() AS INTEGER, FieldNames() AS STRING)AS INTEGER
DECLARE FUNCTION FileClean(FileNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION FileFieldGet(FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER, Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION FileFieldSet(FileNumber AS INTEGER, Offset AS INTEGER, Length AS INTEGER, Value AS VALUETYPE)AS INTEGER
DECLARE FUNCTION FileIsOpen(FileNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION FileReadBuf(FileNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION FileSeek(FileNumber AS INTEGER, RecNum AS INTEGER)AS INTEGER
DECLARE FUNCTION FileSet(FileNumber AS INTEGER, FileData AS FILETYPE)AS INTEGER
DECLARE FUNCTION FileWriteBuf(FileNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION FileValidateAccess(FileNumber AS INTEGER, Mode AS INTEGER)AS INTEGER
'
'   Program memory
'
DECLARE FUNCTION PgmMemAlloc()AS INTEGER
DECLARE FUNCTION PgmMemBuf$(PTR AS INTEGER)
DECLARE FUNCTION PgmMemBufLen(PTR AS INTEGER)AS INTEGER
DECLARE SUB PgmMemDealloc (PTR AS INTEGER)
DECLARE SUB PgmMemDelete (PTR AS INTEGER)
DECLARE FUNCTION PgmMemFind(LineNumber AS INTEGER)AS INTEGER
DECLARE FUNCTION PgmMemFindPos(LineNumber AS INTEGER, PrevPtr AS INTEGER)AS INTEGER
DECLARE SUB PgmMemGet(PTR AS INTEGER, PgmData AS PGMMEMTYPE)
DECLARE SUB PgmMemInit ()
DECLARE SUB PgmMemInsert (PTR AS INTEGER)
DECLARE FUNCTION PgmMemLineNum(PTR AS INTEGER)AS INTEGER
DECLARE FUNCTION PgmMemNext(PTR AS INTEGER)AS INTEGER
DECLARE FUNCTION PgmMemProgram()AS INTEGER
DECLARE SUB PgmMemSet(PTR AS INTEGER, PgmData AS PGMMEMTYPE)

'$DYNAMIC

'======================================================================
'
'   GLOBAL Variables
'
'======================================================================
'
'   PGM
'
GLOBAL PgmCur AS PGMLOCTYPE                 '   Currently executing
GLOBAL PgmMemImm AS INTEGER                 '   Used for immediate cmds
GLOBAL PgmMemInp AS INTEGER                 '   For INPUT
GLOBAL StmtCur AS INTEGER                   '   Offset of current stmt
GLOBAL PgmData AS PGMLOCTYPE                '   Start looking for DATA statements here
'
'   Lexer
'
GLOBAL LexToken AS TOKENTYPE                '   Last token
GLOBAL LexError AS INTEGER                  '   Lex error
'
' Interpreter
'
GLOBAL InterpSrc AS INTEGER                 '   Interpreter source (%DEVCONSOLE etc)
GLOBAL TraceOn AS INTEGER                   '   Trace on flag
GLOBAL LoopCount AS INTEGER                 '   Number of loops to skip
'
'   BRK saved data
'
GLOBAL BrkSaveData AS BRKSAVETYPE           '   BRK saved information
'
'   Error trapping
'
GLOBAL ErrTrapEnabled AS INTEGER            '   Error trapping enabled
GLOBAL ErrTrapTarget AS INTEGER             '   PgmPtr
GLOBAL LastErr AS INTEGER                   '   ERR
GLOBAL LastErl AS INTEGER                   '   ERL
GLOBAL LastErt AS STRING                    '   ERT
'
'   Key Trapping
'
GLOBAL KeyTrapEnabled AS INTEGER            '   Key trapping enabled
'
'   Timer trapping
'
GLOBAL TimerTrapEnabled AS INTEGER          '   Timer trapping enabled
GLOBAL TimerTrapTarget AS INTEGER           '   PgmPtr
GLOBAL TimerInterval AS INTEGER             '   Timer interval
GLOBAL TimerStamp AS LONG                   '   Timestamp
'
'   INKEY$ support
'
GLOBAL InKeyChars AS INTEGER                '   Characters in buffer

'======================================================================
'
'   ChaBasic structures
'
'======================================================================
'
'   Function stack
'


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

FUNCTION PBMAIN

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

    CONSOLE SCREEN 50, 80
    Interpreter

END FUNCTION

'$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)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)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)AS INTEGER

    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) AS INTEGER

    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) AS INTEGER

    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)AS INTEGER

    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 )AS INTEGER
    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   AS INTEGER
   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)  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)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
    DIM Ok 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)AS INTEGER

    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)AS INTEGER

    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) AS INTEGER
   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) AS INTEGER

    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)AS INTEGER

    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)AS INTEGER

    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) 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)AS INTEGER

    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)AS INTEGER

    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) 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) AS INTEGER
    'FileTable(FileNumber).Buffer = INPUT$(FileTable(FileNumber).RecordLen, #FileNumber)
    GET$ #FileNumber, FileTable(FileNumber).RecordLen, FileTable(FileNumber).Buffer
    IF (ERR = 0) THEN
        FileTable(FileNumber).SeekPos = FileTable(FileNumber).SeekPos + 1
    ELSE
       ErrorHit(ERR)
    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)AS INTEGER
    SEEK #FileNumber, (FileTable(FileNumber).RecordLen * (RecNum - 1)) + 1
    IF (ERR = 0) THEN
        FileTable(FileNumber).SeekPos = RecNum
    ELSE
       Errorhit(ERR)
    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) 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) AS INTEGER
    FileTable(FileNumber) = FileData
    FileSet = %TRUE
END FUNCTION

'======================================================================
'
'   FileWriteBuf    -   Writes the file buffer for a RANDOM file
'
'   FileNumber  -   File number
'
'======================================================================
FUNCTION FileWriteBuf (FileNumber AS INTEGER)AS INTEGER
    DIM s AS STRING
    s = LEFT$(FileTable(FileNumber).Buffer, FileTable(FileNumber).RecordLen)
    PUT #FileNumber, , s
    IF (ERR = 0) THEN
        FileTable(FileNumber).SeekPos = FileTable(FileNumber).SeekPos + 1
    ELSE
       ErrorHit(ERR)
    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)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) AS INTEGER
    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) AS INTEGER

    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  AS INTEGER

    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)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)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) 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)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)AS INTEGER
    PgmMemNext = PgmMem(PTR).NextPtr
END FUNCTION

'======================================================================
'
'   PgmMemProgram   -   Returns starting point of program in PgmMem
'
'======================================================================
FUNCTION PgmMemProgram  AS INTEGER
   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)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)AS INTEGER

    DIM PTR AS INTEGER

    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)AS INTEGER

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

    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)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 AS INTEGER

    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)AS INTEGER
    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)AS INTEGER

    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

    DIM Ret AS INTEGER

    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)
    Ret = SymTabAdd("SPACE$", %TOKENFSPACE, 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)AS INTEGER

    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)AS INTEGER

    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)AS INTEGER
    '
    '    Note: Here we only validate length, not syntax
    '
    SymTabValidateSymbol = (LEN(Symbol) < %MAXSYMLEN)
END FUNCTION

'======================================================================
'
'   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
    DIM Ok 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)AS INTEGER

    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 AS INTEGER

    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 AS INTEGER

    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
           OPEN HANDLE GETSTDOUT FOR OUTPUT AS #%DUMPFILENUMBER
        ELSE
            OPEN FileName FOR OUTPUT AS #%DUMPFILENUMBER
        END IF

        IF ERR = 0 THEN
            FileNum = %DUMPFILENUMBER
        ELSE
            ErrorHit(ERR)
            ErrorDisplay (LastErr)
            Ok = %FALSE
        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

    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 ERR = 0 THEN
            Init (%INITNEW)
            InterpSrc = %DEVFILE
        ELSE
            ErrorHit(ERR)
            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

    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

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

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

    Ok = %TRUE

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

    IF Ok THEN

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

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

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

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

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

    END IF

    ApplyOperator = Ok

END FUNCTION

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

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

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

END SUB

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

    DIM Ok AS INTEGER
    Ok = %TRUE

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

    CastToReal = Ok

END FUNCTION

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

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

END FUNCTION

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

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

    Ok = %TRUE

    SymTabEntry SymPtr, SymData

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

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

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

            PgmLoc.Offset = 1

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

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

            IF FuncData.ArgPtr <> %NILPOINTER THEN

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

                Ok = FuncStackPush(FuncData)

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

                    Ok = FuncStackPop(FuncData) AND Ok

                END IF

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

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

        ELSE
            Ok = %FALSE
        END IF

    ELSE
        Ok = %FALSE
    END IF


    EvalFunc = Ok

END FUNCTION

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

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

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

    EvalLoopCondition = Ok

END FUNCTION

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

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

    Ok = %TRUE

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

    ExecGoSub = Ok

END FUNCTION

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

    DIM Ok AS INTEGER
    DIM PgmPtr AS INTEGER

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

    ExecGoTo = Ok

END FUNCTION

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

    DIM Ok AS INTEGER
    DIM PgmM AS PGMMEMTYPE

    Ok = %TRUE

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

        PgmMemGet PgmData.PgmPtr, PgmM

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

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

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

    GetReadData = Ok

END FUNCTION


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

    DIM Count AS INTEGER
    DIM Value AS VALUETYPE

    Count = 0

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

                    vArgs(Count) = Value
                    Count = Count + 1

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

    ParseArgList = (LastErr = 0)

END FUNCTION

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

    DIM Ok AS INTEGER

    DO WHILE (LastErr = 0)

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

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

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

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

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

    ParseBlock = (LastErr = 0)

END FUNCTION

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

    DIM Ok AS INTEGER
    DIM FileNumber AS INTEGER

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

    ParseClose = (LastErr = 0)

END FUNCTION

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

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

    v2Ok = %FALSE

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

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

    ParseCoLoc = (LastErr = 0)

END FUNCTION

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

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

    LexUngetToken
    Offset = PgmCur.Offset
    Tkn = LexGetToken

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

    ParseData = %TRUE

END FUNCTION

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

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

    Ok = %TRUE
    cParam = 0

    IF LexGetToken = %TOKENVARIABLE THEN

        FuncName = LexTokenStr$

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

        IF LexGetToken = %TOKENEQ THEN

            Offset = PgmCur.Offset

            IF ParseExp(%CMDPARSE) THEN

                IF FactorStackPop(Value) THEN

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

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

    ParseDef = (LastErr = 0)

END FUNCTION

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

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

    Ok = %TRUE

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

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

    ParseDim = Ok

END FUNCTION

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

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

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE

    SELECT CASE LexGetToken

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

    ParseFactor = (LastErr = 0)

END FUNCTION

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

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

    cFields = 0

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

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

    ParseField = (LastErr = 0)

END FUNCTION

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

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

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

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

    IF (LastErr = 0) THEN

        Value.DataType = %TYPEINT

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

        Ok = FactorStackPush(Value)

    END IF

    ParseFInstr = (LastErr = 0)

END FUNCTION

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

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

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

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

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

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

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

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

        END IF

        Ok = FactorStackPush(Value)
    END IF

    ParseFMid = (LastErr = 0)

END FUNCTION

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

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

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

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

            IF (LastErr = 0) THEN

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

                Value.DataType = %TYPEINT
                Value.ValueInt = FirstValue

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

    ParseFor = (LastErr = 0)

END FUNCTION

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

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

    Ok = %TRUE
    cArgs = 0

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

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

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

    ParseFunc = Ok

END FUNCTION

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

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

    HaveRecNum = %FALSE

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

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

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

    ParseGetPutSeek = (LastErr = 0)

END FUNCTION

FUNCTION ParseGo (Cmd AS INTEGER, Tkn AS INTEGER)AS INTEGER

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

    LineNumOffset = PgmCur.Offset

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

    ParseGo = (LastErr = 0)

END FUNCTION

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

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

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

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

    ParseIf = (LastErr = 0)

END FUNCTION

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

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

    FileNumber = 0
    Prompt = "? "
    cInput = 0

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

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

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

            PgmI.Offset = 1
        END IF

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

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

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

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

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

                        PgmI = PgmCur
                        PgmCur = PgmC
                    END IF

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

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

                END IF

                IF (LastErr = 0) THEN

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

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

            CASE %TOKENSEP, %TOKENELSE
                LexUngetToken
                EXIT DO

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

    ParseInput = (LastErr = 0)

END FUNCTION

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

    DIM Value AS VALUETYPE

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

    ParseIntExp = (LastErr = 0)

END FUNCTION

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

    DIM Value AS VALUETYPE

    Value.DataType = %TYPEINT

    IF Cmd = %CMDINTERPRET THEN
        SELECT CASE Tkn
            CASE %TOKENFERL
                Value.ValueInt = LastErl
            CASE %TOKENFERR
                Value.ValueInt = LastErr
            CASE %TOKENFCURSORY
                Value.ValueInt = CURSORY
            CASE %TOKENFCURSORX
                Value.ValueInt = CURSORX
        END SELECT
    END IF

    ParseIntF = FactorStackPush(Value)

END FUNCTION

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

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

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

    ParseIntFNum = (LastErr = 0)

END FUNCTION

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

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

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

    ParseIntFStr = (LastErr = 0)

END FUNCTION

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

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

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

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

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

    ParseKeyTimer = (LastErr = 0)

END FUNCTION

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

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

    Symbol = LexTokenStr$

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

    IF (LastErr = 0) THEN

        IF Tkn = %TOKENEQ THEN

            IF ParseExp(Cmd) THEN

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

    ParseLet = (LastErr = 0)

END FUNCTION

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

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

    Symbol = ""

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

    IF (LastErr = 0) THEN

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

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

    ParseNext = (LastErr = 0)

END FUNCTION

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

    DIM Ok AS INTEGER
    DIM Value AS VALUETYPE

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

    ParseNumFNum = (LastErr = 0)

END FUNCTION

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

    DIM Ok AS INTEGER

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

    ParseOn = (LastErr = 0)

END FUNCTION

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

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

    Ok = %TRUE

    IF LexGetToken = %TOKENGOTO THEN

        LineNumOffset = PgmCur.Offset

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

    ParseOnError = (LastErr = 0)

END FUNCTION

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

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

    Count = 0
    HaveTarget = %FALSE

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

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

    ParseOnExp = (LastErr = 0)

END FUNCTION

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

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

    IF LexGetToken = %TOKENOPENPAREN THEN

        IF ParseIntExp(Cmd, Arg) THEN

            IF LexGetToken = %TOKENCLOSEPAREN THEN

                IF LexGetToken = %TOKENGOSUB THEN

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

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

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

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

        IF (LastErr = 0) THEN

            PTR = PgmMemFind(LineNumber)

            IF PTR <> %NILPOINTER THEN

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

    ParseOnKeyTimer = (LastErr = 0)

END FUNCTION

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

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

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

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

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

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

    ParseOpen = (LastErr = 0)

END FUNCTION

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

    %SEPNONE = 0
    %SEPCOMMA = 1
    %SEPSEMICOLON = 2

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

    FileNumber = 0
    s = ""
    LastSep = %SEPNONE

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

    DO WHILE (LastErr = 0)
        Tkn = LexGetToken

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

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

    ParsePrint = (LastErr = 0)

END FUNCTION

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

    DIM Num AS SINGLE
    DIM UseNum AS INTEGER

    UseNum = %FALSE

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

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

    ParseRandomize = (LastErr = 0)

END FUNCTION

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

    DIM Value AS VALUETYPE

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

    ParseRealExp = (LastErr = 0)

END FUNCTION

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

    DIM Value AS VALUETYPE

    Value.DataType = %TYPEREAL

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

    ParseRealF = FactorStackPush(Value)

END FUNCTION

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

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

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

    ParseRealFNum = (LastErr = 0)

END FUNCTION

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

    %RESUMECUR = 0
    %RESUMENEXT = 1
    %RESUMELINE = 2

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

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

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

    ParseResRet = (LastErr = 0)

END FUNCTION

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

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

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

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

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

    ParseRestore = (LastErr = 0)

END FUNCTION

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

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

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

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

    ParseRValue = (LastErr = 0)

END FUNCTION

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

    DIM str AS STRING

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

    ParseShell = (LastErr = 0)

END FUNCTION

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

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

    ParseSimple = %TRUE

END FUNCTION

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

    DIM Tkn AS INTEGER
    DIM Ok AS INTEGER

    StmtCur = PgmCur.Offset

    Tkn = LexGetToken

    SELECT CASE Tkn

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

    ParseStatement = (LastErr = 0)

END FUNCTION

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

    DIM Ok AS INTEGER
    DIM Arg AS INTEGER

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

    ParseStmt1Arg = (LastErr = 0)

END FUNCTION

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

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

    ParseStop = %TRUE

END FUNCTION

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

    DIM Value AS VALUETYPE

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

    ParseStrExp = (LastErr = 0)

END FUNCTION

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

    DIM Value AS VALUETYPE
    DIM s AS STRING

    Value.DataType = %TYPESTR

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

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

    ParseStrF = FactorStackPush(Value)

END FUNCTION

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

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

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

    ParseStrFNum = (LastErr = 0)

END FUNCTION

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

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

    IF LexGetToken = %TOKENOPENPAREN THEN

        IF ParseStrExp(Cmd, strIn) THEN

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

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

    ParseStrFStr = (LastErr = 0)

END FUNCTION

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

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

    IF Level = 0 THEN

        Tkn = LexGetToken

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

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

    ParseTerm = (LastErr = 0)

END FUNCTION

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

    DIM LoopData AS LOOPSTKTYPE
    DIM s AS STRING     ' BUGBUG

    IF Cmd = %CMDINTERPRET THEN
        IF LoopStackPop(LoopData) THEN
            IF LoopData.LoopKind <> %LOOPKINDWHILE THEN
'---------------------
                ' BUGBUG temporary debug code
                PRINT "WEND ERROR!!! - Invalid loop nesting at line " + STR$(PgmMemLineNum(PgmCur.PgmPtr))
                PRINT "Loop stack top:"
                IF LoopData.LoopKind = %LOOPKINDFOR THEN
                   s = "FOR " + RTRIM$(LoopData.Id) + " =" + STR$(LoopData.FirstValue)
                   s = s + " TO" + STR$(LoopData.LastValue)
                   s = s + " STEP" + STR$(LoopData.Increment)
                   PRINT s
                   PRINT "    Body starts at line" + STR$(PgmMemLineNum(LoopData.PgmBegin.PgmPtr))
                ELSE
                   s = "WHILE loop at line" + STR$(PgmMemLineNum(LoopData.PgmBegin.PgmPtr))
                   PRINT s
                END IF
'---------------------
                ErrorHit (%ERRORINVALIDLOOPNESTING)
            ELSE
                PgmCur = LoopData.PgmBegin
            END IF
        END IF
    ELSEIF Cmd = %CMDSKIPLOOP THEN
        LoopCount = LoopCount - 1
    END IF

    ParseWend = (LastErr = 0)

END FUNCTION

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

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

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

    IF ParseIntExp(Cmd, Cond) THEN

        IF Cmd = %CMDINTERPRET THEN

            IF Cond THEN

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

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

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

    ParseWhile = (LastErr = 0)

END FUNCTION

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

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

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

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

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

    NEXT j

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

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

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

    IF NOT Ok THEN
        PgmCur.Offset = OffsetEnd
    END IF

    RenumPatch = Ok

END FUNCTION

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

    DIM Ok AS INTEGER

    Ok = %TRUE
    LoopCount = 1

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

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

            SetPgmCur (PgmMemNext(PgmCur.PgmPtr))

        ELSE

            Ok = ParseBlock(%CMDSKIPLOOP)

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

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

    SkipLoopBlock = Ok

END FUNCTION








































                                           