'Copyright 2020 Luke Ceddia
'
'Licensed under the Apache License, Version 2.0 (the "License");
'you may not use this file except in compliance with the License.
'You may obtain a copy of the License at
'
'  http://www.apache.org/licenses/LICENSE-2.0
'
'Unless required by applicable law or agreed to in writing, software
'distributed under the License is distributed on an "AS IS" BASIS,
'WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
'See the License for the specific language governing permissions and
'limitations under the License.
'
'lbasic.bas - Main file for L-BASIC Compiler

$if VERSION < 2.0 then
    'We use zero-place predicate recursion which is only available in 2.0
    $error QB64 V2.0 or greater required
$end if

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'This file controls what output is given when debug mode is enabled. Please do not
'make commits with these set to true, to avoid releasing versions that are slower
'than they should be (debugging info is calculated even if debug mode is not enabled
'at runtime).

$let DEBUG_TIMINGS = 0
$let DEBUG_PARSE_TRACE = 1
$let DEBUG_TOKEN_STREAM = 0
$let DEBUG_CALL_RESOLUTION = 0
$let DEBUG_PARSE_RESULT = 1
$let DEBUG_MEM_TRACE = 0
$let DEBUG_HEAP = 0

$if DEBUG_TIMINGS then
debug_timing_mark# = timer(0.001)
$end if

dim shared VERSION$
VERSION$ = "0.1.0"

'$dynamic
'Setting the graphics window off by default allows running without a
'graphics environment (and prevents an annoying popup).
$console
$screenhide
option _explicitarray
_dest _console
deflng a-z
const FALSE = 0, TRUE = not FALSE
on error goto error_handler

'If an error occurs, we use this to know where we came from so we can
'give a more meaningful error message.
'0 => Unknown location
'1 => Parsing code; parser line number is valid
'2 => Immediate runtime (interactive)
'3 => Dump code
'4 => Trying to open a file
'5 => Immediate runtime (non-interactive)
dim shared Error_context
'Because we can only throw a numeric error code, this holds a more
'detailed explanation.
dim shared Error_message$
'Set TRUE whenever an error is triggered
dim shared Error_occurred

'We distinguish the runtime platform (where L-BASIC is running) from the target
'platform (where the binaries we produce are running).
type platform_t
    id as string
    posix_paths as long 'TRUE for linux/mac style paths, false for Windows style paths
    executable_extension as string
end type
dim shared as platform_t runtime_platform_settings, target_platform_settings
if instr(_os$, "[WINDOWS]") then
    runtime_platform_settings.id = "Windows"
    runtime_platform_settings.posix_paths = FALSE
    runtime_platform_settings.executable_extension = ".exe"
elseif instr(_os$, "[MACOSX]") then
    runtime_platform_settings.id = "MacOS"
    runtime_platform_settings.posix_paths = TRUE
    runtime_platform_settings.executable_extension = ""
elseif instr(_os$, "[LINUX]") then
    runtime_platform_settings.id = "Linux"
    runtime_platform_settings.posix_paths = TRUE
    runtime_platform_settings.executable_extension = ""
else
    fatalerror "Could not detect runtime platform"
end if
'For now, the target platform is always the same as the runtime platform
target_platform_settings = runtime_platform_settings

'This is an array so we can handle included files.
'The current "reading" file is input_files(input_files_last).
type input_file_t
    handle as long
    'Directory containing the file, further includes are relative to this
    dirname as string
    'To be used only for diagnostic messages
    filename as string
end type
redim shared input_files(0) as input_file_t
dim shared input_files_last
'The logging output is used for debugging output
dim shared logging_file_handle

'Various global options read from the command line
type options_t
    mainarg as string
    preload as string
    outputfile as string
    run_mode as integer
    interactive_mode as integer
    terminal_mode as integer
    command_mode as integer
    compile_mode as integer
    debug as integer
end type
dim shared options as options_t

'Allow immediate mode to access COMMAND$() without picking up interpreter options
dim shared input_file_command_offset

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'cmdflags.bi - Flags for specifying aspects of a runtime function's behaviour.

const STMT_INPUT_NO_NEWLINE = 1 'Semicolon after INPUT
const STMT_INPUT_PROMPT = 2 'A prompt is given
const STMT_INPUT_NO_QUESTION = 4 'Comma after prompt string
const STMT_INPUT_LINEMODE = 8 'Actually a LINE INPUT command

const PRINT_NEXT_FIELD = 1 'A comma used after a variable moves to the next 14-char-wide field
const PRINT_NEWLINE = 2 'No comma or semicolon at the end of the list
'Note: a semicolon sets no flag

const PUTIMAGE_STEP_SRC1 = 1
const PUTIMAGE_STEP_SRC2 = 2
const PUTIMAGE_STEP_DEST1 = 4
const PUTIMAGE_STEP_DEST2 = 8
const PUTIMAGE_SMOOTH = 16

const OPEN_INPUT = 1
const OPEN_OUTPUT = 2
const OPEN_BINARY = 4
const OPEN_RANDOM = 8
'Concurrency options, not currently used
const OPEN_READ = 16
const OPEN_WRITE = 32
const OPEN_SHARED = 64
const OPEN_LOCK = 128
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'type.bi - Declarations for type management routines

'type_signatures() is a linked list.
'A function token points to a single type_signature_t, and that element may point to
'alternative signatures for that function.  This allows us to support declaring a
'function multiple times with different signatures by chaining each declaration's
'signature together.

'type_signature_t.sig is an mkl$-encoded string. Its format is mkl$(return type) +
'mkl$(argument 1 type) + mkl$(argument 1 flags) + mkl$(argument 2 type) +
'mkl$(argument 2 flags) + ...
'For each flag, one or more TYPE_* flags as defined below are set.
'Don't access things directly, use the type_sig_* functions.
type type_signature_t
    sig as string
    succ as long 'Can't call this "next" :(
end type

redim shared type_signatures(10) as type_signature_t
dim shared type_last_signature as long

'Note: constants for actual data types (TYPE_LONG etc.) are defined in tokens.list
'for greater ease of handling UDTs.

'Flags for type signature flags
const TYPE_OPTIONAL = 1
const TYPE_BYREF = 2
const TYPE_BYVAL = 4
'This argument can have a leading # to indicate a file handle
const TYPE_FILEHANDLE = 8
'This argument is a literal token and the type refers to that token id
const TYPE_TOKEN = 16
'This argument is only a syntax element and should not have an ast node generated for it
const TYPE_SYNTAX_ONLY = 32
'This argument needs to be matched by textual name. This allows parameters
'that have meaning only in a specific context, like LINE's B/BF. The argument 'type'
'is the index of a constant that contains a | separated list of allowable values.
const TYPE_CONTEXTUAL = 64
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'symtab.bi - Declarations for symbol table

type symtab_entry_t
    identifier as string
    typ as long
    'the vn are generic parameters whose meaning depends on typ.
    v1 as long
    v2 as long
    v3 as long
    v4 as long
end type

'A generic entry. No vn parameters are used.
const SYM_GENERIC = 1
'A function with infix notation.
'v1 -> reference to the type signature
'v2 -> binding power (controls precedence)
'v3 -> associativity (1/0 = right/left)
const SYM_INFIX = 2
'A function with prefix notation (and parentheses are not required)
'v1 -> reference to the type signature
'v2 -> binding power (controls precedence)
const SYM_PREFIX = 3
'A variable.
'v1 -> the data type
'v2 -> index in this scope (in each scope, first variable has 1, second has 2 etc.)
'v3 -> various SYM_VARIABLE_* flags
const SYM_VARIABLE = 4
'A function (subs too!)
'v1 -> reference to the type signature
'v2 -> One of SYM_FUNCTION_*, see below
'v3 -> If SYM_FUNCTION_USER, the AST_PROCEDURE holding the executable code
'v4 -> IF SYM_FUNCTION_USER, the number of local variables in this function including arguments
const SYM_FUNCTION = 5
'A line number or label. Labels have the : removed.
'v1 -> AST node that is labelled.
'v2 -> Label has been located (if false, label has only been referenced)
const SYM_LABEL = 6
'Both internal types and UDTs
'v1 -> Fixed size of data type
'v2 -> One of SYM_TYPE_*, see below
'v3 -> If SYM_TYPE_ARRAY, type of the array element
'v4 -> If SYM_TYPE_ARRAY, number of dimensions
const SYM_TYPE = 7
'An element of a udt, stored with the name "udt_name.element_name"
'v1 -> the data type
'v2 -> position of element in udt (first is 0, then incrementing by the fixed size of previous values)
const SYM_UDT_ELEMENT = 8
'A metacommand, stored with its characteristic leading $ in the name
const SYM_META = 9

'Further categorisation of SYM_TYPE
'e.g. INTEGER, STRING
const SYM_TYPE_INTERNAL = 0
'Stored as the UDT name
const SYM_TYPE_UDT = 1
'Stored as the element type followed by parentheses and the number of dimensions, e.g. INTEGER(2)
const SYM_TYPE_ARRAY = 2

'Settings for SYM_VARIABLE
'This variable is a constant and cannot be reassigned
const SYM_VARIABLE_CONST = 1
'This variable must be dereferenced before access (to support pass-by-reference)
const SYM_VARIABLE_DEREF = 2
'This variable is stored in the main program's stack frame, not the frame of any scoping function (SHARED or STATIC)
const SYM_VARIABLE_MAINFRAME = 4

'Further categorisation of SYM_FUNCTION
'Functions that are handled directly based on their name
const SYM_FUNCTION_INTRINSIC = 1
'SUBs and FUNCTIONs defined by the processed source code
const SYM_FUNCTION_USER = 2

dim shared symtab(1000) as symtab_entry_t
dim shared symtab_last_entry
dim shared symtab_map(1750)

'The symtab optionally supports transactions; calling symtab_rollback will
'remove all items added since the last call to symtab_commit.
'WARNING: transaction rollbacks only undo adding entries. Changes to entries
'are always immediately permanent.
dim shared symtab_last_commit_id
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'ast.bi - Declarations for Abstract Syntax Tree

'This is a tree structure in a convoluted way
'The node definition
type ast_node_t
    parent as long
    typ as long
    ref as long
    ref2 as long
end type

'The nodes themselves
dim shared ast_nodes(0) as ast_node_t
'The children of a given node as a mkl$-encoded string
dim shared ast_children(0) as string
'The id of the last node registered
dim shared ast_last_node as long

'Every number and string appearing in the program gets an entry here
dim shared ast_constants(0) as string
dim shared ast_constant_types(0) as long
dim shared ast_last_constant as long
'The ast optionally supports transactions; calling ast_rollback will
'remove all items added since the last call to ast_commit.
'WARNING: transaction rollbacks only undo adding nodes. Node changes
'are always immediately permanent.
dim shared ast_last_commit_id
dim shared ast_last_constant_commit_id

const AST_FALSE = 1
const AST_TRUE = 2
const AST_ONE = 3

'This is an AST_BLOCK that is the main program.
dim shared AST_ENTRYPOINT

'The types of node.
'Note: an "expression"/"expr" is a CALL, CONSTANT, CAST, SELECT_VALUE, any of the lvalue
'types or NONE (if allowed).

'Every SUB and FUNCTION is rooted in an AST_PROCEDURE.
'First child is AST_BLOCK. Remaining children are AST_VAR for formal parameters, left to
'right. ref is the symtab entry for the function name.
'Note: the main program is not an AST_PROCEDURE, it is just an AST_BLOCK. See ast_init.
const AST_PROCEDURE = 1
'group of statements
const AST_BLOCK = 2
'assign lvalue expr => lvalue = expr
const AST_ASSIGN = 3
'if expr1 block1 [expr2 block2 ...] [block-n] => IF expr1 THEN block1 ELSEIF expr2 THEN
'block2 ... ELSE block-n
const AST_IF = 4
'while expr block => WHILE expr: block: WEND
'Can't be an AST_DO_PRE because of EXIT
const AST_WHILE = 5
'do expr block => DO WHILE expr: block: LOOP
const AST_DO_PRE = 6
'do expr block => DO: block: LOOP WHILE expr
const AST_DO_POST = 7
'for lvalue expr1 expr2 expr3 block => FOR lvalue = expr1 TO expr2 STEP expr3
const AST_FOR = 8
'select expr [AST_SELECT_LIST]* AST_SELECT_ELSE? => SELECT CASE expr CASE AST_SELECT_LIST... AST_SELECT_ELSE
const AST_SELECT = 9
'Children are AST_SELECT_IS or AST_SELECT_RANGE. Last child is block.
const AST_SELECT_LIST = 10
'ref is comparison function, ref2 is type sig. First child is AST_SELECT_VALUE, second
'child is expr to compare against (second argument to function). Note that this is
'the same format as AST_CALL.
const AST_SELECT_IS = 11
'ref is comparison function, ref2 is type sig. Left & right bounding expr are first and
'second children respectively.
const AST_SELECT_RANGE = 12
'First child is block
const AST_SELECT_ELSE = 13
'When evaluated, returns the base expression value of the inner-most SELECT CASE. ref is
'the type of the expression.
const AST_SELECT_VALUE = 14
'call param* => A function call to ref with type signature ref2 and parameters as children
const AST_CALL = 15
'ref is a reference to an entry in the constants table
const AST_CONSTANT = 16
'Casts are first-class AST elements instead of just CALLs to a cast function. ref is a
'type, child is a CALL, CONSTANT or VAR.
const AST_CAST = 17
'Used to pass extra data to some functions that have behaviour set by syntax (e.g. INPUT, LINE).
'ref is one of AST_FLAG_* defined below. ref2 is the corresponding value.
const AST_FLAGS = 18
'If the goto is resolved, ref is the node to jump to. If unresolved, the label symtab. A
'fully-parsed program will have no unresolved labels.
const AST_GOTO = 19
'Used for empty optional arguments to functions
const AST_NONE = 20
'The EXIT statement. ref is the loop statement or function we're exiting.
const AST_EXIT = 21

'These nodes may appear where-ever an lvalue is required
'ref is reference to symtab
const AST_VAR = 22
'Access to a UDT element. First child is the lvalue we're accessing an element of, ref is
'the UDT element symbol.
const AST_UDT_ACCESS = 23
'Access to an array element. First child is the lvalue to be indexed. Second child is
'expression for the index in leftmost dimension, then so on for other dimensions.
const AST_ARRAY_ACCESS = 24

'Emitted by DIM statements to initialise an array. First child is lvalue to be
'initialised, then each pair of children after are expr for the lower and upper
'bound of each dimension. The array is zeroed out.
const AST_ARRAY_CREATE = 25
'Like above, but preserve the contents of the array if any.
const AST_ARRAY_RESIZE = 26
'Free an array's heap allocation, effectively a destructor. First child is an lvalue.
const AST_ARRAY_DELETE = 27
'Like _CREATE, with the exception that the array is not touched if memory is already
'allocated. Added to support STATIC arrays.
const AST_ARRAY_ESTABLISH = 28

'Sets the return value of the current function. first child is expr to return.
const AST_SET_RETURN = 29

'Flag is a value defined in cmdflags.bi.
const AST_FLAG_MANUAL = 1
'Flag is a contextual argument and value is the index into the list of alternates.
const AST_FLAG_CONTEXTUAL = 2
'Flag is a token.
const AST_FLAG_TOKEN = 3
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'parser.bi - Declarations for parser module

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'tokeng.bi - Delcarations for tokeniser engine

CONST TS_SKIP = 1 
CONST TS_ID = 2 
CONST TS_NEWLINE = 3 
CONST TS_LINENUM = 4 
CONST TS_METACMD = 5 
CONST TS_METAPARAM = 6 
CONST TS_STRINGLIT = 7 
CONST TS_SINGLE_SFX = 8 
CONST TS_STRING_SFX = 9 
CONST TS_POWER = 10 
CONST TS_STAR = 11 
CONST TS_OPAREN = 12 
CONST TS_CPAREN = 13 
CONST TS_DASH = 14 
CONST TS_PLUS = 15 
CONST TS_EQUALS = 16 
CONST TS_BACKSLASH = 17 
CONST TS_COLON = 18 
CONST TS_SEMICOLON = 19 
CONST TS_COMMA = 20 
CONST TS_SLASH = 21 
CONST TS_NUMINT = 22 
CONST TS_NUMDEC = 23 
CONST TS_NUMEXP = 24 
CONST TS_INTEGER_SFX = 25 
CONST TS_OFFSET_SFX = 26 
CONST TS_DOUBLE_SFX = 27 
CONST TS_QUAD_SFX = 28 
CONST TS_LONG_SFX = 29 
CONST TS_INTEGER64_SFX = 30 
CONST TS_NUMBASE = 31 
CONST TS_CMP_LT = 32 
CONST TS_CMP_LTEQ = 33 
CONST TS_CMP_NEQ = 34 
CONST TS_CMP_GT = 35 
CONST TS_CMP_GTEQ = 36 
CONST TS_DOT = 37 
CONST TS_MAX = 37 
CONST TS_ST_Begin = 1 
CONST TS_ST_Id = 2 
CONST TS_ST_Linenum = 3 
CONST TS_ST_Comment = 4 
CONST TS_ST_Metacmd = 5 
CONST TS_ST_General = 6 
CONST TS_ST_Metagap = 7 
CONST TS_ST_Metaparam = 8 
CONST TS_ST_String = 9 
CONST TS_ST_Number = 10 
CONST TS_ST_HashPfx = 11 
CONST TS_ST_PercentPfx = 12 
CONST TS_ST_AmpersandPfx = 13 
CONST TS_ST_LtPfx = 14 
CONST TS_ST_GtPfx = 15 
CONST TS_ST_Dot = 16 
CONST TS_ST_NumDec = 17 
CONST TS_ST_NumExpSgn = 18 
CONST TS_ST_NumExp = 19 
CONST TS_ST_NumBase = 20 
DIM SHARED t_states~%(127, 20)
DIM SHARED t_statenames$(20)
CONST TOK_UNKNOWN = 1
CONST TOK_IEOF = 2
CONST TOK_EOI = 3
CONST TOK_NEWLINE = 4
CONST TOK_COMMA = 5
CONST TOK_SEMICOLON = 6
CONST TOK_DOT = 7
CONST TOK_REM = 8
CONST TOK_LINENUM = 9
CONST META_LIST = 10
CONST META_DEBUG = 11
CONST META_INCLUDE = 12
CONST META_UNKNOWN = 13
CONST TOK_METAPARAM =-1 
CONST TOK_INTEGER_SFX = 14
CONST TOK_LONG_SFX = 15
CONST TOK_INTEGER64_SFX = 16
CONST TOK_SINGLE_SFX = 17
CONST TOK_DOUBLE_SFX = 18
CONST TOK_QUAD_SFX = 19
CONST TOK_STRING_SFX = 20
CONST TYPE_NONE = 21
CONST TYPE_LIST = 22
CONST TYPE_FLAGS = 23
CONST TYPE_ANY = 24
CONST TYPE_ANY_ARRAY = 25
CONST TYPE_INTEGER = 26
CONST TYPE_LONG = 27
CONST TYPE_INTEGER64 = 28
CONST TYPE_SINGLE = 29
CONST TYPE_DOUBLE = 30
CONST TYPE_QUAD = 31
CONST TYPE_STRING = 32
CONST TYPE_CONTEXTUAL_ARGUMENT = 33
CONST TOK_OPAREN = 34
CONST TOK_CPAREN = 35
CONST TOK_NUMINT =-2 
CONST TOK_NUMDEC =-3 
CONST TOK_NUMEXP =-4 
CONST TOK_NUMBASE =-5 
CONST TOK_STRINGLIT =-6 
CONST TOK_CONTEXTUAL_ARGUMENT =-7 
CONST TOK_IMP = 36
CONST TOK_EQV = 37
CONST TOK_XOR = 38
CONST TOK_OR = 39
CONST TOK_AND = 40
CONST TOK_NOT= 41
CONST TOK_EQUALS = 42
CONST TOK_CMP_NEQ = 43
CONST TOK_CMP_LT = 44
CONST TOK_CMP_GT = 45
CONST TOK_CMP_LTEQ = 46
CONST TOK_CMP_GTEQ = 47
CONST TOK_PLUS = 48
CONST TOK_DASH = 49
CONST TOK_MOD = 50
CONST TOK_BACKSLASH = 51
CONST TOK_STAR = 52
CONST TOK_SLASH = 53
CONST TOK_NEGATIVE= 54
CONST TOK_POWER = 55
CONST TOK_AS = 56
CONST TOK_CONST = 57
CONST TOK_GOTO = 58
CONST TOK_EXIT = 59
CONST TOK_IF = 60
CONST TOK_THEN = 61
CONST TOK_ELSE = 62
CONST TOK_ELSEIF = 63
CONST TOK_DO = 64
CONST TOK_LOOP = 65
CONST TOK_UNTIL = 66
CONST TOK_WHILE = 67
CONST TOK_WEND = 68
CONST TOK_FOR = 69
CONST TOK_TO = 70
CONST TOK_STEP = 71
CONST TOK_NEXT = 72
CONST TOK_SELECT = 73
CONST TOK_CASE = 74
CONST TOK_IS = 75
CONST TOK_TYPE = 76
CONST TOK_SUB = 77
CONST TOK_FUNCTION = 78
CONST TOK_DECLARE = 79
CONST TOK_REDIM = 80
CONST TOK_SHARED = 81
CONST TOK__PRESERVE = 82
CONST TOK_STATIC = 83
CONST TOK__EXPLICIT = 84
CONST TOK__EXPLICITARRAY = 85
CONST TOK_BYREF = 86
CONST TOK_BYVAL = 87
CONST TOK_CALL = 88
CONST TOK_ABS = 89
CONST TOK_ASC = 90
CONST TOK_ATN = 91
CONST TOK_BEEP = 92
CONST TOK__BLUE32 = 93
CONST TOK_CDBL = 94
CONST TOK_CHDIR = 95
CONST TOK_CHR = 96
CONST TOK_CINT = 97
CONST TOK_CIRCLE = 98
CONST TOK_CLNG = 99
CONST TOK_CLOSE = 100
CONST TOK_CLS = 101
CONST TOK_COLOR = 102
CONST TOK_COMMAND = 103
CONST TOK__COMMANDCOUNT = 104
CONST TOK_COS = 105
CONST TOK_CSNG = 106
CONST TOK_CSRLIN = 107
CONST TOK_CVD = 108
CONST TOK_CVDMBF = 109
CONST TOK_CVI = 110
CONST TOK_CVL = 111
CONST TOK_CVS = 112
CONST TOK_CVSMBF = 113
CONST TOK_DATE = 114
CONST TOK__DEFLATE = 115
CONST TOK__DELAY = 116
CONST TOK__DEST = 117
CONST TOK_DIM = 118
CONST TOK__DISPLAY = 119
CONST TOK_DRAW = 120
CONST TOK_END = 121
CONST TOK_ENVIRON = 122
CONST TOK_EOF = 123
CONST TOK_ERASE = 124
CONST TOK_EXP = 125
CONST TOK_FILES = 126
CONST TOK_FIX = 127
CONST TOK__FONTHEIGHT = 128
CONST TOK__FONTWIDTH = 129
CONST TOK_FREEFILE = 130
CONST TOK_GET = 131
CONST TOK__GREEN32 = 132
CONST TOK__HEIGHT = 133
CONST TOK_HEX = 134
CONST TOK__INFLATE = 135
CONST TOK_INKEY = 136
CONST TOK_INPUT = 137
CONST TOK_INSTR = 138
CONST TOK_INT = 139
CONST TOK__KEYCLEAR = 140
CONST TOK__KEYDOWN = 141
CONST TOK__KEYHIT = 142
CONST TOK_KILL = 143
CONST TOK_LBOUND = 144
CONST TOK_LCASE = 145
CONST TOK_LEFT = 146
CONST TOK_LEN = 147
CONST TOK__LIMIT = 148
CONST TOK_LINE = 149
CONST TOK_LINEINPUT = 150
CONST TOK__LOADIMAGE = 151
CONST TOK_LOCATE = 152
CONST TOK_LOF = 153
CONST TOK_LOG = 154
CONST TOK_LTRIM = 155
CONST TOK_MID = 156
CONST TOK__NEWIMAGE = 157
CONST TOK_OPEN = 158
CONST TOK_OPTION = 159
CONST TOK__PI = 160
CONST TOK_PLAY = 161
CONST TOK_PRINT = 162
CONST TOK__PRINTSTRING = 163
CONST TOK__PRINTWIDTH = 164
CONST TOK_PSET = 165
CONST TOK_PUT = 166
CONST TOK__PUTIMAGE = 167
CONST TOK_RANDOMIZE = 168
CONST TOK__RED32 = 169
CONST TOK__RGB32 = 170
CONST TOK_RIGHT = 171
CONST TOK_RMDIR = 172
CONST TOK_RND = 173
CONST TOK_RTRIM = 174
CONST TOK_SCREEN = 175
CONST TOK_SGN = 176
CONST TOK_SIN = 177
CONST TOK_SLEEP = 178
CONST TOK__SMOOTH = 179
CONST TOK_SOUND = 180
CONST TOK__SOURCE = 181
CONST TOK_SPACE = 182
CONST TOK_SQR = 183
CONST TOK_STR = 184
CONST TOK__STRCMP = 185
CONST TOK__STRICMP = 186
CONST TOK_SWAP = 187
CONST TOK_SYSTEM = 188
CONST TOK_TAN = 189
CONST TOK_TIME = 190
CONST TOK_TIMER = 191
CONST TOK__TITLE = 192
CONST TOK__TRIM = 193
CONST TOK_UBOUND = 194
CONST TOK_UCASE = 195
CONST TOK_USING = 196
CONST TOK_VAL = 197
CONST TOK__WIDTH = 198

type tokeniser_state_t
    index as long
    curstate as long
    has_data as long
    linestart as long
    recovery_mode as long
    raw_line_in as string
end type

dim shared tokeng_state as tokeniser_state_t

dim shared tok_content$
dim shared tok_token as long
dim shared tok_next_content$
dim shared tok_next_token as long

'Used to map TS_ to TOK_
dim shared tok_direct(1 to TS_MAX)

'Next available slot for variables, used to know how many data slots to allocate.
'This applies to the current scope - the parser for subs/functions will save and
'restore this value so it is preserved for the main program.
dim shared ps_next_var_index as long

'When in a sub/function, we make the main program's counter available too so that
'STATIC variables can be made part of the main program's stack allocation. This
'value is only valid when in a sub/function.
dim shared ps_main_next_var_index as long

'actual as opposed to any explicit old-timey line numbers/labels in the program
dim shared ps_actual_linenum as long

dim shared ps_default_type as long

'Set TRUE if processing a preload file, meaning internal functions
'can be overridden with user-supplied ones.
dim shared ps_is_preload as long

'mkl$ list of symtab labels that are not attached to an AST node.
'This occurs if you have labels on empty or non-executable lines.
dim shared ps_unattached_labels$

'mkl$ list of nodes that ref a label location but were unresolved
'because the label hadn't been positioned yet.
dim shared ps_unresolved_jumps$

'mkl$ list of nodes that are DO, WHILE, FOR, SUB/FUNCTION for the purposes of
'parsing EXIT statements.
dim shared ps_nested_structures$

'Name of the containing function, used as part of a prefix for local objects.
dim shared ps_scope_identifier$

'Sometimes we need to run cleanup code just before exiting a scope. This is
'a list of nodes to be added to the end of a scope's block.
dim shared ps_queued_nodes$

'Set to FALSE if OPTION _EXPLICIT is in effect
dim shared ps_allow_implicit_vars
type imm_value_t
    n as _float
    s as string
end type

'Stack holds objects with fixed memory size. Note a single element can
'hold a variable length string, and all UDTs are of fixed size (because
'any variable-size components like arrays are in fact pointers).
'Begins at 1 so we can catch null pointer errors, and so all pointers have
'SGN = 1.
dim shared imm_stack(1) as imm_value_t
dim shared imm_stack_last

'Used as an offset for stack value access, allowing support for
'stack frames.
dim shared imm_stack_base

'Heap holds dynamically allocated objects i.e. arrays. See heap.bm
'for the allocation strategy. Note that pointers to heap locations are
'always stored as negative values, to distinguish them from stack addresses
'(but are made positive just before heap access, so the array below grows
'in the positive direction). We'd like to grow the array negatively too, but
'that would force a copy on each reallocation which isn't desired.
dim shared imm_heap(1) as imm_value_t
dim shared imm_heap_next_free
const IMM_HEAP_HEADER_SIZE = 2
'some extra values worth tracking
dim shared imm_heap_current_blocks
dim shared imm_heap_max_blocks
dim shared imm_heap_current_bytes
dim shared imm_heap_max_bytes

'Instead of executing the next statement, execution should begin at
'this node if it is > 0 (used to support GOTO)
dim shared imm_jump_path$

'If > 0, an EXIT command is in effect and imm_exit_node is the node to exit
dim shared imm_exit_node

'Allow for input code to use file handles without clashing with internally
'opened files
dim shared imm_filehandle_offset

'When evaluating a SELECT CASE, this holds the base value which is returned
'when AST_SELECT_VALUE is evaluated
dim shared imm_select_value as imm_value_t

parse_cmd_line_args
if not options.terminal_mode then
    _screenshow
    _dest 0
end if

'Send out debugging info to the screen
logging_file_handle = freefile
open_file "SCRN:", logging_file_handle, TRUE

'Setup AST, constants and parser settings
ast_init
ps_init

$if DEBUG_TIMINGS then
debuginfo "Boot time:" + str$(timer(0.001) - debug_timing_mark#)
$end if

'Preload files can override built-in commands; handle that now
if options.preload <> "" then preload_file

'Dispatch based on desired mode of operation
Error_context = 1
if options.interactive_mode then
    'User will type in commands
    interactive_mode FALSE
elseif options.command_mode then
    'Run some code given on the command line
    command_mode
elseif options.compile_mode then
    'Produce a binary output. Currently this just dumps the AST and symbol table.
    compile_mode
else
    run_mode
end if

if options.terminal_mode then system else end

interactive_recovery:
    interactive_mode TRUE

error_handler:
    Error_occurred = TRUE
    select case Error_context
    case 1 'Parsing code
        print "Parser: ";
        if err <> 101 then goto internal_error
        if options.interactive_mode and options.preload = "" then
            print Error_message$
            Error_message$ = ""
            resume interactive_recovery
        else
            if options.preload <> "" then print "In preload file: ";
            print "Line" + str$(ps_actual_linenum) + ": " + Error_message$
        end if
    case 2, 5 'Immediate mode
        'We have no good way of distinguishing between user program errors and internal errors
        'Of course, the internal code is perfect so it *must* be a user program error
        print "Runtime error: ";
        if err = 101 then print Error_message$; else print _errormessage$(err);
        print " ("; _trim$(str$(err)); "/"; _inclerrorfile$; ":"; _trim$(str$(_inclerrorline)); ")"
        if Error_context = 2 then resume interactive_recovery
    case 3 'Dump mode
        print "Dump: ";
        if err <> 101 then goto internal_error
        print Error_message$
    case 4 'File access check
        resume next
    case else
        internal_error:
        if _inclerrorline then
            print "Internal error" + str$(err) + " on line" + str$(_inclerrorline) + " of " + _inclerrorfile$ + " (called from line" + str$(_errorline) + ")"
        else
            print "Internal error" + str$(err) + " on line" + str$(_errorline)
        end if
        print Error_message$
    end select
    if options.terminal_mode then system 1 else end 1

'This one's solely for basic user error like input file not found, bad command line etc.
sub fatalerror(msg$)
    print "Error: " + msg$
    if options.terminal_mode then system 1 else end 1
end sub

sub debuginfo(msg$)
    if options.debug then print #logging_file_handle, msg$
end sub

'This function and the next are called from tokeng.
'They provide a uniform way of loading the next line.
function general_next_line$
    if options.preload <> "" then
        line input #input_files(input_files_last).handle, s$
    elseif options.interactive_mode then
        old_dest = _dest
        _dest 0
        print "> ";
        line input s$
        _dest old_dest
    elseif options.command_mode then
        s$ = options.mainarg
        options.mainarg = ""
    else
        line input #input_files(input_files_last).handle, s$
    end if
    general_next_line$ = s$
end function

function general_eof
    if options.preload <> "" then
        result = eof(input_files(input_files_last).handle)
    elseif options.interactive_mode then
        'Hopefully one day we'll be able to handle ^D/^Z here
        result = FALSE
    elseif options.command_mode then
        result = options.mainarg = ""
    else
        result = eof(input_files(input_files_last).handle)
        'An EOF in an include file just means close that and return to the
        'outer file
        if result and input_files_last > 0 then
            close #input_files(input_files_last).handle
            input_files_last = input_files_last - 1
            'Call recursively in case the outer file has also ended
            result = general_eof
        end if
    end if
    general_eof = result
end function

sub preload_file
    input_files(input_files_last).handle = freefile
    open_file options.preload, input_files(input_files_last).handle, FALSE
    tok_init
    Error_context = 1
    ps_preload_file
    close #input_files(input_files_last).handle
    options.preload = ""
end sub

'Open a file and trigger a fatal error if we couldn't
sub open_file(filename$, handle, is_output)
    old_ctx = Error_context
    Error_context = 4
    Error_occurred = FALSE
    if is_output then
        open filename$ for output as #handle
    else
        open filename$ for input as #handle
    end if
    if Error_occurred then fatalerror "Could not open file " + filename$
    Error_context = old_ctx
end sub

sub interactive_mode(recovery)
    if recovery then
        ps_nested_structures$ = ""
        ps_scope_identifier$ = ""
        tok_recover TOK_NEWLINE
        symtab_commit
        ast_rollback
        ast_clear_entrypoint
    else
        imm_init
        AST_ENTRYPOINT = ast_add_node(AST_BLOCK)
        ast_commit
        tok_init
        ps_init
    end if
    do
        Error_context = 1
        node = ps_stmt
        select case node
        case -2
            'A SUB or FUNCTION was defined, we want to keep that.
            symtab_commit
            ast_commit
        case -1
            '-1 is an end block, this should never happen
            ps_error "Block end at top-level"
        case 0
            'No ast nodes were generated (DIM etc.), but save any
            'symbols created.
            symtab_commit
        case else
            Error_context = 0
            ast_attach AST_ENTRYPOINT, node
            $if DEBUG_PARSE_RESULT then
            if options.debug then
                Error_context = 3
                ast_dump_pretty AST_ENTRYPOINT, 0
                Error_context = 0
                print #1,
            end if
            $end if
            imm_reinit ps_next_var_index - 1
            Error_context = 2
            imm_run AST_ENTRYPOINT
            'Keep any symbols that were defined
            symtab_commit
            'But don't keep any nodes generated
            ast_rollback
            'And clear the main program
            ast_clear_entrypoint
        end select
        Error_context = 1
        ps_consume TOK_NEWLINE
    loop
end sub

sub command_mode
    tok_init
    root = ps_block
    Error_context = 0
    $if DEBUG_PARSE_RESULT then
    if options.debug then
        Error_context = 3
        ast_dump_pretty root, 0
        Error_context = 0
        print #1,
    end if
    $end if
    imm_init
    Error_context = 2
    imm_run root
    Error_context = 0
end sub
    
sub compile_mode
    if options.mainarg = "" then fatalerror "No input file"
    'Output file defaults to input file with .bas changed to .exe (or nothing on Unix)
    if options.outputfile = "" then options.outputfile = remove_ext$(options.mainarg) + target_platform_settings.executable_extension
    input_files(input_files_last).filename = options.mainarg
    options.mainarg = locate_path$(options.mainarg, _startdir$)
    input_files(input_files_last).dirname = dirname$(options.mainarg)
    input_files(input_files_last).handle = freefile
    open_file options.mainarg, input_files(input_files_last).handle, FALSE
    tok_init
    ps_prepass
    seek input_files(input_files_last).handle, 1
    tok_reinit
    ps_init
    ast_rollback
    AST_ENTRYPOINT = ps_block
    ps_finish_labels AST_ENTRYPOINT
    Error_context = 0
    close #input_files(input_files_last).handle
    close #logging_file_handle
    logging_file_handle = freefile
    open_file options.outputfile, logging_file_handle, TRUE
    Error_context = 3
    dump_program
    Error_context = 0
    close #1
end sub

sub run_mode
    if options.mainarg = "" then fatalerror "No input file"
    input_files(input_files_last).filename = options.mainarg
    options.mainarg = locate_path$(options.mainarg, _startdir$)
    input_files(input_files_last).dirname = dirname$(options.mainarg)
    input_files(input_files_last).handle = freefile
    open_file options.mainarg, input_files(input_files_last).handle, FALSE
    tok_init
    $if DEBUG_TIMINGS then
    debug_timing_mark# = timer(0.001)
    $end if
    ps_prepass
    seek input_files(input_files_last).handle, 1
    tok_reinit
    ps_init
    ast_rollback
    AST_ENTRYPOINT = ps_block
    ps_finish_labels AST_ENTRYPOINT
    $if DEBUG_TIMINGS then
    debuginfo "Parse time:" + str$(timer(0.001) - debug_timing_mark#)
    $end if
    Error_context = 0
    close #input_files(input_files_last).handle
    imm_init
    Error_context = 5
    $if DEBUG_TIMINGS then
    debug_timing_mark# = timer(0.001)
    $end if
    imm_run AST_ENTRYPOINT
    $if DEBUG_TIMINGS then
    debuginfo "Run time:" + str$(timer(0.001) - debug_timing_mark#)
    $end if
    Error_context = 0
    $if DEBUG_HEAP then
    if options.debug then imm_heap_stats
    $end if
end sub

'Strip the .bas extension if present
function remove_ext$(fullname$)
    dot = _instrrev(fullname$, ".")
    if mid$(fullname$, dot + 1) = "bas" then
        remove_ext$ = left$(fullname$, dot - 1)
    else
        remove_ext$ = fullname$
    end if
end function

'Get the path to a file relative to the prefix$ path. If prefix$ is
'absolute, then the returned path is absolute too.
function locate_path$(file$, prefix$)
    if runtime_platform_settings.posix_paths then
        if left$(file$, 1) = "/" then
            'path is already absolute
            locate_path$ = file$
        else
            locate_path$ = prefix$ + "/" + file$
        end if
    else
        'This doesn't support UNC paths or DOS device paths
        if mid$(file$, 2, 1) = ":" or left$(file$, 1) = "\" then
            'already absolute, or relative with explicit drive letter
            'that we can't meaningfully modify
            locate_path$ = file$
        else
            if right$(prefix$, 1) = "\" then sep$ = "" else sep$ = "\" '"fix syntax hilight
            locate_path$ = prefix$ + sep$ + file$
        end if
    end if
end function

'Get the directory component of a path
function dirname$(path$)
    if runtime_platform_settings.posix_paths then
        slash$ = "/"
    else
        slash$ = "\" '"
    end if
    s = _instrrev(path$, slash$)
    if s = 0 then
        dirname$ = "."
    else
        dirname$ = left$(path$, s - 1)
    end if
end function

sub show_version
    print "The L-BASIC compiler version " + VERSION$
end sub

sub show_help
    print "The L-BASIC compiler"
    print "Usage: " + command$(0) + " [OPTIONS] [FILE]"
    print "Execute FILE if given, otherwise launch an interactive session."
    print '                                                                                '80 columns
    print "Options:"
    print "  -t, --terminal                   Run in terminal mode (no graphical window)"
    print "  -c, --compile                    Compile FILE instead of executing"
    print "  -o OUTPUT, --output OUTPUT       Place compilation output into OUTPUT"
    print "  -e CMD, --execute CMD            Execute the statement CMD then exit"
    print "  --preload FILE                   Load FILE before parsing main program"
    print "  -d, --debug                      For internal debugging (if available)"
    print "  -h, --help                       Print this help message"
    print "  --version                        Print version information"
end sub

'The error handling here fakes terminal_mode on the assumption that if you're
'using command line arguments you don't want a graphical window popping up.
sub parse_cmd_line_args()
    for i = 1 TO _commandcount
        arg$ = command$(i)
        select case arg$
            case "--version"
                show_version
                system
            case "-h", "--help"
                show_help
                system
            case "-o", "--output"
                if i = _commandcount then
                    options.terminal_mode = TRUE
                    fatalerror arg$ + " requires argument"
                end if
                options.outputfile = locate_path$(command$(i + 1), _startdir$)
                i = i + 1
            case "-d", "--debug"
                options.debug = TRUE
            case "-c", "--compile"
                options.compile_mode = TRUE
            case "-t", "--terminal"
                options.terminal_mode = TRUE
            case "-e", "--execute"
                options.command_mode = TRUE
            case "--preload"
                if i = _commandcount then
                    options.terminal_mode = TRUE
                    fatalerror arg$ + " requires argument"
                end if
                options.preload = locate_path$(command$(i + 1), _startdir$)
                i = i + 1
            case else
                if left$(arg$, 1) = "-" then
                    options.terminal_mode = TRUE
                    fatalerror "Unknown option " + arg$
                end if
                if options.mainarg = "" then
                    options.mainarg = arg$
                    input_file_command_offset = i
                    exit for
                end if
        end select
    next i
    if options.mainarg = "" then options.interactive_mode = TRUE
    if not options.interactive_mode and not options.compile_mode and _
        not options.command_mode then options.run_mode = TRUE
end sub

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'type.bm - Routines for type management

'The fixed size of a type is the amount of memory/elements needed to store
'a variable of that type, but only counting the fixed-sized info (pointer and size)
'for arrays.
function type_fixed_size(typ)
    type_fixed_size = symtab(typ).v1
end function

function type_is_number(typ)
    select case typ
    case TYPE_INTEGER, TYPE_LONG, TYPE_INTEGER64, TYPE_SINGLE, TYPE_DOUBLE, TYPE_QUAD
        type_is_number = TRUE
    end select
end function

function type_is_array(typ)
    type_is_array = symtab(typ).v2 = SYM_TYPE_ARRAY
end function

function type_of_expr(root)
    select case ast_nodes(root).typ
    case AST_CONSTANT
        type_of_expr = type_of_constant(root)
    case AST_CALL
        type_of_expr = type_of_call(root)
    case AST_VAR, AST_UDT_ACCESS, AST_ARRAY_ACCESS
        type_of_expr = type_of_lvalue(root)
    case AST_CAST
        type_of_expr = type_of_cast(root)
    case AST_FLAGS
        type_of_expr = TYPE_FLAGS
    case AST_SELECT_VALUE
        type_of_expr = type_of_select_value(root)
    case else
        type_of_expr = TYPE_NONE
    end select
end function

function type_of_lvalue(node)
    select case ast_nodes(node).typ
    case AST_VAR
        type_of_lvalue = type_of_var(node)
    case AST_UDT_ACCESS
        type_of_lvalue = type_of_udt_access(node)
    case AST_ARRAY_ACCESS
        type_of_lvalue = type_of_array_access(node)
    end select
end function

function type_of_constant(node)
    type_of_constant = ast_constant_types(ast_nodes(node).ref)
end function

function type_of_call(node)
    type_of_call = type_sig_return(ast_nodes(node).ref2)
end function

function type_of_var(node)
    type_of_var = symtab(ast_nodes(node).ref).v1
end function

function type_of_cast(node)
    type_of_cast = ast_nodes(node).ref
end function

function type_of_udt_access(node)
    type_of_udt_access = symtab(ast_nodes(node).ref).v1
end function

function type_of_array_access(node)
    array = ast_get_child(node, 1)
    array_type = type_of_lvalue(array)
    type_of_array_access = symtab(array_type).v3
end function

function type_is_lvalue(node)
    t = ast_nodes(node).typ
    type_is_lvalue = t = AST_VAR or t = AST_UDT_ACCESS or t = AST_ARRAY_ACCESS
end function

function type_of_select_value(node)
    type_of_select_value = ast_nodes(node).ref
end function

'Can a be cast to b, even with loss?
function type_can_cast(a, b)
    type_can_cast = type_can_safely_cast(a, b) or (type_is_number(a) and type_is_number(b))
end function

'Can a be cast to b without loss of data?
function type_can_safely_cast(a, b)
    if a = b then 'Identity cast
        type_can_safely_cast = TRUE
    elseif b = TYPE_ANY then 'Generic type
        type_can_safely_cast = TRUE
    elseif type_is_array(a) or type_is_array(b) then
        'Both arrays, same number of dimensions (or cast to indeterminate number), element type can be cast
        type_can_safely_cast = type_is_array(a) and type_is_array(b) and _
                                (symtab(a).v4 = symtab(b).v4 or symtab(b).v4 = 0) and _
                                type_can_safely_cast(symtab(a).v3, symtab(b).v3)
    elseif not (type_is_number(a) and type_is_number(b)) then
        type_can_safely_cast = FALSE
    else
        select case a
        case TYPE_INTEGER
            type_can_safely_cast = TRUE
        case TYPE_LONG
            type_can_safely_cast = (b = TYPE_INTEGER64) or (b = TYPE_DOUBLE) or (b = TYPE_QUAD)
        case TYPE_INTEGER64
            type_can_safely_cast = b = TYPE_QUAD
        case TYPE_SINGLE
            type_can_safely_cast = (b = TYPE_DOUBLE) or (b = TYPE_QUAD)
        case TYPE_DOUBLE
            type_can_safely_cast = b = TYPE_QUAD
        case TYPE_FLOAT
            type_can_safely_cast = FALSE
        end select
    end if
end function

'The following functions are helpers to extract data from type signatures. type_sig_*
'variants take a numeric indentifier, type_sigt_* variants take a string holding the
'signature itself. arg_index is one-indexed, so 1 is the first argument in the signature.
'The type signature format (mkl$ encoded type, flags pairs) is used more generally for
'lists of types; in those cases the first component (return type) may be meaningless.

'What is the return type of the given signature?
function type_sig_return(sig_index)
    type_sig_return = type_sigt_return(type_signatures(sig_index).sig)
end function

function type_sigt_return(sig$)
    type_sigt_return = cvl(left$(sig$, 4))
end function

'How many arguments (passed parameters) does a signature have, including all optionals?
function type_sig_numargs(sig_index)
    type_sig_numargs = type_sigt_numargs(type_signatures(sig_index).sig)
end function

'How many arguments excluding components that do not have an ast representation
function type_sig_numargs_concrete(sig_index)
    for i = 1 to type_sig_numargs(sig_index)
        if type_sig_concrete_arg(sig_index, i) then
            result = result + 1
        else
        end if
    next i
    type_sig_numargs_concrete = result
end function

function type_sigt_numargs(sig$)
    type_sigt_numargs = (len(sig$) - 4) / 8
end function

'What is the type of a particular argument in a signature?
function type_sig_argtype(sig_index, arg_index)
    type_sig_argtype = type_sigt_argtype(type_signatures(sig_index).sig, arg_index)
end function

function type_sigt_argtype(sig$, arg_index)
    type_sigt_argtype = cvl(mid$(sig$, arg_index * 8 - 3, 4))
end function

'What are the flags of a particular argument in a signature?
function type_sig_argflags(sig_index, arg_index)
    type_sig_argflags = type_sigt_argflags(type_signatures(sig_index).sig, arg_index)
end function

function type_sigt_argflags(sig$, arg_index)
    type_sigt_argflags = cvl(mid$(sig$, arg_index * 8 + 1, 4))
end function

function type_sigt_flagval(flags)
    type_sigt_flagval = _shr(flags, 16)
end function

function type_sigt_merge$(a$, b$)
    type_sigt_merge$ = a$ + mid$(b$, 5)
end function

sub type_sig_merge(sig_index, b$)
    type_signatures(sig_index).sig = type_signatures(sig_index).sig + mid$(b$, 5)
end function

function type_sig_concrete_arg(sig_index, arg_index)
    flags = type_sig_argflags(sig_index, arg_index)
    type_sig_concrete_arg = (flags AND TYPE_SYNTAX_ONLY) = 0
end function

'Append an argument of the given type and flags to a signature
sub type_sig_add_arg(sig_index, typ, flags)
    type_signatures(sig_index).sig = type_sigt_add_arg$(type_signatures(sig_index).sig, typ, flags)
end sub

function type_sigt_add_arg$(old$, new_argtype, new_argflags)
    type_sigt_add_arg$ = old$ + mkl$(new_argtype) + mkl$(new_argflags)
end function

'Begin a new signature (no type_sig variant because it's unneeded)
function type_sigt_create$(return_type)
    type_sigt_create$ = mkl$(return_type)
end function

'Append a sig to the linked list ending in previous if previous > 0, otherwise start a
'new list
function type_add_sig(previous, sig$)
    type_last_signature = type_last_signature + 1
    if ubound(type_signatures) = type_last_signature then
        redim _preserve type_signatures(type_last_signature * 2) as type_signature_t
    end if
    type_signatures(type_last_signature).sig = sig$
    type_signatures(type_last_signature).succ = 0 'Avoids QB64 compiler bug
    if previous then type_signatures(previous).succ = type_last_signature
    type_add_sig = type_last_signature
end function


'Given an incomplete candidate, what types could we possibly expect to see next?
'Return format is list of 4 bytes padding + mkl$(type) + mkl$(flags). Padding
'allows using type_sigt_* functions to access. mkl$(0) + mkl$(0) means
'"expect end of args".
function type_sig_prefix_nexts$(func, candidate$, depth)
    result$ = type_sigt_create$(0) 'return type is meaningless
    compatibles$ = type_sig_prefix_compatibles$(func, candidate$)
    clen = type_sigt_numargs(candidate$)
    'compatibles$ is list of possible sigs, but we can use type_sigt_* on it anyway
    for i = 1 to type_sigt_numargs(compatibles$)
        'For each sig, determine what token we would be added to the candiate next
        'if it were the true signature being read
        sig_index = type_sigt_argtype(compatibles$, i)
        if type_sig_numargs(sig_index) = clen then
            'there are no more tokens expected for this sig, candidate matches exactly
            result$ = type_sigt_add_arg(result$, 0, 0)
        elseif type_sig_numargs(sig_index) > clen then
            'candidate currently only has a prefix-set of the arguments.
            arg_type = type_sig_argtype(sig_index, clen + 1)
            arg_flags = type_sig_argflags(sig_index, clen + 1) OR _shl(depth, 16)
            result$ = type_sigt_add_arg(result$, arg_type, arg_flags)
            'If that was an optional TYPE_TOKEN, also include the args after it to
            'allow for epsilon transition.
            if (arg_flags AND TYPE_TOKEN) > 0 and (arg_flags AND TYPE_OPTIONAL) > 0 then
                lookahead$ = type_sig_prefix_nexts$(func, type_sigt_add_arg(candidate$, arg_type, arg_flags), depth + 1)
                result$ = type_sigt_merge$(result$, lookahead$)
            end if
        else
            'Should never occur
            ps_error "Impossible sig length"
        end if
    next i
    type_sig_prefix_nexts$ = result$
    $if DEBUG_CALL_RESOLUTION then
    for i = 1 to type_sigt_numargs(result$)
        if type_sigt_argflags(result$, i) and TYPE_CONTEXTUAL then
            debugmsg$ = debugmsg$ + " " + ast_constants(type_sigt_argtype(result$, i)) + "/" + str$(type_sigt_flagval(type_sigt_argflags(result$, i)))
        else
            debugmsg$ = debugmsg$ + " " + type_human_readable$(type_sigt_argtype(result$, i)) + "/" + str$(type_sigt_flagval(type_sigt_argflags(result$, i)))
        end if
    next i
    debuginfo "Nexts list:" + debugmsg$
    $end if
end function

'Given a (possibly incomplete) candidate, find sigs for func that are compatible
'Return format is list of mkl$(sig_index)
function type_sig_prefix_compatibles$(func, candidate$)
    compatibles$ = type_sigt_create$(0)
    sig_index = symtab(func).v1
    while sig_index <> 0
        if type_sig_is_prefix_compatible(sig_index, candidate$, 0) then
            compatibles$ = type_sigt_add_arg(compatibles$, sig_index, 0)
        end if
        sig_index = type_signatures(sig_index).succ
    wend
    type_sig_prefix_compatibles$ = compatibles$
end function

function type_sig_is_prefix_compatible(sig_index, candidate$, checkmode)
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "Comparing to " + type_human_sig$(type_signatures(sig_index).sig)
    $end if
    'candidate will generally have ANY or NONE return types for FUNCTION and SUB 
    'contexts respectively. In the future though this may become more specific, 
    'so ensure the actual return type can be cast to what is needed.
    if not type_can_cast(type_sig_return(sig_index), type_sigt_return(candidate$)) then
        $if DEBUG_CALL_RESOLUTION then
        debuginfo "No, return types not compatible"
        $end if
        exit function
    end if
    for argi = 1 to type_sigt_numargs(candidate$)
        if argi > type_sig_numargs(sig_index) then
            'Cannot possibly match, candidate has more args than sig can accept
            $if DEBUG_CALL_RESOLUTION then
            debuginfo "No, candidate has too many arguments"
            $end if
            exit function
        end if
        sig_arg = type_sig_argtype(sig_index, argi)
        sig_flags = type_sig_argflags(sig_index, argi)
        c_arg = type_sigt_argtype(candidate$, argi)
        c_flags = type_sigt_argflags(candidate$, argi)
        if not type_sig_compatible_arg(sig_arg, sig_flags, c_arg, c_flags, checkmode) then
            $if DEBUG_CALL_RESOLUTION then
            debuginfo "No, mismatch on arg" + str$(argi) + " (candidate has " + type_human_readable$(c_arg) + ")"
            $end if
            exit function
        end if
    next argi
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "(Prefix) " + str$(type_sigt_numargs(candidate$)) + " arguments match"
    $end if
    type_sig_is_prefix_compatible = TRUE
end function

'Function call resolution!
'Each function name has one or more signatures. A signature gives the return type and the
'type of each of its arguments. When a call is parsed, a candidate is built which is like
'a signature in that it is a list of the type of each supplied argument and return type
'(a candidate's return type is always NONE or ANY because we can't reliably detect that).
'
'With the candidate we then have to find a signature that matches. The procedure:
'1) 
'   a) Look for a compatible signature. A sig is compatible if all required arguments are
'      supplied, there are not too many optional arguments and all passed arguments can be
'      cast to the expected type.
'   b) if there no matches, fail.
'   c) If there is exactly 1 compatible sig, that is the result.
'   d) If there are multiple strictly compatible sigs, continue to step 2.
'2)
'   a) Of all compatible signatures, select the first one where all the casts are lossless.
'   b) If no sig matches with lossless casts, select the last sig from the list of compatibles.
'
'Rule 1c is the usual case for simple functions. 2a allows polymorphic functions to be listed
'in the tokens.list file in order of increasing type width and the narrowest version that
'doesn't lose data is picked. 2b is a fallback if a cast is inevitable.

function type_find_sig_match(func, candidate$)
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "Function resolution candidate is " + type_human_sig$(candidate$)
    $end if
    sig_index = symtab(func).v1
    compatibles$ = type_sigt_create$(0)
    while sig_index <> 0
        if type_sig_is_compatible(sig_index, candidate$, 0) then
            compatibles$ = type_sigt_add_arg$(compatibles$, sig_index, 0)
        end if
        sig_index = type_signatures(sig_index).succ
    wend
    if type_sigt_numargs(compatibles$) = 0 then
        exit function
    elseif type_sigt_numargs(compatibles$) = 1 then
        type_find_sig_match = type_sigt_argtype(compatibles$, 1)
    else
        type_find_sig_match = type_pick_best_compatible_sig(compatibles$, candidate$)
    end if
end function

function type_sig_is_compatible(sig_index, candidate$, checkmode)
    if not type_sig_is_prefix_compatible(sig_index, candidate$, checkmode) then exit function
    for i = type_sigt_numargs(candidate$) + 1 to type_sig_numargs(sig_index)
        'sig has more args; they had better be optional
        if (type_sig_argflags(sig_index, i) AND TYPE_OPTIONAL) = 0 then
            $if DEBUG_CALL_RESOLUTION then
            debuginfo "No, required argument" + str$(i) + " not provided"
            $end if
            exit function
        end if
    next i
    type_sig_is_compatible = TRUE
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "Compatible"
    $end if
end function

function type_pick_best_compatible_sig(compatibles$, candidate$)
    'Picks the first sig that has lossless casts, otherwise the last sig if
    'no lossless casts are available.
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "Looking for a safe cast option"
    $end if
    for i = 1 to type_sigt_numargs(compatibles$)
        sig_index = type_sigt_argtype(compatibles$, i)
        if type_sig_is_compatible(sig_index, candidate$, 1) then
            type_pick_best_compatible_sig = sig_index
            $if DEBUG_CALL_RESOLUTION then
            debuginfo "Safe signature found."
            $end if
            exit function
        end if
    next i
    $if DEBUG_CALL_RESOLUTION then
    debuginfo "No safe signature found."
    $end if
    'Default to last sig on list
    type_pick_best_compatible_sig = type_sigt_argtype(compatibles$, type_sigt_numargs(compatibles$))
end function

function type_sig_compatible_arg(sig_arg, sig_flags, c_arg, c_flags, checkmode)
    'checkmode = 0 for lossy casts, 1 for lossless casts only
    if c_arg = TYPE_NONE then
        result = (sig_flags and TYPE_OPTIONAL) > 0
    elseif sig_flags and TYPE_BYREF then
        'Hardcoded check for TYPE_ANY, TYPE_ANY_ARRAY to allow for functions that really take any variable, array
        result = (c_flags and TYPE_BYREF) > 0 and (sig_arg = c_arg or sig_arg = TYPE_ANY or (sig_arg = TYPE_ANY_ARRAY and type_is_array(c_arg)))
    elseif checkmode = 0 then
        result = type_can_cast(c_arg, sig_arg)
    elseif checkmode = 1 then
        result = type_can_safely_cast(c_arg, sig_arg)
    end if
    fh_ok = ((c_flags and TYPE_FILEHANDLE) <> 0) imp ((sig_flags and TYPE_FILEHANDLE) <> 0)
    result = result and (fh_ok <> 0)
    type_sig_compatible_arg = result
end function

function type_human_readable$(typ)
    id$ = symtab(typ).identifier
    'Remove any name mangling
    if left$(id$, 1) = "|" then id$ = mid$(id$, 2)
    type_human_readable$ = id$
end function

function type_human_sig$(sig$)
    o$ = type_human_readable$(type_sigt_return(sig$)) + "("
    for p = 1 to type_sigt_numargs(sig$)
        flags = type_sigt_argflags(sig$, p)
        if flags and TYPE_BYVAL then o$ = o$ + "BYVAL "
        if flags and TYPE_BYREF then o$ = o$ + "BYREF "
        if flags and TYPE_OPTIONAL then o$ = o$ + "OPTION "
        if flags and TYPE_FILEHANDLE then o$ = o$ + "#"
        if flags and TYPE_TOKEN then
            o$ = o$ + tok_human_readable$(type_sigt_argtype(sig$, p))
        elseif flags and TYPE_CONTEXTUAL then
            o$ = o$ + ast_constants(type_sigt_argtype(sig$, p))
        else
            o$ = o$ + type_human_readable$(type_sigt_argtype(sig$, p))
        end if
        o$ = o$ + ", "
    next p
    if right$(o$, 2) = ", " then o$ = left$(o$, len(o$) - 2) 'Trim trailing comma
    type_human_sig$ = o$ + ")"
end function
 
function type_detect_numint_type(content$)
    '2^15-1 = 32767
    '2^31-1 = 2147483647
    '2^63-1 = 18446744073709551615
    select case len(content$)
    case is < 5
        type_detect_numint_type = TYPE_INTEGER
    case 5
        if _strcmp("32767", content$) = -1 then
            type_detect_numint_type = TYPE_LONG
        else
            type_detect_numint_type = TYPE_INTEGER
        end if
    case is < 10
        type_detect_numint_type = TYPE_LONG
    case 10
        if _strcmp("2147483647", content$) = -1 then
            type_detect_numint_type = TYPE_INTEGER64
        else
            type_detect_numint_type = TYPE_LONG
        end if
    case is < 20
        type_detect_numint_type = TYPE_INTEGER64
    case 20
        if _strcmp("18446744073709551615", content$) = -1 then
            'Should we be checking for overflow here?
            type_detect_numint_type = TYPE_QUAD
        else
            type_detect_numint_type = TYPE_INTEGER64
        end if
    case > 20
        'Again, should maybe check for overflow here
        type_detect_numint_type = TYPE_QUAD
    end select
end function

function type_detect_numdec_type(content$)
    '<= 7 digits -> single, <= 16 digits -> double
    select case len(content$) - 1 '-1 because there's a decimal point
    case is <= 7
        type_detect_numdec_type = TYPE_SINGLE
    case is <= 16
        type_detect_numdec_type = TYPE_DOUBLE
    case else
        type_detect_numdec_type = TYPE_QUAD
    end select
end function

function type_detect_numexp_type(content$)
    'e -> single, d -> double, (q -> quad ?)
    for i = 1 to len(content$)
        if asc(content$, i) = 68 or asc(content$, i) = 100 then 'd or D
            type_detect_numexp_type = TYPE_DOUBLE
            exit function
        end if
    next i
    type_detect_numexp_type = TYPE_SINGLE
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'ast.bm - Routines for Abstract Syntax Tree

deflng a-z

' Initialise a clean AST
sub ast_init
    redim ast_nodes(10) as ast_node_t
    redim ast_children(10) as string
    ast_last_node = 0
    redim ast_constants(10) as string
    redim ast_constant_types(10) as long
    ast_constants(AST_FALSE) = "0"
    ast_constant_types(AST_FALSE) = TYPE_INTEGER
    ast_constants(AST_TRUE) = "-1"
    ast_constant_types(AST_TRUE) = TYPE_INTEGER
    ast_constants(AST_ONE) = "1"
    ast_constant_types(AST_ONE) = TYPE_INTEGER
    ast_last_constant = 3
    ast_commit
end sub

sub ast_commit
    ast_last_commit_id = ast_last_node
    ast_last_constant_commit_id = ast_last_constant
end sub

sub ast_rollback
    for i = ast_last_commit_id + 1 to ast_last_node
        ast_children(i) = ""
    next i
    ast_last_node = ast_last_commit_id
    ast_last_constant = ast_last_constant_commit_id
end sub

sub ast_clear_entrypoint
    'Sets the main block to have 0 nodes.
    'This doesn't actually delete the nodes, use ast_rollback for that.
    ast_children(AST_ENTRYPOINT) = ""
end sub

function ast_add_constant(token, content$, force_type)
    if ast_last_constant = ubound(ast_constants) then ast_expand_constants_array
    ast_last_constant = ast_last_constant + 1
    select case token
    case TOK_NUMINT
        ast_constants(ast_last_constant) = content$
        detected_type = type_detect_numint_type(content$)
    case TOK_NUMDEC
        ast_constants(ast_last_constant) = content$
        detected_type = type_detect_numdec_type(ast_constants(ast_last_constant))
    case TOK_NUMBASE
        ast_constants(ast_last_constant) = ltrim$(str$(val(content$)))
        detected_type = type_detect_numint_type(ast_constants(ast_last_constant))
    case TOK_NUMEXP
        ast_constants(ast_last_constant) = content$
        detected_type = type_detect_numexp_type(ast_constants(ast_last_constant))
    case TOK_STRINGLIT
        'Strip quotes
        ast_constants(ast_last_constant) = mid$(content$, 2, len(content$) - 2)
        detected_type = TYPE_STRING
    case TOK_CONTEXTUAL_ARGUMENT
        ast_constants(ast_last_constant) = "|" + content$ + "|"
        detected_type = TYPE_CONTEXTUAL_ARGUMENT
    end select
    if force_type > 0 then
        'If you've used D or E, don't try and use # or ! as well!
        if token = TOK_NUMEXP or not type_can_safely_cast(detected_type, force_type) then ps_error "Cannot retype constant"
        ast_constant_types(ast_last_constant) = force_type
    else
        ast_constant_types(ast_last_constant) = detected_type
    end if
    ast_add_constant = ast_last_constant
end function
    
function ast_add_node(typ)
    if ast_last_node = ubound(ast_nodes) then ast_expand_nodes_arrays
    ast_last_node = ast_last_node + 1
    ast_nodes(ast_last_node).typ = typ
    ast_add_node = ast_last_node
end function

function ast_add_cast(expr, vartyp)
    if vartyp = type_of_expr(expr) or vartyp = TYPE_ANY or vartyp = TYPE_ANY_ARRAY then
        'Don't cast to TYPE_ANY(_ARRAY) because that's just a shorthand
        'for a function that can handle any type.
        ast_add_cast = expr
        exit function
    end if
    cast_node = ast_add_node(AST_CAST)
    ast_nodes(cast_node).ref = vartyp
    ast_attach cast_node, expr
    ast_add_cast = cast_node
end function

sub ast_attach(parent, child)
    if child = 0 or child = -1 then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Not adding child node because it is " + ltrim$(str$(child))
        $end if
        exit sub
    end if
    ast_nodes(child).parent = parent
    ast_children(parent) = ast_children(parent) + mkl$(child)
end sub

sub ast_pre_attach(parent, child)
    if child = 0 or child = -1 then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Not adding child node because it is " + ltrim$(str$(child))
        $end if
        exit sub
    end if
    ast_nodes(child).parent = parent
    ast_children(parent) = mkl$(child) + ast_children(parent)
end sub

function ast_num_children(node)
    ast_num_children = len(ast_children(node)) / len(dummy&)
end function

function ast_is_none(node)
    ast_is_none = ast_nodes(node).typ = AST_NONE
end function

function ast_is_lvalue(node)
    select case ast_nodes(node).typ
    case AST_VAR, AST_ARRAY_ACCESS, AST_UDT_ACCESS
        ast_is_lvalue = TRUE
    end select
end function

function ast_get_child(node, index)
    ast_get_child = cvl(mid$(ast_children(node), len(dummy&) * (index - 1) + 1, len(dummy&)))
end function

sub ast_replace_child(node, index, new_child)
    mid$(ast_children(node), len(dummy&) * (index - 1) + 1, len(dummy&)) = mkl$(new_child)
end sub

'Inverse of ast_get_child. node == ast_get_child(parent, ast_find_child(parent, node))
function ast_find_child(parent, node)
    for i = 1 to ast_num_children(parent)
        if ast_get_child(parent, i) = node then
            ast_find_child = i
            exit function
        end if
    next i
end function

sub ast_expand_nodes_arrays()
    new_size = ubound(ast_nodes) * 2
    redim _preserve ast_nodes(new_size) as ast_node_t
    redim _preserve ast_children(new_size) as string
end sub

sub ast_expand_constants_array()
    new_size = ubound(ast_constants) * 2
    redim _preserve ast_constants(new_size) as string
    redim _preserve ast_constant_types(new_size) as long
end sub

'List of nodes beginning at common ancestor of src & dest, ending at dest
function ast_path_from_ancestor$(src, dest)
    src_path$ = ast_abs_path$(src)
    dest_path$ = ast_abs_path$(dest)
    for i = 1 to len(dest_path$) step 4
        if mid$(src_path$, i, 4) <> mid$(dest_path$, i, 4) then exit for
    next i
    ast_path_from_ancestor$ = mid$(dest_path$, i - 4)
end function

function ast_abs_path$(node)
    n = node
    do
        r$ = mkl$(n) + r$
        n = ast_nodes(n).parent
    loop while n
    ast_abs_path$ = r$
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'symtab.bm - Symbol Table

sub symtab_add_entry(entry as symtab_entry_t)
    symtab_expand_if_needed
    symtab_last_entry = symtab_last_entry + 1
    symtab(symtab_last_entry) = entry
    symtab_map_insert entry.identifier, symtab_last_entry
end sub

function symtab_get_id(identifier$)
    h~& = symtab_hash~&(identifier$, ubound(symtab_map))
    do
        id = symtab_map(h~&)
        if id = 0 then
            exit function
        end if
        if symtab(id).identifier  = identifier$ then
            symtab_get_id = id
            exit function
        endif
        h~& = (h~& + 1) mod (ubound(symtab_map) + 1)
    loop
end function

sub symtab_commit
    symtab_last_commit_id = symtab_last_entry
end sub

sub symtab_rollback
    'Would it be more efficient to do this in reverse order?
    'Does anyone care about how fast it is?
    for i = symtab_last_commit_id + 1 to symtab_last_entry
        identifier$ = symtab(i).identifier
        h~& = symtab_hash~&(identifier$, ubound(symtab_map))
        do
            id = symtab_map(h~&)
            if symtab(id).identifier = identifier$ then exit do
            h~& = (h~& + 1) mod (ubound(symtab_map) + 1)
        loop
        symtab_map(h~&) = 0
    next i
    symtab_last_entry = symtab_last_commit_id
end sub

'Strictly internal functions below
sub symtab_expand_if_needed
    const SYMTAB_MAX_LOADING = 0.75
    const SYMTAB_GROWTH_FACTOR = 2
    if symtab_last_entry = ubound(symtab) then
        redim _preserve symtab(ubound(symtab) * SYMTAB_GROWTH_FACTOR) as symtab_entry_t
    end if

    if symtab_last_entry / ubound(symtab_map) <= SYMTAB_MAX_LOADING then exit function
    redim symtab_map(ubound(symtab_map) * SYMTAB_GROWTH_FACTOR)
    for i = 1 to symtab_last_entry
        symtab_map_insert symtab(i).identifier, i
    next i
end sub

sub symtab_map_insert  (k$, v)
    h~& = symtab_hash~&(k$, ubound(symtab_map))
    do
        if symtab_map(h~&) = 0 then exit do
        h~& = (h~& + 1) mod (ubound(symtab_map) + 1)
    loop
    symtab_map(h~&) = v
end sub

'http://www.cse.yorku.ca/~oz/hash.html
'Attributed to D. J. Bernstein
function symtab_hash~&(k$, max)
    hash~& = 5381
    for i = 1 to len(k$)
        hash~& = ((hash~& * 33) xor asc(k$, i)) mod max
    next i
    '0<=hash<=max-1, so 1<=hash+1<=max
    symtab_hash~& = hash~& + 1
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'parser.bm - Recursive Descent Parser

sub ps_init
    ps_next_var_index = 1
    ps_actual_linenum = 1
    ps_default_type = TYPE_SINGLE
    ps_allow_implicit_vars = TRUE
end sub

function ps_is_linejoin
    ps_is_linejoin = tok_token = TOK_NEWLINE and tok_content$ = ":"
end function
    
sub ps_consume(expected)
    ps_assert expected
    tok_advance
end sub

function ps_consumed(expected)
    if tok_token = expected then
        if tok_token = TOK_NEWLINE and not ps_is_linejoin then ps_actual_linenum = ps_actual_linenum + 1
        tok_advance
        ps_consumed = TRUE
    end if
end function

sub ps_assert(expected)
    if tok_token <> expected then
        if ucase$(tok_human_readable(tok_token)) = ucase$(tok_content$) then
            ps_error "Syntax error: expected " + tok_human_readable(expected) + " got " + tok_human_readable(tok_token)
        else
            ps_error "Syntax error: expected " + tok_human_readable(expected) + " got " + tok_human_readable(tok_token) + " " + chr$(34) + tok_content$ + chr$(34)
        end if
    else
        $if DEBUG_PARSE_TRACE then
        debuginfo "Assert " + tok_human_readable(expected)
        $end if
    end if
    if tok_token = TOK_NEWLINE and not ps_is_linejoin then ps_actual_linenum = ps_actual_linenum + 1
end sub

'Execute this when at the beginning of a line. As well as consuming whitespace,
'it handles the EOI from interactive mode.
sub ps_line_prelude
    do while tok_token = TOK_NEWLINE
        ps_consume TOK_NEWLINE
    loop
    if tok_token = TOK_EOI then
        ps_consume TOK_EOI
    end if
end sub

function ps_is_terminator(t)
    select case t
    case TOK_ELSE, TOK_NEWLINE
        ps_is_terminator = TRUE
    end select
end function

function ps_last_nested(ast_type)
    for i = len(ps_nested_structures$) - 3 to 1 step -4
        if ast_nodes(cvl(mid$(ps_nested_structures$, i, 4))).typ = ast_type then
            ps_last_nested = cvl(mid$(ps_nested_structures$, i, 4))
            exit function
        end if
    next i
end function

function ps_final_nested
    if len(ps_nested_structures$) = 0 then exit function
    ps_final_nested = cvl(right$(ps_nested_structures$, 4))
end function

sub ps_add_nested_structure(node)
    ps_nested_structures$ = ps_nested_structures$ + mkl$(node)
end sub

sub ps_remove_nested_structure
    ps_nested_structures$ = left$(ps_nested_structures$, len(ps_nested_structures$) - 4)
end sub

function ps_scope$
    'Note: global symbols (functions, SHARED vars) have no @ at all
    ps_scope$ = "@" + ps_scope_identifier$ + "@"
end function

function ps_get_scope$(token)
    varname$ = symtab(token).identifier
    if left$(varname$, 1) <> "@" then
        ps_get_scope$ = ""
    else
        ps_get_scope$ = mid$(varname$, 2, instr(2, varname$, "@") - 2)
    end if
end function

sub ps_queue_cleanup(node)
    ps_queued_nodes$ = ps_queued_nodes$ + mkl$(node)
end sub

sub ps_error(msg$)
    Error_message$ = msg$
    error 101
end sub

'Expects: first token in block
'Results: block end marker or IEOF
function ps_block
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start block"
    $end if
    root = ast_add_node(AST_BLOCK)
    do
        do while tok_token = TOK_NEWLINE
            ps_consume TOK_NEWLINE
        loop
        stmt = ps_stmt
        ' -2 -> SUB or FUNCTION definition, continue processing input
        if stmt = -1 then exit do 'use -1 to signal the end of a block
        if stmt > 0 then ast_attach root, stmt '0 means that statement did not generate any ast nodes
    loop
    ps_block = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "End block"
    $end if
end function

'Because some program elements can be referenced before they are defined, we need to
'do a first pass through the program to identify these declarations. We contrast this
'"prepass" with a main pass, usually an invocation of ps_block or similar.
'The prepass will detect and instantiate the following objects:
' - SUB/FUNCTION definitions
' - DIM SHARED variables
' - TYPE definitions
'everything else is ignored. Importantly, the ast will be reset after this so no nodes
'or constants can be created.
sub ps_prepass
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start prepass"
    $end if

    do
        select case tok_token
        case TOK_SUB, TOK_FUNCTION
            dummy = ps_declare_p
        case TOK_EXIT, TOK_END
            'These could be followed by SUB or FUNCTION which would cause confusion
            tok_advance
            tok_advance
        case TOK_DIM
            tok_advance
            if tok_token = TOK__PRESERVE then tok_advance
            if tok_token <> TOK_SHARED then exit select
            'TODO handle shared variable
        case TOK_TYPE
            dummy = ps_udt
        case TOK_NEWLINE
            ps_line_prelude
        case else
            tok_advance
        end select
    loop until ps_consumed(TOK_IEOF)
     
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed prepass"
    $end if
end sub

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'array.bm - Parse rules for array declaration and usage

'Expects: (
'Results: token after ) or sigil, if present
'This sub produces AST_ARRAY_DELETE and AST_ARRAY_RESIZE operations
'and adds them to the supplied block. It also generates the symtab entries
'for the array itself and its type.
sub ps_dim_array(token, var_name$, sigil, block, is_shared, preserve, is_static)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start dim array"
    $end if
    'array declaration. dims$ will be a series of pairs of AST_EXPR,
    'which are the lower and upper bounds for each dimension.
    dim sym as symtab_entry_t
    do
        dims$ = dims$ + mkl$(ps_expr)
        if ps_consumed(TOK_TO) then
            dims$ = dims$ + mkl$(ps_expr)
        else
            'Whoops, there was in implicit lower bound. Add it in.
            implicit_zero = ast_add_node(AST_CONSTANT)
            ast_nodes(implicit_zero).ref = AST_FALSE
            dims$ = left$(dims$, len(dims$) - 4) + mkl$(implicit_zero) + right$(dims$, 4)
        end if
    loop while ps_consumed(TOK_COMMA)
    ps_assert TOK_CPAREN
    tok_advance

    sigil2 = ps_opt_sigil
    if sigil2 > 0 and sigil > 0 then ps_error "Cannot give type twice"
    if sigil2 then sigil = sigil2
    if sigil = 0 then sigil = ps_default_type

    if token <> TOK_UNKNOWN then existing_array = token

    'First we construct the array's type
    array_type_name$ = symtab(sigil).identifier + "(" + ltrim$(str$(len(dims$) / 4 / 2)) + ")"
    array_type_sym = symtab_get_id(array_type_name$)
    if existing_array and symtab(existing_array).v1 <> array_type_sym then
        ps_error "Cannot change array type"
    end if
    if array_type_sym = 0 then
        sym.identifier = array_type_name$
        sym.typ = SYM_TYPE
        'Array descriptor:
        ' - pointer to data
        ' - number of dimensions
        ' - lbound of leftmost dimension
        ' - ubound of leftmost dimension
        ' - etc.
        ' - lbound of rightmost dimension
        ' - ubound of rightmost dimension
        sym.v1 = 2 + len(dims$) / 4
        sym.v2 = SYM_TYPE_ARRAY
        sym.v3 = sigil
        sym.v4 = len(dims$) / 4 / 2
        symtab_add_entry sym
        array_type_sym = symtab_last_entry
    end if

    'Now we have a SYM_ for the type, we can create the actual array variable
    if existing_array = 0 then
        if is_shared then
            sym.identifier = ucase$(var_name$)
        else
            sym.identifier = ps_scope$ + ucase$(var_name$)
        end if
        sym.typ = SYM_VARIABLE
        sym.v1 = array_type_sym
        sym.v2 = ps_next_var_index
        ps_next_var_index = ps_next_var_index + type_fixed_size(sym.v1)
        if is_static or is_shared then sym.v3 = SYM_VARIABLE_MAINFRAME else sym.v3 = 0
        symtab_add_entry sym
        var = symtab_last_entry
    else
        var = existing_array
    end if

    var_node = ast_add_node(AST_VAR)
    ast_nodes(var_node).ref = var
    if is_static then
        node = ast_add_node(AST_ARRAY_ESTABLISH)
    elseif preserve then
        node = ast_add_node(AST_ARRAY_RESIZE)
    else
        node = ast_add_node(AST_ARRAY_CREATE)
    end if
    ast_attach node, var_node
    ast_attach block, node
    ast_children(node) = mkl$(var_node) + dims$

    'Generate an array destructor if:
    ' - we are in a procedure (no need to destruct at program exit), and
    ' - the array is not shared or static, and
    ' - the variable is not a reference (would imply it is owned by a caller).
    proc = ps_last_nested(AST_PROCEDURE)
    v3 = symtab(var).v3
    if proc > 0 and (v3 AND SYM_VARIABLE_MAINFRAME) = 0 and (v3 AND SYM_VARIABLE_DEREF) = 0 then
        'Have a check to see if there's already a destructor.
        'This could occur if there are multiple DIMs in the same function.
        for i = 1 to len(ps_queued_nodes$) - 3 step 4
            other = cvl(mid$(ps_queued_nodes$, i, 4))
            if ast_nodes(other).typ = AST_ARRAY_DELETE and _
                ast_nodes(ast_get_child(other, 1)).ref = var then goto array_dstr_dup
        next i
        node = ast_add_node(AST_ARRAY_DELETE)
        ast_attach node, var_node
        ps_queue_cleanup node
    end if
    array_dstr_dup:
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed dim array"
    $end if
end sub

'Expects: First index of array access
'Results: token after )
'Takes array variable as argument
function ps_array_element_access(lvalue)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start array element access"
    $end if
    array_type = type_of_lvalue(lvalue)
    if symtab(array_type).v2 <> SYM_TYPE_ARRAY then ps_error "Value is not an array"
    dimensions = symtab(array_type).v4
    node = ast_add_node(AST_ARRAY_ACCESS)
    ast_attach node, lvalue
    do
        ast_attach node, ps_expr
    loop while ps_consumed(TOK_COMMA)
    ps_assert TOK_CPAREN
    tok_advance
    if ast_num_children(node) - 1 <> dimensions then ps_error "Incorrect number of dimensions"
    ps_array_element_access = node
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed array element access"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'assignment.bm - Parse rules for variable assignment

'Expects: lvalue token
'Results: token after rvalue
function ps_assignment
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start assignment"
    $end if
    root = ast_add_node(AST_ASSIGN)

    lval = ps_lvalue_mutable
    ast_attach root, lval
    ps_consume TOK_EQUALS

    expr = ps_expr
    lvalue_type = type_of_lvalue(lval)
    rvalue_type = type_of_expr(expr)
    if not type_can_cast(rvalue_type, lvalue_type) then ps_error "Type of variable in assignment does not match value being assigned"
    expr = ast_add_cast(expr, lvalue_type)
    ast_attach root, expr

    ps_assignment = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed assignment"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'const.bm - Parse rules for CONST

'Expects: TOK_CONST
'Results: token after rvalue
function ps_const
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start const"
    $end if
    ps_consume TOK_CONST
    'We use a block so we can deal with multiple consts
    root = ast_add_node(AST_BLOCK)

    do
        if tok_token <> TOK_UNKNOWN then ps_error "CONST already defined"
        const_name$ = tok_content$
        tok_advance
        sigil = ps_opt_sigil
        var = ps_new_var_pp(const_name$, sigil, TRUE)
        lval = ast_add_node(AST_VAR)
        ast_nodes(lval).ref = var
        symtab(var).v3 = symtab(var).v3 or SYM_VARIABLE_CONST 'Mark constant
        assignment = ast_add_node(AST_ASSIGN)
        ast_attach root, assignment
        ast_attach assignment, lval
        ps_consume TOK_EQUALS

        expr = ps_expr
        if sigil = 0 then
            symtab(var).v1 = type_of_expr(expr)
            ast_attach assignment, expr
        elseif type_can_cast(type_of_expr(expr), sigil) then
            cast = ast_add_node(AST_CAST)
            ast_nodes(cast).ref = sigil
            ast_attach cast, expr
            ast_attach assignment, cast
        else
            ps_error "Type mismatch"
        end if
    loop while ps_consumed(TOK_COMMA) 

    ps_const = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed const"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'drawing.bm - Parse rules for vector drawing commands
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'exit.bm - Parse rules for EXIT statements

function ps_exit
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start exit"
    $end if
    root = ast_add_node(AST_EXIT)
    ps_consume TOK_EXIT

    select case tok_token
    case TOK_DO
        target = ps_last_nested(AST_DO_PRE)
        if target = 0 then target = ps_last_nested(AST_DO_POST)
    case TOK_WHILE
        target = ps_last_nested(AST_WHILE)
    case TOK_FOR
        target = ps_last_nested(AST_FOR)
    case TOK_FUNCTION, TOK_SUB
        target = ps_last_nested(AST_PROCEDURE)
    case else
        ps_error "Expected DO, WHILE or FOR"
    end select
    if target = 0 then ps_error "Not inside a " + tok_human_readable$(tok_token) + " block"
    tok_advance
    ast_nodes(root).ref = target

    ps_exit = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed exit"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'for.bm - Parse rules for FOR loop

'Expects: FOR
'Results: NEWLINE after NEXT or iterator variable
function ps_for
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start FOR loop"
    $end if
    root = ast_add_node(AST_FOR)
    ps_add_nested_structure root
    ps_consume TOK_FOR

    var = ps_lvalue_mutable
    var_type = type_of_lvalue(var)
    if not type_is_number(var_type) then ps_error "FOR iterator variable must be numeric"
    ast_attach root, var
    ps_consume TOK_EQUALS

    start_val = ps_expr
    if not type_is_number(type_of_expr(start_val)) then ps_error "FOR start value must be numeric"
    if type_of_expr(start_val) <> var_type then
        cast = ast_add_node(AST_CAST)
        ast_nodes(cast).ref = var_type
        ast_attach cast, start_val
        start_val = cast
    end if
    ps_consume TOK_TO

    end_val = ps_expr
    if not type_is_number(type_of_expr(end_val)) then ps_error "FOR end value must be numeric"
    if type_of_expr(end_val) <> var_type then
        cast = ast_add_node(AST_CAST)
        ast_nodes(cast).ref = var_type
        ast_attach cast, end_val
        end_val = cast
    end if

    if tok_token = TOK_STEP then
        ps_consume TOK_STEP
        step_val = ps_expr
        if not type_is_number(type_of_expr(step_val)) then ps_error "FOR STEP value must be numeric"
    else
        step_val = ast_add_node(AST_CONSTANT)
        ast_nodes(step_val).ref = AST_ONE
    end if
    if type_of_expr(step_val) <> var_type then
        cast = ast_add_node(AST_CAST)
        ast_nodes(cast).ref = var_type
        ast_attach cast, step_val
        step_val = cast
    end if
    ps_consume TOK_NEWLINE

    ast_attach root, start_val
    ast_attach root, end_val
    ast_attach root, step_val
    ast_attach root, ps_block

    ps_consume TOK_NEXT
    'TODO: Check this lvalue matches the one at the top of the loop
    if tok_token <> TOK_NEWLINE then dummy = ps_lvalue_mutable

    ps_remove_nested_structure
    ps_for = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed FOR loop"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'function.bm - Parse rules for function calls

'Expects: TOK_CALL
'Results: NEWLINE
function ps_call
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start call"
    $end if
    ps_consume TOK_CALL
    token = tok_token
    tok_advance
    ps_call = ps_funccall_p(token)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed call"
    $end if
end function

'Expects: function token
'Results: token after last argument
function ps_funccall
    token = tok_token
    tok_advance
    ps_funccall = ps_funccall_p(token)
end function

'Expects: token after function, function token as arg
'Results: token after last argument
function ps_funccall_p(func)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start function call"
    $end if
    root = ast_add_node(AST_CALL)
    ast_nodes(root).ref = func
    sigil = ps_opt_sigil
    if tok_token = TOK_OPAREN then
        ps_consume TOK_OPAREN
        ps_funcargs root, type_sigt_create$(TYPE_ANY), FALSE
        ps_consume TOK_CPAREN
    else
       'function has no arguments
        matching_sig = type_find_sig_match(func, type_sigt_create$(TYPE_ANY))
        if matching_sig = 0 then ps_error "Cannot find matching type signature"
        ast_nodes(root).ref2 = matching_sig
        'Add any optional arguments at end
        for i = 1 to type_sig_numargs(matching_sig)
            ast_attach root, ast_add_node(AST_NONE)
        next i
    end if
    if sigil > 0 and sigil <> type_of_call(root) then ps_error "Function must have correct type suffix if present"
    ps_funccall_p = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed function call"
    $end if
 end function

'Expects: first token after function name
'Results: token after argument list
sub ps_funcargs(root, candidate$, is_statement)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start funcargs"
    $end if
    'Handle empty argument at start
    if tok_token = TOK_COMMA then ps_funcarg root, candidate$, suppress_comma
    'Loop over arguments and build candidate$ as a list of argument types
    do
        'is_statement allows ) to appear in statements, whereas it terminates a function
        if ps_is_terminator(tok_token) or (not is_statement and tok_token = TOK_CPAREN) then exit do
        select case tok_token
        case TOK_COMMA
            ps_consume TOK_COMMA
            ps_funcarg root, candidate$, suppress_comma
        case else
            ps_funcarg root, candidate$, suppress_comma
        end select
    $if DEBUG_PARSE_TRACE then
    debuginfo "Candidate is now " + type_human_sig$(candidate$)
    $end if
    loop
    'candidate$ may match multiple sigs; decide which fits "best". See type.bm for
    'details on what "best" means. This may still fail because the candidate has only
    'been checked as a prefix, never for an exect match on the number of arguments.
    best_sig = type_find_sig_match(ast_nodes(root).ref, candidate$)
    if best_sig = 0 then ps_error "Cannot find matching type signature"
    ast_nodes(root).ref2 = best_sig

    'Modify argument nodes to add in casts where needed
    for i = 1 to ast_num_children(root)
        expr = ast_get_child(root, i)
        expr_type = type_of_expr(expr)
        'The skip value allows us to skip over token that are in the sig but don't
        'get a corresponding ast node.
        do while not type_sig_concrete_arg(best_sig, i + skip)
            skip = skip + 1
        loop
        if i + skip > type_sig_numargs(best_sig) then exit for
        arg_type = type_sig_argtype(best_sig, i + skip)
        if not (expr_type = arg_type or _
                expr_type = TYPE_NONE or _
                expr_type = TYPE_FLAGS) then
            ast_replace_child root, i, ast_add_cast(expr, arg_type)
        end if
    next i
    'Add any optional arguments at end
    for i = ast_num_children(root) + 1 to type_sig_numargs_concrete(best_sig)
        ast_attach root, ast_add_node(AST_NONE)
    next i
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed funcargs"
    $end if
end sub

sub ps_funcarg(root, candidate$, suppress_comma)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start funcarg"
    $end if
    func = ast_nodes(root).ref
    expects$ = type_sig_prefix_nexts$(func, candidate$, 0)
    suppress_comma = FALSE
    'Step 1: Check if any tokens or contextual arguments are present
    for i = 1 to type_sigt_numargs(expects$)
        expected_type = type_sigt_argtype(expects$, i)
        expected_flags = type_sigt_argflags(expects$, i)
        if (expected_flags AND TYPE_TOKEN) > 0 and expected_type = tok_token then
            'We have found a literal token we were told to expect
            typ = expected_type
            flags = expected_flags
            if expected_flags AND TYPE_SYNTAX_ONLY then
                'Don't generate any ast nodes, but add this to the candidate
                expr = 0
            else
                'We need to generate an AST_FLAGS for this
                expr = ast_add_node(AST_FLAGS)
                ast_nodes(expr).ref = AST_FLAG_TOKEN
                ast_nodes(expr).ref2 = typ
            end if
            tok_advance
            suppress_comma = TRUE
            goto arg_done
        elseif expected_flags AND TYPE_CONTEXTUAL then
            l = instr(ast_constants(expected_type), "|" + ucase$(tok_content$) + "|")
            ast_nodes(expr).ref2 = 0
            if l then
                'We have found a matching contextual argument
                typ = expected_type
                flags = expected_flags
                expr = ast_add_node(AST_FLAGS)
                ast_nodes(expr).ref = AST_FLAG_CONTEXTUAL
                do while l > 1
                    ast_nodes(expr).ref2 = ast_nodes(expr).ref2 + 1
                    l = _instrrev(l - 1, ast_constants(expected_type), "|")
                loop
                ast_nodes(expr).ref2 = ast_nodes(expr).ref2 + 1
                tok_advance
                suppress_comma = TRUE
                goto arg_done
            end if
        end if
    next i
    'Step 2: The file handle prefix (#)
    if ps_consumed(TOK_DOUBLE_SFX) then flags = TYPE_FILEHANDLE
    'Step 3a: Try parse an expression
    if tok_token = TOK_COMMA then
        'empty argument
        expr = ast_add_node(AST_NONE)
        flags = flags or TYPE_BYREF
    else
        expr = ps_expr
        if type_is_lvalue(expr) then flags = flags or TYPE_BYREF
    end if
    'Step 3b: See if that expression fits type-wise
    typ = type_of_expr(expr)
    for i = 1 to type_sigt_numargs(expects$)
        expected_type = type_sigt_argtype(expects$, i)
        expected_flags = type_sigt_argflags(expects$, i)
        'it's unclear if "or (expected_type = 0 and expected_flags = 0)" is needed in
        'the below condition.
        if type_sig_compatible_arg(expected_type, expected_flags, typ, flags, 0) then
            ok = TRUE
        end if
    next i
    if not ok then ps_error "Bad argument type " + type_human_readable$(typ)

    arg_done:
    'Step 4a: If the processed arg skipped some optional components, add those optional
    'components as placeholders
    for i = 1 to type_sigt_flagval(flags)
        ast_attach root, ast_add_node(AST_NONE)
    next i
    'Step 4b: Add ast node if any
    if expr then ast_attach root, expr
    
    'Step 5: Like step 4 for for the candidate
    for i = 1 to type_sigt_flagval(flags)
        candidate$ = type_sigt_add_arg(candidate$, TYPE_NONE, 0)
    next i
    candidate$ = type_sigt_add_arg(candidate$, typ, flags)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed funcarg"
    $end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'goto.bm - Parse rules for GOTO statement

'Expects: GOTO
'Results: token after line number
function ps_goto
    ps_consume TOK_GOTO
    ps_goto = ps_goto_p
end function

'Expects: line number
'Results: token after line number
function ps_goto_p
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start goto"
    $end if
    ps_assert TOK_NUMINT
    root = ast_add_node(AST_GOTO)
    id = symtab_get_id(tok_content$)
    if id > 0 and symtab(id).v2 = TRUE and symtab(id).v1 > 0 then
        'Label exists, is resolved and is attached
        $if DEBUG_PARSE_TRACE then
        debuginfo "Goto resolves to" + str$(symtab(id).v1)
        $end if
        ast_nodes(root).ref = symtab(id).v1
    elseif id > 0 then
        'This case helps with things like "10 GOTO 10" (label resolved but not attached)
        $if DEBUG_PARSE_TRACE then
        debuginfo "Reference to pre-existing unresolved or unattached label"
        $end if
        ast_nodes(root).ref = id
        ps_unresolved_jumps$ = ps_unresolved_jumps$ + mkl$(root)
    else
        $if DEBUG_PARSE_TRACE then
        debuginfo "Unresolved goto"
        $end if
        dim symtab_label as symtab_entry_t
        symtab_label.identifier = tok_content$
        symtab_label.typ = SYM_LABEL
        symtab_add_entry symtab_label
        'Unresolved, so point directly to the label
        ast_nodes(root).ref = symtab_last_entry
        ps_unresolved_jumps$ = ps_unresolved_jumps$ + mkl$(root)
    end if
    ps_consume TOK_NUMINT
    ps_goto_p = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed goto"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'if.bm - Parse rules for IF statement

'Expects: IF
'Results: newline
function ps_if
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start conditional"
    $end if
    root = ast_add_node(AST_IF)
    ps_consume TOK_IF
    ps_add_nested_structure root

    condition = ps_expr
    if not type_is_number(type_of_expr(condition)) then ps_error "Condition must be a numeric expression"
    ast_attach root, condition
    ps_consume TOK_THEN

    'A REM after THEN acts as a command; we remain in single-line if mode
    if ucase$(tok_content$) = "REM" then
        block = ast_add_node(AST_BLOCK)
        ast_attach root, block
        ps_remove_nested_structure
        ps_if = root
        $if DEBUG_PARSE_TRACE then
        debuginfo "Completed conditional (single-line REM)"
        $end if
        exit function
    end if

    if tok_token <> TOK_NEWLINE or ps_is_linejoin then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Single-line IF"
        $end if
        ast_attach root, ps_if_stmts
        if tok_token = TOK_ELSE then
            ps_consume TOK_ELSE
            ast_attach root, ps_if_stmts
        end if
    else
        $if DEBUG_PARSE_TRACE then
        debuginfo "Multi-line IF"
        $end if
        ast_attach root, ps_block
        do while tok_token = TOK_ELSEIF
            ps_consume TOK_ELSEIF
            condition = ps_expr
            if not type_is_number(type_of_expr(condition)) then ps_error "Condition must be a numeric expression"
            ast_attach root, condition
            ps_consume TOK_THEN
            ast_attach root, ps_block
        loop
        if tok_token = TOK_ELSE then
            ps_consume TOK_ELSE
            ast_attach root, ps_block 
        end if
        ps_consume TOK_END
        ps_consume TOK_IF
    end if

    ps_remove_nested_structure
    ps_if = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed conditional"
    $end if
end function

'Expects: Start of a statement or :
'Results: ELSE or NEWLINE
'Note: This handles one or more statements joined by : and terminated by ELSE/NEWLINE, or an implicit GOTO
function ps_if_stmts
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start if stmts"
    $end if
    block = ast_add_node(AST_BLOCK)
    if tok_token = TOK_NUMINT then
        ast_attach block, ps_goto_p
    else
        do
            while ps_is_linejoin
                ps_consume TOK_NEWLINE
            wend
            stmt = ps_stmt
            ast_attach block, stmt
            while ps_is_linejoin
                ps_consume TOK_NEWLINE
            wend
        loop until ps_is_terminator(tok_token)
    end if
    ps_if_stmts = block
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed if stmts"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'input.bm - Parse rules for INPUT statement

'Expects: TOK_INPUT or TOK_LINEINPUT
'Results: token after input variables
'Format: INPUT[;]["prompt"{;|,}]variablelist
'or LINE INPUT[;]["prompt"{;|,}]variable$
function ps_stmt_input
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start stmt input"
    $end if
    root = ast_add_node(AST_CALL)
    ast_nodes(root).ref = TOK_INPUT
    ast_nodes(root).ref2 = symtab(TOK_INPUT).v1
    flags = ast_add_node(AST_FLAGS)
    ast_nodes(flags).ref = AST_FLAG_MANUAL
    ast_attach root, flags
    ast_nodes(flags).ref2 = 0
    if ps_consumed(TOK_LINEINPUT) then
        ast_nodes(flags).ref2 = ast_nodes(flags).ref2 OR STMT_INPUT_LINEMODE
        linemode = TRUE
    end if
    ps_consume TOK_INPUT

    if ps_consumed(TOK_SEMICOLON) then
        ast_nodes(flags).ref2 = STMT_INPUT_NO_NEWLINE
    end if

    'The prompt must be a literal string, no expressions. Crazy, right?
    if tok_token = TOK_STRINGLIT then
        prompt = ast_add_node(AST_CONSTANT)
        ast_nodes(prompt).ref = ast_add_constant(tok_token, tok_content$, TYPE_STRINGLIT)
        ast_nodes(flags).ref2 = ast_nodes(flags).ref2 OR STMT_INPUT_PROMPT
        ast_attach root, prompt
        ps_consume TOK_STRINGLIT
        if tok_token = TOK_COMMA then
            ast_nodes(flags).ref2 = ast_nodes(flags).ref2 OR STMT_INPUT_NO_QUESTION
            ps_consume TOK_COMMA
        else
            ps_consume TOK_SEMICOLON
        end if
        'It turns out INPUT and LINE INPUT interpret the {;|,} with exactly opposite
        'meaning
        if linemode then
            ast_nodes(flags).ref2 = ast_nodes(flags).ref2 XOR STMT_INPUT_NO_QUESTION
        end if
    end if

    if linemode then
        var = ps_lvalue_mutable
        if type_of_lvalue(var) <> TYPE_STRING then ps_error "Variable must be a string"
        ast_attach root, var
    else
        do
            var = ps_lvalue_mutable
            ast_attach root, var
        loop while ps_consumed(TOK_COMMA)
    end if

    ps_stmt_input = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed stmt input"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'labels.bm - Parse rule for labels and utility functions for handling them

'Expects: TOK_LINENUM
'Results: next token
'Note: this is for label definitions, not references
sub ps_label
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start label"
    $end if
    id = symtab_get_id(tok_content$)
    if id > 0 and symtab(id).typ <> SYM_LABEL then
        ps_error "Label name conflicts with existing identifier"
    elseif id > 0 and symtab(id).v2 = TRUE then
        ps_error "Label already defined"
    elseif id > 0 then
        'This is a label that was only referenced until now; mark it found
        symtab(id).v2 = TRUE
    else
        dim symtab_label as symtab_entry_t
        symtab_label.identifier = tok_content$
        symtab_label.typ = SYM_LABEL
        symtab_label.v2 = TRUE
        symtab_add_entry symtab_label
        id = symtab_last_entry
    end if
    ps_unattached_labels$ = ps_unattached_labels$ + mkl$(id)
    ps_consume TOK_LINENUM
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed label"
    $end if
end sub

'There may have been 0 or more labels since the last statement that produced
'nodes (some non-executable statements may not produce nodes). This attaches
'those labels to a node. It also resolves any jumps to those labels to point
'to the node.
sub ps_attach_labels(node)
    if node > 0 then
        for i = 1 to len(ps_unattached_labels$) step 4
            label_id = cvl(mid$(ps_unattached_labels$, i, 4))
            $if DEBUG_PARSE_TRACE then
            debuginfo "Attached label " + symtab(label_id).identifier
            $end if
            symtab(label_id).v1 = node
            'Have we resolved an unresolved jump?
            for j = 1 to len(ps_unresolved_jumps$) step 4
                unres_node = cvl(mid$(ps_unresolved_jumps$, j, 4))
                if ast_nodes(unres_node).ref = label_id then
                    ast_nodes(unres_node).ref = node
                else
                    still_unres$ = still_unres$ + mkl$(unres_node)
                end if
            next j
            ps_unresolved_jumps$ = still_unres$
        next i
        ps_unattached_labels$ = ""
    end if
end sub

'Handles any labels not yet attached by the end of the program, because
'they're trailing empty lines or trailing non-executable statements.
'Also ensures all references point to an existent label.
sub ps_finish_labels(block)
    if len(ps_unattached_labels$) > 0 then
        end_node = ast_add_node(AST_BLOCK)
        ast_attach block, end_node
        ps_attach_labels end_node
    end if 
    if len(ps_unresolved_jumps$) then
        labels$ = symtab(ast_nodes(cvl(left$(ps_unresolved_jumps$, 4))).ref).identifier
        for i = 5 to len(ps_unresolved_jumps$) step 4
            labels$ = ", " + symtab(ast_nodes(cvl(mid$(ps_unresolved_jumps$, i, 4))).ref).identifier
        next i
        ps_error "Undefined label(s): " + labels$
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'loop.bm - Parse rules for DO LOOP and WHILE WEND

'Expects: WHILE
'Results: NEWLINE after WEND
function ps_while
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start WHILE loop"
    $end if
    root = ast_add_node(AST_WHILE)
    ps_add_nested_structure root
    ps_consume TOK_WHILE

    ast_attach root, ps_expr
    ps_consume TOK_NEWLINE

    ast_attach root, ps_block
    ps_consume TOK_WEND

    ps_remove_nested_structure
    ps_while = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed WHILE loop"
    $end if
end function

'Expects: DO
'Results: NEWLINE after LOOP or condition
function ps_do
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start DO loop"
    $end if
    ps_consume TOK_DO
    if tok_token = TOK_WHILE or tok_token = TOK_UNTIL then ps_do = ps_do_pre else ps_do = ps_do_post
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed DO loop"
    $end if
end function

'Expects: WHILE or UNTIL
'Results: NEWLINE after LOOP
function ps_do_pre
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start DO-pre loop"
    $end if
    root = ast_add_node(AST_DO_PRE)
    ps_add_nested_structure root
    if tok_token = TOK_UNTIL then
        ps_consume TOK_UNTIL
        'Need to invert guard condition
        guard = ast_add_node(AST_CALL)
        ast_nodes(guard).ref = TOK_EQUALS
        sig$ = type_sigt_add_arg(type_sigt_add_arg(type_sigt_create$(TYPE_ANY), TYPE_INTEGER, 0), TYPE_INTEGER, 0)
        ast_nodes(guard).ref2 = type_find_sig_match(TOK_EQUALS, sig$)
        ast_attach guard, ps_expr
        f = ast_add_node(AST_CONSTANT)
        ast_nodes(f).ref = AST_FALSE
        ast_attach guard, f
    else
        ps_consume TOK_WHILE
        guard = ps_expr
    end if
    ast_attach root, guard
    ps_consume TOK_NEWLINE

    ast_attach root, ps_block
    ps_consume TOK_LOOP

    ps_remove_nested_structure
    ps_do_pre = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed DO-pre loop"
    $end if
end function

'Expects: NEWLINE
'Results: NEWLINE after loop guard condition
function ps_do_post
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start DO-post loop"
    $end if
    ps_consume TOK_NEWLINE
    root = ast_add_node(AST_DO_POST)
    ps_add_nested_structure root
    block = ps_block

    ps_consume TOK_LOOP
    if tok_token = TOK_UNTIL then
        ps_consume TOK_UNTIL
        'Need to invert guard condition
        guard = ast_add_node(AST_CALL)
        ast_nodes(guard).ref = TOK_EQUALS
        sig$ = type_sigt_add_arg(type_sigt_add_arg(type_sigt_create$(TYPE_ANY), TYPE_INTEGER, 0), TYPE_INTEGER, 0)
        ast_nodes(guard).ref2 = type_find_sig_match(TOK_EQUALS, sig$)
        ast_attach guard, ps_expr
        f = ast_add_node(AST_CONSTANT)
        ast_nodes(f).ref = AST_FALSE
        ast_attach guard, f
    elseif tok_token = TOK_WHILE then
        ps_consume TOK_WHILE
        guard = ps_expr
    else
        'Infinite loop
        guard = ast_add_node(AST_CONSTANT)
        ast_nodes(guard).ref = AST_TRUE
    end if
    ast_attach root, guard
    ast_attach root, block

    ps_remove_nested_structure
    ps_do_post = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed DO-post loop"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'metacommands.bm - Process $metacommands in parser

'Expects: META_LIST
'Results: TOK_NEWLINE
sub ps_meta_list
    ps_consume META_LIST
    category$ = "SYMTAB"
    if tok_token = TOK_METAPARAM then
        category$ = _trim$(ucase$(tok_content$))
        ps_consume TOK_METAPARAM
    end if
    select case left$(category$, 1)
    case "S" 'SYMTAB
        symtab_dump
    case "F" 'FUNCTIONS
        type_dump_functions
    case "P" 'PROGRAM
        ast_dump_pretty AST_ENTRYPOINT, 0
        dump_subprocedures
    case "C" 'CONSTANTS
        ast_dump_constants
    case else
        ps_error "$LIST [SFPC]"
    end select
end sub

'Expects: META_DEBUG
'Results: TOK_NEWLINE
sub ps_meta_debug
    ps_consume META_DEBUG
    action$ = "ON"
    if tok_token = TOK_METAPARAM then
        action$ = _trim$(ucase$(tok_content$))
        ps_consume TOK_METAPARAM
    end if
    select case action$
    case "ON"
        options.debug = TRUE
    case "OFF"
        options.debug = FALSE
    case else
        ps_error "$DEBUG [ON|OFF]"
    end select
end sub

'Expects: META_INCLUDE
'Results: TOK_NEWLINE
sub ps_meta_include
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start $include"
    $end if
    if input_files(input_files_last).handle = 0 then
        'No file is open, we must be in interactive mode or similar
        ps_error "Cannot include files in this mode"
    end if
    ps_consume META_INCLUDE
    if tok_token <> TOK_METAPARAM then ps_error "Filename required"
    filename$ = _trim$(tok_content$)
    tok_advance 'Consume file name
    if left$(filename$, 1) <> "'" or right$(filename$, 1) <> "'" then
        ps_error "Filename must be surrounded by single quotes"
    end if
    filename$ = mid$(filename$, 2, len(filename$) - 2)
    input_files_last = input_files_last + 1
    if ubound(input_files) < input_files_last then
        redim _preserve input_files(input_files_last) as input_file_t
    end if
    input_files(input_files_last).handle = freefile
    input_files(input_files_last).filename = filename$
    'A relative path is relative to the location of the including file
    filename$ = locate_path$(filename$, input_files(input_files_last - 1).dirname)
    input_files(input_files_last).dirname = dirname$(filename$)
    open_file filename$, input_files(input_files_last).handle, FALSE
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed $include"
    $end if
end sub

'Expects: unknown metacommand
'Results: TOK_NEWLINE
sub ps_meta_unknown
    $if DEBUG_PARSE_TRACE then
    debuginfo "Metacommand " + tok_content$ + " is unknown"
    $end if
    while tok_token <> TOK_NEWLINE
        tok_advance
    wend
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'option.bm - Parse rules for the OPTION statement

'Expects: TOK_OPTION
'Results: NEWLINE
sub ps_stmt_option
    ps_consume TOK_OPTION
    if ps_consumed(TOK__EXPLICIT) then
        ps_allow_implicit_vars = FALSE
    elseif ps_consumed(TOK__EXPLICITARRAY) then
        'Arrays are never allowed to be implicit so this is always in effect.
        'Ignore silently for compatibility.
    else
        ps_error "Expected OPTION _EXPLICIT"
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'pratt.bm - Expression parser using the Pratt algorithm

'Expects: first token of expr
'Results: token after expression
'Note: the expression parser is greedy; it will only stop when it encounters
'      a token that cannot possibly be part of an expression.
function ps_expr
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start expr"
    $end if
    ps_expr = pt_expr(0)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed expr"
    $end if
end function

function pt_expr(rbp)
    t = tok_token
    content$ = tok_content$
    tok_advance
    left_node = nud(t, content$)
    while rbp < lbp(tok_token, tok_content$)
        t = tok_token
        content$ = tok_content$
        tok_advance
        left_node = led(t, content$, left_node)
    wend
    pt_expr = left_node
end function

'tok_token is positioned one after whatever token is.
'ps_ functions called from here usually need to be specially written
'to take their first token as an argument instead of from tok_token.
function nud(token, content$)
    select case token
    case TOK_NUMINT, TOK_NUMBASE, TOK_NUMDEC, TOK_NUMEXP, TOK_STRINGLIT
        node = ast_add_node(AST_CONSTANT)
        ast_nodes(node).ref = ast_add_constant(token, content$, ps_opt_sigil)
    case TOK_OPAREN
        node = pt_expr(0)
        ps_consume TOK_CPAREN
    case TOK_DASH
        'Hardcoded hack to change TOK_DASH into TOK_NEGATIVE
        token = TOK_NEGATIVE
        goto negative_hack
    case TOK_UNKNOWN
        'Implicit variable definitions
        node = ps_simple_variable_p(token, content$)
    case else
        negative_hack:
        select case symtab(token).typ
        case SYM_FUNCTION
            node = ps_funccall_p(token)
        case SYM_VARIABLE
            node = ps_lvalue_p(token, content$)
        case SYM_PREFIX
            node = ast_add_node(AST_CALL)
            ast_nodes(node).ref = token
            expr = pt_expr(symtab(token).v2)
            if type_is_lvalue(expr) then candidate_flags = TYPE_BYREF
            candidate$ = type_sigt_create$(TYPE_ANY)
            candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr), flags)
            matching_sig = type_find_sig_match(token, candidate$)
            if matching_sig = 0 then ps_error "Cannot find matching type signature"
            ast_attach node, ast_add_cast(expr, type_sig_argtype(matching_sig, 1))
            ast_nodes(node).ref2 = matching_sig
        case else
            ps_error "Unexpected " + tok_human_readable$(token)
        end select
    end select
    nud = node
end function

function lbp(token, content$)
    select case token
    case is < 0
        ps_error "Unexpected literal " + content$
    case TOK_CPAREN
        lbp = 0
    case else
        select case symtab(token).typ
        case SYM_INFIX
            lbp = symtab(token).v2
        case else
            'We've hit something that isn't part if the expression,
            'time to finish.
            lbp = 0
        end select
    end select
end function

function led(token, content$, left_node)
    'content$ is not used but might be useful one day.
    'This next line stops the warning about unused variables.
    content$ = content$
    node = ast_add_node(AST_CALL)
    ast_nodes(node).ref = token
    select case symtab(token).typ
    case SYM_INFIX
        if symtab(token).v3 = 0 then 'Left-associative
            right_node = pt_expr(symtab(token).v2)
        else 'right-associative
            right_node = pt_expr(symtab(token).v2 - 1)
        end if
        candidate$ = type_sigt_create$(TYPE_ANY)
        if type_is_lvalue(left_node) then candidate_flags = TYPE_BYREF
        candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(left_node), flags)
        if type_is_lvalue(right_node) then candidate_flags = TYPE_BYREF
        candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(right_node), flags)
        matching_sig = type_find_sig_match(token, candidate$)
        if matching_sig = 0 then ps_error "Cannot find matching type signature"
        ast_attach node, ast_add_cast(left_node, type_sig_argtype(matching_sig, 1))
        ast_attach node, ast_add_cast(right_node, type_sig_argtype(matching_sig, 2))
        ast_nodes(node).ref2 = matching_sig
    case else
        ps_error "Unexpected led " + tok_human_readable$(token)
    end select
    led = node
end function
sub ps_preload_file
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start preload file"
    $end if
    ps_is_preload = TRUE
    do
        do while tok_token = TOK_NEWLINE
            ps_consume TOK_NEWLINE
        loop
        stmt = ps_stmt
        if stmt > 0 then ps_error "Preload cannot contain executable code in main program"
        if stmt = -1 then exit do
    loop
    ps_is_preload = FALSE
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed preload file"
    $end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'print.bm - Parse rules for PRINT statement

'Expects: TOK_PRINT
'Results: token after last expression, comma or semicolon
'Format: PRINT [expressionlist][{,|;}]
function ps_print
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start print"
    $end if
    root = ast_add_node(AST_CALL)
    ast_nodes(root).ref = TOK_PRINT
    ast_nodes(root).ref2 = symtab(TOK_PRINT).v1
    ps_consume TOK_PRINT

    newline = TRUE
    do
        if ps_is_terminator(tok_token) then exit do
        select case tok_token
        case TOK_COMMA
            node = ast_add_node(AST_FLAGS)
            ast_nodes(node).ref = AST_FLAG_MANUAL
            ast_nodes(node).ref2 = PRINT_NEXT_FIELD
            ast_attach root, node
            ps_consume TOK_COMMA
            newline = FALSE
        case TOK_SEMICOLON
            'No flags needed here
            ps_consume TOK_SEMICOLON
            newline = FALSE
        case else
            ast_attach root, ps_expr
            newline = TRUE
        end select
    loop
    if newline then
        node = ast_add_node(AST_FLAGS)
        ast_nodes(node).ref = AST_FLAG_MANUAL
        ast_nodes(node).ref2 = PRINT_NEWLINE
        ast_attach root, node
    end if
    
    ps_print = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed print"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'putimage.bm - Parse rules for _PUTIMAGE statement

'Expects: TOK__PUTIMAGE
'Results: NEWLINE
'Format: [[STEP] (single, single) [- [STEP] (single, single)]], [long], [long], [[STEP] (single, single) [- STEP (single, single)]] [, _SMOOTH]

function ps__putimage
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start _putimage"
    $end if

    root = ast_add_node(AST_CALL)
    ast_nodes(root).ref = TOK__PUTIMAGE
    ast_nodes(root).ref2 = symtab(TOK__PUTIMAGE).v1
    ps_consume TOK__PUTIMAGE
    flag_node = ast_add_node(AST_FLAGS)
    ast_nodes(flag_node).ref = AST_FLAG_MANUAL
    ast_attach root, flag_node

    if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_SRC1
    if ps_consumed(TOK_OPAREN) then
        ast_attach root, ps_expr
        ps_consume TOK_COMMA
        ast_attach root, ps_expr
        ps_consume TOK_CPAREN
    else
        ast_attach root, ast_add_node(AST_NONE)
        ast_attach root, ast_add_node(AST_NONE)
    end if
    if ps_consumed(TOK_DASH) then
        if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_SRC2
        ps_consume TOK_OPAREN
        ast_attach root, ps_expr
        ps_consume TOK_COMMA
        ast_attach root, ps_expr
        ps_consume TOK_CPAREN
    else
        ast_attach root, ast_add_node(AST_NONE)
        ast_attach root, ast_add_node(AST_NONE)
    end if
    if not ps_consumed(TOK_COMMA) then goto putimage_parse_done
    if tok_token <> TOK_COMMA then ast_attach root, ps_expr else ast_attach root, ast_add_node(AST_NONE)
    if not ps_consumed(TOK_COMMA) then goto putimage_parse_done
    if tok_token <> TOK_COMMA then ast_attach root, ps_expr else ast_attach root, ast_add_node(AST_NONE)
    if not ps_consumed(TOK_COMMA) then goto putimage_parse_done
    if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_DEST1
    if ps_consumed(TOK_OPAREN) then
        ast_attach root, ps_expr
        ps_consume TOK_COMMA
        ast_attach root, ps_expr
        ps_consume TOK_CPAREN
    else
        ast_attach root, ast_add_node(AST_NONE)
        ast_attach root, ast_add_node(AST_NONE)
    end if
    if ps_consumed(TOK_DASH) then
        if ps_consumed(TOK_STEP) then flags = flags OR PUTIMAGE_STEP_DEST2
        ps_consume TOK_OPAREN
        ast_attach root, ps_expr
        ps_consume TOK_COMMA
        ast_attach root, ps_expr
        ps_consume TOK_CPAREN
    else
        ast_attach root, ast_add_node(AST_NONE)
        ast_attach root, ast_add_node(AST_NONE)
    end if
    if ps_consumed(TOK_COMMA) then
        ps_consume TOK__SMOOTH
        flags = flags OR PUTIMAGE_SMOOTH
    end if

    putimage_parse_done:
    ast_nodes(flag_node).ref2 = flags
    'Fill in any missing arguments on the end
    for i = ast_num_children(root) + 1 to 11
        ast_attach root, ast_add_node(AST_NONE)
    next i
    ps__putimage = root

    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed _putimage"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'select.bm - Parse rules for SELECT CASE statement

'Expects: TOK_SELECT
'Results: NEWLINE
function ps_select
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start select"
    $end if

    root = ast_add_node(AST_SELECT)
    ps_consume TOK_SELECT
    ps_consume TOK_CASE
    expr = ps_expr
    ast_attach root, expr
    ps_add_nested_structure root
    ps_consume TOK_NEWLINE
    ps_line_prelude
    
    while not ps_consumed(TOK_END)   
        ast_attach root, ps_select_case(type_of_expr(expr))
    wend

    ps_consume TOK_SELECT
    ps_remove_nested_structure
    ps_select = root

    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed select"
    $end if
end function

function ps_select_case(typ)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start select case"
    $end if

    ps_consume TOK_CASE
    if ps_consumed(TOK_ELSE) then
        node = ast_add_node(AST_SELECT_ELSE)
    else
        node = ast_add_node(AST_SELECT_LIST)
        do
            ast_attach node, ps_select_case_guard(typ)
        loop while ps_consumed(TOK_COMMA)
    end if
    ast_attach node, ps_block
    ps_select_case = node

    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed select case"
    $end if
end function

function ps_select_case_guard(typ)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start select case guard"
    $end if

    if ps_consumed(TOK_IS) then
        node = ast_add_node(AST_SELECT_IS)
        ref = tok_token
        ref_typ = symtab(ref).typ
        if not (ref_typ = SYM_INFIX or ref_typ = SYM_PREFIX or ref_typ = SYM_FUNCTION) then
            ps_error "Not a function"
        end if
        tok_advance
        expr = ps_expr
        candidate$ = type_sigt_create$(TYPE_INTEGER)
        candidate$ = type_sigt_add_arg$(candidate$, typ, 0)
        candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr), 0)
        sig = type_find_sig_match(ref, candidate$)
        if sig = 0 then ps_error "Bad function"
        ast_nodes(node).ref = ref
        ast_nodes(node).ref2 = sig
        value_node = ast_add_node(AST_SELECT_VALUE)
        ast_nodes(value_node).ref = typ
        ast_attach node, ast_add_cast(value_node, type_sig_argtype(sig, 1))
        expr = ast_add_cast(expr, type_sig_argtype(sig, 2))
        ast_attach node, expr
    else
        expr1 = ps_expr
        if ps_consumed(TOK_TO) then
            expr2 = ps_expr
            'Lookup <= to confirm types are well-ordered. Note that we use <= for
            'both bounds, which simplfied this code a little and allows future fancy
            'stuff (custom orderings etc.) to only need to implement the one function.
            node = ast_add_node(AST_SELECT_RANGE)
            candidate$ = type_sigt_create$(TYPE_INTEGER)
            candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr1), 0)
            candidate$ = type_sigt_add_arg$(candidate$, typ, 0)
            sig = type_find_sig_match(TOK_CMP_LTEQ, candidate$)
            if sig = 0 then ps_error "Bad function"
            if type_sig_argtype(sig, 1) <> type_sig_argtype(sig, 2) then
                'The arguments need to have the same type so we can use it
                'with reversed arguments too.
                ps_error "Function does not have exchangable argument types"
            end if
            ast_nodes(node).ref = TOK_CMP_LTEQ
            ast_nodes(node).ref2 = sig
            ast_attach node, expr1
            ast_attach node, expr2
        else
            'Simple CASE x
            node = ast_add_node(AST_SELECT_IS)
            candidate$ = type_sigt_create$(TYPE_INTEGER)
            candidate$ = type_sigt_add_arg$(candidate$, typ, 0)
            candidate$ = type_sigt_add_arg$(candidate$, type_of_expr(expr1), 0)
            sig = type_find_sig_match(TOK_EQUALS, candidate$)
            if sig = 0 then ps_error "Cannot compare for equality"
            ast_nodes(node).ref = TOK_EQUALS
            ast_nodes(node).ref2 = sig
            value_node = ast_add_node(AST_SELECT_VALUE)
            ast_nodes(value_node).ref = typ
            ast_attach node, ast_add_cast(value_node, type_sig_argtype(sig, 1))
            expr1 = ast_add_cast(expr1, type_sig_argtype(sig, 2))
            ast_attach node, expr1
        end if
    end if
    ps_select_case_guard = node

    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed select case guard"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'statement.bm - Parse rules for statements

'Expects: first token of statement
'Results: NEWLINE or block end marker
'Returns:
'   -2 -> a SUB or FUNCTION was defined (useful for interactive mode to know)
'   -1 ->  end of a block
'   0 -> statement did not generate any ast nodes
'   > 0 -> ast node
function ps_stmt
    ps_line_prelude

    if tok_token = TOK_LINENUM then ps_label
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start statement"
    $end if
    'Sigh
    if tok_token = TOK_LINE and ucase$(tok_next_content$) = "INPUT" then tok_token = TOK_LINEINPUT
    select case tok_token
        case is < 0
            ps_error "Unexpected literal " + tok_content$
        case META_LIST
            ps_meta_list
        case META_DEBUG
            ps_meta_debug
        case META_INCLUDE
            ps_meta_include
        case META_UNKNOWN
            ps_meta_unknown
        case TOK_CALL
            stmt = ps_call
        case TOK_CONST
            stmt = ps_const
        case TOK_DECLARE
            stmt = ps_declare
        case TOK_DIM, TOK_REDIM, TOK_STATIC
            'REDIM is treated as an alias for DIM.
            'STATIC is so similar we handle it here too.
            stmt = ps_dim
        case TOK_DO
            stmt = ps_do
        case TOK_EXIT
            stmt = ps_exit
        case TOK_FOR
            stmt = ps_for
        case TOK_FUNCTION
            stmt = ps_userfunc
        case TOK_GOTO
            stmt = ps_goto
        case TOK_IF
            stmt = ps_if
        case TOK_INPUT, TOK_LINEINPUT
            'These two are so similar, we parse them as the same function
            stmt = ps_stmt_input
        case TOK_OPTION
            ps_stmt_option
        case TOK_PRINT
            stmt = ps_print
        case TOK__PUTIMAGE
            stmt = ps__putimage
        case TOK_SELECT
            stmt = ps_select
        case TOK_SUB
            stmt = ps_userfunc
        case TOK_TYPE
            'For non-interactive modes a TYPE is processed in the prepass, so ignore
            'it here
            if options.compile_mode or options.run_mode then
                ps_udt_ignore
            else
                stmt = ps_udt
            end if
        case TOK_WHILE
            stmt = ps_while
        case TOK_UNKNOWN
            stmt = ps_assignment
        case TOK_NEWLINE
            'Blank line; ignore it
            stmt = 0
        'These all end a block in some fashion. The block-specific code will assert the
        'ending token, but we check it's syntactically valid here.
        case TOK_END
            'We can't check tok_next_token because it does not always contain correct look-ahead information
            next_content$ = ucase$(tok_next_content$)
            nesting = ast_nodes(ps_final_nested).typ
            if next_content$ <> "IF" and _
                next_content$ <> "SELECT" and _
                next_content$ <> "SUB" and _
                next_content$ <> "FUNCTION" then
                'Handle regular END command
                stmt = ps_stmtreg
            elseif nesting <> AST_IF and nesting <> AST_SELECT and nesting <> AST_PROCEDURE then
                ps_error "Unexpected END"
            else
                stmt = -1
            end if
        case TOK_ELSE, TOK_ELSEIF
            if ast_nodes(ps_final_nested).typ <> AST_IF then ps_error tok_human_readable$(tok_token) + " without IF"
            stmt = -1
        case TOK_LOOP
            if ast_nodes(ps_final_nested).typ <> AST_DO_PRE and ast_nodes(ps_final_nested).typ <> AST_DO_POST then ps_error "LOOP without DO"
            stmt = -1
        case TOK_WEND
            if ast_nodes(ps_final_nested).typ <> AST_WHILE then ps_error "WEND without WHILE"
            stmt = -1
        case TOK_NEXT
            if ast_nodes(ps_final_nested).typ <> AST_FOR then ps_error "NEXT without FOR"
            stmt = -1
        case TOK_CASE
            if ast_nodes(ps_final_nested).typ <> AST_SELECT then ps_error "CASE without SELECT"
            stmt = -1
        case TOK_IEOF
            if ps_final_nested <> 0 then ps_error "Unexpected end of file"
            stmt = -1
        case else
            select case symtab(tok_token).typ
            case SYM_VARIABLE
                stmt = ps_assignment
            case SYM_FUNCTION
                stmt = ps_stmtreg
            case else
                ps_error tok_human_readable$(tok_token) + " (" + tok_content$ + ") doesn't belong here"
            end select
    end select

    ps_attach_labels stmt

    ps_stmt = stmt
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed statement"
    $end if
end function


'Expects: statement token
'Results: token after last argument
function ps_stmtreg
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start stmtreg"
    $end if
    'Is this in fact assigning the return value of a function?
    root = ps_func_return
    if root = 0 then
        'Nope, it's just a statement
        root = ast_add_node(AST_CALL)
        ast_nodes(root).ref = tok_token
        tok_advance
        'TYPE_NONE to indicate we have no return value
        ps_funcargs root, type_sigt_create$(TYPE_NONE), TRUE
    end if
    ps_stmtreg = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed stmtreg"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'tokeng.bm - Tokeniser Engine

deflng a-z

sub tok_init
    $if DEBUG_TIMINGS then
    debug_timing_mark# = timer(0.001)
    $end if
    'Read in the state machine for the lexer
    restore tokeng_data
    for s = 1 to ubound(t_states~%, 2)
        read t_statenames$(s)
        for b = 1 to 127
            read cmd
            t_states~%(b, s) = cmd
        next b
    next s


    'Populate token and type signature data
    'TODO check if this impacts startup times
dim sym as symtab_entry_t
sym.typ = SYM_GENERIC
sym.identifier = "|UNKNOWN"
symtab_add_entry sym
sym.identifier = "|IEOF"
symtab_add_entry sym
sym.identifier = "|EOI"
symtab_add_entry sym
sym.identifier = "|NEWLINE"
symtab_add_entry sym
tok_direct(TS_NEWLINE) = 4 
sym.identifier = "|COMMA"
symtab_add_entry sym
tok_direct(TS_COMMA) = 5 
sym.identifier = "|SEMICOLON"
symtab_add_entry sym
tok_direct(TS_SEMICOLON) = 6 
sym.identifier = "."
symtab_add_entry sym
tok_direct(TS_DOT) = 7 
sym.identifier = "REM"
symtab_add_entry sym
sym.identifier = "|LINENUM"
symtab_add_entry sym
sym.typ = SYM_META
sym.identifier = "$LIST"
symtab_add_entry sym
sym.identifier = "$DEBUG"
symtab_add_entry sym
sym.identifier = "$INCLUDE"
symtab_add_entry sym
sym.identifier = "|$UNKNOWN"
symtab_add_entry sym
tok_direct(TS_METAPARAM) =-1 
sym.typ = SYM_GENERIC
sym.identifier = "|INTEGER_SFX"
symtab_add_entry sym
tok_direct(TS_INTEGER_SFX) = 14 
sym.identifier = "|LONG_SFX"
symtab_add_entry sym
tok_direct(TS_LONG_SFX) = 15 
sym.identifier = "|INTEGER64_SFX"
symtab_add_entry sym
tok_direct(TS_INTEGER64_SFX) = 16 
sym.identifier = "|SINGLE_SFX"
symtab_add_entry sym
tok_direct(TS_SINGLE_SFX) = 17 
sym.identifier = "|DOUBLE_SFX"
symtab_add_entry sym
tok_direct(TS_DOUBLE_SFX) = 18 
sym.identifier = "|QUAD_SFX"
symtab_add_entry sym
tok_direct(TS_QUAD_SFX) = 19 
sym.identifier = "|STRING_SFX"
symtab_add_entry sym
tok_direct(TS_STRING_SFX) = 20 
sym.typ = SYM_TYPE
sym.v1 = 1
sym.v2 = SYM_TYPE_INTERNAL
sym.identifier = "|NONE"
symtab_add_entry sym
sym.identifier = "|LIST"
symtab_add_entry sym
sym.identifier = "|FLAGS"
symtab_add_entry sym
sym.identifier = "|ANY"
symtab_add_entry sym
sym.v1 = type_fixed_size(TYPE_ANY) * 0
sym.v2 = SYM_TYPE_ARRAY
sym.v3 = TYPE_ANY
sym.v4 = 0
sym.identifier = "|ANY_ARRAY"
symtab_add_entry sym
sym.typ = SYM_TYPE
sym.v1 = 1
sym.v2 = SYM_TYPE_INTERNAL
sym.identifier = "INTEGER"
symtab_add_entry sym
sym.identifier = "LONG"
symtab_add_entry sym
sym.identifier = "INTEGER64"
symtab_add_entry sym
sym.identifier = "SINGLE"
symtab_add_entry sym
sym.identifier = "DOUBLE"
symtab_add_entry sym
sym.identifier = "QUAD"
symtab_add_entry sym
sym.identifier = "STRING"
symtab_add_entry sym
sym.identifier = "CONTEXTUAL_ARGUMENT"
symtab_add_entry sym
sym.typ = SYM_GENERIC
sym.identifier = "|OPAREN"
symtab_add_entry sym
tok_direct(TS_OPAREN) = 34 
sym.identifier = "|CPAREN"
symtab_add_entry sym
tok_direct(TS_CPAREN) = 35 
tok_direct(TS_NUMINT) =-2 
tok_direct(TS_NUMDEC) =-3 
tok_direct(TS_NUMEXP) =-4 
tok_direct(TS_NUMBASE) =-5 
tok_direct(TS_STRINGLIT) =-6 
sym.typ = SYM_INFIX
sym.v2 = 2
sym.v3 = 0
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "IMP"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v2 = 3
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "EQV"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v2 = 4
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "XOR"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v2 = 5
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "OR"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v2 = 6
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "AND"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.typ = SYM_PREFIX
sym.v2 = 7
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "NOT"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.typ = SYM_INFIX
sym.v2 = 8
sym.v3 = 0
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "="
symtab_add_entry sym
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_EQUALS) = 42 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "<>"
symtab_add_entry sym
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_CMP_NEQ) = 43 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "<"
symtab_add_entry sym
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_CMP_LT) = 44 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = ">"
symtab_add_entry sym
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_CMP_GT) = 45 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "<="
symtab_add_entry sym
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_CMP_LTEQ) = 46 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = ">="
symtab_add_entry sym
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_CMP_GTEQ) = 47 
sym.v2 = 9
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "+"
symtab_add_entry sym
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_PLUS) = 48 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "-"
symtab_add_entry sym
tok_direct(TS_DASH) = 49 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_DASH) = 49 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_DASH) = 49 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_DASH) = 49 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_DASH) = 49 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_DASH) = 49 
sym.v2 = 10
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "MOD"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v2 = 11
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "\"
symtab_add_entry sym
tok_direct(TS_BACKSLASH) = 51 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_BACKSLASH) = 51 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_BACKSLASH) = 51 
sym.v2 = 12
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "*"
symtab_add_entry sym
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_STAR) = 52 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "/"
symtab_add_entry sym
tok_direct(TS_SLASH) = 53 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_SLASH) = 53 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_SLASH) = 53 
sym.typ = SYM_PREFIX
sym.v2 = 13
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "|NEGATIVE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.typ = SYM_INFIX
sym.v2 = 14
sym.v3 = 0
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "^"
symtab_add_entry sym
tok_direct(TS_POWER) = 55 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
tok_direct(TS_POWER) = 55 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
tok_direct(TS_POWER) = 55 
sym.typ = SYM_GENERIC
sym.identifier = "AS"
symtab_add_entry sym
sym.identifier = "CONST"
symtab_add_entry sym
sym.identifier = "GOTO"
symtab_add_entry sym
sym.identifier = "EXIT"
symtab_add_entry sym
sym.identifier = "IF"
symtab_add_entry sym
sym.identifier = "THEN"
symtab_add_entry sym
sym.identifier = "ELSE"
symtab_add_entry sym
sym.identifier = "ELSEIF"
symtab_add_entry sym
sym.identifier = "DO"
symtab_add_entry sym
sym.identifier = "LOOP"
symtab_add_entry sym
sym.identifier = "UNTIL"
symtab_add_entry sym
sym.identifier = "WHILE"
symtab_add_entry sym
sym.identifier = "WEND"
symtab_add_entry sym
sym.identifier = "FOR"
symtab_add_entry sym
sym.identifier = "TO"
symtab_add_entry sym
sym.identifier = "STEP"
symtab_add_entry sym
sym.identifier = "NEXT"
symtab_add_entry sym
sym.identifier = "SELECT"
symtab_add_entry sym
sym.identifier = "CASE"
symtab_add_entry sym
sym.identifier = "IS"
symtab_add_entry sym
sym.identifier = "TYPE"
symtab_add_entry sym
sym.identifier = "SUB"
symtab_add_entry sym
sym.identifier = "FUNCTION"
symtab_add_entry sym
sym.identifier = "DECLARE"
symtab_add_entry sym
sym.identifier = "REDIM"
symtab_add_entry sym
sym.identifier = "SHARED"
symtab_add_entry sym
sym.identifier = "_PRESERVE"
symtab_add_entry sym
sym.identifier = "STATIC"
symtab_add_entry sym
sym.identifier = "_EXPLICIT"
symtab_add_entry sym
sym.identifier = "_EXPLICITARRAY"
symtab_add_entry sym
sym.identifier = "BYREF"
symtab_add_entry sym
sym.identifier = "BYVAL"
symtab_add_entry sym
sym.identifier = "CALL"
symtab_add_entry sym
sym.typ = SYM_FUNCTION
sym.v2 = SYM_FUNCTION_INTRINSIC
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "ABS"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
sym.identifier = "ASC"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "ATN"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
sym.identifier = "BEEP"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_BLUE32"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.identifier = "CDBL"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CHDIR"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "CHR"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "CINT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
sym.identifier = "CIRCLE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "CLNG"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 9 
sym.identifier = "CLOSE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "CLS"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "COLOR"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "COMMAND"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
sym.identifier = "_COMMANDCOUNT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "COS"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "CSNG"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
sym.identifier = "CSRLIN"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVD"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVDMBF"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVI"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVL"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVS"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "CVSMBF"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
sym.identifier = "DATE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_DEFLATE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "_DELAY"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_DEST"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_ANY_ARRAY, 0 
sym.identifier = "DIM"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
sym.identifier = "_DISPLAY"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "DRAW"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "END"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "ENVIRON"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "EOF"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_ANY_ARRAY, 2 
sym.identifier = "ERASE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "EXP"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 1 
sym.identifier = "FILES"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "FIX"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_FONTHEIGHT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_FONTWIDTH"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
sym.identifier = "FREEFILE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_STRING, 3 
sym.identifier = "GET"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_LONG, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_SINGLE, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_QUAD, 3 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TOK_DASH, 48 
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_ANY_ARRAY, 2 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_GREEN32"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_HEIGHT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.identifier = "HEX"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_INFLATE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
sym.identifier = "INKEY"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LIST, 0 
sym.identifier = "INPUT"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 9 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "INSTR"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "INT"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
sym.identifier = "_KEYCLEAR"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_KEYDOWN"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
sym.identifier = "_KEYHIT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "KILL"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_ANY_ARRAY, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "LBOUND"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "LCASE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.identifier = "LEFT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "LEN"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER, 2 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_LONG, 2 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 2 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_SINGLE, 2 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 2 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_QUAD, 2 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_LIMIT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_DASH, 48 
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1,ast_add_constant(TOK_CONTEXTUAL_ARGUMENT,"B|BF",0), 65 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "LINE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TOK_DASH, 48 
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1,ast_add_constant(TOK_CONTEXTUAL_ARGUMENT,"B|BF",0), 65 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.typ = SYM_GENERIC
sym.identifier = "LINEINPUT"
symtab_add_entry sym
sym.typ = SYM_FUNCTION
sym.v2 = SYM_FUNCTION_INTRINSIC
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_LOADIMAGE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "LOCATE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
sym.identifier = "LOF"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "LOG"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "LTRIM"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
sym.identifier = "MID"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_NEWIMAGE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TOK_FOR, 48 
type_sig_add_arg sym.v1,ast_add_constant(TOK_CONTEXTUAL_ARGUMENT,"RANDOM|INPUT|OUTPUT|BINARY|APPEND",0), 64 
type_sig_add_arg sym.v1, TOK_AS, 48 
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TOK_LEN, 49 
type_sig_add_arg sym.v1, TOK_EQUALS, 49 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "OPEN"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_ANY, 2 
sym.identifier = "OPTION"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
sym.identifier = "_PI"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "PLAY"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LIST, 0 
sym.identifier = "PRINT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_PRINTSTRING"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_PRINTWIDTH"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_STEP, 17 
type_sig_add_arg sym.v1, TOK_OPAREN, 48 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TOK_CPAREN, 48 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "PSET"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_STRING, 1 
sym.identifier = "PUT"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 1 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 8 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 1 
type_sig_add_arg sym.v1, TYPE_QUAD, 1 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_FLAGS, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "_PUTIMAGE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 1 
sym.identifier = "RANDOMIZE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TOK_USING, 16 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_RED32"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "_RGB32"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.identifier = "RIGHT"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "RMDIR"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
sym.identifier = "RND"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "RTRIM"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "SCREEN"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "SGN"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "SIN"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "SLEEP"
symtab_add_entry sym
sym.typ = SYM_GENERIC
sym.identifier = "_SMOOTH"
symtab_add_entry sym
sym.typ = SYM_FUNCTION
sym.v2 = SYM_FUNCTION_INTRINSIC
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.identifier = "SOUND"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "_SOURCE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_LONG))
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.identifier = "SPACE"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "SQR"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER, 0 
sym.identifier = "STR"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_LONG, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_INTEGER64, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_STRCMP"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_STRICMP"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_ANY, 2 
type_sig_add_arg sym.v1, TYPE_ANY, 2 
sym.identifier = "SWAP"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "SYSTEM"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_SINGLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 0 
sym.identifier = "TAN"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_DOUBLE, 0 
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_QUAD, 0 
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
sym.identifier = "TIME"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_DOUBLE))
type_sig_add_arg sym.v1, TYPE_SINGLE, 1 
sym.identifier = "TIMER"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_NONE))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_TITLE"
symtab_add_entry sym
sym.v1 = type_add_sig(sym.v1, type_sigt_create$(TYPE_STRING))
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "_TRIM"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_INTEGER64))
type_sig_add_arg sym.v1, TYPE_ANY_ARRAY, 0 
type_sig_add_arg sym.v1, TYPE_INTEGER, 1 
sym.identifier = "UBOUND"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_STRING))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "UCASE"
symtab_add_entry sym
sym.typ = SYM_GENERIC
sym.identifier = "USING"
symtab_add_entry sym
sym.typ = SYM_FUNCTION
sym.v2 = SYM_FUNCTION_INTRINSIC
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_QUAD))
type_sig_add_arg sym.v1, TYPE_STRING, 0 
sym.identifier = "VAL"
symtab_add_entry sym
sym.v1 = type_add_sig(0, type_sigt_create$(TYPE_LONG))
type_sig_add_arg sym.v1, TYPE_LONG, 1 
sym.identifier = "_WIDTH"
symtab_add_entry sym
ast_commit

    tokeng_data:
DATA "Begin",0,0,0,0,0,0,0,0,257,259,257,257,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,257,0,0,0,1280,0,0,1024,0,0,0,0,0,0,0,0,768,768,768,768,768,768,768,768,768,768,0,0,0,0,0,1538,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,0,0,0,512,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,0,0,0,0
DATA "Id",0,0,0,0,0,0,0,0,1666,386,1666,1666,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1666,1666,1666,1666,1666,1666,1666,1024,1666,1666,1666,1666,1666,1666,1666,1666,512,512,512,512,512,512,512,512,512,512,1666,1666,1666,1666,1666,1666,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,1666,0,1666,512,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,0,0,1666,0
DATA "Linenum",0,0,0,0,0,0,0,0,1668,388,1668,1668,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1668,0,0,0,0,0,0,1156,0,0,0,0,0,0,0,0,768,768,768,768,768,768,768,768,768,768,1540,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
DATA "Comment",1024,1024,1024,1024,1024,1024,1024,1024,1024,259,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024,1024
DATA "Metacmd",0,0,0,0,0,0,0,0,1925,389,1925,1925,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1925,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1925,0,0,0,0,0,0,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,0,0,0,0,1280,0,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,1280,0,0,0,0,0
DATA "General",0,0,0,0,0,0,0,0,1537,259,1537,1537,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1537,1544,2304,2816,1545,3072,3328,259,1548,1549,1547,1551,1556,1550,4096,1557,2560,2560,2560,2560,2560,2560,2560,2560,2560,2560,1554,1555,3584,1552,3840,1538,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,1553,0,1546,512,0,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,512,0,0,0,0,0
DATA "Metagap",2048,2048,2048,2048,2048,2048,2048,2048,2049,2048,2049,2049,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2049,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2049,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048
DATA "Metaparam",2048,2048,2048,2048,2048,2048,2048,2048,2048,390,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048,2048
DATA "String",2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,1543,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304,2304
DATA "Number",1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,4352,1686,2560,2560,2560,2560,2560,2560,2560,2560,2560,2560,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,4608,4608,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,4608,4608,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686,1686
DATA "HashPfx",1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1564,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691,1691
DATA "PercentPfx",1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1562,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689,1689
DATA "AmpersandPfx",1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1566,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,1693,5120,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693,1693
DATA "LtPfx",1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1569,1570,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696,1696
DATA "GtPfx",1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1572,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699,1699
DATA "Dot",0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4352,4352,4352,4352,4352,4352,4352,4352,4352,4352,0,0,0,0,0,0,0,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,0,0,0,0,1701,0,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,1701,0,0,0,0,0
DATA "NumDec",1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,4352,4352,4352,4352,4352,4352,4352,4352,4352,4352,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,4608,4608,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,4608,4608,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687,1687
DATA "NumExpSgn",1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,4864,1688,4864,1688,1688,4864,4864,4864,4864,4864,4864,4864,4864,4864,4864,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688
DATA "NumExp",1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,4864,4864,4864,4864,4864,4864,4864,4864,4864,4864,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688,1688
DATA "NumBase",1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,5120,5120,5120,5120,5120,5120,5120,5120,5120,5120,1695,1695,1695,1695,1695,1695,1695,5120,5120,5120,5120,5120,5120,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,5120,5120,5120,5120,5120,5120,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695,1695

    tok_reinit
    $if DEBUG_TIMINGS then
    debuginfo "Parser init time:" + str$(timer(0.001) - debug_timing_mark#)
    $end if
end sub

sub tok_reinit
    tokeng_state.index = 1
    tokeng_state.curstate = 1
    tokeng_state.has_data = FALSE
    tokeng_state.linestart = TRUE
    tokeng_state.recovery_mode = FALSE
    'Fill the 'next' buffer and propagate to tok_token
    tok_read_next_token
    tok_advance
end sub

sub tok_advance
    'We defer symbol table lookups to now (instead of in tok_read_next_token) so
    'we can correctly find any recently declared symbols.
    'Also avoid ever doing lookups in recovery mode, because results are likely
    'garbage.
    if tok_next_token = 0 and not tokeng_state.recovery_mode then
        'First check local scope
        id = symtab_get_id(ucase$(ps_scope$ + tok_next_content$))
        'Then check global scope
        if id = 0 then id = symtab_get_id(ucase$(tok_next_content$))
        'Did we find anything?
        if id = 0 then
            tok_token = TOK_UNKNOWN
        else
            tok_token = id
        end if
    else
        tok_token = tok_next_token
    end if
    tok_content$ = tok_next_content$
    if not options.interactive_mode then
        tok_read_next_token
    else
        if tok_token = TOK_NEWLINE and tok_content$ <> ":" then
            'All lines end with TOK_EOI
            tok_next_token = TOK_EOI
        elseif tok_token = TOK_EOI then
            'No line starts with TOK_NEWLINE
            do
                tok_read_next_token
            loop while tok_next_token = TOK_NEWLINE and tok_content$ <> ":"
        else
            tok_read_next_token
        end if
    end if
    $if DEBUG_TOKEN_STREAM then
    debuginfo ">>> " + tok_content$
    $end if
end sub

'Advance token stream until reaching end_marker, but do no processing of
'incoming data. Used to recover from errors. Results in tok_token = end_marker.
sub tok_recover(end_marker)
    tokeng_state.recovery_mode = TRUE
    do until tok_token = end_marker
        tok_advance
    loop
    tokeng_state.recovery_mode = FALSE
end sub

sub tok_read_next_token
    if not tokeng_state.has_data then
        if general_eof then
            tok_next_token = TOK_IEOF
            exit function
        end if
        tokeng_state.index = 1
        tokeng_state.raw_line_in = general_next_line$
        tokeng_state.has_data = TRUE
    end if

    tok_next_content$ = tok_next_ts$(tokeng_state.raw_line_in + chr$(10), ts_type)

    select case ts_type
        case 0 'Out of data (an error)
            ps_error "Unexpected end of line"

        case TS_ID
            'Special cases!
            if tok_next_content$ = "?" then
                tok_next_content$ = "PRINT"
            elseif ucase$(tok_next_content$) = "REM" then
                goto rem_hack
            end if
            tokeng_state.linestart = FALSE
            'tok_next_token is not properly set here; see comments in tok_advance
            tok_next_token = 0
        
        case TS_METACMD
            tok_next_token = symtab_get_id(ucase$(tok_next_content$))
            if tok_next_token = 0 then tok_next_token = META_UNKNOWN

        case TS_LINENUM
            if not tokeng_state.linestart then ps_error "Line number must be at start of line"
            tok_next_token = TOK_LINENUM
            tokeng_state.linestart = FALSE

        case TS_COLON
            tok_next_token = TOK_NEWLINE
            tokeng_state.linestart = FALSE

        case TS_NEWLINE
            rem_hack:
            tokeng_state.has_data = FALSE
            tokeng_state.linestart = TRUE
            tok_next_token = TOK_NEWLINE
        
        case else
            if tok_direct(ts_type) then
                tok_next_token = tok_direct(ts_type)
            else
                ps_error "Unhandled TS" + str$(ts_type)
            end if
            tokeng_state.linestart = FALSE
    end select
end function

function tok_next_ts$(text$, ts_type)
    if tokeng_state.index > len(text$) then
        'Out of data
        ts_type = 0
        exit function
    end if
    for i = tokeng_state.index to len(text$)
        c = asc(text$, i)
        'No utf-8 support for now
        if c > 127 then ps_error "Character outside character set (" + ltrim$(str$(c)) + ")"
        command = t_states~%(c, tokeng_state.curstate)
        'Rules of the form "A: B ~ Error" encode to 0
        if command = 0 then
            'As an affordance to interactive mode, skip over the bad character so we don't get caught in an
            'infinite loop when we restart after error
            tokeng_state.index = i + 1
            ps_error chr$(34) + chr$(c) + chr$(34) + " from " + t_statenames$(tokeng_state.curstate) + " illegal"
        end if
        'High byte is next state, low byte is token, high bit of low byte is pushback flag
        ts_type_internal = command and 127
        pushback = command and 128
        'print t_statenames$(tokeng_state.curstate); ":"; c; "~ ";
        tokeng_state.curstate = command \ 2^8
        'print t_statenames$(tokeng_state.curstate)
        if ts_type_internal > 0 then
            ts_type = ts_type_internal
            if pushback then
                'This doesn't include the current character, and uses it next time...
                if ts_type <> 1 then tok_next_ts$ = mid$(text$, tokeng_state.index, i - tokeng_state.index)
                tokeng_state.index = i
            else
                '...but this does include it, and starts from the next character next time.
                if ts_type <> 1 then tok_next_ts$ = mid$(text$, tokeng_state.index, i - tokeng_state.index + 1)
                tokeng_state.index = i + 1
            end if
            if ts_type <> TS_SKIP then exit function
        end if
    next i
    ts_type = 0
end function 

function tok_human_readable$(token)
    if token > 0 then
        tok_human_readable$ = symtab(token).identifier
    else
        tok_human_readable$ = "LITERAL_" + mid$(str$(token), 2)
    end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'udt.bm - Parser for user-defined types

'Expects: TOK_TYPE
'Results: token after END TYPE
sub ps_udt_ignore
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start ignored UDT"
    $end if
    ps_consume TOK_TYPE
    tok_advance 'type name
    if ps_consumed(TOK_NEWLINE) then ps_line_prelude
    do
        dummy = ps_opt_sigil
        do
            tok_advance 'field name
            dummy = ps_opt_sigil
        loop while ps_consumed(TOK_COMMA)
        if ps_consumed(TOK_NEWLINE) then ps_line_prelude
    loop until ps_consumed(TOK_END)
    ps_consume TOK_TYPE
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed ignored UDT"
    $end if
end sub

'Expects: TOK_TYPE
'Results: token after END TYPE
function ps_udt
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start UDT definition"
    $end if
    dim udt_sym as symtab_entry_t
    udt_sym.typ = SYM_TYPE
    udt_sym.v1 = 0
    udt_sym.v2 = SYM_TYPE_UDT

    ps_consume TOK_TYPE
    if tok_token <> TOK_UNKNOWN then ps_error "UDT name already in use"
    udt_sym.identifier = ucase$(tok_content$)
    tok_advance
    if ps_consumed(TOK_NEWLINE) then ps_line_prelude
    do
        'Handle As Long X style definitions
        typ = ps_opt_sigil
        do
            elem = ps_udt_element(udt_sym, typ)
            udt_sym.v1 = udt_sym.v1 + type_fixed_size(symtab(elem).v1)
        loop while ps_consumed(TOK_COMMA)
        'If we ever need to keep a list of all the elements in a UDT,
        'this is where we'd build it.
        if ps_consumed(TOK_NEWLINE) then ps_line_prelude
    loop until ps_consumed(TOK_END)
    ps_consume TOK_TYPE

    symtab_add_entry udt_sym
    ps_udt = 0 'Never generate any ast nodes
    $if DEBUG_PARSE_TRACE then
    debuginfo "End UDT definition"
    $end if
end function

'Expects: Element identifier
'Results: token after variable (comma or newline)
function ps_udt_element(udt_sym as symtab_entry_t, pre_typ)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start UDT element"
    $end if
    dim elem_sym as symtab_entry_t
    elem_sym.typ = SYM_UDT_ELEMENT
    
    'Because UDT element names appear in such a restricted environment,
    'they can live in their own namespace without conflicting with
    'existing symbols. We just require that the name be an alphanumeric
    'identifier.
    elem_name$ = ucase$(tok_content$)
    select case left$(elem_name$, 1)
    case "A" to "Z", "_"
    case else
        print tok_content$
        ps_error "Invalid UDT element name"
    end select
    for i = 2 to len(elem_name$)
        select case mid$(elem_name$, i, 1)
        case "A" to "Z", "0" to "9", "_"
        case else
            ps_error "Invalid UDT element name"
        end select
    next i
    elem_sym.identifier = udt_sym.identifier + "." + elem_name$
    tok_advance

    'Set type from sigil, AS clause or default type
    sigil = ps_opt_sigil
    if pre_typ > 0 and sigil > 0 and pre_typ <> sigil then
        ps_error "Declared type does not match"
    end if
    if sigil = 0 then sigil = pre_typ
    if sigil = 0 then elem_sym.v1 = ps_default_type else elem_sym.v1 = sigil

    'Get offset of element in UDT
    elem_sym.v2 = udt_sym.v1
    symtab_add_entry elem_sym
    
    ps_udt_element = symtab_last_entry
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed UDT element"
    $end if
end function

'Expects: Element
'Results: token after element
'Takes udt variable as argument
function ps_udt_element_access(lvalue)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start udt element access"
    $end if
    head_typ_name$ = symtab(type_of_lvalue(lvalue)).identifier
    elem = symtab_get_id(head_typ_name$ + "." + ucase$(tok_content$))
    if elem = 0 or symtab(elem).typ <> SYM_UDT_ELEMENT then ps_error "Bad UDT element access"
    tok_advance
    node = ast_add_node(AST_UDT_ACCESS)
    ast_attach node, lvalue
    ast_nodes(node).ref = elem
    ps_udt_element_access = node
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed udt element access"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'userfuncs.bm - Parse rules for SUB and FUNCTION definitions

'Expects: TOK_DECLARE
'Results: NEWLINE
function ps_declare
    ps_consume TOK_DECLARE
    ps_declare = ps_declare_p
end function

function ps_declare_p
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start declare_p"
    $end if
    if ps_consumed(TOK_SUB) then is_sub = TRUE else ps_consume(TOK_FUNCTION)
    if tok_token <> TOK_UNKNOWN then
        ps_error "Name already in use"
    end if
    dim sym as symtab_entry_t
    sym.identifier = ucase$(tok_content$)
    sym.typ = SYM_FUNCTION
    tok_advance
    if is_sub then return_type = TYPE_NONE else return_type = ps_opt_sigil
    if return_type = 0 then return_type = ps_default_type
    sym.v1 = type_add_sig(0, type_sigt_create$(return_type)) 
    if ps_consumed(TOK_OPAREN) then
        sig$ = ps_formal_args$(0)
        type_sig_merge sym.v1, sig$
        ps_consume TOK_CPAREN
    end if
    sym.v2 = SYM_FUNCTION_USER
    sym.v3 = 0 'We have no implementation for this function yet
    symtab_add_entry sym
    proc_id = symtab_last_entry
    ps_declare_p = 0
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed declare_p"
    $end if
end function

'Expects: TOK_FUNCTION or TOK_SUB
'Results: NEWLINE
'Return -2, which is handled particularly by ps_block, ps_stmt and interactive_mode
function ps_userfunc
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start userfunc"
    $end if
    if ps_final_nested then
        ps_error "SUB and FUNCTION must appear at top level"
    end if
    if ps_consumed(TOK_SUB) then is_sub = TRUE else ps_consume(TOK_FUNCTION)
    
    if tok_token <> TOK_UNKNOWN then
        if symtab(tok_token).typ <> SYM_FUNCTION then ps_error "Existing name is not a function"
        'if not preload mode and (intrinsic function or implemented user function)
        if not ps_is_preload and (symtab(tok_token).v2 <> SYM_FUNCTION_USER or symtab(tok_token).v3 <> 0) then ps_error "Function already exists"
        override_sym = tok_token
    end if

    dim sym as symtab_entry_t
    sym.identifier = ucase$(tok_content$)
    sym.typ = SYM_FUNCTION
    tok_advance

    root = ast_add_node(AST_PROCEDURE)
    ps_add_nested_structure root
    ps_scope_identifier$ = sym.identifier
    'Save this value so we can restore it later (and so STATIC can access it)
    ps_main_next_var_index = ps_next_var_index
    ps_next_var_index = 1

    if is_sub then return_type = TYPE_NONE else return_type = ps_opt_sigil
    if return_type = 0 then return_type = ps_default_type

    new_sig = type_add_sig(0, type_sigt_create$(return_type)) 
    if ps_consumed(TOK_OPAREN) then
        sig$ = ps_formal_args$(root)
        type_sig_merge new_sig, sig$
        ps_consume TOK_CPAREN
    end if

    if override_sym then
        'Overriding existing function, or implementing a declaration
        'TODO: Be more smart about the type signature for intrinsics
        if symtab(override_sym).v2 = SYM_FUNCTION_USER and _
            type_signatures(symtab(override_sym).v1).sig <> type_signatures(new_sig).sig then
            print type_human_sig$(type_signatures(symtab(override_sym).v1).sig)
            print type_human_sig$(type_signatures(new_sig).sig)
            ps_error "Type signature does not match existing"
        end if
        symtab(override_sym).v2 = SYM_FUNCTION_USER
        symtab(override_sym).v3 = root
        proc_id = override_sym
    else
        sym.v1 = new_sig
        sym.v2 = SYM_FUNCTION_USER
        sym.v3 = root
        symtab_add_entry sym
        proc_id = symtab_last_entry
    end if
    ast_nodes(root).ref = proc_id

    'TODO: STATIC and other modifiers

    ps_consume TOK_NEWLINE
    block = ps_block
    for i = 1 to len(ps_queued_nodes$) - 3 step 4
        other = cvl(mid$(ps_queued_nodes$, i, 4))
        ast_attach block, other
    next i
    ps_queued_nodes$ = ""

    ast_pre_attach root, block
    ps_consume TOK_END
    if is_sub then ps_consume TOK_SUB else ps_consume TOK_FUNCTION
    symtab(proc_id).v4 = ps_next_var_index - 1
    ps_next_var_index = ps_main_next_var_index

    ps_scope_identifier$ = ""
    ps_remove_nested_structure

    ps_userfunc = -2
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed userfunc"
    $end if
end function

'Expects: token after OPAREN
'Result: CPAREN
'Return list of formal args. If root is <> 0, attach AST_VAR nodes.
function ps_formal_args$(root)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start formal args"
    $end if
    result$ = type_sigt_create$(0)
    do
        flags = 0
        do
            select case tok_token
            case TOK_BYREF
                if flags and TYPE_BYREF then ps_error "Duplicate modifier"
                flags = flags OR TYPE_BYREF
                tok_advance
            case TOK_BYVAL
                if flags and TYPE_BYVAL then ps_error "Duplicate modifier"
                flags = flags OR TYPE_BYVAL
                tok_advance
            case TOK_OPTION
                if flags and TYPE_OPTIONAL then ps_error "Duplicate modifier"
                flags = flags OR TYPE_OPTIONAL
                tok_advance
            case else
                exit do
            end select
        loop
        if tok_token <> TOK_UNKNOWN then ps_error "Expected new variable name"
        'Our calling convention can't handle optional byval arguments
        if ((flags AND TYPE_BYVAL) <> 0) and ((flags AND TYPE_OPTIONAL) <> 0) then
            ps_error "Optional arguments cannot be BYVAL"
        end if
        if root then
            'Force allow implicit variable declarations because that is how we
            'parse parameters.
            old_implicit_allow = ps_allow_implicit_vars
            ps_allow_implicit_vars = TRUE
            var = ps_simple_variable
            ps_allow_implicit_vars = old_implicit_allow
            if (flags AND TYPE_BYVAL) = 0 then
                'Default to making the argument pass-by-reference
                symtab(ast_nodes(var).ref).v3 = symtab(ast_nodes(var).ref).v3 OR SYM_VARIABLE_DEREF
            end if
            ast_attach root, var
            typ = type_of_var(var)
        else
            'Stripped down variable parser used just for declarations
            tok_advance 'Skip name
            typ = ps_opt_sigil
            if typ = 0 then typ = ps_default_type
        end if
        result$ = type_sigt_add_arg(result$, typ, flags)
    loop while ps_consumed(TOK_COMMA)
    ps_formal_args$ = result$
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed formal args"
    $end if
end function

'Expects: function name token
'Result: NEWLINE if valid return assignment, unchanged otherwise
'Returns node if this is a function return value assignment, 0 otherwise
function ps_func_return
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start func return"
    $end if
    'Are we in a procedure with a matching name?
    u$ = ucase$(tok_content$)
    if u$ <> ps_scope_identifier$ then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Completed func return"
        $end if
        exit function
    end if
    proc_id = symtab_get_id(u$)
    'Is this actually a function, not a sub?
    return_type = type_sig_return(symtab(proc_id).v1)
    if return_type = 0 then
        $if DEBUG_PARSE_TRACE then
        debuginfo "Completed func return"
        $end if
        exit function
    end if
    tok_advance
    'Ensure any type sigils match
    sigil = ps_opt_sigil
    if sigil <> 0 and return_type <> sigil then ps_error "Function return type not consistent"
    'Ok, definitely setting the return value
    ps_consume TOK_EQUALS
    root = ast_add_node(AST_SET_RETURN)
    expr = ps_expr
    expr_type = type_of_expr(expr)
    if not type_can_cast(expr_type, return_type) then ps_error "Function return type does not match that of expression"
    expr = ast_add_cast(expr, return_type)
    ast_attach root, expr
    ps_func_return = root
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed func return"
    $end if
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'var.bm - Parse rules for DIM and variables

'Expects: TOK_DIM, TOK_REDIM or TOK_STATIC
'Results: token after last declaration
'Format: DIM [STATIC] [_PRESERVE] [SHARED] variablelist
function ps_dim
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start dim"
    $end if
    if tok_token = TOK_DIM or tok_token = TOK_REDIM then tok_advance
    if ps_consumed(TOK_STATIC) then is_static = TRUE
    if ps_consumed(TOK__PRESERVE) then preserve = TRUE
    if ps_consumed(TOK_SHARED) then is_shared = TRUE
    if is_static then
        if is_shared or preserve then ps_error "Cannot be SHARED or _PRESERVE when STATIC"
        if ps_last_nested(AST_PROCEDURE) = 0 then ps_error "Not in function"
        'Switch back to the main program's var counter so that statics are allocated
        'in the main program's stack frame.
        inner_next_var_index = ps_next_var_index
        ps_next_var_index = ps_main_next_var_index
    end if

    'Check for Dim As Long style syntax
    typ = ps_opt_sigil
    do
        name_token = tok_token
        'This is a little messy because we have to look-ahead some to see if
        'it's a scalar or array.
        variable_name$ = tok_content$
        tok_advance
        sigil = ps_opt_sigil
        if typ > 0 and sigil > 0 and typ <> sigil then ps_error "Variable type does not match DIM type"
        if typ then sigil = typ
        if ps_consumed(TOK_OPAREN) then
            'Array declaration.
            'The block holds all resizes declared in this DIM statement
            if block = 0 then block = ast_add_node(AST_BLOCK)
            ps_dim_array name_token, variable_name$, sigil, block, is_shared, preserve, is_static
        else
            'Just a regular variable
            if name_token <> TOK_UNKNOWN then ps_error "Expected new variable name"
            sym = ps_new_var_pp(variable_name$, sigil, is_shared)
            if is_static then symtab(sym).v3 = symtab(sym).v3 OR SYM_VARIABLE_MAINFRAME
        end if
    loop while ps_consumed(TOK_COMMA)
    ps_dim = block

    if is_static then
        ps_main_next_var_index = ps_next_var_index
        ps_next_var_index = inner_next_var_index
    end if
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed dim"
    $end if
end function

function ps_lvalue
    token = tok_token
    content$ = tok_content$
    tok_advance
    ps_lvalue = ps_lvalue_p(token, content$)
end function

function ps_lvalue_mutable
    node = ps_lvalue
    if symtab(ast_nodes(node).ref).v3 AND SYM_VARIABLE_CONST then
        ps_error "Cannot reassign CONST"
    end if
    ps_lvalue_mutable = node
end function

function ps_lvalue_p(head, content$)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start lvalue"
    $end if
    node = ps_simple_variable_p(head, content$)
    do while tok_token = TOK_DOT or tok_token = TOK_OPAREN
        if ps_consumed(TOK_DOT) then
            'UDT element access
            node = ps_udt_element_access(node)
        elseif ps_consumed(TOK_OPAREN) and not ps_consumed(TOK_CPAREN) then
            'array access. Something like `a()` is a reference to the entire array,
            'so no access operation needed.
            node = ps_array_element_access(node)
        end if
    loop
    ps_lvalue_p = node
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed lvalue"
    $end if
end function

function ps_simple_variable
    token = tok_token
    content$ = tok_content$
    tok_advance
    ps_simple_variable = ps_simple_variable_p(token, content$)
end function

'Expects: token after variable, variable token as arg
'Results: token after optional sigil
'Note: process simple variables, i.e. no udt or array stuff. Returns AST_VAR.
function ps_simple_variable_p(head, content$)
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start simple variable"
    $end if
    node = ast_add_node(AST_VAR)
    if head = TOK_UNKNOWN then
        'Add new variable (implicit declaration)
        if not ps_allow_implicit_vars then ps_error "Implicit variable declaration"
        ast_nodes(node).ref = ps_new_var_p(content$)
    elseif symtab(head).typ <> SYM_VARIABLE then
        ps_error "Expected variable"
    else
        'Existing variable
        sigil = ps_opt_sigil
        current_type = symtab(head).v1
        if symtab(current_type).v2 = SYM_TYPE_ARRAY then current_type = symtab(current_type).v3
        if sigil and sigil <> current_type then ps_error "Type suffix does not match existing variable type"
        ast_nodes(node).ref = head
    end if

    ps_simple_variable_p = node
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed simple variable"
    $end if
end function

'Expects: sigil or otherwise
'Results: post token if sigil present, unchanged otherwise
function ps_opt_sigil
    $if DEBUG_PARSE_TRACE then
    debuginfo "Start optional sigil"
    $end if
    if ps_consumed(TOK_AS) then
        typ = tok_token
        if typ = 0 or symtab(typ).typ <> SYM_TYPE then ps_error "Expected type name"
    else
        select case tok_token
        case TOK_INTEGER_SFX
            typ = TYPE_INTEGER
        case TOK_LONG_SFX
            typ = TYPE_LONG
        case TOK_INTEGER64_SFX
            typ = TYPE_INTEGER64
        case TOK_SINGLE_SFX
            typ = TYPE_SINGLE
        case TOK_DOUBLE_SFX
            typ = TYPE_DOUBLE
        case TOK_QUAD_SFX
            typ = TYPE_QUAD
        case TOK_STRING_SFX
            typ = TYPE_STRING
        case else
            typ = 0
        end select
    end if
    if typ then tok_advance
    ps_opt_sigil = typ
    $if DEBUG_PARSE_TRACE then
    debuginfo "Completed optional sigil"
    $end if
end function

function ps_new_var_p(var_name$)
    sigil = ps_opt_sigil
    ps_new_var_p = ps_new_var_pp(var_name$, sigil, FALSE)
end function

function ps_new_var_pp(var_name$, sigil, is_shared)
    dim sym as symtab_entry_t
    if is_shared then
        sym.identifier = ucase$(var_name$)
    else
        sym.identifier = ps_scope$ + ucase$(var_name$)
    end if
    sym.typ = SYM_VARIABLE
    if sigil then sym.v1 = sigil else sym.v1 = ps_default_type
    sym.v2 = ps_next_var_index
    ps_next_var_index = ps_next_var_index + type_fixed_size(sym.v1)
    if is_shared then sym.v3 = SYM_VARIABLE_MAINFRAME else sym.v3 = 0
    symtab_add_entry sym
    ps_new_var_pp = symtab_last_entry
end function
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'dump.bm - Produce human readable representation of parsed program

sub dump_program
    print #logging_file_handle, "Table of identifiers:"
    symtab_dump
    print #logging_file_handle,
    'print #logging_file_handle, "Function type signatures:"
    'type_dump_functions
    'print #logging_file_handle,
    print #logging_file_handle, "Table of constants:"
    ast_dump_constants
    print #logging_file_handle,
    print #logging_file_handle, "Program:"
    ast_dump_pretty AST_ENTRYPOINT, 0
    dump_subprocedures
end sub

sub type_dump_functions
    for i = 1 to symtab_last_entry
        typ = symtab(i).typ
        if typ = SYM_FUNCTION or typ = SYM_INFIX or typ = SYM_PREFIX then
            sig_index = symtab(i).v1
            do
                print #logging_file_handle, sig_index; " "; symtab(i).identifier; " "; type_human_sig$(type_signatures(sig_index).sig)
                sig_index = type_signatures(sig_index).succ
            loop while sig_index <> 0
        end if
    next i
end sub

sub symtab_dump
    print #logging_file_handle, " ID          Name     Typ     v1     v2     v3     v4"
    for i = 1 to symtab_last_entry
        print #logging_file_handle, using "###    \            \ ###    ###    ###    ###    ###"; i; symtab(i).identifier; _
                        symtab(i).typ,symtab(i).v1; symtab(i).v2; symtab(i).v3; symtab(i).v4
    next i
end sub

sub dump_subprocedures
    for i = 1 to symtab_last_entry
        if symtab(i).typ = SYM_FUNCTION and symtab(i).v2 = SYM_FUNCTION_USER then
            return_type = type_sig_return(symtab(i).v1)
            if return_type = TYPE_NONE then is_sub = TRUE else is_sub = FALSE
            print #logging_file_handle,
            if is_sub then
                print #logging_file_handle, "SUB "; symtab(i).identifier; " (";
            else
                print #logging_file_handle, "FUNCTION "; symtab(i).identifier; " AS "; type_human_readable$(return_type); " (";
            end if
            root = symtab(i).v3
            for j = 2 to ast_num_children(root)
                ast_dump_pretty ast_get_child(root, j), 0
                if j < ast_num_children(root) then print #logging_file_handle, ", ";
            next j
            print #logging_file_handle, ")"
            ast_dump_pretty ast_get_child(root, 1), 1
            if is_sub then print #logging_file_handle, "END SUB" else print #logging_file_handle, "END FUNCTION"
        end if
    next i
end sub

sub ast_dump_pretty(root, indent_level)
    indent$ = space$(indent_level * 4)
    if ast_nodes(root).typ = 0 then
        Error_message$ = "Node" + str$(root) + " is invalid": error 101
    end if
    select case ast_nodes(root).typ
    case AST_PROCEDURE
        print #logging_file_handle, "Invalid nested procedure"
    case AST_ASSIGN
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, " = ";
        ast_dump_pretty ast_get_child(root, 2), 0
    case AST_IF
        for clause = 1 to ast_num_children(root) \ 2
            if clause = 1 then print #logging_file_handle, indent$; "IF "; else print #logging_file_handle, indent$; "ELSEIF ";
            ast_dump_pretty ast_get_child(root, clause * 2 - 1), 0
            print #logging_file_handle, " THEN "
            ast_dump_pretty ast_get_child(root, clause * 2), indent_level + 1
        next clause
        if ast_num_children(root) mod 2 then
            print #logging_file_handle, indent$; "ELSE"
            ast_dump_pretty ast_get_child(root, ast_num_children(root)), indent_level + 1
        end if
        print #logging_file_handle, indent$; "END IF";
    case AST_WHILE
        print #logging_file_handle, indent$; "WHILE ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle,
        ast_dump_pretty ast_get_child(root, 2), indent_level + 1
        print #logging_file_handle, indent$; "WEND";
    case AST_DO_PRE
        print #logging_file_handle, indent$; "DO WHILE ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle,
        ast_dump_pretty ast_get_child(root, 2), indent_level + 1
        print #logging_file_handle, indent$; "LOOP";
    case AST_DO_POST
        print #logging_file_handle, indent$; "DO"
        ast_dump_pretty ast_get_child(root, 2), indent_level + 1
        print #logging_file_handle, indent$; "LOOP WHILE ";
        ast_dump_pretty ast_get_child(root, 1), 0
    case AST_FOR
        print #logging_file_handle, indent$; "FOR ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, " = ";
        ast_dump_pretty ast_get_child(root, 2), 0
        print #logging_file_handle, " TO ";
        ast_dump_pretty ast_get_child(root, 3), 0
        print #logging_file_handle, " STEP ";
        ast_dump_pretty ast_get_child(root, 4), 0
        print #logging_file_handle,
        ast_dump_pretty ast_get_child(root, 5), indent_level + 1
        print #logging_file_handle, indent$; "NEXT ";
        ast_dump_pretty ast_get_child(root, 1), 0
    case AST_SELECT
        print #logging_file_handle, indent$; "SELECT CASE ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle,
        for i = 2 to ast_num_children(root)
            ast_dump_pretty ast_get_child(root, i), indent_level
        next i
        print #logging_file_handle, indent$; "END SELECT";
    case AST_SELECT_LIST
        print #logging_file_handle, indent$; "CASE ";
        for i = 1 to ast_num_children(root) - 1
            ast_dump_pretty ast_get_child(root, i), 0
            if i < ast_num_children(root) - 1 then print #logging_file_handle, ", ";
        next i
        print #logging_file_handle,
        ast_dump_pretty ast_get_child(root, ast_num_children(root)), indent_level + 1
    case AST_SELECT_ELSE
        print #logging_file_handle, indent$; "CASE ELSE"
        ast_dump_pretty ast_get_child(root, ast_num_children(root)), indent_level + 1
    case AST_SELECT_IS
        print #logging_file_handle, indent$; "IS ";
        print #logging_file_handle, symtab(ast_nodes(root).ref).identifier; " ";
        ast_dump_pretty ast_get_child(root, 2), 0
    case AST_SELECT_RANGE
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, indent$; " TO ";
        ast_dump_pretty ast_get_child(root, 2), 0
    case AST_CALL
        print #logging_file_handle, "call(";
        print #logging_file_handle, symtab(ast_nodes(root).ref).identifier;
        print #logging_file_handle, " ["; type_human_sig$(type_signatures(ast_nodes(root).ref2).sig); "]";
        if len(ast_children(root)) then print #logging_file_handle, ", ";
        for i = 1 to ast_num_children(root)
            ast_dump_pretty ast_get_child(root, i), 0
            if i <> ast_num_children(root) then print #logging_file_handle, ", ";
        next i
        print #logging_file_handle, ")";
    case AST_CONSTANT
        if type_of_constant(root) = TYPE_STRING then
            print #logging_file_handle, chr$(34); ast_constants(ast_nodes(root).ref); chr$(34);
        else
            print #logging_file_handle, ast_constants(ast_nodes(root).ref);
        end if
    case AST_BLOCK
        for i = 1 to ast_num_children(root)
            print #logging_file_handle, indent$;
            ast_dump_pretty ast_get_child(root, i), indent_level + 1
            print #logging_file_handle,
        next i
    case AST_VAR
        print #logging_file_handle, "var(";
        var = ast_nodes(root).ref
        if symtab(var).v3 AND SYM_VARIABLE_CONST then print #logging_file_handle, "CONST ";
        print #logging_file_handle, symtab(var).identifier; ")";
    case AST_UDT_ACCESS
        print #logging_file_handle, "udt(";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, ", "; symtab(ast_nodes(root).ref).identifier; ")";
    case AST_ARRAY_ACCESS
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, "(";
        for i = 2 to ast_num_children(root)
            ast_dump_pretty ast_get_child(root, i), 0
            if i <> ast_num_children(root) then print #logging_file_handle, ", "
        next i
        print #logging_file_handle, ")";
    case AST_ARRAY_CREATE, AST_ARRAY_RESIZE
        print #logging_file_handle, "REDIM ";
        if ast_nodes(root).typ = AST_ARRAY_RESIZE then print #logging_file_handle, "_PRESERVE ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, "(";
        for i = 2 to ast_num_children(root) step 2
            ast_dump_pretty ast_get_child(root, i), 0
            print #logging_file_handle, " TO ";
            ast_dump_pretty ast_get_child(root, i + 1), 0
            if i < ast_num_children(root) - 1 then print #logging_file_handle, ", ";
        next i
        print #logging_file_handle, ")";
    case AST_ARRAY_DELETE
        print #logging_file_handle, "delete ";
        ast_dump_pretty ast_get_child(root, 1), 0
    case AST_CAST
        print #logging_file_handle, "cast("; type_human_readable$(type_of_cast(root)); ", ";
        ast_dump_pretty ast_get_child(root, 1), 0
        print #logging_file_handle, ")";
    case AST_FLAGS
        print #logging_file_handle, "flag(";
        select case ast_nodes(root).ref
        case AST_FLAG_MANUAL, AST_FLAG_CONTEXTUAL
            print #logging_file_handle, ltrim$(str$(ast_nodes(root).ref2));
        case AST_FLAG_TOKEN
            print #logging_file_handle, symtab(ast_nodes(root).ref2).identifier;
        end select
        print #logging_file_handle, ")";
    case AST_GOTO
        print #logging_file_handle, indent$; "goto("; ast_nodes(root).ref; ")";
    case AST_EXIT
        print #logging_file_handle, "EXIT ";
        select case ast_nodes(ast_nodes(root).ref).typ
        case AST_WHILE
            print #logging_file_handle, "WHILE";
        case AST_DO_POST, AST_DO_PRE
            print #logging_file_handle, "DO";
        case AST_FOR
            print #logging_file_handle, "FOR";
        end select
    case AST_NONE
        print #logging_file_handle, "[NONE]";
    case AST_SET_RETURN
        print #logging_file_handle, "return ";
        ast_dump_pretty ast_get_child(root, 1), 0
    case else
        print #logging_file_handle, "Unknown AST type"; ast_nodes(root).typ
    end select
end sub

sub ast_dump_constants
    print #logging_file_handle, " ID    Type      Value"
    for i = 1 to ast_last_constant
        print #logging_file_handle, using "###    &    &"; i; type_human_readable(ast_constant_types(i)); ast_constants(i)
    next i
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'immediate.bm - Execute a parsed program

sub imm_init
    'ps_next_var_index describes number of variables in the main program
    imm_stack_last = ps_next_var_index - 1
    redim imm_stack(1 to imm_stack_last) as imm_value_t
    'No, I'm not crazy - this explicit initialisation is to
    'work around a QB64 bug where it doesn't set these values
    'properly. Probably something to do with the dynamic-length
    'string in a UDT.
    for i = 1 to imm_stack_last
        imm_stack(i).s = ""
        imm_stack(i).n = 0
    next i
    imm_filehandle_offset = freefile - 1
    imm_heap_init
end sub

sub imm_reinit(stack_size)
    old_last = imm_stack_last
    imm_stack_last = stack_size
    if imm_stack_last > u then redim _preserve imm_stack(1 to imm_stack_last) as imm_value_t
    for i = old_last + 1 to imm_stack_last
        imm_stack(i).s = ""
        imm_stack(i).n = 0
    next i
end sub

sub imm_run(node)
    dim dummy_result as imm_value_t
    imm_eval node, dummy_result
end sub

sub imm_error(msg$)
    Error_message$ = msg$
    error 101
end sub

'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'array.bm - Array handling functions

sub imm_do_array_establish(node)
    array = ast_get_child(node, 1)
    'get address of descriptor
    info_base_addr = imm_get_addr(array)
    'get data block address
    data_addr = imm_get_at_addr_n(info_base_addr)
    if data_addr <> 0 then exit sub
    imm_array_init node
end sub
    
sub imm_do_array_delete(node)
    array = ast_get_child(node, 1)
    'get address of descriptor
    info_base_addr = imm_get_addr(array)
    'get data block address
    data_addr = imm_get_at_addr_n(info_base_addr)
    imm_heap_free data_addr
end sub

sub imm_array_init(node)
    dim temp as imm_value_t
    'New array
    'Array descriptor:
    ' - pointer to data
    ' - number of dimensions
    ' - lbound of leftmost dimension
    ' - ubound of leftmost dimension
    ' - etc.
    ' - lbound of rightmost dimension
    ' - ubound of rightmost dimension
    array = ast_get_child(node, 1)
    info_base_addr = imm_get_addr(array)
    data_addr = imm_get_at_addr_n(info_base_addr)
    array_type = type_of_lvalue(array)
    element_type = symtab(array_type).v3
    dimensions = (ast_num_children(node) - 1) / 2
    block_size = 1
    imm_set_at_addr_n imm_add_offset(info_base_addr, 1), dimensions
    for i = 1 to dimensions
        'evaluate upper and lower bounds for this dimension
        imm_eval ast_get_child(node, i * 2), temp
        lower_bound = temp.n
        imm_eval ast_get_child(node, i * 2 + 1), temp
        upper_bound = temp.n
        'write values to descriptor
        imm_set_at_addr_n imm_add_offset(info_base_addr, i * 2), lower_bound
        imm_set_at_addr_n imm_add_offset(info_base_addr, i * 2 + 1), upper_bound
        'accumulate total data block size as number of elements
        data_size = data_size + (upper_bound - lower_bound + 1) * block_size
        block_size = upper_bound - lower_bound + 1
    next i
    'convert to bytes
    data_size = data_size * type_fixed_size(element_type)
    'allocate and store pointer
    data_addr = imm_heap_alloc(data_size)
    imm_set_at_addr_n info_base_addr, data_addr
    temp.n = 0
    temp.s = ""
    imm_memset data_addr, data_size, temp
end sub
    
sub imm_do_array_resize(node, preserve)
    dim temp as imm_value_t
    array = ast_get_child(node, 1)
    'get address of descriptor
    info_base_addr = imm_get_addr(array)
    'get data block address
    data_addr = imm_get_at_addr_n(info_base_addr)
    if data_addr = 0 then
        imm_array_init node
    elseif not preserve then
        imm_heap_free data_addr
        imm_array_init node
    else
        'only allow resizing the last dimension because otherwise we would need to
        'rearrange all the data
        array_type = type_of_lvalue(array)
        element_type = symtab(array_type).v3
        dimensions = (ast_num_children(node) - 1) / 2
        old_block_size = 1
        new_block_size = 1
        for i = 1 to dimensions
            'check lower bound
            imm_eval ast_get_child(node, i * 2), temp
            old_lower_bound = imm_get_at_addr_n(imm_add_offset(info_base_addr, i * 2))
            new_lower_bound = temp.n
            if i < dimensions and old_lower_bound <> new_lower_bound then imm_error "Bad array resize"
            'check upper bound
            imm_eval ast_get_child(node, i * 2 + 1), temp
            old_upper_bound = imm_get_at_addr_n(imm_add_offset(info_base_addr, i * 2 + 1))
            new_upper_bound = temp.n
            if i < dimensions and old_upper_bound <> new_upper_bound then imm_error "Bad array resize"
            imm_set_at_addr_n imm_add_offset(info_base_addr, i * 2), new_lower_bound
            imm_set_at_addr_n imm_add_offset(info_base_addr, i * 2 + 1), new_upper_bound
            old_data_size = old_data_size + (old_upper_bound - old_lower_bound + 1) * old_block_size
            old_block_size = old_upper_bound - old_lower_bound + 1
            new_data_size = new_data_size + (new_upper_bound - new_lower_bound + 1) * new_block_size
            new_block_size = new_upper_bound - new_lower_bound + 1
        next i
        old_data_size = old_data_size * type_fixed_size(element_type)
        new_data_size = new_data_size * type_fixed_size(element_type)
        if new_data_size <= old_data_size then
            'Array is shrinking or staying the same. Since we don't have the ability
            'to shrink allocations, just leave it the same size.
            'TODO implement heap shrinking
        else
            'Array is expanding. Copy data to a new allocation.
            'TODO implement heap expanding
            new_data_addr = imm_heap_alloc(new_data_size)
            for i = 0 to old_data_size - 1
                imm_get_at_addr imm_add_offset(data_addr, i), temp
                imm_set_at_addr imm_add_offset(new_data_addr, i), temp
            next i
            imm_heap_free data_addr
            imm_set_at_addr_n info_base_addr, new_data_addr
        end if
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'assignment.bm - Executor for variable assignment

sub imm_do_assign(node)
    dim rvalue as imm_value_t
    lvalue = ast_get_child(node, 1)
    imm_eval ast_get_child(node, 2), rvalue
    dest_addr = imm_get_addr(lvalue)  
    typ = type_of_lvalue(lvalue)
    if symtab(typ).v2 = SYM_TYPE_UDT then
        src_addr = rvalue.n
        for i = 1 to type_fixed_size(typ)
            'TODO: Deep copy
            dim temp as imm_value_t
            imm_get_at_addr src_addr, temp
            imm_set_at_addr dest_addr, temp
            src_addr = imm_add_offset(src_addr, 1)
            dest_addr = imm_add_offset(dest_addr, 1)
        next i
    elseif symtab(typ).v2 = SYM_TYPE_ARRAY then
        imm_error "Cannot assign entire array"
    else
        imm_set_at_addr dest_addr, rvalue
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'block.bm - Executor for a BLOCK

sub imm_do_block(node, result as imm_value_t)
    start_at = 1
    if imm_next_jump then
        imm_trim_jump
        start_at = ast_find_child(node, imm_next_jump)
        imm_trim_jump
    end if
    for i = start_at to ast_num_children(node)
        imm_eval ast_get_child(node, i), result
        if imm_next_jump then 'Are we GOTOing somewhere?
            if imm_next_jump = ast_get_child(node, i) then
                'Handle the crazy case of things like "10 GOTO 10"
                imm_trim_jump
                i = i - 1
            elseif imm_next_jump = node then
                imm_trim_jump
                'This node is on the jump path
                'Note: labels never attach directly to a block
                '-1 because the top of the loop does +1
                i = ast_find_child(node, imm_next_jump) - 1
                imm_trim_jump
            else
                'Our target is in another block, unwind further
                exit function
            end if
        end if
        if imm_exit_node > 0 then exit sub
    next i
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'call.bm - Executor for CALLs

sub imm_do_call(node, result as imm_value_t)
    if symtab(ast_nodes(node).ref).v2 = SYM_FUNCTION_USER then
        imm_do_call_userfunc node, result
    else
        imm_do_call_internal node, result
    end if
end sub

sub imm_do_call_internal(node, result as imm_value_t)
    dim v1 as imm_value_t
    dim v2 as imm_value_t
    dim v3 as imm_value_t
    dim v4 as imm_value_t
    dim v5 as imm_value_t
    dim v6 as imm_value_t
    dim v7 as imm_value_t
    dim v8 as imm_value_t
    dim v9 as imm_value_t
    dim v10 as imm_value_t
    return_type = type_of_call(node)
    select case ast_nodes(node).ref
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'input.bm - Executor for INPUT statement and function

case TOK_INPUT
    if return_type <> TYPE_NONE then
        'INPUT$ function
        imm_eval ast_get_child(node, 1), v1
        c2 = ast_get_child(node, 2)
        if ast_is_none(c2) then
            result.s = input$(v1.n)
        else
            imm_eval c2, v2
            result.s = input$(v1.n, v2.n + imm_filehandle_offset)
        end if
    else
        'INPUT statement
        numvars = ast_num_children(node) - 1
        first_var_offset = 1
        flags = ast_nodes(ast_get_child(node, 1)).ref2
        if flags AND STMT_INPUT_PROMPT then
            imm_eval ast_get_child(node, 2), v1
            print v1.s;
            numvars = numvars - 1
            first_var_offset = 2
        end if
        if (flags AND STMT_INPUT_NO_QUESTION) = 0 then print "? ";
        if flags AND STMT_INPUT_NO_NEWLINE then line input ; readline$ else line input readline$
        if flags AND STMT_INPUT_LINEMODE then
            var = ast_get_child(node, first_var_offset + 1)
            var_addr = imm_get_addr(var)
            imm_set_at_addr_s var_addr, readline$
        else
            'TODO: Better error handling
            for i = 1 to numvars
                comma = instr(readline$, ",")
                if comma = 0 then comma = len(readline$) + 1
                var = ast_get_child(node, first_var_offset + i)
                var_addr = imm_get_addr(var)
                if nomoredata then
                    v1.n = 0
                    v1.s = ""
                elseif type_of_var(var) = TYPE_STRING then
                    v1.s = left$(readline$, comma - 1)
                else
                    v1.n = val(left$(readline$, comma - 1))
                end if
                imm_enforce_type v1, type_of_var(var)
                imm_set_at_addr var_addr, v1
                readline$ = mid$(readline$, comma + 1)
                if readline$ = "" then nomoredata = TRUE
            next i
        end if
    end if
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'file.bm - Executors for file management commands

case TOK_CHDIR
    imm_eval ast_get_child(node, 1), v1
    chdir v1.s

case TOK_CLOSE
    fh = ast_get_child(node, 1)
    if ast_is_none(fh) then
        for i = imm_filehandle_offset + 1 to 255
            close i
        next i
    else
        imm_eval fh, v1
        close #v1.n + imm_filehandle_offset
    end if

case TOK_EOF
    imm_eval ast_get_child(node, 1), v1
    result.n = eof(v1.n + imm_filehandle_offset)

case TOK_FILES
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        files
    else
        imm_eval c1, v1
        files v1.s
    end if

case TOK_FREEFILE
    result.n = freefile

case TOK_KILL
    imm_eval ast_get_child(node, 1), v1
    kill v1.s

case TOK_LOF
    imm_eval ast_get_child(node, 1), v1
    result.n = lof(v1.n + imm_filehandle_offset)

case TOK_OPEN
    imm_eval ast_get_child(node, 1), v1 'filename
    mode = ast_nodes(ast_get_child(node, 2)).ref2
    imm_eval ast_get_child(node, 3), v2 'file handle
    v2.n = v2.n + imm_filehandle_offset
    v3.n = 128 'len
    reclen = ast_get_child(node, 4)
    if not ast_is_none(reclen) then imm_eval reclen, v3
    select case mode
    case 1
        open v1.s for random as #v2.n len=v3.n
    case 2
        open v1.s for input as #v2.n
    case 3
        open v1.s for output as #v2.n
    case 4
        open v1.s for binary as #v2.n
    case 5
        open v1.s for append as #v2.n
    end select

case TOK_PUT
    imm_eval ast_get_child(node, 1), v1
    v1.n = v1.n + imm_filehandle_offset
    v2.n = seek(v1.n)
    position = ast_get_child(node, 2)
    if not ast_is_none(position) then imm_eval position, v2
    src_var = ast_get_child(node, 3)
    if ast_is_none(src_var) then
        put #v1.n, v2.n
    else
        imm_eval src_var, v3
        select case type_of_expr(src_var)
        case TYPE_INTEGER
            putvar_int% = v3.n
            put #v1.n, v2.n, putvar_int%
        case TYPE_LONG
            putvar_long& = v3.n
            put #v1.n, v2.n, putvar_long&
        case TYPE_INTEGER64
            putvar_int64&& = v3.n
            put #v1.n, v2.n, putvar_int64&&
        case TYPE_SINGLE
            putvar_single! = v3.n
            put #v1.n, v2.n, putvar_single!
        case TYPE_DOUBLE
            putvar_double# = v3.n
            put #v1.n, v2.n, putvar_double#
        case TYPE_QUAD
            putvar_quad## = v3.n
            put #v1.n, v2.n, putvar_quad##
        case TYPE_STRING
            putvar_str$ = v3.s
            put #v1.n, v2.n, putvar_str$
        end select
    end if

case TOK_GET
    imm_eval ast_get_child(node, 1), v1
    v1.n = v1.n + imm_filehandle_offset
    v2.n = seek(v1.n)
    position = ast_get_child(node, 2)
    if not ast_is_none(position) then imm_eval position, v2
    dest_var = ast_get_child(node, 3)
    if ast_is_none(dest_var) then
        get #v1.n, v2.n
    else
        dest_addr = imm_get_addr(dest_var)
        select case type_of_var(dest_var)
        case TYPE_INTEGER
            get #v1.n, v2.n, getvar_int%
            imm_set_at_addr_n dest_addr, getvar_int%
        case TYPE_LONG
            get #v1.n, v2.n, getvar_long&
            imm_set_at_addr_n dest_addr, getvar_long&
        case TYPE_INTEGER64
            get #v1.n, v2.n, getvar_int64&&
            imm_set_at_addr_n dest_addr, getvar_int64&&
        case TYPE_SINGLE
            get #v1.n, v2.n, getvar_single!
            imm_set_at_addr_n dest_addr, getvar_single!
        case TYPE_DOUBLE
            get #v1.n, v2.n, getvar_double#
            imm_set_at_addr_n dest_addr, getvar_double#
        case TYPE_QUAD
            get #v1.n, v2.n, getvar_quad##
            imm_set_at_addr_n dest_addr, getvar_quad##
        case TYPE_STRING
            getvar_string$ = space$(len(imm_get_at_addr_s(dest_addr)))
            get #v1.n, v2.n, getvar_string$
            imm_set_at_addr_s dest_addr, getvar_string$
        end select
    end if
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'font.bm - Executors for font handling functions

case TOK__FONTHEIGHT
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        result.n = _fontheight
    else
        imm_eval c1, v1
        result.n = _fontheight(v1.n)
    end if

case TOK__FONTWIDTH
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        result.n = _fontwidth
    else
        imm_eval c1, v1
        result.n = _fontwidth(v1.n)
    end if

case TOK__PRINTWIDTH
    imm_eval ast_get_child(node, 1), v1
    c2 = ast_get_child(node, 2)
    if ast_is_none(c2) then v2.n = _dest else imm_eval c2, v2
    result.n = _printwidth(v1.s, v2.n)
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'graphics.bm - Executors for graphics functions

case TOK__BLUE32
    imm_eval ast_get_child(node, 1), v1
    result.n = _red32(v1.n)

case TOK_CIRCLE
    'Node 1 is flag for STEP
    imm_eval ast_get_child(node, 2), v1
    imm_eval ast_get_child(node, 3), v2
    imm_eval ast_get_child(node, 4), v3
    v4.n = _defaultcolor
    c4 = ast_get_child(node, 5)
    if not ast_is_none(c4) then imm_eval c4, v4
    v5.n = 0
    c5 = ast_get_child(node, 6)
    if not ast_is_none(c5) then imm_eval c5, v5
    v6.n = _pi(2)
    c6 = ast_get_child(node, 7)
    if not ast_is_none(c6) then imm_eval c6, v6
    v7.n = 1
    c7 = ast_get_child(node, 8)
    if not ast_is_none(c7) then imm_eval c7, v7
    if not ast_is_none(ast_get_child(node, 1)) then
        circle step (v1.n, v2.n), v3.n, v4.n, v5.n, v6.n, v7.n
    else
        circle (v1.n, v2.n), v3.n, v4.n, v5.n, v6.n, v7.n
    end if

case TOK_DRAW
    imm_eval ast_get_child(node, 1), v1
    draw v1.s

case TOK__GREEN32
    imm_eval ast_get_child(node, 1), v1
    result.n = _green32(v1.n)

case TOK_LINE
    if ast_num_children(node) = 6 then
        src_step = true
        v1.n = 0
        v2.n = 0
        if ast_is_none(ast_get_child(node, 1)) then dest_step = false else dest_step = true
        imm_eval ast_get_child(node, 2), v3
        imm_eval ast_get_child(node, 3), v4
        imm_eval ast_get_child(node, 4), v5
        mode_child = ast_get_child(node, 5)
        style_child = ast_get_child(node, 6)
    else
        if ast_is_none(ast_get_child(node, 1)) then src_step = false else src_step = true
        imm_eval ast_get_child(node, 2), v1
        imm_eval ast_get_child(node, 3), v2
        if ast_is_none(ast_get_child(node, 4)) then dest_step = false else dest_step = true
        imm_eval ast_get_child(node, 5), v3
        imm_eval ast_get_child(node, 6), v4
        imm_eval ast_get_child(node, 7), v5
        mode_child = ast_get_child(node, 8)
        style_child = ast_get_child(node, 9)
    end if
    old_source = _source
    _source _dest
    if src_step then
        v1.n = v1.n + point(2)
        v2.n = v2.n + point(3)
    end if
    _source old_source
    if dest_step then
        v3.n = v3.n + v1.n
        v4.n = v4.n + v2.n
    end if
    if ast_is_none(mode_child) then mode = 0 else mode = ast_nodes(mode_child).ref2
    if ast_is_none(style_child) then v6.n = 65535 else imm_eval style_child, v6
    select case mode
    case 0
        line (v1.n, v2.n)-(v3.n, v4.n), v5.n, , v6.n
    case 1
        line (v1.n, v2.n)-(v3.n, v4.n), v5.n, b, v6.n
    case 2
        line (v1.n, v2.n)-(v3.n, v4.n), v5.n, bf, v6.n
    end select

case TOK__LOADIMAGE
    imm_eval ast_get_child(node, 1), v1
    c1 = ast_get_child(node, 2)
    if ast_is_none(c1) then
        result.n = _loadimage(v1.s)
    else
        imm_eval c1, v2
        result.n = _loadimage(v1.s, v2.n)
    end if

case TOK__NEWIMAGE
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    c3 = ast_get_child(node,3)
    if ast_is_none(c3) then
        result.n = _newimage(v1.n, v2.n)
    else
        imm_eval ast_get_child(node, 3), v3
        result.n = _newimage(v1.n, v2.n, v3.n)
    end if

case TOK_PSET
    imm_eval ast_get_child(node, 2), v1
    imm_eval ast_get_child(node, 3), v2
    v3.n = _defaultcolor
    c3 = ast_get_child(node, 4)
    if not ast_is_none(c3) then imm_eval c3, v3
    if not ast_is_none(ast_get_child(node, 1)) then
        pset step (v1.n, v2.n), v3.n
    else
        pset (v1.n, v2.n), v3.n
    end if

case TOK__PUTIMAGE
    flags = ast_nodes(ast_get_child(node, 1)).ref2
    v5.n = _source
    v6.n = _dest
    imm_eval ast_get_child(node, 6), v5
    imm_eval ast_get_child(node, 7), v6

    v1.n = 0
    v2.n = 0
    imm_eval ast_get_child(node, 2), v1
    imm_eval ast_get_child(node, 3), v2
    if flags AND PUTIMAGE_STEP_SRC1 then
        old_source = _source
        _source v6.n
        v1.n = v1.n + point(2)
        v2.n = v2.n + point(3)
        _source old_source
    end if

    v3.n = _width(v6.n)
    v4.n = _height(v6.n)
    imm_eval ast_get_child(node, 4), v3
    imm_eval ast_get_child(node, 5), v4
    if flags AND PUTIMAGE_STEP_SRC2 then
        v3.n = v3.n + v1.n
        v4.n = v4.n + v2.n
    end if

    v7.n = 0
    v8.n = 0
    imm_eval ast_get_child(node, 8), v7
    imm_eval ast_get_child(node, 9), v8
    if flags AND PUTIMAGE_STEP_DEST1 then
        old_source = _source
        _source v5.n
        v7.n = v7.n + point(2)
        v8.n = v8.n + point(3)
        _source old_source
    end if

    v9.n = _width(v5.n)
    v10.n = _height(v5.n)
    imm_eval ast_get_child(node, 10), v9
    imm_eval ast_get_child(node, 11), v10
    if flags AND PUTIMAGE_STEP_DEST2 then
        v9.n = v9.n + v7.n
        v10.n = v10.n + v8.n
    end if

    if flags AND PUTIMAGE_SMOOTH then
        _putimage (v1.n, v2.n)-(v3.n, v4.n), v5.n, v6.n, (v7.n, v8.n)-(v9.n, v10.n), _smooth
    else
        _putimage (v1.n, v2.n)-(v3.n, v4.n), v5.n, v6.n, (v7.n, v8.n)-(v9.n, v10.n)
    end if
    
    
case TOK__RED32
    imm_eval ast_get_child(node, 1), v1
    result.n = _red32(v1.n)

case TOK__RGB32
    select case ast_num_children(node)
    case 1
        imm_eval ast_get_child(node, 1), v1
        r = _rgb32(v1.n)
    case 2
        imm_eval ast_get_child(node, 1), v1
        imm_eval ast_get_child(node, 2), v2
        r = _rgb32(v1.n, v2.n)
    case 3
        imm_eval ast_get_child(node, 1), v1
        imm_eval ast_get_child(node, 2), v2
        imm_eval ast_get_child(node, 3), v3
        r = _rgb32(v1.n, v2.n, v3.n)
    case 4
        imm_eval ast_get_child(node, 1), v1
        imm_eval ast_get_child(node, 2), v2
        imm_eval ast_get_child(node, 3), v3
        imm_eval ast_get_child(node, 4), v4
        r = _rgb32(v1.n, v2.n, v3.n, v4.n)
    end select
    result.n = r

case TOK_SCREEN
    'Ignores second argument
    imm_eval ast_get_child(node, 1), v1
    v2.n = 0
    c2 = ast_get_child(node, 3)
    if not ast_is_none(c2) then imm_eval c2, v2
    v3.n = 0
    c3 = ast_get_child(node, 4)
    if not ast_is_none(c3) then imm_eval c3, v3
    screen v1.n, , v2.n, v3.n
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'keyboard.bm - Executors for keyboard handling functions

case TOK_INKEY
    result.s = inkey$

case TOK__KEYCLEAR
    _keyclear

case TOK__KEYDOWN
    imm_eval ast_get_child(node, 1), v1
    result.n = _keydown(v1.n)

case TOK__KEYHIT
    result.n = _keyhit
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'logic.bm - Executors for logic operations

case TOK_AND
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n and v2.n

case TOK_CMP_GT
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n > v2.n

case TOK_CMP_GTEQ
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n >= v2.n

case TOK_CMP_LT
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n < v2.n

case TOK_CMP_LTEQ
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n <= v2.n

case TOK_CMP_NEQ
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    if type_of_expr(ast_get_child(node, 1)) = TYPE_STRING then result.n = v1.s <> v2.s else result.n = v1.n <> v2.n

case TOK_EQUALS
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    if type_of_expr(ast_get_child(node, 1)) = TYPE_STRING then result.n = v1.s = v2.s else result.n = v1.n = v2.n

case TOK_EQV
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n eqv v2.n

case TOK_IMP
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n imp v2.n

case TOK_NOT
    imm_eval ast_get_child(node, 1), v1
    result.n = not v1.n

case TOK_OR
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n or v2.n

case TOK_XOR
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n xor v2.n
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'maths.bm - Executors for maths operations

case TOK_ABS
    imm_eval ast_get_child(node, 1), v1
    result.n = abs(v1.n)

case TOK_ATN
    imm_eval ast_get_child(node, 1), v1
    result.n = atn(v1.n)

case TOK_BACKSLASH
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n \ v2.n

case TOK_COS
    imm_eval ast_get_child(node, 1), v1
    result.n = cos(v1.n)

case TOK_DASH
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n - v2.n

case TOK_EXP
    imm_eval ast_get_child(node, 1), v1
    result.n = exp(v1.n)

case TOK__PI
    v1.n = 1
    c1 = ast_get_child(node, 1)
    if not ast_is_none(c1) then imm_eval c1, v1
    result.n = _pi(v1.n)

case TOK_LOG
    imm_eval ast_get_child(node, 1), v1
    result.n = log(v1.n)

case TOK_MOD
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n mod v2.n

case TOK_POWER
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n ^ v2.n

case TOK_NEGATIVE
    imm_eval ast_get_child(node, 1), v1
    result.n = -v1.n

case TOK_PLUS
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    if type_of_call(node) = TYPE_STRING then result.s = v1.s + v2.s else result.n = v1.n + v2.n

case TOK_SIN
    imm_eval ast_get_child(node, 1), v1
    result.n = sin(v1.n)

case TOK_SGN
    imm_eval ast_get_child(node, 1), v1
    result.n = sgn(v1.n)

case TOK_SQR
    imm_eval ast_get_child(node, 1), v1
    result.n = sqr(v1.n)

case TOK_SLASH
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n / v2.n

case TOK_STAR
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = v1.n * v2.n

case TOK_TAN
    imm_eval ast_get_child(node, 1), v1
    result.n = tan(v1.n)
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'os.bm - Various OS and environment functions

case TOK_COMMAND
    if ast_is_none(ast_get_child(node, 1)) then
        result.s = ""
        for i = input_file_command_offset + 1 to _commandcount
            result.s = result.s + command$(i)
            if i <> _commandcount then result.s = result.s + " "
        next
    else
        imm_eval ast_get_child(node, 1), v1
        result.s = command$(input_file_command_offset + v1.n)
    end if

case TOK__COMMANDCOUNT
    result.n = _commandcount - input_file_command_offset

case TOK_END
    v1.n = 0
    if not ast_is_none(ast_get_child(node, 1)) then imm_eval ast_get_child(node, 1), v1
    'END is only useful when the display will disappear after execution is finished,
    'which is not the case when running in terminal mode.
    $if DEBUG_HEAP then
    if options.debug then imm_heap_stats
    $end if
    if options.terminal_mode then system v1.n else end v1.n
        
case TOK_ENVIRON
    c1 = ast_get_child(node, 1)
    imm_eval c1, v1
    if type_of_expr(c1) = TYPE_STRING then
        result.s = environ$(v1.s)
    else
        result.s = environ$(v1.n)
    end if

case TOK_RMDIR
    c1 = ast_get_child(node, 1)
    imm_eval c1, v1
    rmdir v1.s

case TOK_SYSTEM
    v1.n = 0
    if not ast_is_none(ast_get_child(node, 1)) then imm_eval ast_get_child(node, 1), v1
    $if DEBUG_HEAP then
    if options.debug then imm_heap_stats
    $end if
    system v1.n

case TOK__TITLE
    if return_type = TYPE_STRING then
        result.s = _title$
    else
        imm_eval ast_get_child(node, 1), v1
        _title v1.s
    end if
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'print.bm - Executor for PRINT statement and friends

case TOK_PRINT
    for i = 1 to ast_num_children(node)
        child = ast_get_child(node, i)
        if ast_nodes(child).typ = AST_FLAGS then
            if ast_nodes(child).ref2 AND PRINT_NEXT_FIELD then
                print ,
            elseif ast_nodes(child).ref2 AND PRINT_NEWLINE then
                print
            end if
        else
            imm_eval child, v1
            'Need to check type explicitly so we can explicitly give the correct C*() function
            select case type_of_expr(child)
            case TYPE_INTEGER
                print cint(v1.n);
            case TYPE_LONG
                print clng(v1.n);
            case TYPE_INTEGER64
                print _round(v1.n);
            case TYPE_SINGLE
                print csng(v1.n);
            case TYPE_DOUBLE
                print cdbl(v1.n);
            case TYPE_QUAD
                print v1.n;
            case TYPE_STRING
                print v1.s;
            end select
        end if
    next i

case TOK__PRINTSTRING
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    imm_eval ast_get_child(node, 3), v3
    v4.n = _dest
    c4 = ast_get_child(node, 4)
    if not ast_is_none(c4) then imm_eval c4, v4
    _printstring (v1.n, v2.n), v3.s, v4.n
case TOK_RANDOMIZE
    if ast_num_children(node) = 1 then
        c1 = ast_get_child(node, 1)
        if ast_is_none(c1) then
            randomize
        else
            imm_eval c1, v1
            randomize v1.n
        end if
    else
        c1 = ast_get_child(node, 2)
        imm_eval c1, v1
        randomize using v1.n
    end if

case TOK_RND
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        result.n = rnd
    else
        imm_eval c1, v1
        result.n = rnd(v1.n)
    end if
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'rounding.bm - Executors for numeric rounding functions

case TOK_CDBL, TOK_CINT, TOK_CLNG, TOK_CSNG
    imm_eval ast_get_child(node, 1), v1
    result.n = v1.n

case TOK_FIX
    imm_eval ast_get_child(node, 1), v1
    result.n = fix(v1.n)

case TOK_INT
    imm_eval ast_get_child(node, 1), v1
    result.n = int(v1.n)
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'screen.bm - Executors for screen management commands

case TOK_CLS
    c1 = ast_get_child(node, 1)
    c2 = ast_get_child(node, 2)
    if ast_is_none(c1) and ast_is_none(c2) then
        cls
    elseif not ast_is_none(c1) then
        imm_eval c1, v1
        cls v1.n
    elseif not ast_is_none(c2) then
        imm_eval c2, v2
        cls , v2.n
    else
        imm_eval c1, v1
        imm_eval c2, v2
        cls v1.n, v2.n
    end if

case TOK_COLOR
    v1.n = _defaultcolor
    v2.n = _backgroundcolor
    c1 = ast_get_child(node, 1)
    c2 = ast_get_child(node, 2)
    if not ast_is_none(c1) then imm_eval c1, v1
    if not ast_is_none(c2) then imm_eval c2, v2
    color v1.n, v2.n

case TOK_CSRLIN
    result.n = csrlin

case TOK__DEST
    if return_type = TYPE_NONE then
        imm_eval ast_get_child(node, 1), v1
        _dest v1.n
    else
        result.n = _dest
    end if

case TOK__DISPLAY
    _display

case TOK__HEIGHT
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        v1.n = _dest
    else
        imm_eval c1, v1
    end if
    result.n = _height(v1.n)

case TOK_LOCATE
    v1.n = csrlin
    v2.n = pos(0)
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    cursor = ast_get_child(node, 3)
    imm_eval cursor, v3
    if ast_num_children(node) = 5 then
        imm_eval ast_get_child(node, 4), v4
        imm_eval ast_get_child(node, 5), v5
        if ast_is_none(cursor) then
            locate v1.n, v2.n, , v4.n, v5.n
        else
            locate v1.n, v2.n, v3.n, v4.n, v5.n
        end if
    else
        if ast_is_none(cursor) then
            locate v1.n, v2.n
        else
            locate v1.n, v2.n, v3.n
        end if
    end if

case TOK__SOURCE
    if return_type = TYPE_NONE then
        imm_eval ast_get_child(node, 1), v1
        _source v1.n
    else
        result.n = _source
    end if

case TOK__WIDTH
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        v1.n = _dest
    else
        imm_eval c1, v1
    end if
    result.n = _width(v1.n)
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'sound.bm - Executors for sound functions

case TOK_BEEP
    beep

case TOK_PLAY
    imm_eval ast_get_child(node, 1), v1
    play v1.s

case TOK_SOUND
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    sound v1.n, v2.n
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'string.bm - Executors for string manipulation functions

case TOK_ASC
    imm_eval ast_get_child(node, 1), v1
    if not ast_is_none(ast_get_child(node, 2)) then
        imm_eval ast_get_child(node, 2), v2
        result.n = asc(v1.s, v2.n)
    else
        result.n = asc(v1.s)
    end if

case TOK_CHR
    imm_eval ast_get_child(node, 1), v1
    result.s = chr$(v1.n)

case TOK_CVD
    imm_eval ast_get_child(node, 1), v1
    result.n = cvd(v1.s)

case TOK_CVDMBF
    imm_eval ast_get_child(node, 1), v1
    result.n = cvdmbf(v1.s)

case TOK_CVI
    imm_eval ast_get_child(node, 1), v1
    result.n = cvi(v1.s)

case TOK_CVL
    imm_eval ast_get_child(node, 1), v1
    result.n = cvl(v1.s)

case TOK_CVS
    imm_eval ast_get_child(node, 1), v1
    result.n = cvs(v1.s)

case TOK_CVSMBF
    imm_eval ast_get_child(node, 1), v1
    result.n = cvsmbf(v1.s)

case TOK__DEFLATE
    imm_eval ast_get_child(node, 1), v1
    result.s = _deflate$(v1.s)

case TOK_HEX
    imm_eval ast_get_child(node, 1), v1
    result.s = hex$(v1.n)

case TOK__INFLATE
    imm_eval ast_get_child(node, 1), v1
    result.s = _inflate$(v1.s)

case TOK_INSTR
    v1.n = 1
    haystack = 1
    'TODO: Make this use signature identifiers or something
    if ast_num_children(node) = 3 then
        haystack = 2
        imm_eval ast_get_child(node, 1), v1
    end if
    imm_eval ast_get_child(node, haystack), v2
    imm_eval ast_get_child(node, haystack + 1), v3
    result.n = instr(v1.n, v2.s, v3.s)

case TOK_LEFT
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.s = left$(v1.s, v2.n)

case TOK_LCASE
    imm_eval ast_get_child(node, 1), v1
    result.s = lcase$(v1.s)

case TOK_LTRIM
    imm_eval ast_get_child(node,1), v1
    result.s = ltrim$(v1.s)

case TOK_MID
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    if not ast_is_none(ast_get_child(node, 3)) then
        imm_eval ast_get_child(node, 3), v3
        result.s = mid$(v1.s, v2.n, v3.n)
    else
        result.s = mid$(v1.s, v2.n)
    end if

case TOK_RIGHT
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.s = right$(v1.s, v2.n)

case TOK_RTRIM
    imm_eval ast_get_child(node, 1), v1
    result.s = rtrim$(v1.s)

case TOK_SPACE
    imm_eval ast_get_child(node, 1), v1
    result.s = space$(v1.n)

case TOK_STR
    imm_eval ast_get_child(node, 1), v1
    result.s = str$(v1.n)

case TOK__STRCMP
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = _strcmp(v1.s,v2.s)

case TOK__STRICMP
    imm_eval ast_get_child(node, 1), v1
    imm_eval ast_get_child(node, 2), v2
    result.n = _stricmp(v1.s,v2.s)	

case TOK__TRIM
    imm_eval ast_get_child(node, 1), v1
    result.s = _trim$(v1.s)

case TOK_UCASE
    imm_eval ast_get_child(node, 1), v1
    result.s = ucase$(v1.s)

case TOK_VAL
    imm_eval ast_get_child(node, 1), v1
    result.n = val(v1.s)
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'time.bm - Executors for time and date related functions

case TOK_DATE
    result.s = date$

case TOK__DELAY
    imm_eval ast_get_child(node, 1), v1
    _delay v1.n

case TOK__LIMIT
    imm_eval ast_get_child(node, 1), v1
    _limit v1.n

case TOK_SLEEP
    period = ast_get_child(node, 1)
    if ast_is_none(period) then
        sleep
    else
        imm_eval period, v1
        sleep v1.n
    end if

case TOK_TIME
    result.s = time$

case TOK_TIMER
    c1 = ast_get_child(node, 1)
    if ast_is_none(c1) then
        result.n = timer
    else
        imm_eval c1, v1
        result.n = timer(v1.n)
    end if
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'varinfo.bm - Various variable interrogation function

case TOK_DIM
    'This is the DIM function
    child = ast_get_child(node, 1)
    imm_eval child, v1
    result.n = imm_get_at_addr_n(imm_add_offset(v1.n, 1))

case TOK_ERASE
    child = ast_get_child(node, 1)
    addr = imm_get_addr(child)
    data_addr = imm_get_at_addr_n(addr)
    if data_addr <> 0 then
        imm_heap_free data_addr
        imm_set_at_addr_n addr, 0
    end if

case TOK_OPTION
    'The OPTION function to check if an OPTION variable was passed
    child = ast_get_child(node, 1)
    if ast_nodes(child).typ <> AST_VAR then
        'TODO: Implement
        imm_error "OPTION check not supported on arrays & UDTs"
    end if
    sym = ast_nodes(child).ref
    if (symtab(sym).v3 AND SYM_VARIABLE_DEREF) = 0 then
        'Not pass-by-reference, so could not have been optional
        result.n = TRUE
    else
        'Don't use imm_get_addr because that'll attempt to dereference
        addr = imm_stack_base + symtab(sym).v2
        if imm_get_at_addr_n(addr) then
            result.n = TRUE
        else
            result.n = FALSE
        end if
    end if

case TOK_LEN
    child = ast_get_child(node, 1)
    imm_eval child, v1
    select case type_of_expr(child)
    case TYPE_INTEGER
        result.n = len(dummy_integer%)
    case TYPE_LONG
        result.n = len(dummy_long&)
    case TYPE_INTEGER64
        result.n = len(dummy_int64&&)
    case TYPE_SINGLE
        result.n = len(dummy_single!)
    case TYPE_DOUBLE
        result.n = len(dummy_double#)
    case TYPE_QUAD
        'QB64 gives this as 32, but should be 16
        result.n = len(dummy_quad##)
    case TYPE_STRING
        result.n = len(v1.s)
    end select

case TOK_LBOUND
    imm_eval ast_get_child(node, 1), v1
    dimension = ast_get_child(node, 2)
    if ast_is_none(dimension) then v2.n = 1 else imm_eval dimension, v2
    if v2.n < 1 or v2.n > imm_get_at_addr_n(imm_add_offset(v1.n, 1)) then
        error 9
    end if
    result.n = imm_get_at_addr_n(imm_add_offset(v1.n, v2.n * 2))

case TOK_SWAP
    l = ast_get_child(node, 1)
    r = ast_get_child(node, 2)
    l_addr = imm_get_addr(l)
    r_addr = imm_get_addr(r)
    l_type = type_of_lvalue(l)
    r_type = type_of_lvalue(r)
    'TODO check this at compile time!
    if l_type <> r_type then imm_error "Bad SWAP"
    for i = 1 to type_fixed_size(l_type)
        imm_get_at_addr l_addr, v1
        imm_get_at_addr r_addr, v2
        imm_set_at_addr l_addr, v2
        imm_set_at_addr r_addr, v1
    next i

case TOK_UBOUND
    imm_eval ast_get_child(node, 1), v1
    dimension = ast_get_child(node, 2)
    if ast_is_none(dimension) then v2.n = 1 else imm_eval dimension, v2
    if v2.n < 1 or v2.n > imm_get_at_addr_n(imm_add_offset(v1.n, 1)) then
        error 9
    end if
    result.n = imm_get_at_addr_n(imm_add_offset(v1.n, v2.n * 2 + 1))
    case else
        imm_error "Unhandled call to " + tok_human_readable$(ast_nodes(node).ref)
    end select
    imm_enforce_type result, type_of_call(node)
end sub

sub imm_do_call_userfunc(node, result as imm_value_t)
    proc_id = ast_nodes(node).ref
    proc_node = symtab(proc_id).v3
    num_locals = symtab(proc_id).v4
    if proc_node = 0 then imm_error "Call to unimplemented function"
    'Create new stack frame
    $if DEBUG_MEM_TRACE then
    debuginfo "New stack frame at" + str$(imm_stack_last + 1)
    debuginfo "Allocate"  + str$(num_locals) + " slots"
    $end if
    old_stack_last = imm_stack_last
    old_stack_base = imm_stack_base
    imm_reinit imm_stack_last + num_locals

    'Evaluate and store arguments, left to right
    dim arg as imm_value_t
    for i = 1 to ast_num_children(node)
        arg_node = ast_get_child(node, i)
        if i > ast_num_children(proc_node) - 1 then
            'This should only happen when the function definition doesn't declare
            'all parameters, such as for overriding functions.
            'We still need to evaluate the argument being passed though in case
            'it has side effects.
            imm_eval arg_node, arg
        elseif ast_nodes(arg_node).typ = AST_NONE then
            'Not supplied optional argument, pass a null pointer
            imm_set_at_addr_n old_stack_last + i, 0
        elseif symtab(ast_nodes(ast_get_child(proc_node, i + 1)).ref).v3 AND SYM_VARIABLE_DEREF then
            'Callee needs a reference. Can we just provide a pointer to a passed variable?
            if ast_is_lvalue(arg_node) then
                'Yes, passed argument is an lvalue so we can get a reference to it
                imm_set_at_addr_n old_stack_last + i, imm_get_addr(arg_node)
            else
                'No, we need to make a shadow copy and pass a reference to that.
                'The shadow copy will also be on the stack.
                imm_reinit imm_stack_last + 1
                imm_eval arg_node, arg
                imm_set_at_addr imm_stack_last, arg
                imm_set_at_addr_n old_stack_last + i, imm_stack_last
            end if
        else
            'Force pass-by-value
            arg_node = ast_get_child(node, i)
            imm_eval arg_node, arg
            imm_set_at_addr old_stack_last + i, arg
        end if
    next i
    'If we're expected to return a value, allocate an extra stack slot
    'after the formal arguments and shadow copies to hold that value
    if type_sig_return(ast_nodes(node).ref2) <> TYPE_NONE then
        has_return_value = TRUE
        imm_reinit imm_stack_last + 1
    end if
    'Set frame pointer appropriately (delayed to here so argument evaluation
    'occurs in the caller's stack frame)
    imm_stack_base = old_stack_last
    'Do the call!
    imm_eval ast_get_child(symtab(proc_id).v3, 1), result
    'Collect return value if relevant
    if has_return_value then imm_get_at_addr imm_stack_last, result
    'Restore previous stack frame
    imm_stack_last = imm_stack_base
    imm_stack_base = old_stack_base
    'If we exited early, clear the exit flag (no need to actually check it because
    'we can't nest functions).
    imm_exit_node = 0
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'eval.bm - Top level executor function

sub imm_eval(node, result as imm_value_t)
    select case ast_nodes(node).typ
    case AST_ASSIGN
        imm_do_assign node
    case AST_IF
        imm_do_conditional node
    case AST_WHILE
        imm_do_do_pre node
    case AST_DO_PRE
        imm_do_do_pre node
    case AST_DO_POST
        imm_do_do_post node
    case AST_FOR
        imm_do_for node
    case AST_SELECT
        imm_do_select node
    case AST_SELECT_VALUE
        result = imm_select_value
    case AST_CALL, AST_SELECT_IS
        imm_do_call node, result
    case AST_CONSTANT
        if type_of_constant(node) = TYPE_STRING then
            result.s = ast_constants(ast_nodes(node).ref)
        else
            result.n = val(ast_constants(ast_nodes(node).ref))
        end if
    case AST_BLOCK
        imm_do_block node, result
    case AST_VAR, AST_UDT_ACCESS, AST_ARRAY_ACCESS
        addr = imm_get_addr(node)
        'Take address for a full UDT or array
        if symtab(type_of_lvalue(node)).v2 then
            result.n = addr
        else
            imm_get_at_addr addr, result
        end if
    case AST_ARRAY_CREATE
        imm_do_array_resize node, FALSE
    case AST_ARRAY_RESIZE
        imm_do_array_resize node, TRUE
    case AST_ARRAY_DELETE
        imm_do_array_delete node
    case AST_ARRAY_ESTABLISH
        imm_do_array_establish node
    case AST_CAST
        imm_do_cast node, result
    case AST_GOTO
        imm_do_goto node
    case AST_EXIT
        imm_exit_node = ast_nodes(node).ref
    case AST_SET_RETURN
        dim temp as imm_value_t
        imm_eval ast_get_child(node, 1), temp
        imm_set_at_addr imm_stack_last, temp
    case AST_NONE
        'do nothing
    end select
end sub

sub imm_do_cast(node, result as imm_value_t)
    imm_eval ast_get_child(node, 1), result
    imm_enforce_type result, ast_nodes(node).ref
end sub

sub imm_enforce_type(result as imm_value_t, typ)
    select case typ
    case TYPE_INTEGER
        result.n = cint(result.n)
    case TYPE_LONG
        result.n = clng(result.n)
    case TYPE_INTEGER64
        result.n = _round(result.n)
        if result.n < -2147483648 or result.n > 2147483647 then error 6
    case TYPE_SINGLE
        result.n = csng(result.n)
    case TYPE_DOUBLE
        result.n = cdbl(result.n)
    case TYPE_QUAD, TYPE_STRING
        'Nothing to do here
    end select
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'for.bm - Executor for FOR loop

sub imm_do_for(node)
    dim start_val as imm_value_t
    dim end_val as imm_value_t
    dim step_val as imm_value_t

    iterator_addr = imm_get_addr(ast_get_child(node, 1))
    if imm_next_jump = 0 then
        'If we're GOTOing the middle of the loop, the start value isn't even evaluated
        imm_eval ast_get_child(node, 2), start_val
        imm_set_at_addr iterator_addr, start_val
    end if
    imm_eval ast_get_child(node, 3), end_val
    imm_eval ast_get_child(node, 4), step_val

    block = ast_get_child(node, 5)
    direction = sgn(step_val.n)
    if direction = 0 then direction = 1
    do while (direction = 1 and imm_get_at_addr_n(iterator_addr) <= end_val.n) or _
             (direction = -1 and imm_get_at_addr_n(iterator_addr) >= end_val.n) or _
             imm_next_jump > 0
        imm_run block
        if imm_next_jump then exit sub
        if imm_exit_node > 0 and imm_exit_node = node then
            imm_exit_node = 0
            exit sub
        elseif imm_exit_node > 0 then
            exit sub
        end if
        imm_set_at_addr_n iterator_addr, imm_get_at_addr_n(iterator_addr) + step_val.n
    loop
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'goto.bm - Executor for GOTO and utility functions for managing jumps

sub imm_do_goto(node)
    n = ast_nodes(node).ref
    imm_jump_path$ = ast_path_from_ancestor$(node, n)
    '?"Jump path: ";
    'for i = 1 to len(imm_jump_path$) step 4
    '    print cvl(mid$(imm_jump_path$, i, 4));
    'next i
    '?
end sub

function imm_next_jump
    if len(imm_jump_path$) = 0 then exit function
    imm_next_jump = cvl(left$(imm_jump_path$, 4))
end function

sub imm_trim_jump
    imm_jump_path$ = mid$(imm_jump_path$, 5)
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'heap.bm - Heap data management

'The heap is used for allocating dynamically sized objects, or objects
'that are not necessarily tied to a single function's scope.
'
'Block header:
' - size of region, including header
' - pointer to next free region
'Blocks are in a cyclic linked list.
'
'The list of free blocks is searched until a suitable sized block is found.
'If the block is bigger than needed, the tail end is returned. Blocks are
'always allocated in sizes a multiple of IMM_HEAP_HEADER_SIZE. Freed blocks
'will be coalesced with an adjacent free block if possible.
'
'This is based on the allocator presented in Chapter 8.7 of K&R C.

'Allocate 'req_elems' elements on the heap and return start address.
function imm_heap_alloc(req_elems)
    'Calculate needed size to the next multiple of IMM_HEAP_HEADER_SIZE,
    'including +1 for the header itself.
    nelems = (_ceil(req_elems / IMM_HEAP_HEADER_SIZE) + 1) * IMM_HEAP_HEADER_SIZE
    prevp = imm_heap_next_free
    p = imm_heap(prevp + 1).n
    do
        if (imm_heap(p).n >= nelems) then 'big enough
            if (imm_heap(p).n = nelems) then 'exactly
                imm_heap(prevp + 1).n = imm_heap(p + 1).n
            else 'split block, allocate tail end
                imm_heap(p).n = imm_heap(p).n - nelems
                p = p + imm_heap(p).n
                imm_heap(p).n = nelems
            end if
            imm_heap_next_free = prevp
            imm_heap_alloc = -(p + IMM_HEAP_HEADER_SIZE)
            $if DEBUG_HEAP then
            imm_heap_current_blocks = imm_heap_current_blocks + 1
            imm_heap_current_bytes = imm_heap_current_bytes + nelems
            if imm_heap_current_blocks > imm_heap_max_blocks then imm_heap_max_blocks = imm_heap_current_blocks
            if imm_heap_current_bytes > imm_heap_max_bytes then imm_heap_max_bytes = imm_heap_current_bytes
            debuginfo "Allocated" + str$(nelems) + " elements at " + str$(-p - IMM_HEAP_HEADER_SIZE)
            $end if
            exit function
        end if
        if p = imm_heap_next_free then 'wrapped around free list
            p = imm_heap_expand(nelems)
        end if
        prevp = p
        p = imm_heap(p + 1).n
    loop
end function

'Free allocation at 'address'
sub imm_heap_free(address)
    data_addr = -address 
    addr = data_addr - IMM_HEAP_HEADER_SIZE
    p = imm_heap_next_free 'Start at next free block
    'Search for p s.t. addr is between p and next block address
    while not (addr > p and addr < imm_heap(p + 1).n)
        if p >= imm_heap(p + 1).n and (addr > p or addr < imm_heap(p + 1).n) then
            'Freed block at start or end of memory region
            exit while
        end if
        p = imm_heap(p + 1).n
    wend
    if addr + imm_heap(addr).n = imm_heap(p + 1).n then
        'Adjacent to upper block
        imm_heap(addr).n = imm_heap(addr).n + imm_heap(imm_heap(p + 1).n).n
        imm_heap(addr + 1).n = imm_heap(imm_heap(p + 1).n + 1).n
    else
        imm_heap(addr + 1).n = imm_heap(p + 1).n
    end if
    if p + imm_heap(p).n = addr then
        'Adjacent to lower block
        imm_heap(p).n = imm_heap(p).n + imm_heap(addr).n
        imm_heap(p + 1).n = imm_heap(addr + 1).n
    else
        imm_heap(p + 1).n = addr
    end if
    imm_heap_next_free = p
    $if DEBUG_HEAP then
    imm_heap_current_blocks = imm_heap_current_blocks - 1
    imm_heap_current_bytes = imm_heap_current_bytes - imm_heap(addr).n
    debuginfo "Freed" + str$(imm_heap(addr).n) + " elements at " + str$(address)
    $end if
end sub

'Setup initial heap
sub imm_heap_init
    redim imm_heap(1 to 2) as imm_value_t
    imm_heap(1).n = 0
    imm_heap(2).n = 1
    imm_heap_next_free = 1
end sub

'Increase the total heap size by adding new memory to list
function imm_heap_expand(nu)
    const IMM_HEAP_MIN_ALLOC = 1024 'Value from K&R, rather arbitrary
    nelems = nu
    if nelems < IMM_HEAP_MIN_ALLOC then nelems = IMM_HEAP_MIN_ALLOC
    new_mem = ubound(imm_heap) + 1
    redim _preserve imm_heap(1 to ubound(imm_heap) + nelems) as imm_value_t
    $if DEBUG_HEAP then
    debuginfo "Expand heap to" + str$(ubound(imm_heap)) + " elements"
    imm_heap_current_blocks = imm_heap_current_blocks + 1
    imm_heap_current_bytes = imm_heap_current_bytes + nelems
    $end if
    imm_heap(new_mem).n = nelems
    imm_heap_free -(new_mem + IMM_HEAP_HEADER_SIZE)
    imm_heap_expand = imm_heap_next_free
end sub

sub imm_heap_stats
    print #logging_file_handle, "Total heap allocation:"; ubound(imm_heap); " elements"
    print #logging_file_handle, "Current heap:"; imm_heap_current_blocks; " blocks /"; imm_heap_current_bytes; " elements"
    print #logging_file_handle, "Max heap:"; imm_heap_max_blocks; " blocks /"; imm_heap_max_bytes; " elements"
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'if.bm - Executor for IF statement

sub imm_do_conditional(node)
    if imm_next_jump then 'Don't start at top, we're GOTOing a point
        imm_run imm_next_jump
        exit sub
    end if
    dim condition as imm_value_t
    for clause = 1 to ast_num_children(node) \ 2
        imm_eval ast_get_child(node, clause * 2 - 1), condition
        if condition.n then
            imm_run ast_get_child(node, clause * 2)
            exit sub
        end if
    next clause
    if ast_num_children(node) mod 2 then
        imm_run ast_get_child(node, ast_num_children(node))
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'loop.bm - Executor for DO LOOP and WHILE WEND

'Also used for WHILE WEND loops
sub imm_do_do_pre(node)
    dim temp as imm_value_t
    guard = ast_get_child(node, 1)
    block = ast_get_child(node, 2)
    if imm_next_jump = 0 then imm_eval guard, temp
    do while temp.n <> 0 or imm_next_jump <> 0
        imm_run block
        if imm_next_jump then exit sub
        if imm_exit_node > 0 and imm_exit_node = node then
            imm_exit_node = 0
            exit sub
        elseif imm_exit_node > 0 then
            exit sub
        end if
        imm_eval guard, temp
    loop
end sub

sub imm_do_do_post(node)
    dim temp as imm_value_t
    guard = ast_get_child(node, 1)
    block = ast_get_child(node, 2)
    do
        imm_run block
        if imm_next_jump then exit sub
        if imm_exit_node > 0 and imm_exit_node = node then
            imm_exit_node = 0
            exit sub
        elseif imm_exit_node > 0 then
            exit sub
        end if
        imm_eval guard, temp
    loop while temp.n
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'memory.bm - Memory access and addressing routines

function imm_add_offset(base_addr, offset)
    'The base_addr might be negative if it is a heap address, so "pass through"
    'the negative sign. e.g. base_addr = -10, offset = 2, result = -12
    imm_add_offset = (abs(base_addr) + offset) * sgn(base_addr)
end function

'Get the address of a variable. Handles simple scalars, elments of nested UDTs & arrays,
'and entire UDTs & arrays. If the returned value is < 0, it is a heap address. Otherwise,
'it is a stack address.
function imm_get_addr(node)
    select case ast_nodes(node).typ
    case AST_VAR
        'Always a stack address. Even arrays, because a reference to the entire array
        'refers to the dimension info block that sits on the stack (unless it's an
        'array in a UDT in an array, but that wouldn't be an AST_VAR).
        if symtab(ast_nodes(node).ref).v3 AND SYM_VARIABLE_MAINFRAME then
            'shared or static variable
            addr = symtab(ast_nodes(node).ref).v2
        else
            'local variable
            addr = imm_stack_base + symtab(ast_nodes(node).ref).v2
        end if
        'Dereference if needed
        if symtab(ast_nodes(node).ref).v3 AND SYM_VARIABLE_DEREF then
            addr = imm_get_at_addr_n(addr)
        end if
        imm_get_addr = addr
    case AST_UDT_ACCESS
        'TODO: Is a dereference check needed here?
        base_addr = imm_get_addr(ast_get_child(node, 1))
        offset = symtab(ast_nodes(node).ref).v2
        imm_get_addr = imm_add_offset(base_addr, offset)
    case AST_ARRAY_ACCESS
        array = ast_get_child(node, 1)
        array_type = type_of_lvalue(array)
        info_base_addr = imm_get_addr(array)
        element_type = symtab(array_type).v3
        dimensions = symtab(array_type).v4
        'Array descriptor:
        ' - pointer to data
        ' - number of dimensions
        ' - lbound of leftmost dimension
        ' - ubound of leftmost dimension
        ' - etc.
        ' - lbound of rightmost dimension
        ' - ubound of rightmost dimension
        block_size = 1
        for i = 1 to dimensions
            dim index as imm_value_t
            lower_bound = imm_get_at_addr_n(imm_add_offset(info_base_addr, i * 2))
            upper_bound = imm_get_at_addr_n(imm_add_offset(info_base_addr, i * 2 + 1))
            imm_eval ast_get_child(node, i + 1), index
            'TODO: bounds checking
            offset = offset + (index.n - lower_bound) * block_size
            block_size = upper_bound - lower_bound + 1
        next i
        offset = offset * type_fixed_size(element_type)
        imm_get_addr = imm_add_offset(imm_get_at_addr_n(info_base_addr), offset)
    case else
        imm_error "Attempt to take address of something not an lvalue"
    end select
end function

sub imm_set_at_addr(addr, v as imm_value_t)
    $if DEBUG_MEM_TRACE then
    debuginfo "Write [" + str$(addr) + " ] = " + str$(v.n) + " " + v.s
    $end if
    if addr < 0 then
        imm_heap(-addr) = v
    elseif addr > 0 then
        imm_stack(addr) = v
    else
        imm_error "Null pointer value write"
    end if
end sub

sub imm_set_at_addr_s(addr, v$)
    $if DEBUG_MEM_TRACE then
    debuginfo "Write [" + str$(addr) + " ] =" + v$
    $end if
    if addr < 0 then
        imm_heap(-addr).s = v$
    elseif addr > 0 then
        imm_stack(addr).s = v$
    else
        imm_error "Null pointer string write"
    end if
end sub

sub imm_set_at_addr_n(addr, n as _float)
    $if DEBUG_MEM_TRACE then
    debuginfo "Write [" + str$(addr) + " ] =" + str$(n)
    $end if
    if addr < 0 then
        imm_heap(-addr).n = n
    elseif addr > 0 then
        imm_stack(addr).n = n
    else
        imm_error "Null pointer numeric write"
    end if
end sub

sub imm_get_at_addr(addr, v as imm_value_t)
    $if DEBUG_MEM_TRACE then
    debuginfo "Read [" + str$(addr) + " ]"
    $end if
    if addr < 0 then
        v = imm_heap(-addr)
    elseif addr > 0 then
        v = imm_stack(addr)
    else
        imm_error "Null pointer value read"
    end if
    $if DEBUG_MEM_TRACE then
    debuginfo "=" + str$(v.n) + " " + v.s
    $end if
end sub

function imm_get_at_addr_s$(addr)
    $if DEBUG_MEM_TRACE then
    debuginfo "Read [" + str$(addr) + " ]"
    $end if
    if addr < 0 then
        r$ = imm_heap(-addr).s
    elseif addr > 0 then
        r$ = imm_stack(addr).s
    else
        imm_error "Null pointer string read"
    end if
    imm_get_at_addr_s$ = r$
    $if DEBUG_MEM_TRACE then
    debuginfo "=" + r$
    $end if
end sub

function imm_get_at_addr_n##(addr)
    $if DEBUG_MEM_TRACE then
    debuginfo "Read [" + str$(addr) + " ]"
    $end if
    if addr < 0 then
        r## = imm_heap(-addr).n
    elseif addr > 0 then
        r## = imm_stack(addr).n
    else
        imm_error "Null pointer numeric read"
    end if
    imm_get_at_addr_n## = r##
    $if DEBUG_MEM_TRACE then
    debuginfo "=" + str$(r##)
    $end if
end function

sub imm_memset(addr, size, value as imm_value_t)
    $if DEBUG_MEM_TRACE then
    debuginfo "Write [" + str$(addr) + "+" + str$(size) + "] =" + str$(value.n) + " " + value.s
    $end if
    if addr < 0 then
        for i = addr to imm_add_offset(addr, size - 1) step -1
            imm_heap(-i).s = value.s
            imm_heap(-i).n = value.n
        next i
    elseif addr > 0 then
        for i = addr to imm_add_offset(addr, size - 1)
            imm_stack(i).s = value.s
            imm_stack(i).n = value.n
        next i
    else
        imm_error "Null pointer write"
    end if
end sub
'Copyright 2020 Luke Ceddia
'SPDX-License-Identifier: Apache-2.0
'select.bm - Executor for SELECT statement

sub imm_do_select(node)
    if imm_next_jump then 'We're GOTOing a point
        imm_run imm_next_jump
        exit sub
    end if

    dim base_expr as imm_value_t
    base_node = ast_get_child(node, 1)
    base_type = type_of_expr(base_node)
    imm_eval base_node, base_expr
    for i = 2 to ast_num_children(node)
        child = ast_get_child(node, i)
        select case ast_nodes(child).typ
        case AST_SELECT_LIST
            'If any of the guards are true, execute the block
            for j = 1 to ast_num_children(child) - 1
                guard = ast_get_child(child, j)
                if imm_select_eval_guard(guard, base_type, base_expr) then
                    imm_run ast_get_child(child, ast_num_children(child))
                    exit sub
                end if
            next j
        case AST_SELECT_ELSE
            imm_run ast_get_child(child, 1)
            exit sub
        case else
            imm_error "Malformed SELECT CASE"
        end select
    next i
end sub

function imm_select_eval_guard(guard, base_type, base_expr as imm_value_t)
    dim as imm_value_t l, r
    select case ast_nodes(guard).typ
    case AST_SELECT_RANGE
        imm_eval ast_get_child(guard, 1), l
        imm_eval ast_get_child(guard, 2), r
        if type_is_number(base_type) then
            if l.n <= base_expr.n and base_expr.n <= r.n then imm_select_eval_guard = TRUE
        elseif base_type = TYPE_STRING then
            if l.s <= base_expr.s and base_expr.s <= r.s then imm_select_eval_guard = TRUE
        else
            imm_error "Cannot evaluate range"
        end if
    case AST_SELECT_IS
        'Because evaluating a guard could result in calling a function
        'that uses SELECT CASE, we ensure the select value is current here.
        imm_select_value = base_expr
        imm_eval guard, l
        imm_select_eval_guard = l.n
    end select
end function