-- HamsterSpeak Compiler

-- (C) Copyright 2001-2025 James Paige, Ralph Versteegen, and the OHRRPGCE Developers
-- Dual licensed under the GNU GPL v2+ and MIT Licenses. Read LICENSE.txt for terms and disclaimer of liability.

-- This is a compiler for HamsterSpeak scripts used for plotscripting in
-- the O.H.R.RPG.C.E. For more info, visit http://HamsterRepublic.com

-- This code is written in Euphoria 4.0. You can get the Free Open-Source
-- Euphoria compiler from http://OpenEuphoria.com . I also highly recommend
-- David Cuny's EE editor

---------------------------------------------------------------------------

--Changelog
--3Wa 2025-07-31 definerole alternative spelling of definetrigger
--3W  2024-02-06 Add srcpos debug info, local var names, and srcfiles.txt
--3Vb 2024-02-06 Disallow local/subscript or script/global with the same name
--    2024-01-11 Fix lexing of identifiers ending in : & | or -
--3Va 2022-04-08 Add exit
--3V  2022-04-07 Add showvalueof, and tracevalueof alias
--3Ug 2021-12-12 Change license to Dual GPL+MIT (with consent of all contributors)
--3Uf 2020-02-29 Accept non-breaking space as whitespace
--3Ue 2019-09-09 Windows: fix double-inclusion detection
--3Ud 2019-07-12 Windows: double-include detection now case-insensitive
--3Uc 2019-03-25 Enforce at most 32 args allowed
--3Ub 2018-11-17 Fix some error messages
--3Ua 2018-08-18 Script can also have attributes
--3U  2018-08-12 @obsolete attribute
--3Tl 2018-05-14 Delete (possibly-bad) .hs output file on error
--3Tk 2018-03-18 Optimise binary_compile; puts nodes in opposite order
--3Tj 2018-03-18 Fix some number and - lexing bugs
--3Ti 2018-03-17 More compiler global_scope optimisations
--3Th 2018-03-15 Optimize compiler, rewriting global_scope lookup
--3Tg 2017-12-31 Fix crash due to missing KIND_LONGNAMES[KIND_KEYWORD]
--3Tf 2017-11-08 Specialise assert(x==y) to use _asserteq
--3Te 2017-10-29 Look for plotscr.hsd/scancode.hsi first in global dirs
--3Td 2017-10-07 Add parent ID to scripts.bin, for --reuse-ids
--3Tc 2017-10-02 Make -j wait for warnings too
--3Tb 2017-09-28 Added -j option; warn on unknown options
--3Ta 2017-07-28 Increased MAXGLOBAL to 50000
--    2017-06-13 0x, 0o and 0b number prefixes
--3T  2017-06-11 Allow subscript vars/args to shadow outer locals
--3Se 2017-05-17 Disallow extra commas
--3Sd 2017-03-17 --incdir option; check ../share/games/ohrrpgce/ instead
--3Sc 2016-04-11 Check /usr/share/games/ohrrpgce/ for include files
--3Sb 2014-11-11 Better 'include' line lexing & garbage detection
--3Sa 2014-08-23 Fix printing of a lexer error message
--3S  2014-07-22 Automatically include plotscr.hsd and ignore
--               double inclusion; added --include and -b
--3Rg 2013-02-23 Fix a subscript related crash
--3Rf 2013-02-17 Fix several 31-bit int overflows
--3Re 2014-02-17 Trivial change to math builtin warnings
----- 2013-11-09 Prevent misuse of betweenable-operators in
--               declarations, and allow constants for global ids
--3Rc 2013-10-11 subscript implementation changes (add nonlocal kind)
--3Rb 2013-10-10 Remove variable() later, for syntax checking
--3Ra 2013-10-09 Fixed \r lineendings (AGAIN) and slow \r\n handling
--3R  2013-10-05 Add subscript
--3Qc 2013-10-04 Disallow flow statements used as expressions
--3Qb 2013-07-24 Require begin after then, do, etc. (else excluded)
--3Qa 2013-04-11 Warn when plotscr.hsd not included
----- 2013-02-28 Allow non-constant expressions in case blocks again
--3Pe 2013-01-03 Faster compile times
--3Pd 2012-10-24 Fix \x escape code
--3Pc 2012-10-09 Change srcpos encoding to remove source size limits
--3Pb 2012-10-08 \x escape code
--3Pa 2012-08-24 --reuse-ids option
--3P  2012-08-18 Change way include is lexed: quotes no longer needed
--               [], {}, . now totally disallowed
--               Add < and > operators
--               Add plotscrversion block and new HS header lump
--               New switch syntax: do after case optional, case(else)
--               Added elseif
--3Of 2012-08-18 Lexer bugfix
--3Oe 2012-04-11 Add \n and \t escape codes
--3Od 2012-03-03 Change directory search order slightly
--3Oc 2012-02-07 Increased MAXGLOBAL to 16383
--3Ob 2012-02-07 Make the max script global number set by a constant
--3Oa 2012-01-20 Fix lexer allowing newlines in strings
--3O  2012-01-19 Unicode support
--3Nd 2011-10-16 Fix commands.bin generation bug
--3Nc 2011-08-28 Additional expression optimisations
--3Nb 2011-08-28 Fix overflow_int32 and bitwise operator overflow
--3Na 2011-07-25 Add -x option for Hamster Whisper's benefit
--3N  2011-07-12 Add assert
--3Ma 2010-10-21 Correctly strip \r to fix newlines ... again.
--3M  2010-05-02 abs, sign, sqrt; fix error reporting
--3L  2010-04-29 tracevalue support, involving a few internal changes
--3Ke 2010-04-18 Add -t commandline option
--3Kd 2010-04-14 Quite a few bugfixes in optimizer
--3Kc 2010-04-14 Start checking well-formedness of numbers with lexer
--3Kb 2010-04-12 Whole lot of bugfixes in script declarations and
--               checking for unreserved identifier names
--3Ka 2010-04-12 Throw error if source file contains binary
--3K 2010-04-12 Error column reporting (introducing srcpos); lump
--              original source files into source.lumped
--3Ja 2010-04-07 Wrote a (nearly) proper lexer
--3J 2009-12-05 Multiple function names may now alias the same id
--3I 2009-07-27 Export a backup copy of full source to source.txt lump
--              disable with -n option
--3H 2009-06-18 Export function names to commands.bin lump
--3Gk 2009-05-25 Fix short references crash
--3Gj 2009-01-27 Show future-compatability warning when using square
--               brackets [] and curly brackets {} in names
--3Gi 2008-08-03 Disallow orphaned then() and else(), a common mistake
--3Gh 2008-07-14 Disable warnings for unused variables by default, and
--               Add -u option to enable warnings for unused variables.
--3Gg 2008-03-01 Raise global variable limits
--3Gf 2008-02-11 Give user another chance on missing Y key :P
--3Ge 2007-07-01 String conversion rewrite to allow more whitespace
--3Gd 2007-07-01 Allow constants for new syntax default args
--3Gc 2007-05-29 Handle empty paratheses correctly, and use
--               lowercase ".hs" extension
--3Gb 2007-05-09 Throw error on missing include file
--3Ga 2007-05-09 String length not limited to 40
--3G 2007-02-09 Offset to string literal tables given as a 32-bit
--              int, script format version++ to 2.
--3F 2006-12-11 Support for variable number of arguments to functions
--              by giving -1 as the number of args in the define block
--3Ec 2006-11-30 while(true) no longer produces a warning
--3Eb 2006-10-23 Two small fixes to some rare bugs causing crashes
--3Ea 2006-09-03 Actually export triggers in scripts.bin
--3E 2006-08-30 "define trigger" support
--3D 2006-08-16 String literal lookup tables added to end of
--              HSZ lumps replacing setstring + appendstring
--3C 2006-08-15 New syntax for giving default script arguments,
--              and for leaving out definescript
--3B 2006-08-13 HSX lumps renamed to HSZ
--3A 2006-08-10 HamsterSpeak becomes 32-bit. Also, script format
--              version added to HSX header. Current is 1
--2Na 2006-07-07 Minor update to add new logical operators
--2N 2006-07-07 Added not() logic function
--2M 2006-07-06 Set exit code on warnings
--2L 2006-05-13 Added switch statement (+ case keyword)
--2K 2006-05-01 Added @scriptname and @globalvariable syntax to
--              return script or global ID number at compile-time
--              not run-time (for use with "run script by ID" and
--              "read global" and "write global")
--2J 2006-04-10 Added break, continue, exitscript, exitreturning
--              flow statements. Also fixed some return bugs
--2I 2006-04-04 Extended HSX header to include number of arguments
--              to a script, to really fix arguments-overflow-into
--              -locals bug
--2H 2006-03-29 Display better help and wait for keypress when run
--              by double-clicking the icon. Added -k command line
--              option to skip waiting for keypress
--2G 2005-10-03 Additional operators $+ and $=
--              Mention GPL in help text
--2F 2005-07-24 Strings implemented:
--              $id="..." -> setstring
--              $id+"..." -> appendstring
--2E 2005-02-15 Changed license to GPL
--              Added += and -= operators
--2D 2002-08-03 Only a small change, strip out \r from lines of
--              the script as we read them to avoid errors related
--              to busted newlines
--2C 2002-03-05 Fixed some bugs that could cause crashes when
--              non-printable characters exist in the input file.
--              (naturally the script will not compile right, but
--              at least it will not crash)
--2B 2001-06-06 Added := as a commaless separater so it can be
--              defined as an operator
--2A 2001-05-04 Fixed -w command line option when used with -z
--2             First Release

---------------------------------------------------------------------------

without warning       --to avoid annoying warnings
without type_check    --for a small speed boost
--with profile_time     --time profiling

include hsspiffy.e --various routines, sequence manipulation - James Paige
include machine.e  --needed for int_to_bytes
include std/math.e --needed for mod
include std/graphics.e --needed for color output
include std/filesys.e
include std/map.e
include euphoria/unicode.e
include euphoria/ucstypes.e
include euphoria/io_with_unicode.e

---------------------------------------------------------------------------
--constants--
constant false=0
constant true=1

-- increment COMPILER_VERSION only for major language-altering changes
constant COMPILER_VERSION="3"
-- For small changes increment the second letter of COMPILER_SUB_VERSION
-- For large changes increment the first letter and reset the second letter
--*Please make sure this is 2 chararacters long! Append a space if required.*
constant COMPILER_SUB_VERSION="Wa"
constant COPYRIGHT_DATE="2025"

--Known single-character commandline options
constant VALID_OPTIONS="abcdfjknstwuyz"

--This is the oldest version of plotscr.hsd which is supported (feel free to
--increment this whenever using an older plotscr.hsd means you're missing out
--on new but nonessential features; there's no harm)
--*Should be 3 characters long, same captialisation as COMPILER_SUB_VERSION*
constant MIN_PLOTSCR_VERSION="3Tf"

--these constants are color-flags. May add more colors, up to #F8FF
--These values are also passed directly to Hamster Whisper.
--(these codes are at the end of the first private use area)
constant COL_FIRST=#F8E0
constant COLYEL=#F8E0
constant COLRED=#F8E1
constant COLPNK=#F8E2
constant COLWHI=#F8E3
constant COLBWHI=#F8E4
constant COL_LAST=#F8FF
--Map from the above to the color constants in std/graphics.e
--(which incidentally vary from the constants in graphics.e)
constant HS_TO_EU_COLORS={YELLOW, RED, BRIGHT_RED, WHITE, BRIGHT_WHITE}

--These are character classes used in lexer_table
constant LEX_CHAR=0       --Most character which are valid in identifiers. Everything above char 255
constant LEX_SPACE=1      --space and tab
constant LEX_BEGIN=2      --(
constant LEX_END=3        --)
constant LEX_OPERATOR=4   --The first character of an operator
constant LEX_COMMENT=5    --#
constant LEX_STRING=6     --"
constant LEX_COMMA=7      --,
constant LEX_WARN=8       --[]{}.
constant LEX_BINARY=9     --Nonprintable characters
constant LEX_DIGIT=10     --0-9
constant LEX_HEXDIGIT=11  --a-fA-F
constant LEX_OPERATOR2=12 --Only used in lexer_table_key2!!
constant LEX_NEWLINE=13   --\n

constant FILE_NAME=1          --With whatever path was needed to open it
constant FILE_TEXT=2          --Entire contents of the file
constant FILE_LINE_EXTENTS=3  --List of {start,end} pairs; inclusive indices, not including newlines
constant FILE_OFFSET=4        --Used by srcpos's
constant FILE_LUMP=5
--POS_* index sequence returned by decode_srcpos
constant POS_FILENAME=1  --FILE_NAME of the file
constant POS_LINE=2      --1-based line number
constant POS_COLUMN=3    --0-based column number
constant POS_LENGTH=4    --token length in characters (might be 0)
constant POS_LINETEXT=5  --The line containing the token
constant POS_TOKTEXT=6   --The text of the token
constant CMD_TEXT=1
constant CMD_POS=2
--For global_scope
constant SYM_KIND=1     --KIND_*
constant SYM_ID=2       --ID or 0
constant SYM_POS=3      --srcpos or 0
constant PAIR_NUM=1
constant PAIR_NAME=2
constant PAIR_START=1
constant PAIR_END=2
constant OPER_TRUENAME=3
constant OPER_POS=4
--FUNC_* are for elements of math_list, function_list or script_list
--(When changing these, also update create_function() and math_list)
constant FUNC_ID=1      --(aka PAIR_NUM)
constant FUNC_NAME=2    --(aka PAIR_NAME)
constant FUNC_ARGS=3    --Either list of default values (each an integer or NO_DEFAULT), or VAR_ARGS
constant FUNC_ATTRS=4   --List of attributes as a list of {string,TokenList} pairs where the
                        --TokenList are the arguments. Like a Node except children are Tokens instead of Nodes.
constant FUNC_FLAGS=5   --Bitvector of FLAG_* bits. Also indicates presence of attributes. See attribute_list
constant FUNC_POS=6     --srcpos of start of function/script. Not used by math_list
--ATTR_* are for attribute_list
constant ATTR_NAME=1
constant ATTR_FLAGS=2   --An integer which gets OR'd into FUNC_FLAGS
constant FLAG_OBSOLETE=#01  --Has @obsolete attribute
constant GLB_POS=3      --srcpos of globalvariable definition
constant CONST_VALUE=1
constant CONST_POS=2
constant VAR_FRAME=3    --VarToken index, integer giving frame number of a variable (0 is current script, 1 is enclosing...)
constant VAR_ID=4       --VarToken index, integer giving ID in frame
constant REUSE_PARENT_AND_NAME=2

constant NO_DEFAULT={}  --when appears in script_list[FUNC_ARGS], indicates arg with no default value
constant VAR_ARGS=0     --when appears AS function_list[FUNC_ARGS], indicates unlimited num of args

--KIND_* constants are used BOTH to describe the types of raw tokens, and tokens
--which been parsed into Nodes in an AST, although many of them can only appear
--as one or the other.
constant KIND_NUMBER=1      --int32. ID is the value
constant KIND_FLOW=2        --Flow control (flow_list), including begin and end.
constant KIND_GLOBAL=3      --Global variable (global_list)
constant KIND_LOCAL=4       --Local variable
constant KIND_MATH=5        --Math builtin function (math_list)
constant KIND_FUNCTION=6    --Builtin command (function_list)
constant KIND_SCRIPT=7      --Call to script (script_list)
constant KIND_NONLOCAL=8    --Nonlocal variable
--The following never appear in compiled scripts
constant KIND_REFERENCE=9   --Reference to a global or script. Converted to KIND_NUMBER in compiled script
constant KIND_OPERATOR=10   --Infix binary operator created by defineoperator. (operator_list)
                            --If a name like 'mod' is both operator and something else, it gets added
                            --to global_scope as the other thing, not KIND_OPERATOR.
constant KIND_PARENS=11     --Node created by extra pair of brackets around an expression
constant KIND_MACRO=12      --Expanded by hspeak, e.g. assert
constant KIND_KEYWORD=13    --Other builtin keywords that can appear in scripts but aren't flow constructs.
                            --Currently just 'variable' and 'subscript'.
constant KIND_CONSTANT=14   --A constant which hasn't been translated to a KIND_NUMBER yet
constant KIND_SEPARATOR=15  --Auto-delimiting tokens like +, if they haven't been turned into a
                            --KIND_OPERATOR yet. Can only be used in defineoperator. (separator_list)
constant KIND_ATTRIBUTE=16  --An @attribute
constant KIND_LAST_VALID_IN_SCRIPT=16
constant KIND_TOPLEVEL=17   --Toplevel keyword such as defineconstant, or script role, eg. plotscript
constant KIND_UNIMPLEMENTED=18
constant KIND_LAST=18

constant KIND_LONGNAMES={"number"
                        ,"flow control statement"
                        ,"global variable"
                        ,"local variable"
                        ,"built-in function"
                        ,"hard-coded function"
                        ,"script"
                        ,"non-local variable"
                        ,"reference"
                        ,"operator"
                        ,"order-of-operations-enforcing parentheses"
                        ,"hard-coded function/macro"
                        ,"keyword"
                        ,"constant"
                        ,"untranslated operator"
                        ,"attribute declaration"
                        ,"top-level declaration"
                        ,"unimplemented keyword"
                        ,"function attribute"
                        }

constant nil_sym={0,0,0}

constant TREE_TRUNK=1
constant TREE_BRANCHES=2
constant TIMING_DEPTH=1
constant TIMING_DESCRIPTION=2
constant TIMING_TIME=3
constant TIMING_ACTIVE=4

--Version number for the .hs/.hsp format (not including HSZ files!)
constant HSP_FORMAT_VERSION=1

constant CODE_START_BYTE_OFFSET=32
constant HSZ_FORMAT_VERSION=3

constant MAXGLOBAL=50000  --largest ID
constant MAX_LOCALS=100   --max number of locals per script (not including nonlocals)
constant MAX_ARGS=32     --max number of arguments to a script, function or builting

constant MAX_NEST_DEPTH=4

---------------------------------------------------------------------------
--globals--               --initializations--
string compiler_dir       compiler_dir=""
string include_dir        include_dir=""
string source_file        source_file=""
string dest_file          dest_file=""
integer dest_file_fh      dest_file_fh=0          --For use by error handlers only!
integer cleanup_dest      cleanup_dest=false      --Whether to delete dest_file on error
sequence optlist          optlist={}
sequence file_list        file_list={}            --type {FILE_NAME,FILE_TEXT,FILE_LINE_EXTENTS}
sequence additional_includes
                          additional_includes={}
srcpos max_srcpos         max_srcpos=0            --Maximum possible value of a valid srcpos (for typechecking)
srcpos script_position    script_position=0         --All srcpos's emitted to a .hsz are relative to this. (Length 0)
integer debug_info        debug_info=false
integer total_lines       total_lines=0
sequence cmd              cmd={}                  --TokenList (but type checking is very slow)
sequence reuse_ids        reuse_ids={}            --type {PAIR_NUM, REUSE_PARENT_AND_NAME={parent_id, PAIR_NAME}}
map constant_list         constant_list=map:new()
sequence script_role_list script_role_list={}     --type {PAIR_NUM, PAIR_NAME}
sequence operator_list    operator_list={}        --type {PAIR_NUM, PAIR_NAME, OPER_TRUENAME, OPER_POS}
sequence function_list    function_list={}        --type {PAIR_NUM, PAIR_NAME, FUNC_ARGS, FUNC_POS, FUNC_ATTRS, FUNC_FLAGS}
sequence global_list      global_list={{},{},{}}  --NOTE: three lists {PAIR_NUM, PAIR_NAME, GLB_POS}, not a list of globals
sequence string_list      string_list={}          --list of strings
sequence script_list      script_list={}          --type {PAIR_NUM, PAIR_NAME, FUNC_ARGS, FUNC_POS, FUNC_ATTRS, FUNC_FLAGS}
--See also math_list, below
                                                  --(PAIR_NAME is the full name)
map global_scope          global_scope=map:new()  --Maps all names in global scope EXCEPT operators to {SYM_KIND, SYM_ID, SYM_POS} tuples

--SCRIPT_* are for all_scripts.
--The number of data fields existing is variable, between _SCRIPT_MIN_LAST and _SCRIPT_MAX_LAST
constant SCRIPT_ROLE_TOK=1        --Script role token (type {CMD_TEXT, CMD_POS}), e.g. "script"
constant SCRIPT_NAME=2            --String, not fully-scoped
constant SCRIPT_POS=3             --srcpos of script name token
constant SCRIPT_FULL_NAME=4       --Full-scoped script name
constant SCRIPT_ARG_TOKS=5        --List of argument name tokens (type {CMD_TEXT, CMD_POS})
                                  --Initially the tokens may include default values (like "a=4"), which are later removed
constant SCRIPT_BODY_TOKS=6       --List of tokens (type {CMD_TEXT, CMD_POS}) in the body, of the form do,begin,...,end
constant SCRIPT_PARENT_IDX=7      --Index in all_scripts of parent, or 0 for none
constant SCRIPT_NEST_DEPTH=8      --Nesting depth. A script is 0, subscript 1, sub-subscript 2...
constant SCRIPT_ATTRIBUTES=9      --Temporary store, do not use. These attributes get copied to script_list's FUNC_ATTRS
constant SCRIPT_END_POS=10        --A srcpos of the last token of the script ('end' or ')')
constant _SCRIPT_MIN_LAST=10
--The following are added later
constant SCRIPT_ID=11             --Script ID. Value not appended until all IDs are assigned in check_script_declarations
--The following are added in compile_a_script
constant SCRIPT_ROLE_ID=12        --Role ID. 0 is "script", etc
constant SCRIPT_NUM_NONLOCALS=13
constant SCRIPT_VARIABLES=14      --VarList of locals and nonlocals
constant SCRIPT_AST=15            --NodeList of the abstract syntax tree
constant SCRIPT_BINARY=16         --Compiled data to go into the HSZ lumps
constant _SCRIPT_MAX_LAST=16

sequence all_scripts      all_scripts={}       --list of 'Script's == {SCRIPT_*} (variable length)

atom start_time           start_time=time()
atom run_time             run_time=0
sequence timing_data      timing_data={}
integer timing_depth      timing_depth=-1
integer get_cmd_pointer   get_cmd_pointer=0
integer autonumber_id     autonumber_id=32767
sequence flow_list        flow_list={
                              {0,"do"}
                             ,{1,"begin"}
                             ,{2,"end"}
                             ,{3,"return"}
                             ,{4,"if"}
                             ,{5,"then"}
                             ,{6,"else"}
                             ,{7,"for"}
                             ,{10,"while"}
                             ,{11,"break"}
                             ,{12,"continue"}
                             ,{13,"exitscript"}
                             ,{14,"exitreturning"}
                             ,{15,"switch"}
                             ,{16,"case"}  --never appears in compiled script
                             ,{17,"subscript"}  --never appears in compiled script
                          }
                          --elseif is not a flow type
sequence flow_requiring_brackets  --else is excluded, because of case(else)
                          flow_requiring_brackets={
                             "do",
                             "if",
                             "then",
                             "elseif",
                             "for",
                             "while",
                             "exitreturning",
                             "switch",
                             "case"
                          }
sequence math_list        math_list={
                            --{FUNC_ID, FUNC_NAME, FUNC_ARGS, FUNC_ATTRS, FUNC_FLAGS} (FUNC_POS omitted)
                              {0,"random",                {0,1}, {}, 0}
                             ,{1,"exponent",              {0,2}, {}, 0}
                             ,{2,"modulus",               {0,1}, {}, 0}
                             ,{3,"divide",                {0,1}, {}, 0}
                             ,{4,"multiply",              {0,0}, {}, 0}
                             ,{5,"subtract",              {0,0}, {}, 0}
                             ,{6,"add",                   {0,0}, {}, 0}
                             ,{7,"xor",                   {0,0}, {}, 0}
                             ,{8,"or",                    {0,0}, {}, 0}
                             ,{9,"and",                   {0,0}, {}, 0}
                             ,{10,"equal",                {0,0}, {}, 0}
                             ,{11,"notequal",             {0,0}, {}, 0}
                             ,{12,"lessthan",             {0,0}, {}, 0}
                             ,{13,"greaterthan",          {0,0}, {}, 0}
                             ,{14,"lessthanorequalto",    {0,0}, {}, 0}
                             ,{15,"greaterthanorequalto", {0,0}, {}, 0}
                             ,{16,"setvariable",          {0,0}, {}, 0}
                             ,{17,"increment",            {0,1}, {}, 0}
                             ,{18,"decrement",            {0,1}, {}, 0}
                             ,{19,"not",                  {0},   {}, 0}
                             ,{20,"logand",               {0,0}, {}, 0}
                             ,{21,"logor",                {0,0}, {}, 0}
                             ,{22,"logxor",               {0,0}, {}, 0}
                             ,{23,"abs",                  {0},   {}, 0}
                             ,{24,"sign",                 {0},   {}, 0}
                             ,{25,"sqrt",                 {0},   {}, 0}
                          }
--update is_simple_math_op on adding new operators

sequence attribute_list   attribute_list={     --type {ATTR_NAME, ATTR_FLAGS}
                             {"@obsolete",FLAG_OBSOLETE}
                          }

sequence separator_list   separator_list={
                             "+=","-=","$+","$=","$","+","--","/","*","^^","^"
                             ,"==","<>",">>","<<","<=",">=",">","<",":=","=","&&","||"
                          }
sequence lexer_table      lexer_table={}      --maps from ASCII value+1 (note +1!) to LEX_* constant
sequence lexer_table_key2 lexer_table_key2={}
string hex_chars          hex_chars="0123456789abcedfABCDEF"
sequence hex_char_values  hex_char_values={0,1,2,3,4,5,6,7,8,9,#a,#b,#c,#e,#d,#f,#A,#B,#C,#D,#E,#F}

sequence compiled_data    compiled_data={}    --used inside binary_compile only; compiled data for the current script
map node_lookup                               --used inside binary_compile only; map from serialised nodes to offsets
string current_script     current_script=""   --name of current script
integer cur_script_num    cur_script_num=0    --index into all_scripts of current script
integer colors_enabled    colors_enabled=true
integer simple_colorcodes simple_colorcodes=false
integer error_file        error_file=false
map used_globals          used_globals=map:new()  --set of ids (keys are ids, values are true)
map used_locals           used_locals=map:new()   --set of ids (keys are ids, values are true)
sequence string_table     string_table={}     --binary data
string plotscr_version    plotscr_version=""
integer max_used_function max_used_function=0 --maximum id of a function used in a script
integer fast_mode         fast_mode=false
integer end_anchor_kludge end_anchor_kludge=false
integer was_warnings      was_warnings=false

---------------------------------------------------------------------------
--types--

--A position in the script source (where newlines are one character).
--Encoded in 32-bit integer, where:
--bits 0..7 : Length of the token in characters, including whitespace
--            (aside from leading/trailing whitespace), capped to 254.
--            (255 reserved for future use)
--bit  8    : Virtual flag
--bits 9..31: The (1-based) character number of the start of the token in the file
--            plus the file's FILE_OFFSET
--
--The first file has FILE_OFFSET=1, to ensure srcpos 0 is never used.
--Offset FILE_OFFSET+0 is reserved to refer to the file as a whole (unused);
--FILE_OFFSET+1 is the start of the file.
--
--See also encode_srcpos and decode_srcpos
type srcpos(object pos)
  --need to allow 0 as a dummy value, and ignore max_srcpos if it's uninitialised)
  if atom(pos) and pos=floor(pos) and pos>=0 and (max_srcpos=0 or pos<=max_srcpos) then
    --odd, 'or' and 'and' only seem to shortcut when used in if condition, not
    --in a general expression
    return true
  else
    return false
  end if
end type

--Not the same as Euphoria's string type, which is limited to extended ASCII
type string(object str)
  if not sequence(str) then
    return false
  end if
  --Too slow
  -- for i=1 to length(str) do
  --   if not integer(str[i]) or str[i]<0 then
  --     return false
  --   end if
  -- end for
  return true
end type

type Kind(integer kind)
  return kind>=0 and kind<=KIND_LAST
end type

--SYM_KIND,SYM_ID,SYM_POS tuple
type Symbol(object sym)
  return length(sym)=3 and Kind(sym[SYM_KIND]) and srcpos(sym[SYM_POS])
end type

--A CMD_TEXT,CMD_POS pair
type Token(object tok)
  if sequence(tok) and length(tok)=2 and string(tok[1]) and srcpos(tok[2]) then
    return true
  else
    return false
  end if
end type

--A CMD_TEXT,CMD_POS,VAR_FRAME,VAR_ID tuple describing a local/nonlocal variable
type VarToken(object var)
  if length(var)=4 and string(var[1]) and srcpos(var[2]) and integer(var[3]) and integer(var[4]) then
    return true
  end if
  return false
end type

--sequence of Tokens
type TokenList(object list)
  if not sequence(list) then
    return false
  end if
  for i=1 to length(list) do
    if not Token(list[i]) then
      return false
    end if
  end for
  return true
end type

--sequence of VarTokens
type VarList(object vars)
  if not sequence(vars) then
    return false
  end if
  for i=1 to length(vars) do
    if not VarToken(vars[i]) then
      return false
    end if
  end for
  return true
end type

--{Token,children}
type Node(object node)
  if sequence(node) and length(node)=2 and Token(node[1]) and sequence(node[2]) then
    for i=1 to length(node[2]) do
      if not Node(node[2][i]) then
        return false
      end if
    end for
    return true
  else
    return false
  end if 
end type

--sequence of Nodes
type NodeList(object list)
  if not sequence(list) then
    return false
  end if
  for i=1 to length(list) do
    if not Node(list[i]) then
      return false
    end if
  end for
  return true
end type

--An element of all_scripts
type Script(object script)
  if sequence(script) and length(script)>=_SCRIPT_MIN_LAST and length(script)<=_SCRIPT_MAX_LAST then
    return true
  else
    return false
  end if
end type

---------------------------------------------------------------------------

--time spent waiting for a user-keypress shouldnt count
function timeless_wait_key()
  atom skip_time
  integer key
  skip_time=time()
  key=wait_key()
  skip_time=time()-skip_time
  start_time+=skip_time
  for i=1 to length(timing_data) do
    if timing_data[i][TIMING_ACTIVE] then
      timing_data[i][TIMING_TIME]+=skip_time
    end if
  end for
  return(key)
end function

---------------------------------------------------------------------------

--Euphoria's built-in sprintf truncates all string elements to 8 bits,
--so this is an Unicode-enabled replacement. Supports %d, %s, %g, %%
--Beware! This will be way slower than sprintf, but luckily it's not
--needed anywhere where speed matters.
function sprintf_utf(string s, sequence printf_args)
  integer seg_start, seg_end
  integer arg_ctr
  integer code
  string ret
  if length(printf_args)=0 then
    return s
  end if

  ret=""
  arg_ctr=1
  seg_start=1
  seg_end=find('%',s)
  while seg_end do
    ret&=s[seg_start..seg_end-1]
    code=s[seg_end+1]
    if code='s' then
      ret&=printf_args[arg_ctr]
      arg_ctr+=1
    elsif code='d' or code='g' then
      ret&=sprintf({'%',code},printf_args[arg_ctr])
      arg_ctr+=1
    elsif code='%' then
      ret&='%'
    else
      simple_error(sprintf("sprintf_utf: unrecognised format code %%%s\n",{s[seg_end+1]}))
    end if
    seg_start=seg_end+2
    seg_end=find('%',s,seg_start)
  end while
  if seg_start<=length(s) then
    ret&=s[seg_start..$]
  end if

  if arg_ctr!=length(printf_args)+1 then
    simple_error(sprintf("sprintf_utf: recieved %d format arguments, only used %d\n",{length(printf_args),arg_ctr-1}))
  end if
  return ret
end function

---------------------------------------------------------------------------

--fprintf as UTF8
procedure print_utf(object fh, string s, sequence printf_args)
  if length(printf_args) then
    s=sprintf_utf(s,printf_args)
  end if
  s=toUTF(s,utf_32,utf_8)
  puts(fh,s)
end procedure

---------------------------------------------------------------------------

--prints a string with printf to stdout converting color codes
procedure color_print(string s, sequence printf_args)
  string buffer
  s=sprintf_utf(s,printf_args)
  if simple_colorcodes then
    buffer=s
  else
    buffer=""
    for i=1 to length(s) do
      if s[i]>=COL_FIRST and s[i]<=COL_LAST then
        print_utf(stdout,buffer,{})
        buffer=""
        if colors_enabled then
          text_color(HS_TO_EU_COLORS[s[i]-COL_FIRST+1])
        end if
      else
        buffer&=s[i]
      end if
    end for
  end if
  if length(buffer) then
    print_utf(stdout,buffer,{})
  end if
end procedure

---------------------------------------------------------------------------

procedure opt_wait_for_key(integer error_or_warning)
  if (not error_or_warning and find('j',optlist)) or find('k',optlist) then
    --skip
  else
    color_print("[Press Any Key]\n",{})
    timeless_wait_key()
  end if
end procedure

---------------------------------------------------------------------------

procedure enter_timing_zone(string description)
  if not find('t',optlist) then
    return
  end if
  timing_depth+=1
  timing_data=append(timing_data,{timing_depth,description,-time(),true})
end procedure

---------------------------------------------------------------------------

procedure reenter_timing_zone(string description)
  if not find('t',optlist) then
    return
  end if
  for i=1 to length(timing_data) do
    if equal(timing_data[i][TIMING_DESCRIPTION],description) then
      timing_depth+=1
      timing_data[i][TIMING_DEPTH]=timing_depth  --could change...
      timing_data[i][TIMING_TIME]-=time()
      timing_data[i][TIMING_ACTIVE]=true
      return
    end if
  end for
  enter_timing_zone(description)
end procedure

---------------------------------------------------------------------------

procedure exit_timing_zone()
  if not find('t',optlist) then
    return
  end if
  for i=length(timing_data) to 1 by -1 do
    --there can only be one active timing job at each depth at a time
    if timing_data[i][TIMING_ACTIVE] and timing_data[i][TIMING_DEPTH]=timing_depth then
      timing_data[i][TIMING_TIME]+=time()
      timing_data[i][TIMING_ACTIVE]=false
      exit
    end if
  end for
  timing_depth-=1
end procedure

---------------------------------------------------------------------------

procedure print_timing_data()
  string indent
  sequence data
  string tmp1, tmp2
  if run_time=0 then
    --so that all percentages show as 0%
    run_time=1e100
  end if
  for i=1 to length(timing_data) do
    data=timing_data[i]
    indent=repeat(' ',data[TIMING_DEPTH]*4)
    tmp1=sprintf("%.2f",{data[TIMING_TIME]})
    tmp2=sprintf("%5.2g",{100*data[TIMING_TIME]/run_time})
    color_print("%s "&COLBWHI&"%s"&COLWHI&"s %s%%  %s\n",{indent,tmp1,tmp2,data[TIMING_DESCRIPTION]})
  end for
end procedure

---------------------------------------------------------------------------

function html_char_convert(string s)
  string buffer
  string result
  result=""
  buffer=""
  for i=1 to length(s) do
    if s[i]=' ' and i>1 then
      if s[i-1]=' ' then
        buffer&="&nbsp;"
      else
        buffer&=s[i]
      end if
    elsif s[i]='<' then
      buffer&="&lt;"
    elsif s[i]='>' then
      buffer&="&gt;"
    else
      buffer&=s[i]
    end if
  end for
  if length(buffer) then
    result&=buffer
  end if
  return(result)
end function

---------------------------------------------------------------------------

function error_string_convert(string s)
  string buffer
  string result
  result=""
  buffer=""
  for i=1 to length(s) do
    if s[i]>=COL_FIRST and s[i]<=COL_LAST then
      if s[i]=COLYEL then
        buffer&="<font color=\"#F0F000\">"
      elsif s[i]=COLRED then
        buffer&="</font>"
      elsif s[i]=COLPNK then
        buffer&="<font color=\"#F07070\">"
      elsif s[i]=COLWHI then
        buffer&="<font color=\"#909090\">"
      elsif s[i]=COLBWHI then
        buffer&="<font color=\"#F0F0F0\">"
      end if
    elsif s[i]='\n' then
      buffer&="<br>\n"
    else
      buffer&=s[i]
    end if
  end for
  if length(buffer) then
    result&=buffer
  end if
  return(result)
end function

---------------------------------------------------------------------------

--prints a long string wrapped at 80 columns
procedure wrap_print(string s, sequence arguments)
  string outstring
  s=sprintf_utf(s,arguments)
  while length(s) do
    outstring=before_wrap_point(s)
    s=after_wrap_point(s)
    color_print("%s\n",{outstring})
  end while
end procedure

---------------------------------------------------------------------------

procedure error_file_print(string s)
  integer fh
  if error_file then
    fh=open(compiler_dir&"hs_error.htm","a")
    if fh!=failure then
      print_utf(fh,error_string_convert(s)&"\n",{})
      close(fh)
    end if
  end if
end procedure

---------------------------------------------------------------------------

--prints out warning message in red with word wrap
procedure simple_warn(string s)
  sequence pos
  if not find('w',optlist) then
    --do not warn if -w is set
    pos=get_position()
    if pos[2]>1 then
      print_utf(stdout,"\n",{})
    end if
    wrap_print(COLRED&"WARNING: %s"&COLWHI&"\n",{s})
    error_file_print(sprintf_utf("<Font color=\"#FF0000\">WARNING: %s</font>",{html_char_convert(s)}))
    was_warnings = true
  end if
end procedure

---------------------------------------------------------------------------

--prints out an error message in red with word wrap, then aborts
procedure simple_error(string s)
  sequence pos
  pos=get_position()
  if pos[2]>1 then
    print_utf(stdout,"\n",{})
  end if
  wrap_print(COLRED&"ERROR: %s"&COLWHI&"\n",{s})
  error_file_print(sprintf_utf("<font color=\"#FF0000\">ERROR: %s</font>",{html_char_convert(s)}))
  if end_anchor_kludge then
    error_file_print("</a>\n<hr>\n")
  end if
  opt_wait_for_key(true)
  --Custom doesn't check hspeak's error code (due to difficulty retrieving it after spawning),
  --it only checks whether the output .hs file was created.
  if cleanup_dest then
    if dest_file_fh then
      close(dest_file_fh)
    end if
    delete_file(dest_file)
  end if
  abort(1)
end procedure

---------------------------------------------------------------------------

--prints out usage info if not enough arguments
procedure check_arg_count(sequence args)
  if length(args)=2 then
    wrap_print("HamsterSpeak Compiler v%s%s\n",{COMPILER_VERSION,COMPILER_SUB_VERSION})
    wrap_print("(C)2001-%s James Paige, Ralph Versteegen, and the OHRRPGCE Developers\n",{COPYRIGHT_DATE})
    wrap_print("Please read LICENSE.txt for GNU GPL & MIT dual license details and disclaimer of liability",{})
    wrap_print(COLYEL&"%s [-%s] [long-options] source.hss [dest.hs]"&COLWHI&"\n\n",{file_only(args[2]),VALID_OPTIONS})
    color_print("   -f fast mode. Disables some optimization\n",{})
    color_print("   -j don't wait for a keypress when finished if there's no error or warning\n",{})
    color_print("   -k don't wait for a keypress when finished\n",{})
    color_print("   -n don't add debug info, or a copy of the source code, to .hs file\n",{})
    color_print("   -w suppress warnings\n",{})
    color_print("   -u show warnings for unused variables\n",{})
    color_print("   -y overwrite the destination file without asking\n",{})
    color_print("   --incdir <path>\n" &
                "      also search this directory for include files\n",{})
    color_print("   --include <filename>\n" &
                "      include an additional file\n",{})
    color_print("\nAdvanced options (not intended for normal use):\n",{})
    color_print("   -b don't include plotscr.hsd automatically\n",{})
    color_print("   -c colors will be disabled\n",{})
    color_print("   -d dump debug report to hs_debug.txt\n",{})
    color_print("   -s print the name of each plotscript as it is compiled\n",{})
    color_print("     -a same as -s, but printing all scripts\n",{})
    color_print("   -t print detailed timing info (for HSpeak developers)\n",{})
    color_print("   -z write error messages to hs_error.htm\n",{})
    --Undocumented arguments:
    --              --unicode-cols
    --                 used by Hamster Whisper for piped output
    --              --reuse-ids scripts.bin
    --                 Read the provided scripts.bin file from a previous compilation, and reuse script ID mapping
    wrap_print("\nFor more info about HamsterSpeak visit "&COLBWHI&"http://HamsterRepublic.com/ohrrpgce"&COLWHI&"\n",{})
    wrap_print("\nThis is a command-line program. You should either run it from the command-line, or drag and drop your script file onto it. You don't ever need to run HSpeak yourself; Custom will do that for you.\n",{})
    opt_wait_for_key(false)
    abort(0)
  end if
end procedure

---------------------------------------------------------------------------

--Build the lexer tables, which for each code point 0<=i<256, contains the type
--of that character in entry i+1 (have to handle NUL)
--Other characters above code 255 are always LEX_CHAR
procedure init_lexer()
  sequence table_insert

  --main table
  --(\xa0 is non-breaking space)
  table_insert={" (),\n#\t\"[]{}.\xa0",
                {LEX_SPACE,LEX_BEGIN,LEX_END,LEX_COMMA,LEX_NEWLINE,LEX_COMMENT,LEX_SPACE,LEX_STRING,LEX_WARN,LEX_WARN,LEX_WARN,LEX_WARN,LEX_WARN,LEX_SPACE}}
  --by default each character is either binary, or an allowed identifier
  --character. This is for backwards compatibility
  --NOTE the +1!
  lexer_table=repeat(LEX_BINARY,32) & repeat(LEX_CHAR,127-32) & repeat(LEX_BINARY,#A1-127) & repeat(LEX_CHAR,256-#A1)
  for i=1 to length(table_insert[1]) do
    lexer_table[table_insert[1][i]+1]=table_insert[2][i]
  end for
  for i=0 to 9 do
    lexer_table['0'+i+1]=LEX_DIGIT
  end for
  for i=0 to 5 do
    lexer_table['a'+i+1]=LEX_HEXDIGIT
    lexer_table['A'+i+1]=LEX_HEXDIGIT
  end for
  --add the one-character prefix of each operator
  for i=1 to length(separator_list) do
    lexer_table[separator_list[i][1]+1]=LEX_OPERATOR
  end for

  --keyword suffix parsing table
  lexer_table_key2=repeat(LEX_CHAR,256)
  lexer_table_key2[' '+1]=LEX_SPACE
  lexer_table_key2['\t'+1]=LEX_SPACE
  --2nd character of each operator
  for i=1 to length(separator_list) do
    if length(separator_list[i])=2 then
      lexer_table_key2[separator_list[i][2]+1]=LEX_OPERATOR2
    end if
  end for

  --when floating point is added will want a table for number parsing
end procedure

---------------------------------------------------------------------------

--initializes global variables, and generally gets things ready to roll
procedure init()
  sequence args
  integer index
  integer key
  integer fh
  sequence sym

  --Process arguments
  args=command_line()
  compiler_dir=path_only(args[2])
  check_arg_count(args)

  wrap_print("HamsterSpeak Compiler v%s%s\n",{COMPILER_VERSION,COMPILER_SUB_VERSION})

  optlist={}
  index=3
  while index<=length(args) do
    --These are undocumented
    if equal(args[index],"--unicode-cols") then
      simple_colorcodes=true
      args=delete_element(args,index)
    elsif equal(args[index],"--reuse-ids") and index+1<=length(args) then
      color_print(COLWHI&"Reading script IDs from previous compile\n",{})
      reuse_ids=read_scripts_dot_bin(args[index+1])
      args=delete_slice(args,index,index+1)
    elsif equal(args[index],"--include") and index+1<=length(args) then
      additional_includes&={args[index+1]}
      args=delete_slice(args,index,index+1)
    elsif equal(args[index],"--incdir") and index+1<=length(args) then
      include_dir=args[index+1]
      args=delete_slice(args,index,index+1)
    elsif args[index][1]='-' then
      optlist=optlist&hs_lower(args[index][2..length(args[index])])
      args=delete_element(args,index)
    else
      index+=1
    end if
  end while
  for i=1 to length(optlist) do
    if not find(optlist[i], VALID_OPTIONS) then
      simple_warn("Unknown commandline option -" & optlist[i])
    end if
  end for
  check_arg_count(args)
  source_file=normalize_filename(args[3])
  if length(args)>3 then
    dest_file=normalize_filename(args[4])
  else
    dest_file=normalize_filename(alter_extension(source_file,"hs"))
  end if
  if find('f',optlist) then
    fast_mode=true
    color_print("Using fast mode. Some size optimization disabled\n",{})
  end if
  if find('c',optlist) then
    colors_enabled=false
  end if
  if not find('n',optlist) then
    debug_info=true
  end if
  --'x' used by old versions of Hamster Whisper to specify color code format
  --However this clashes with Latin-1 characters and doesn't work with UTF-8 anyway
  --Replaced by --unicode-cols
  --the semi-undocumented command line argument -z writes a file called
  --hs_error.htm formatted for HssEd to read
  if find('z',optlist) then
    error_file=true
    if file_exists(compiler_dir&"hs_error.htm") then
      fh=open(compiler_dir&"hs_error.htm","w")
      if fh!=failure then
        puts(fh,"")
        close(fh)
      end if
    end if
  end if

  wrap_print("Compiling "&COLBWHI&"%s"&COLWHI&" to "&COLBWHI&"%s"&COLWHI&"\n",{source_file,dest_file})
  if file_exists(dest_file) then
    if find(extension_only(dest_file),{"hss","txt"}) then
      simple_error("Refusing to write output to "&dest_file&" because only input files should have hss/txt extension!")
    end if
    if find('y',optlist) then
      --found the -y command line arg, overwrite automatically
    else
      while true do
        --prompt the user to overwrite
        wrap_print("file "&COLBWHI&"%s"&COLWHI&" already exists. Overwrite it? (Y/N)",{dest_file})
        key=timeless_wait_key()
        color_print(" "&COLYEL&"%s"&COLWHI&"\n",{key})

        if hs_lower(key)='y' then
          exit
        elsif hs_lower(key)='n' then
          simple_error("output file overwrite cancelled by user")
        else
          wrap_print(COLYEL&"%s"&COLWHI&"? "&COLYEL&"%s"&COLWHI&"!? How is that Y or N?",{key,hs_upper(key)})
        end if
      end while
    end if
  end if
  --From now on, delete dest_file on error
  cleanup_dest=true

  --Init global data tables
  global_scope=map:new_from_kvpairs({
           {"defineconstant",{KIND_TOPLEVEL,0,0}}
          ,{"definerole"    ,{KIND_TOPLEVEL,0,0}}
          ,{"definetrigger" ,{KIND_TOPLEVEL,0,0}}  --obsolete naming of definerole
          ,{"defineoperator",{KIND_TOPLEVEL,0,0}}
          ,{"globalvariable",{KIND_TOPLEVEL,0,0}}
          ,{"definefunction",{KIND_TOPLEVEL,0,0}}
          ,{"definescript"  ,{KIND_TOPLEVEL,0,0}}
          ,{"plotscrversion",{KIND_TOPLEVEL,0,0}}
          ,{"include"       ,{KIND_TOPLEVEL,0,0}}  --should never appear, in theory
          ,{"cfor"          ,{KIND_UNIMPLEMENTED,0,0}}
          ,{"foreach"       ,{KIND_UNIMPLEMENTED,0,0}}
          ,{"="             ,{KIND_UNIMPLEMENTED,0,0}}
          ,{"elseif"        ,{KIND_FLOW,-1,0}}  --not in flow_list... shouldn't that be a problem?
          ,{"exit"          ,{KIND_FLOW,-1,0}}  --not in flow_list
          --keywords have special case handling
          ,{"subscript"     ,{KIND_KEYWORD,0,0}} --subscript is also in flow_list!
          ,{"variable"      ,{KIND_KEYWORD,0,0}}
          ,{"tracevalue"    ,{KIND_MACRO,0,0}}
          ,{"tracevalueof"  ,{KIND_MACRO,0,0}}
          ,{"showvalueof"   ,{KIND_MACRO,0,0}}
          ,{"assert"        ,{KIND_MACRO,0,0}}
          -- Stray "$"'s are picked up by the lexer (not totally ideal maybe)
        })

  for i=1 to length(flow_list) do
    sym=flow_list[i]
    if map:has(global_scope, sym[PAIR_NAME])=false then  --omit subscript
      map:put(global_scope, sym[PAIR_NAME], {KIND_FLOW,sym[PAIR_NUM],0})
    end if
  end for
  for i=1 to length(math_list) do
    sym=math_list[i]
    map:put(global_scope, sym[PAIR_NAME], {KIND_MATH,sym[PAIR_NUM],0})
  end for
  -- Adding the separators (operators) here prevents them from being used before
  -- defineoperator is handled (either a block before include,plotscr.hsd, or in
  -- e.g. defineconstant)
  for i=1 to length(separator_list) do
    if map:has(global_scope,separator_list[i])=false then  --omit =
      map:put(global_scope,separator_list[i],{KIND_SEPARATOR,i,0})
    end if
  end for
  for i=1 to length(attribute_list) do
    map:put(global_scope,attribute_list[i][ATTR_NAME],{KIND_ATTRIBUTE,i,0})
  end for
  --Append subscript role id (this is needed for scripts.bin)
  script_role_list=append(script_role_list,{-1,"subscript"})
  --Lexer finite state transition tables
  init_lexer()
end procedure

---------------------------------------------------------------------------

--Returns offset component of a srcpos (usually you want to use decode_srcpos_file
--instead if you want to know the file offset)
function srcpos_offset(srcpos pos)
  integer ret
  --It appears to be a Euphoria euc bug that it's necessary to explicitly cast to integer
  ret=floor(pos/power(2,9))
  return ret
end function

---------------------------------------------------------------------------

--Returns length of a srcpos (between 0 and 254)
function srcpos_length(srcpos pos)
  return and_bits(pos,power(2,8)-1)
end function

---------------------------------------------------------------------------

--returns {filenumber,file position} pair, later being 1-based character offset
function decode_srcpos_file(srcpos pos)
  integer len, offset

  --0 is an invalid srcpos
  if pos=0 then
    simple_error("compiler bug: can't decode uninitialised srcpos")
  end if

  integer point
  point=srcpos_offset(pos)
  if not integer(point) or point<=0 then
    simple_error(sprintf("compiler bug: bad srcpos offset %d", {point}))
  end if

  for i=1 to length(file_list) do
    len=length(file_list[i][FILE_TEXT])
    offset=file_list[i][FILE_OFFSET]
    if point<=offset+len then
      return {i,point-offset}
      exit
    end if
  end for
  simple_error(sprintf_utf("compiler bug: can't decode invalid srcpos %d",{pos}))
end function

---------------------------------------------------------------------------

function srcpos_file_number(srcpos pos)
  sequence temp
  temp=decode_srcpos_file(pos)
  return temp[1]
end function

---------------------------------------------------------------------------

--Returns 1-based character number in file
function srcpos_file_offset(srcpos pos)
  sequence temp
  temp=decode_srcpos_file(pos)
  return temp[2]
end function

---------------------------------------------------------------------------

--Combine base/file offset (usually FILE_OFFSET), token offset (in
--characters from start of file counting from 1) and token length into
--a non-virtual a srcpos.  The redundancy between baseoffset and
--offset is for clarity.
function encode_srcpos(integer baseoffset, integer offset, integer len)
  if len > 254 then
    len = 254
  end if
  if offset < 1 or len < 0 then
    --offset 0 is allowed, it refers to the file. But if you wanted it you'd
    --just write file_list[i][FILE_OFFSET]. So disallow it here.
    simple_error(sprintf("Compiler bug! encode_srcpos(%d,%d,%d)\n",{baseoffset,offset,len}))
  end if
  return (baseoffset+offset)*power(2,9)+len
end function

---------------------------------------------------------------------------

--This transforms a srcpos into one marked as virtual. Indicates a roughly relevant position, but
--not something that actually occurs in the source. Use for inserted dummy code
function virtual_pos(srcpos pos)
  return(or_bits(pos,256))
end function

---------------------------------------------------------------------------

--Return just the original text of a token.
--Unlike decode_srcpos, this is quite fast
function get_srcpos_text(srcpos pos)
  integer point, tokenlen, filenum
  sequence temp

  temp=decode_srcpos_file(pos)
  filenum=temp[1]
  point=temp[2]
  tokenlen=srcpos_length(pos)
  if tokenlen=0 then
    return ""
  else
    return file_list[filenum][FILE_TEXT][point..point+tokenlen-1]
  end if
end function

---------------------------------------------------------------------------

--Probably slow: avoid heavy use.
--Returns {file name, line number, column number, token length, line text, token text}: index with POS_*
--Column number returned is 0-based
function decode_srcpos(srcpos pos)
  integer point, tokenlen, filenum, columnnum
  integer lineno, line_start, line_end
  string filetext, linetext, tokentext
  sequence lines
  sequence temp

  if pos=0 then
    simple_error("compiler bug: can't decode uninitialised srcpos")
  end if

  temp=decode_srcpos_file(pos)
  filenum=temp[1]
  point=temp[2]
  tokenlen=srcpos_length(pos)

  --Find the line it's on
  filetext=file_list[filenum][FILE_TEXT]
  lines=file_list[filenum][FILE_LINE_EXTENTS]
  for i=1 to length(lines) do
    if point>=lines[i][PAIR_START] then
      lineno=i
    else
      exit
    end if
  end for

  line_start=lines[lineno][PAIR_START]
  line_end=lines[lineno][PAIR_END]
  linetext=filetext[line_start..line_end]
  -- +1 for 1-based column indexing
  columnnum=point-line_start+1
  if tokenlen=0 then
    tokentext=""
  else
    tokentext=linetext[columnnum..min({length(linetext),columnnum+tokenlen-1})]
  end if

  return({file_list[filenum][FILE_NAME],lineno,columnnum,tokenlen,linetext,tokentext})
end function

---------------------------------------------------------------------------

function form_error_text(string s, srcpos pos)
  integer poscol, poslen, posend
  string posline, line_display
  sequence src_position
  string column_display, caret_display
  integer tab_compensate, token_tab_compensate
  src_position=decode_srcpos(pos)
  --?pos
  --pretty_print(1,src_position,{2})

  posline=src_position[POS_LINETEXT]
  poscol=src_position[POS_COLUMN]
  poslen=src_position[POS_LENGTH]

  --Expand tabs, because we don't know how the terminal displays then.
  line_display=substring_replace(posline,"\t","    ")
  posline&=" "  --Used to point to the newline at the end
  posend=poscol+large(0,poslen-1)
  if posend>length(posline) then  --One past the end of the actual line is allowed
    simple_warn(sprintf_utf("Compiler bug: srcpos past end of line %d", {src_position[POS_LINE]}))
    posend=length(posline)
  end if
  --Count number of tabs in the line before and in the token,
  --so that we can determine their display length
  tab_compensate=3*count('\t',posline[1..poscol-1])
  token_tab_compensate=3*count('\t',posline[poscol..posend])
  caret_display=repeat('^',large(1,poslen)+token_tab_compensate)
  column_display=repeat(' ',poscol-1+tab_compensate)

  error_file_print(sprintf_utf("<a href=\"%s#%d\">\n",{src_position[POS_FILENAME],src_position[POS_LINE]}))
  if length(current_script) then
    return(
      sprintf_utf(
         "in script "&COLYEL&"%s"&COLRED&" on line %d in "&COLPNK&"%s"&COLRED&"\n"
         &COLBWHI&"%s\n"
         &"%s%s\n"
         &COLRED&"%s\n"
        ,{current_script,src_position[POS_LINE],src_position[POS_FILENAME],line_display,column_display,caret_display,s}
      )
    )
  else
    return(
      sprintf_utf(
         "in line %d of "&COLPNK&"%s"&COLRED&"\n"
         &COLBWHI&"%s\n"
         &"%s%s\n"
         &COLRED&"%s\n"
        ,{src_position[POS_LINE],src_position[POS_FILENAME],line_display,column_display,caret_display,s}
      )
    )
  end if
  --note that the calling procedure must send/deal with closing tags to error_file_print
end function

---------------------------------------------------------------------------

procedure src_warn(string s, srcpos pos)
  if not find('w',optlist) then
    --do not warn if -w is set
    simple_warn(form_error_text(s,pos))
    error_file_print("</a>\n<hr>\n")
  end if
end procedure

---------------------------------------------------------------------------

procedure src_error(string s, srcpos pos)
  end_anchor_kludge=true
  simple_error(form_error_text(s,pos))
end procedure

---------------------------------------------------------------------------

--Find newlines in a file (possibly mixed type), returns line extents
--({start of line, end of line} pairs, both inclusive, newlines excluded)
--and the file_text with Mac lineendings converted to Unix, because the engine's
--decode_srcpos expects source.lumped contents don't use Mac lineendings.
--Note also read_file() adds a newline at the end if none.
function split_lines(string file_text)
  integer line_start=1
  integer last_13=-1
  sequence line_extents = {}
  for i=1 to length(file_text) do
    if file_text[i]=13 then
      line_extents=append(line_extents, {line_start,i-1})
      last_13=i
      line_start=i+1
      if i+1<=length(file_text) and file_text[i+1]!=10 then -- A \r lineending
        file_text[i]=10
      end if
    elsif file_text[i]=10 then
      if last_13!=i-1 then  -- handle {13,10} "\r\n"
        line_extents=append(line_extents, {line_start,i-1})
      end if
      line_start=i+1
    end if
  end for

  if line_start<=length(file_text) then
    line_extents=append(line_extents, {line_start,length(file_text)})
  end if
  return {line_extents,file_text}
end function

---------------------------------------------------------------------------

--Read a file, adding to file_list.
--pos is used only for location of include statement, may be 0.
procedure load_source(string filename, string reading_how, srcpos pos)
  integer fh
  string file_text
  sequence line_extents  -- {start of line, end of line} pairs
  integer offset  -- FILE_OFFSET value

  -- First file starts at FILE_OFFSET=1, to ensure srcpos 0 is never used,
  -- and each file's FILE_OFFSET+0 is reserved. First char of first file
  -- has offset 2.
  offset=1
  if length(file_list) then
    offset=file_list[$][FILE_OFFSET]+length(file_list[$][FILE_TEXT])+1
  end if

  fh=open(filename,"r")
  if fh!=failure then
    wrap_print("%s "&COLBWHI&"%s"&COLWHI&"\n",{reading_how,filename})

    reenter_timing_zone("read_file")
    --Autodetect the encoding
    file_text=read_file(fh, TEXT_MODE, UTF)
    exit_timing_zone()
    close(fh)

    sequence temp=split_lines(file_text)
    line_extents=temp[1]
    file_text=temp[2]

    total_lines+=length(line_extents)
    file_list=append(file_list,{filename,file_text,line_extents,offset,""})
    --Maximum valid srcpos points to length 1 virtual token at end of file.
    --max_srcpos is used to do srcpos type checking... so we need to disable that
    --check before we can assign to it!
    max_srcpos=0
    max_srcpos=virtual_pos(encode_srcpos(offset,length(file_text),1))
  else
    if pos then
      src_error(sprintf_utf("file "&COLYEL&"%s"&COLRED&" not found\n",{filename}),pos)
    else
      simple_error(sprintf_utf("file "&COLYEL&"%s"&COLRED&" not found\n",{filename}))
    end if
  end if
end procedure

---------------------------------------------------------------------------

--Load and lex, recursively finding includes
procedure load_and_lex_source(string filename, string reading_how, srcpos pos, sequence include_stack)
  string canon_filename

  --We don't really support \ in paths on Unix.
  canon_filename=normalize_filename(filename)
  ifdef WINDOWS then
    canon_filename=hs_lower(canon_filename)
  end ifdef

  if find(canon_filename,include_stack) then
    src_error(sprintf_utf("File "&COLPNK&"%s"&COLRED&" is being included recursively",{filename}),pos)
  end if
  include_stack&={canon_filename}

  if find(canon_filename,column(file_list,FILE_NAME)) then
    --This exact same include file has already been included.
    --Silently ignore this include. Double includes are allowed because of automatic inclusion.
    --src_warn(sprintf_utf("File "&COLPNK&"%s"&COLRED&" is being included multiple times",{include_name}),pos)
    return
  end if

  --Reads one additional file
  reenter_timing_zone("load_and_lex_source/reading")
  load_source(canon_filename,reading_how,pos)
  exit_timing_zone()
  --Lex that file, and load and lex all included files
  lex_file(length(file_list), include_stack)
end procedure

---------------------------------------------------------------------------

function find_include_file_globally(string include_name)
  if file_exists(compiler_dir&include_name) then
    return normalize_filename(compiler_dir&include_name)
  end if
  --in case we're installed at $prefix/games, try $prefix/share/games/ohrrpgce/
  if file_exists(compiler_dir&"../share/games/ohrrpgce/"&include_name) then
    return normalize_filename(compiler_dir&"../share/games/ohrrpgce/"&include_name)
  end if
  --Failure: return filename, used for error messages
  return include_name
end function

---------------------------------------------------------------------------

--Search for an include file
function find_include_file(string include_name)
  sequence ret
  if equal(include_name,"plotscr.hsd") or equal(include_name,"scancode.hsi") then
    --Prefer to use fundamental include files found in global locations, because
    --plotscr.hsd and scancode.hsi will be exported too, when exporting scripts
    --from Custom.
    return find_include_file_globally(include_name)
  end if
  --try source directory
  if file_exists(path_only(source_file)&include_name) then
    return normalize_filename(path_only(source_file)&include_name)
  end if
  if file_exists(include_dir&include_name) then
    return include_dir&include_name
  end if
  --try current directory (which will be where the .rpg is)
  if file_exists(include_name) then
    return include_name
  end if
  --try global locations
  return find_include_file_globally(include_name)
end function

---------------------------------------------------------------------------

procedure show_source_info()
  if total_lines then
    wrap_print("%d lines read from %d files\n",{total_lines,length(file_list)})
  else
    simple_error("no data to compile\n")
  end if
  if file_list[$][FILE_OFFSET]+length(file_list[$][FILE_TEXT])>power(2,23) then
    simple_warn("You have over 8 MB of scripts! Unfortunately compile and in-game errors will report the wrong line numbers for some errors.")
  end if
end procedure

---------------------------------------------------------------------------

procedure lexer_binary_error(srcpos pos)
  --better use src_error, to track down garbage if accidentally creeping in
  src_error("This file contains binary gunk. Are you sure that this is the text file you want to compile?",pos)
end procedure

---------------------------------------------------------------------------

--Lex a string, processing the escape codes.
--s is the source text (typically whole file contents), i is the starting offset in s,
--1 past the opening ", and stop is last permissible offset in s to include.
--Returns {closing_quote_offset,quoted_string} (i.e. enclosed in quote marks, but with escape codes processed)
function lexer_read_string(string s, integer i, integer stop, integer posoff)
  string string
  integer escaping
  integer at1, at2
  escaping=false
  string="\""
  while true do
    if i>stop then  --did not find a closing " so not a valid string
      src_error("Expected \" at end of line to end string (multi-line strings are not supported)", encode_srcpos(posoff,i,1))
    end if
    if s[i]<256 and lexer_table[s[i]+1]=LEX_BINARY then
      lexer_binary_error(encode_srcpos(posoff,i,1))
    end if
    if escaping then
      if s[i]='"' or s[i]='\\' or s[i]='\'' then
        --including ' for closer compatibility with Python
        string&=s[i]
      elsif s[i]='n' then
        string&=10
      elsif s[i]='t' then
        string&=9
      elsif s[i]='x' then
        --escape 8 bit values (later will add \u and \U for 16 bit and 32 bit escapes)
        at1=0
        at2=0
        if i+2<=stop then
          at1=find(s[i+1],hex_chars)
          at2=find(s[i+2],hex_chars)
        end if
        if at1=0 or at2=0 then
          src_error("Expected two hexidecimal characters to follow \\x escape code",encode_srcpos(posoff,i-1,4))
        end if
        string&={16*hex_char_values[at1]+hex_char_values[at2]}
        i+=2
      else
        --invalid sequence
        string&='\\'
        string&=s[i]
      end if
      escaping=false
    else
      if s[i]='"' then
        return({i,string&'"'})
      elsif s[i]='\\' then
        escaping=true
      else
        string&=s[i]
      end if
    end if
    i+=1
  end while
end function

---------------------------------------------------------------------------

--Lex a signed or unsigned integer literal.
--Returns {newi, text} with text is the string representation of an integer.
function lexer_read_number(string s, integer i, integer stop, integer posoff)
  integer state
  atom val
  integer sign,base
  string text
  integer textstart
  integer textend
  integer digits

  textstart=i
  textend=i
  --Process negative prefix, because it isn't treated as a unary operator
  if s[i]='-' then
    text="-"
    i+=1
    sign=-1
  else
    text=""
    sign=1
  end if
  --Skip whitespace
  while i<=stop and (s[i]=' ' or s[i]='\t') do
    i+=1
  end while
  --Check for base prefix 0x 0o or 0b. No separating space allowed!
  base=10
  if i+1<=stop and s[i]='0' then
    if s[i+1]='x' or s[i+1]='X' then
      base=16
      i+=2
    elsif s[i+1]='o' or s[i+1]='O' then
      base=8
      i+=2
    elsif s[i+1]='b' or s[i+1]='B' then
      base=2
      i+=2
    end if
  end if
  val=0
  digits=0
  while i<=stop do
    if s[i]<256 then
      state=lexer_table[s[i]+1]
    else
      state=LEX_CHAR
    end if
    --color_print("lexing number i=%d %d=%s state %d\n",{i,s[i],{s[i]},state})
    if state=LEX_DIGIT then  --0-9
      integer digit
      digit=s[i]-'0'
      if digit>=base then
        src_error(sprintf_utf("Found digit "&COLYEL&"%s"&COLRED&" which is not permitted in a base-%d number",{s[i],base}),encode_srcpos(posoff,i,1))
      end if
      text&=s[i]
      textend=i
      val=val*base+digit
      digits+=1
    elsif base=16 and state=LEX_HEXDIGIT then  --a-fA-F
      text&=s[i]
      textend=i
      val=val*16+(toLower(s[i])-'a'+10)
      digits+=1
    elsif state=LEX_SPACE then  --yes, allowed in numbers too
    elsif state=LEX_COMMA or state=LEX_BEGIN or state=LEX_END or state=LEX_OPERATOR or state=LEX_COMMENT or state=LEX_BINARY or state=LEX_NEWLINE then
      --backtrack one character
      --FIXME: bug: if this looks like part of a separator (KEYWORD) but isn't, then have granted a free comma where probably should throw an error instead
      i-=1
      exit
    else  --currently, state=LEX_CHAR or state=LEX_HEXDIGIT or state=LEX_WARN or state=LEX_STRING
      if s[i]='.' then
        src_error("Non-whole (decimal) numbers are not yet implemented", encode_srcpos(posoff,textstart,i-textstart+1))
      end if
      if equal(text,"-") then
        exit  --Jumps down to the 'if digits=0' error case
      end if
      src_error(
        sprintf_utf("Found unexpected character "&COLYEL&"%s"&COLRED&" while reading a number, "&COLYEL&"%s"&COLRED&". Names such as variables can't start with a digit. Or maybe you forgot a comma or operator?"
                ,{s[i],text})
        ,encode_srcpos(posoff,i,1)
      )
    end if
    i+=1
  end while
  if digits=0 then
    --Encountered just '-' or '0x' or '-0x' (etc)
    if equal(text,"-") then
      src_error(COLYEL&"-"&COLRED&" can only be used to take the negation of a number, not other values/expressions (sorry!). Write "&COLYEL&"-1 * ..."&COLRED&" instead. Write "&COLYEL&"x -- y"&COLRED&" for subtraction.", encode_srcpos(posoff, textstart, 1))
    else
      src_error(sprintf_utf(COLYEL&"%s"&COLRED&" looks like the start of a number, but there are no digits!",{s[textstart..i-1]}), encode_srcpos(posoff, textstart, i-textstart+1))
    end if
  end if
  if base!=10 then
    --Special behaviour for non-decimals: silently overflow large 32 bit unsigned values to negatives
    if val>=#80000000 and val<#100000000 then
      val=val-#100000000
    end if
    --Convert to text
    text=sprintf("%d",{sign*val})
  end if
  if not int32(sign*val) then
    src_error(sprintf_utf(COLYEL&"%s"&COLRED&" is too big to be stored in a 32-bit signed integer. Numbers must be between -2147483648 and 2147483647",{text}),encode_srcpos(posoff,textstart,textend-textstart+1))
  end if
  return({textend,text})
end function

---------------------------------------------------------------------------

--Clean the rest of a line for seek_include after 'include' occurs
--s is the whole line, i is end of the 'include', posoff is the file position at start of line
function lexer_read_include_line(TokenList tokens, string s, integer i, integer stop, integer posoff)
  integer at
  integer whitespace_len
  sequence temp
  string filename_string
  srcpos pos
  integer isquoted

  if not equal(tokens[1][CMD_TEXT],"include") then
    src_error(COLYEL&"include"&COLRED&" must be the only statement on the line. Maybe you tried to use this reserved keyword illegally?",tokens[$][CMD_POS])
  end if

  filename_string=""
  --Trim the 'include', comments, and whitespace,
  i+=1  --Skip the comma or whatever character ended the 'include'
  s=s[i..stop]
  if length(s) then
    --Need to increment i while stripping
    while s[1]=' ' or s[1]='\t' do
      s=s[2..length(s)]
      i+=1
    end while
    whitespace_len=0
    --Optionally allow quotes around the filename.
    --A quote mark in the middle of a filename doesn't need any escaping
    isquoted=(s[1]='"')
    if isquoted then
      temp=lexer_read_string(s,2,length(s),posoff+i-1)
      -- temp is {closing_quote_offset,quoted_string}
      pos=encode_srcpos(posoff,i,temp[1])

      s=s[temp[1]+1..$]
      --s is now whatever is after the string
      i+=temp[1]  --1 past the closing "
      filename_string=temp[2]  --enclosed in quotes
      whitespace_len=length(s)

      --Trim comment and whitespace to check for anything after the filename string
      at=find('#',s)
      if at then
        s=s[1..at-1]
        whitespace_len=at-1
      end if
      s=trim_whitespace(s)
      if length(s) then
        src_error("Found unexpected text after "&COLYEL&"include, \"filename\""&COLRED,encode_srcpos(posoff,i,whitespace_len))
      end if

    else
      --Trim comment and whitespace: for an unquoted filename this delimits the filename
      at=find('#',s)
      if at then
        s=s[1..at-1]
      end if
      s=trim_whitespace(s)  --Trims only from the right because we already striped left

      filename_string=s
      pos=encode_srcpos(posoff,i,length(s))
    end if

    tokens=append(tokens,{filename_string,pos})
  end if

  if length(tokens)=1 then
    src_error("Expected name of file to follow "&COLYEL&"include"&COLRED,tokens[1][CMD_POS])
  end if
  if length(tokens)>2 then
    src_error(sprintf_utf("Found unexpected syntax "&COLYEL&"%s"&COLRED&" instead of filename to include. Syntax of an include statement is "&COLYEL&"include, filename"&COLRED&" possibly with a path",{tokens[2][CMD_TEXT]}),tokens[2][CMD_POS])
  end if

  return(tokens)
end function

---------------------------------------------------------------------------

-- s is usually the text for the whole file, the interval i..stop is a single line,
-- and posoff is the srcpos offset for the beginning of the file
function lex_line(sequence s, integer i, integer stop, integer posoff)
  integer state
  TokenList tokens
  string ident  --identifier text being built up
  sequence temp
  string masked
  integer found
  integer textstart  --the offset at which this identifier starts, otherwise 0
  integer textend    --the offset at which the last non-whitespace character was read
  string remem_ident
  integer remem_textstart
  integer backtracked
  integer last_state   --A LEX_* constant; the last state that was not LEX_SPACE
  integer last_state_i --Value at i where last_state was set

  ident=""
  last_state=LEX_NEWLINE
  last_state_i=0
  textstart=0
  tokens={}

  --pretty_print(stdout, {"lex_line posoff: ", posoff, "i:", i, "srcpos:", decode_srcpos(encode_srcpos(posoff,i,0))}, {2})

  while i<=stop do
    if s[i]<256 then
      state=lexer_table[s[i]+1]
    else
      state=LEX_CHAR  --other unicode
    end if
    --color_print("lexing i=%d %d=%s state %d ident=%s\n",{i,s[i],{s[i]},state,ident})
    if state=LEX_CHAR or state=LEX_HEXDIGIT then
      ident=ident & toLower(s[i])
      if textstart=0 then
        textstart=i
      end if
      textend=i
    elsif state=LEX_SPACE then
    elsif state=LEX_DIGIT then
      if length(ident) then
        ident=ident & s[i]
        textend=i
      else
        --Start of a number not starting with - (those are parsed below)
        temp=lexer_read_number(s,i,stop,posoff)  --{offset of end of number, number string}
        tokens=append(tokens,{temp[2],encode_srcpos(posoff,i,temp[1]-i+1)})
        i=temp[1]
      end if
    elsif state=LEX_WARN then
      ident=ident & toLower(s[i])
      if textstart=0 then
        textstart=i
      end if
      textend=i
      src_error(sprintf_utf(COLYEL&"%s"&COLRED&" is reserved and not allowed in names (identifiers)!", {s[i]}), encode_srcpos(posoff,i,1))
    else
      --We've reached the end of a token... unless it's only the first character
      --of a two-character operator.
      remem_ident=ident  --for backtracking
      remem_textstart=textstart
      backtracked=false
      if length(ident) then
        tokens=append(tokens,{ident,encode_srcpos(posoff,textstart,textend+1-textstart)})
      end if
      ident=""
      textstart=0
      if state=LEX_BEGIN then  --(
        tokens=append(tokens,{"begin",encode_srcpos(posoff,i,1)})
      elsif state=LEX_END then  --)
        if last_state=LEX_COMMA then
          --foo(1,). This probably doesn't particularly need to be disallowed
          --Could also check for <op>) but that will be caught later
        end if
        tokens=append(tokens,{"end",encode_srcpos(posoff,i,1)})
      elsif state=LEX_COMMA then
        --Check we didn't just finish an identifier, to allow using : (which is LEX_OPERATOR) on the end of an identifier.
        if length(remem_ident)=0 and (last_state=LEX_COMMA or last_state=LEX_BEGIN or last_state=LEX_OPERATOR or last_state=LEX_OPERATOR2) then
          --foo(, 1) or foo(1, , 2) or <op>, but not ),
          src_error(
            sprintf_utf("Found an extra comma which previous HSpeak versions ignored, but which might have a different meaning in the future. Remove it.",{}),
            encode_srcpos(posoff,i,1))
        end if
      elsif state=LEX_NEWLINE then
      elsif state=LEX_COMMENT then
        exit
      elsif state=LEX_STRING then
        temp=lexer_read_string(s,i+1,stop,posoff)  --{final offset, string}
        tokens=append(tokens,{temp[2],encode_srcpos(posoff,i,temp[1]-i+1)})
        i=temp[1]
      elsif state=LEX_OPERATOR then
        --A character which the start of some auto-separating sequence such as +=.
        --Read the next non-space character. If it's LEX_OPERATOR2 we greedily
        --add it, otherwise we do nothing (we only support length 1 and 2
        --separators).  However, we might have have been too greedy (not a value
        --two-char separator), and need to put it back.
        textstart=i
        masked=s[i..i]
        integer lookahead_state
        --This while loop is in order to allow whitespace in the middle of separators.
        while i<stop do
          i+=1
          if s[i]<256 then
            lookahead_state=lexer_table_key2[s[i]+1]
          else
            lookahead_state=LEX_CHAR
          end if
          if lookahead_state=LEX_OPERATOR2 then
            --Could be a second character. Stop
            masked&=s[i]
            exit
          elsif lookahead_state=LEX_CHAR then
            --includes binary gunk, warning characters and comments
            i-=1
            exit
          end if
          --otherwise, it's a space character
        end while
        --now i+1 is the start of another token, or is > stop
        --Lookup for separators which are prefixes of masked
        found=false
        for j=1 to length(separator_list) do
          if match(separator_list[j],masked)=1 then
            --very ugly
            if length(separator_list[j])=1 then
              --Backtrack if necessary to first character in masked, otherwise remain at second
              i=textstart
            end if
            tokens=append(tokens,{separator_list[j],encode_srcpos(posoff,textstart,i-textstart+1)})
            found=true
            exit
          end if
        end for
        if found=false then
          --need to backtrack, in particular for -
          --color_print("backtracking on '%s'\n", {masked})
          backtracked=true
          ident=remem_ident & masked[1]
          i=textstart
          if length(remem_ident) then
            --This character appeared inside a normal token, resume reading that token
            tokens=tokens[1..$-1]
            textstart=remem_textstart
          elsif equal(ident,"-") then
            --'-' appears at the start of a token: this is only allowed to be a number.
            --We haven't appended anything to tokens that needs removing.
            ident=""
            temp=lexer_read_number(s,i,stop,posoff)
            tokens=append(tokens,{temp[2],encode_srcpos(posoff,i,temp[1]-i+1)})
            i=temp[1]
            textstart=0
            state=LEX_DIGIT  --Sensible last_state to avoid 'extra comma' error
          else
            --a keyword character followed by garbage
            src_error(
              "Expected a two-character operator (like "&COLYEL&":="&COLRED&") but the second character (e.g. "&COLYEL&"="&COLRED&") is missing",
              encode_srcpos(posoff,i,1))
          end if
        else
          textstart=0
          if last_state=LEX_COMMA then
            -- ,<op>
            --(Could check for (<op> but that will be detected later anyway.)
            --Allowed if it's a unary operator. There's only one, since - is not an operator.
            if s[i]!='$' then
              src_error(
                "Found an extra comma which previous HSpeak versions ignored, but which might have a different meaning in the future. Remove it.",
                encode_srcpos(posoff,last_state_i,1))
            end if
          end if
        end if
      elsif state=LEX_BINARY then
        lexer_binary_error(encode_srcpos(posoff,i,1))
      end if
      if backtracked=false then
        if equal(remem_ident,"include") then
          --include is a special case, as normal lexing rules don't apply for rest of line
          if length(ident) then
            simple_error("compiler bug! [before lexer_read_include_line]\n")
          end if
          return lexer_read_include_line(tokens,s,i,stop,posoff)
        end if
      end if
      --End of a complete token
    end if
    if state!=LEX_SPACE then
      last_state_i=i
      last_state=state
    end if
    i+=1
  end while
  if length(ident) then
    --ought to check whether ident is 'include'...
    tokens=append(tokens,{ident,encode_srcpos(posoff,textstart,textend+1-textstart)})
  end if
  return(tokens)
end function

---------------------------------------------------------------------------

--this also checks for rogue strings and $'s
function translate_plotstrings(TokenList tokens)
  integer state
  integer start_token
  integer i
  Token string_func
  Token string_token
  srcpos pos,vpos
  state=0
  i=1
  while i<=length(tokens) do
    if compare(tokens[i][CMD_TEXT],"$")=0 then
      pos=tokens[i][CMD_POS]
      vpos=virtual_pos(pos)
      if state=0 then
        state=1
        start_token=i
      else
        --jump to error throw
        state=1
        exit
      end if
    end if
    if state=2 then
      if tokens[i][CMD_TEXT][1]='"' then
        string_list=append(string_list,tokens[i][CMD_TEXT][2..$-1])
        string_token={sprintf("@$string%d",{length(string_list)}),tokens[i][CMD_POS]}
        tokens=tokens[1..start_token-1]&{string_func,{"begin",vpos}}&tokens[start_token+1..i-2]&{string_token,{"end",vpos}}&tokens[i+1..$]
        state=0  --may have multiple strings on one line
      else  --we saw a + (or illegal =) inside the string number expression
        state=1
      end if
    end if
    if state=1 and compare(tokens[i][CMD_TEXT],"=")=0 then
      string_func={"setstringfromtable",pos}
      state=2
    elsif state=1 and compare(tokens[i][CMD_TEXT],"+")=0 then
      string_func={"appendstringfromtable",pos}
      state=2
    end if
    i+=1
  end while

  if state!=0 then
    --we've seen a surplus $, not right
    src_error(COLYEL&"$"&COLRED&" may only be used as part of a $...=\"...\" or $...+\"...\" construct",pos)
  end if
  return(tokens)
end function

---------------------------------------------------------------------------

--Given a command tree, get the original text from the file
--OK, this function is horribly complicated just so tracevalue can print
--"hero X (me)" instead of "herox(me)". It could be implemented much simpler if
--macros were expanded in the lexer, but then build_ast and
--convert_macros would have to be as well
function tree_original_text(Node tree)
  TokenList script_toks
  Node subtree
  srcpos leftmost, rightmost
  integer left_at, right_at
  integer filenum
  integer left_point, right_point
  integer depth
  TokenList tokens
  string text

  script_toks=all_scripts[cur_script_num][SCRIPT_BODY_TOKS]

  --Find leftmost and rightmost tokens making up the expression, not including brackets
  --(Do we care about virtual flags?)
  --NOTE: we're making an assumption about srcpos encoding here, that
  --if token A begins before token B, then srcpos A < srcpos B

  leftmost=tree[TREE_TRUNK][CMD_POS]
  subtree=tree
  while length(subtree[TREE_BRANCHES]) do
    subtree=subtree[TREE_BRANCHES][1]
    if subtree[TREE_TRUNK][CMD_POS]<leftmost then
      leftmost=subtree[TREE_TRUNK][CMD_POS]
    end if
  end while

  rightmost=tree[TREE_TRUNK][CMD_POS]
  subtree=tree
  while length(subtree[TREE_BRANCHES]) do
    subtree=subtree[TREE_BRANCHES][$]
    rightmost=subtree[TREE_TRUNK][CMD_POS]
  end while

  --grab those tokens from the script's token list
  left_at=find_in_column(leftmost,script_toks,CMD_POS)
  right_at=find_in_column(rightmost,script_toks,CMD_POS)
  tokens=script_toks[left_at..right_at]
  --pretty_print(stdout,{"tree_original_text tokens: ",tokens},{2})

  --keep grabbing extra tokens until brackets are balanced
  --note: this will read 'foo(bar())' but will read 'foo()' as 'foo'
  depth=count("begin",column(tokens,CMD_TEXT))-count("end",column(tokens,CMD_TEXT))
  if depth<0 then
    src_error("Compiler bug: negative depth in tree_original_text",tokens[1][CMD_POS])
  end if
  while depth do
    right_at+=1
    if equal(script_toks[right_at][CMD_TEXT],"begin") then
      depth+=1
    else  --only other possibility is "end"
      depth-=1
    end if
  end while

  --grab original text corresponding to this range of tokens
  filenum=srcpos_file_number(leftmost)
  left_point=srcpos_file_offset(leftmost)

  --this +1 is safe, guaranteed to be followed by either another argument or "end"
  right_point=srcpos_file_offset(script_toks[right_at+1][CMD_POS])
  text=file_list[filenum][FILE_TEXT][left_point..right_point-1]
  --pretty_print(stdout, {"tree_original_text left/right_point:", left_point, right_point, "text:", text, decode_srcpos(leftmost)},{2})

  --NOTE: should be able to make use of srcpos lengths instead. (Again, how to handle virtuals?)

  --clean up the grabbed text
  text=trim_whitespace(substitute(text,'\n',','))
  while find(text[$],", \t") do
    text=text[1..$-1]
  end while

  return(text)
end function

---------------------------------------------------------------------------

function seek_include(TokenList tokens)
  string ret
  if length(tokens) and equal(tokens[1][CMD_TEXT],"include") then
    if length(tokens)=1 or length(tokens[2][CMD_TEXT])=0 then
      src_error(COLYEL&"include"&COLRED&" is a keyword which should be followed on the same line by the filename to include",tokens[1][CMD_POS])
    end if
    ret=tokens[2][CMD_TEXT]
    if ret[1]='"' then
      --trim quote marks
      ret=ret[2..$-1]
    end if
    return(ret)
    -- --Alternatively use original text (escape sequences won't work)... so might be useful on Wdinwos
    -- srcdata=decode_srcpos(s[at+1][CMD_POS])
    -- return(srcdata[POS_LINETEXT][srcdata[POS_COLUMN]+1..srcdata[POS_COLUMN]+srcdata[POS_LENGTH]])
  end if
  return("")
end function

---------------------------------------------------------------------------

procedure lex_file(integer file_num, sequence include_stack)
  TokenList broken
  string include_name
  sequence lines
  integer posoff
  -- object temp
  posoff=file_list[file_num][FILE_OFFSET]

  lines=file_list[file_num][FILE_LINE_EXTENTS]
  for i=1 to length(lines) do
    broken=lex_line(file_list[file_num][FILE_TEXT],lines[i][PAIR_START],lines[i][PAIR_END],posoff)

    -- for j=1 to length(broken) do
    --   temp = decode_srcpos(broken[j][CMD_POS])
    --   pretty_print(stdout,{broken[j][CMD_TEXT], temp},{2})
    -- end for

    include_name=seek_include(broken)
    if length(include_name) then
      load_and_lex_source(find_include_file(include_name),"including",broken[2][CMD_POS],include_stack)
    else
      --this is probably not the best place to do this translation, but for now we simply emulate old string translation
      --this also checks for stray strings and $'s
      cmd&=translate_plotstrings(broken)
    end if
  end for
end procedure

---------------------------------------------------------------------------

procedure load_and_lex_all()
  enter_timing_zone("Loading & lexing files")
  if find('b',optlist)=0 then
    load_and_lex_source(find_include_file("plotscr.hsd"),"reading",0,{})
  end if
  --Load any additional includes first, because it is almost certainly
  --an exported .hsi of constants. Due to the two-pass parsing
  --the order of includes matters for almost nothing aside from defineconstant,
  --eg including the .hsi first allows "defineconstant(song:foobar, victory song)"
  for i=1 to length(additional_includes) do
    load_and_lex_source(additional_includes[i],"reading",0,{})
  end for
  --Load the main file
  load_and_lex_source(source_file,"reading",0,{})
  exit_timing_zone()
end procedure

---------------------------------------------------------------------------

--Warning: you normally want to use check_undefined_string instead of this
--This does not check whether s is defined as a constant, subscript, or local variable,
--and may miss scripts too.
procedure check_for_reserved(string s, srcpos pos, string expect)
  string extra
  Symbol sym
  sequence src_position
  if map:has(global_scope,s) then
    extra=""
    sym=map:get(global_scope,s)
    if sym[SYM_POS] then
      src_position=decode_srcpos(sym[SYM_POS])
      extra&=sprintf_utf(
          " (which was declared on line %d in "&COLPNK&"%s"&COLRED&")"
          ,{src_position[POS_LINE],src_position[POS_FILENAME]}
        )
    end if
    if equal("top-level declaration",expect) then
      extra&=". Perhaps there is an extra "&COLYEL&"end"&COLRED&" or "&COLYEL&")"&COLRED&" earlier in the file"
    end if
    src_error(
      sprintf_utf(
        "Expected %s, but found %s "&COLYEL&"%s"&COLRED&"%s"
        ,{expect, KIND_LONGNAMES[sym[SYM_KIND]], s, extra}
      )
      ,pos
    )
  end if
end procedure

---------------------------------------------------------------------------

procedure mustnt_be_a_number(Token s)
  --note that identifiers are allowed to start with -
  if length(exclude(s[CMD_TEXT],"-0123456789"))=0 and count('-',s[CMD_TEXT])!=length(s[CMD_TEXT]) then
    --Work backwards to figured out if constant substitution has occurred on s[CMD_TEXT]
    sequence src_position
    sequence const_src_position
    string original_text
    string msg
    src_position=decode_srcpos(s[CMD_POS])
    original_text=src_position[POS_TOKTEXT]

    object const_data
    const_data=map:get(constant_list,original_text,{})
    if length(const_data) then
      const_src_position=decode_srcpos(const_data[CONST_POS])
      msg=sprintf_utf("Expected a name, but found "&COLYEL&"%s"&COLRED&" which is defined as a constant on line %d of "&COLPNK&"%s"&COLRED&" with the value "&COLYEL&"%d"&COLRED,
                      {
                        original_text,
                        const_src_position[POS_LINE],
                        const_src_position[POS_FILENAME],
                        const_data[CONST_VALUE]
                      })
    else
      msg="Expected a name, but found a number "&COLYEL &s[CMD_TEXT] &COLRED
    end if

    src_error(msg, s[CMD_POS])
  end if
end procedure

---------------------------------------------------------------------------

procedure check_undefined_constant(Token s, atom value)
   sequence const_data
   sequence src_position
   string err_string
   string whats_happening
   if map:has(constant_list,s[CMD_TEXT]) then
     --constant is already defined
     const_data=map:get(constant_list,s[CMD_TEXT])
     src_position=decode_srcpos(const_data[CONST_POS])
     if const_data[CONST_VALUE]=value then
       whats_happening="will be ignored because"
     else
       whats_happening="is being redefined;"
     end if
     err_string=sprintf_utf("Constant "&COLYEL&"%s"&COLRED&" %s it is already defined in line %d of "&COLPNK&"%s"&COLRED&" with the value "&COLYEL&"%d"&COLRED
                   ,{
                      s[CMD_TEXT]
                     ,whats_happening
                     ,src_position[POS_LINE]
                     ,src_position[POS_FILENAME]
                     ,const_data[CONST_VALUE]
                   }
                )
     if const_data[CONST_VALUE]=value then
       src_warn(err_string,s[CMD_POS])
     else
       src_error(err_string,s[CMD_POS])
     end if
     --if it's in constant_list, then it's also in global_scope.
   else
     check_for_reserved(s[CMD_TEXT],s[CMD_POS],"constant name")
   end if
   mustnt_be_a_number(s)
end procedure

---------------------------------------------------------------------------

--Check whether an identifier is unused and available. If cur_script_num is set, also
--checks local variables and subscripts in the current scope, but not nonlocal vars.
procedure check_undefined_string(Token s, string expect)
  sequence src_position
  integer at

  --Check global_scope
  check_for_reserved(s[CMD_TEXT],s[CMD_POS],expect)
  --Check constant_list and for number literals
  mustnt_be_a_number(s)

  --Search for an in-scope subscript of that name (subscripts aren't shadowed)
  --Also, when check_for_reserved is called from inside parse_script, script names haven't been added to global_scope yet
  --so non-subscripts are missed by check_for_reserved.
  at=lookup_scoped_script_name(s[CMD_TEXT])
  if at then
    src_position=decode_srcpos(all_scripts[at][SCRIPT_POS])
    src_error(
      sprintf_utf(
        COLYEL&"%s"&COLRED&" can't be used as a %s because it's already declared as a %s on line %d of "&COLPNK&"%s"&COLRED,
        {s[CMD_TEXT], expect, all_scripts[at][SCRIPT_ROLE_TOK][CMD_TEXT],
         src_position[POS_LINE], src_position[POS_FILENAME]}
      )
      ,s[CMD_POS]
    )
  end if

  if cur_script_num!=0 then
    --Search for a local with that name. Ignore non-locals because they are allowed to be shadowed.
    VarList local_vars
    --Might be in the middle of building this script and not have SCRIPT_VARIABLES yet
    if length(all_scripts[cur_script_num]) >= SCRIPT_VARIABLES then
      local_vars=all_scripts[cur_script_num][SCRIPT_VARIABLES]
      for idx=1 to length(local_vars) do
        if equal(local_vars[idx][CMD_TEXT],s[CMD_TEXT]) then
          if local_vars[idx][VAR_FRAME]=0 then  --is local
            src_position=decode_srcpos(local_vars[idx][CMD_POS])
            src_error(
              sprintf_utf(
                COLYEL&"%s"&COLRED&" can't be used as a %s because it's already defined as a local variable/argument on line %d of "&COLPNK&"%s"&COLRED,
                {s[CMD_TEXT],expect,src_position[POS_LINE],src_position[POS_FILENAME]}
              )
              ,s[CMD_POS]
            )
          end if
        end if
      end for
    end if
  end if
end procedure

---------------------------------------------------------------------------

function force_16_bit(atom n, srcpos pos)
  if n>32767 then
    src_warn(sprintf_utf("number "&COLYEL&"%d"&COLRED&" is out of range for a 16-bit signed integer, and will be truncated to "&COLYEL&"32767"&COLRED,{n}),pos)
    n=32767
  elsif n<-32768 then
    src_warn(sprintf_utf("number "&COLYEL&"%d"&COLRED&" is out of range for a 16-bit signed integer, and will be truncated to "&COLYEL&"-32768"&COLRED,{n}),pos)
    n=-32768
  end if
  return(n)
end function

---------------------------------------------------------------------------

function try_string_to_number(Token s)
  atom result
  result=floor(string_to_object(s[CMD_TEXT],0))
  if not string_is_int32(s[CMD_TEXT]) then
    src_error(sprintf_utf("Expected number but found "&COLYEL&"%s"&COLRED,{s[CMD_TEXT]}),s[CMD_POS])
  end if
  return(result)
end function

---------------------------------------------------------------------------

function enforce_constants(string s)
  --enforces both constants
  object v
  v=map:get(constant_list,s,{})
  if length(v) then
    v=v[CONST_VALUE]
    if int32(v) then
      return(sprintf("%d",{v}))
    end if
  end if
  return(s)
end function

---------------------------------------------------------------------------

function get_cmd()
  Token result
  if get_cmd_pointer>length(cmd) then
    src_error("Unexpected end of file",cmd[length(cmd)][CMD_POS])
  end if
  result=cmd[get_cmd_pointer]
  get_cmd_pointer+=1
  result[CMD_TEXT]=enforce_constants(result[CMD_TEXT])
  return(result)
end function

---------------------------------------------------------------------------

function get_cmd_no_constants()
  Token result
  if get_cmd_pointer>length(cmd) then
    src_error("Unexpected end of file",cmd[length(cmd)][CMD_POS])
  end if
  result=cmd[get_cmd_pointer]
  get_cmd_pointer+=1
  result[CMD_TEXT]=result[CMD_TEXT]
  return(result)
end function

---------------------------------------------------------------------------

--Returns a list of tokens enclosed in begin,end, with no nested begin,end allowed.
function get_cmd_block(integer convert_constants)
  Token this
  TokenList result
  result={}
  this=get_cmd()
  if compare("begin",this[CMD_TEXT])!=0 then
    src_error(sprintf_utf("Expected "&COLYEL&"begin"&COLRED&" or "&COLYEL&"("&COLRED&" bracket but found "&COLYEL&"%s"&COLRED,{this[CMD_TEXT]}),this[CMD_POS])
  end if
  while true do
    if convert_constants then
      this=get_cmd()
    else
      this=get_cmd_no_constants()
    end if
    if compare("begin",this[CMD_TEXT])=0 then
      src_error("Recursive "&COLYEL&"begin"&COLRED&" and "&COLYEL&"("&COLRED&" brackets are not permitted in this block",this[CMD_POS])
    elsif compare("end",this[CMD_TEXT])=0 then
      exit--break out of the while
    else
      result=append(result,this)
    end if
  end while
  return(result)
end function

---------------------------------------------------------------------------

--Get a block containing balanced begin,end pairs.
--Returns {ptr,TokenList}
--Initial ptr is 1 if we already grabbed the opening 'begin'.
function get_cmd_depth(integer ptr, TokenList data, integer depth)
  TokenList result
  Token this
  result={}
  while true do
    --if get_key()=27 then abort(1/0) end if
    if ptr>length(data) then
      src_error("block ended prematurely. Missing "&COLYEL&"end"&COLRED&" or "&COLYEL&")"&COLRED&"?",data[length(data)][CMD_POS])
    end if
    this=data[ptr]
    ptr+=1
    if compare("end",this[CMD_TEXT])=0 then
      depth-=1
    elsif compare("begin",this[CMD_TEXT])=0 then
      depth+=1
    end if
    if depth=0 then
      exit --break out of the while
    else
      result=append(result,this)
    end if
  end while
  return({ptr,result})
end function

---------------------------------------------------------------------------

--Like get_cmd_block, but allowed to contain balanced begin,end pairs.
function get_cmd_block_nestable(integer convert_constants)
  sequence ptr_and_block
  TokenList block
  ptr_and_block=get_cmd_depth(get_cmd_pointer,cmd,0)
  get_cmd_pointer=ptr_and_block[1]
  block=ptr_and_block[2][2..$]  --trim leading begin
  if convert_constants then
    for i=1 to length(block) do
      block[i][CMD_TEXT]=enforce_constants(block[i][CMD_TEXT])
    end for
  end if
  return block
end function

---------------------------------------------------------------------------

procedure parse_constant_block(TokenList block)
  atom num
  string name
  srcpos pos
  for i=1 to length(block) by 2 do
    if i+1>length(block) then
      src_error("Expected name to follow but defineconstant block ended",block[i][CMD_POS])
    end if
    num=try_string_to_number({enforce_constants(block[i][CMD_TEXT]),block[i][CMD_POS]})
    check_undefined_constant(block[i+1],num)
    name=block[i+1][CMD_TEXT]
    pos=block[i+1][CMD_POS]
    map:put(constant_list,name,{num,pos})
    map:put(global_scope,name,{KIND_CONSTANT,num,pos})
  end for
end procedure

---------------------------------------------------------------------------

procedure parse_role_block(TokenList block)
  integer num
  string name
  srcpos pos
  for i=1 to length(block) by 2 do
    if i+1>length(block) then
      src_error("Expected name but define role block ended",block[i][CMD_POS])
    end if
    num=force_16_bit(try_string_to_number(block[i]),block[i][CMD_POS])
    check_undefined_string(block[i+1],"script role name")
    name=block[i+1][CMD_TEXT]
    pos=block[i+1][CMD_POS]
    script_role_list=append(script_role_list,{num,name})
    map:put(global_scope,name,{KIND_TOPLEVEL,0,pos})
  end for
end procedure

---------------------------------------------------------------------------

procedure parse_version_block(TokenList block)
  string req_version
  if length(block)<2 then
    --Don't have a srcpos
    simple_error(COLYEL&"plotscr.hsd"&COLRED&" is malformed (empty 'plotscr version' block)")
  end if
  plotscr_version=block[1][CMD_TEXT] --version ID of this plotscr.hsd version (equal to the version of HSpeak at the time)
  req_version=block[2][CMD_TEXT] --the minimum version of HSpeak which supports this plotscr.hsd
  --trim quote marks
  if plotscr_version[1]!='"' or req_version[1]!='"' then
    simple_error(COLYEL&"plotscr.hsd"&COLRED&" is malformed (expected strings in 'plotscr version')")
  end if
  plotscr_version=plotscr_version[2..$-1]
  req_version=req_version[2..$-1]
  if compare(plotscr_version, MIN_PLOTSCR_VERSION) < 0 then
    simple_error("You have included a copy of "&COLYEL&"plotscr.hsd"&COLRED&" (version "&trim_whitespace(plotscr_version)&") from an old release of the OHRRPGCE. Please use the copies of plotscr.hsd and HSpeak provided with the OHRRPGCE.")
  end if
  --printf(stdout,"'%s' '%s'\n", {req_version, COMPILER_VERSION&COMPILER_SUB_VERSION})
  if compare(req_version, COMPILER_VERSION&COMPILER_SUB_VERSION) > 0 then
    simple_error("You have included a copy of "&COLYEL&"plotscr.hsd"&COLRED&" (version "&trim_whitespace(plotscr_version)&") from a newer version of the OHRRPGCE than supported by this version of HSpeak. Please use the copies of plotscr.hsd and HSpeak provided with the OHRRPGCE.")
  end if
end procedure

---------------------------------------------------------------------------

procedure create_global(atom id, string name, srcpos pos)
  integer at
  at=find(id,global_list[PAIR_NUM])
  if at then
    src_error(sprintf_utf("global variable ID "&COLYEL&"%d"&COLRED&" is already defined as "&COLYEL&"%s"&COLRED,{id,global_list[PAIR_NAME][at]}),pos)
  else
    if id>=0 and id<=MAXGLOBAL then
      global_list[PAIR_NUM]=append(global_list[PAIR_NUM],id)
      global_list[PAIR_NAME]=append(global_list[PAIR_NAME],name)
      global_list[GLB_POS]=append(global_list[GLB_POS],pos)
      map:put(global_scope,name,{KIND_GLOBAL,id,pos})
    else
      src_error(sprintf_utf("global variable ID "&COLYEL&"%d"&COLRED&" is not permitted. Valid IDs are 0 to %d",{id,MAXGLOBAL}),pos)
    end if
  end if
end procedure

---------------------------------------------------------------------------

procedure parse_global_block(TokenList block)
  atom num
  for i=1 to length(block) by 2 do
    if i+1>length(block) then
      src_error("expected name but globalvariable block ended",block[i][CMD_POS])
    end if
    num=try_string_to_number({enforce_constants(block[i][CMD_TEXT]),block[i][CMD_POS]})
    check_undefined_string(block[i+1],"global variable name")
    create_global(num,block[i+1][CMD_TEXT],block[i][CMD_POS])
  end for
end procedure

---------------------------------------------------------------------------

procedure parse_operator_block(TokenList block)
  atom num
  Symbol sym
  Kind kind
  string name,truename
  srcpos pos
  for i=1 to length(block) by 3 do
    if i+2>length(block) then
      src_error("expected name but defineoperator block ended",block[i][CMD_POS])
    end if
    num=try_string_to_number(block[i])
    mustnt_be_a_number(block[i+1])
    mustnt_be_a_number(block[i+2])
    name=block[i+1][CMD_TEXT]
    truename=block[i+2][CMD_TEXT]
    pos=block[i+2][CMD_POS]
    operator_list=append(operator_list,{num,name,truename,pos})
    sym=map:get(global_scope,name,nil_sym)
    kind=sym[SYM_KIND]
    if kind then
      if kind!=KIND_SEPARATOR and kind!=KIND_MATH then
        src_error(sprintf_utf("%s "&COLYEL&"%s"&COLRED&" may not be used as an operator",{KIND_LONGNAMES[kind],name}),pos)
      else
        --Existing names do not get added to global_scope, because we need to be able to use
        --global_scope to map names like 'mod' to the math function rather than the operator.
        --Instead, operator_list is consulted directly to lookup operators.
      end if
    else
      --Add to global_scope to prevent it from being reused for anything else.
      map:put(global_scope,name,{KIND_OPERATOR,length(operator_list),pos})
    end if
  end for
end procedure

---------------------------------------------------------------------------

--Decide which ID number to assign to an autonumbered script.
--name isn't fully-scoped.
function pick_script_id(integer parent_id, string name)
  integer at, id
  sequence encoded

  if length(reuse_ids) then
    encoded=encode_ohr(name)
    if length(encoded)>36 then
      encoded=encoded[1..36]
    end if
    at=find_in_column({parent_id,encoded},reuse_ids,REUSE_PARENT_AND_NAME)
    if at then
      id=reuse_ids[at][PAIR_NUM]
      --Ignore non-autonumbered IDs, otherwise you couldn't change a script
      --from definescript to autonumbered!
      if id>=16384 then
        return id
      end if
    end if
  end if

  loop do
    autonumber_id-=1
    id=autonumber_id
    until find_in_column(id,reuse_ids,PAIR_NUM)=0
  end loop
  return id
end function

---------------------------------------------------------------------------

--Compute bits to add to FUNC_FLAGS from a FUNC_ATTRS sequence
function compute_attribute_bits(sequence attributes)
  integer at
  integer attr_bits
  attr_bits=0
  for i=1 to length(attributes) do
    at=find_in_column(attributes[i][CMD_TEXT],attribute_list,ATTR_NAME)
    if at=0 then
      simple_error("Compiler bug! compute_attribute_bits can't handle "&attributes[i][CMD_TEXT])
    end if
    attr_bits=or_bits(attr_bits,attribute_list[at][ATTR_FLAGS])
  end for
  return attr_bits
end function

---------------------------------------------------------------------------

--arglist is either a sequence of default values (which may equal to the NO_DEFAULT constant), or it's equal to
--VAR_ARGS indicating a variable (unlimited) number of arguments.
--id may only be -1 (autonumbered) when there is no parent script (so that the unscoped
--and fully-scoped name are the same), otherwise pick_script_id must be called explicitly!
function create_function(sequence list, integer id, string name, object arglist, integer func_type, srcpos pos, sequence attributes)
  integer at, attr_bits
  if func_type=KIND_SCRIPT then
    at=find(id,column(list,PAIR_NUM))
    if at then
      src_error(sprintf_utf("%s ID "&COLYEL&"%d"&COLRED&" is already defined as "&COLYEL&"%s"&COLRED,{KIND_LONGNAMES[func_type],id,list[at][PAIR_NAME]}),pos)
    end if
    if id=0 or id<-1 then
      src_error(sprintf_utf("ID "&COLYEL&"%d"&COLRED&" is not valid",{id}),pos)
    elsif id=-1 then
      --autonumber
      id=pick_script_id(0,name)
    end if
  end if
  attr_bits=compute_attribute_bits(attributes)
  list=append(list,{id,name,arglist,attributes,attr_bits,pos})
  map:put(global_scope,name,{func_type,id,pos})
  return(list)
end function

---------------------------------------------------------------------------

--Read zero or more attributes (token prefixed with @ to set them apart, optionally with parameters)
--from current position 'ptr' in 'block'.
--We assume that this is never called on a token that might be a reference instead of an attribute
--(eg by first checking for KIND_ATTRIBUTE)
function parse_attributes(TokenList block, integer ptr)
  sequence attributes
  sequence attr_args, ptr_and_block
  string attr_name
  integer at
  attributes={}
  while ptr<=length(block) and block[ptr][CMD_TEXT][1]='@' do
    attr_name=block[ptr][CMD_TEXT]
    at=find_in_column(attr_name,attribute_list,ATTR_NAME)
    if at=0 then
      src_error("Unrecognised function attribute "&COLYEL&attr_name&COLRED, block[ptr][CMD_POS])
    end if

    if ptr+1<length(block) and equal(block[ptr+1][CMD_TEXT],"begin") then
      --FIXME: should probably enforce constants in the params, because when called from parse_top_level,
      --that hasn't been done yet.
      ptr_and_block=get_cmd_depth(ptr+2,block,1)
      ptr=ptr_and_block[1]
      attr_args=ptr_and_block[2]
    else
      ptr+=1
      attr_args={}
    end if
    attributes&={{attr_name,attr_args}}
  end while
  return {attributes,ptr}
end function

---------------------------------------------------------------------------

function parse_define_block(TokenList block, sequence list, integer func_type)
  atom num
  string name
  atom args
  object arglist  --sequence of strings, or VAR_ARGS
  sequence attributes
  sequence attrs_and_ptr
  srcpos name_pos
  integer i
  i=1
  while i<=length(block) do

    --Parse any attributes
    attrs_and_ptr=parse_attributes(block,i)
    attributes=attrs_and_ptr[1]
    i=attrs_and_ptr[2]

    if length(attributes)>0 and i>length(block) then
      src_error(sprintf_utf("expected %s id to follow, but define block ended",{KIND_LONGNAMES[func_type]}),block[i-1][CMD_POS])
    end if

    --ID
    num=force_16_bit(try_string_to_number(block[i]),block[i][CMD_POS])
    if i+1>length(block) then
      src_error(sprintf_utf("expected %s name but define block ended",{KIND_LONGNAMES[func_type]}),block[i][CMD_POS])
    end if

    --Name
    i+=1
    check_undefined_string(block[i],KIND_LONGNAMES[func_type]&" name")
    name=block[i][CMD_TEXT]
    name_pos=block[i][CMD_POS]
    if i+1>length(block) then
      src_error("expected argument count but define block ended",block[i][CMD_POS])
    end if

    --Get arglist
    i+=1
    args=try_string_to_number(block[i])
    arglist={}
    if args<0 then
      if func_type=KIND_SCRIPT then
        src_error("Number of arguments for a script can't be negative (variable number of arguments aren't supported)",block[i][CMD_POS])
      end if
      arglist=VAR_ARGS
    else
      for j=1 to args do
        if i+1>length(block) then
          src_error("expected argument default but define block ended",block[i][CMD_POS])
        end if
        i+=1
        arglist=append(arglist,try_string_to_number(block[i]))
      end for
      if args>MAX_ARGS then
        src_error(sprintf_utf("Number of arguments (%d) is more than allowed (%d)",{args,MAX_ARGS}),block[i][CMD_POS])
      end if
    end if
    i+=1

    list=create_function(list,num,name,arglist,func_type,name_pos,attributes)
  end while
  return(list)
end function

---------------------------------------------------------------------------

procedure preliminary_parse_pass()
  Token this
  enter_timing_zone("Preliminary pass")
  color_print("preliminary pass\n",{})
  get_cmd_pointer=1
  while get_cmd_pointer<=length(cmd) do
    --read a top-level command
    this=get_cmd()
    if equal("defineconstant",this[CMD_TEXT]) then
      parse_constant_block(get_cmd_block(false))
    elsif equal("definerole",this[CMD_TEXT]) or equal("definetrigger",this[CMD_TEXT]) then
      parse_role_block(get_cmd_block(false))
    elsif equal("plotscrversion",this[CMD_TEXT]) then
      parse_version_block(get_cmd_block(false))
    end if
  end while
  --Check for very old plotscr.hsd
  if equal(plotscr_version,"") then
    if find("plotscr.hsd",column(file_list,FILE_NAME)) then
      simple_error("You have included a copy of "&COLYEL&"plotscr.hsd"&COLRED&" from an old release of the OHRRPGCE. Please use the copies of plotscr.hsd and HSpeak provided with the OHRRPGCE..")
    end if
    --If plotscr.hsd is not included then we're compiling with -b, so don't complain
  end if
  exit_timing_zone()
end procedure

---------------------------------------------------------------------------

--Parse a script or subscript, finding the list of tokens (NOT yet transformed into a tree),
--and appending an entry to all_scripts.
--parent_name is a fully-scoped name of parent script, or ""
--if this script isn't a subscript of another.
--Returns Token with name of parsed script
function parse_script(Token role, string parent_name, integer parent_idx, sequence attributes)
  Token name
  string full_name
  TokenList arglist
  TokenList body
  Token this
  string err_string
  string previous_script
  sequence src_position
  string msg
  integer depth
  integer nest_depth
  Symbol sym
  integer temp
  integer idx
  sequence subscript_attributes
  sequence attrs_and_ptr

  name=get_cmd()
  if parent_idx=0 then
    full_name=name[CMD_TEXT]
    nest_depth=0
  else
    full_name=sprintf_utf("%s<-%s",{parent_name,name[CMD_TEXT]})
    nest_depth=all_scripts[parent_idx][SCRIPT_NEST_DEPTH]+1
    if nest_depth>MAX_NEST_DEPTH then
      src_error(
        sprintf_utf("%s "&COLYEL&"%s"&COLRED&" is nested too deeply (%d layers deep), which is more than is supported. Reorganise your scripts to not use so much nesting."
          ,{role[CMD_TEXT],name[CMD_TEXT],nest_depth})
        ,name[CMD_POS]
      )
    end if
  end if

  --Check name not already in use... unless it appears in a definescript block; if it did the name is already reserved.
  --Note that we won't add it to script_list or global_scope yet; that happens later in check_script_declarations
  if not find_in_column(full_name,script_list,PAIR_NAME) then
    cur_script_num=parent_idx --temporarily to check for subscripts
    check_undefined_string(name, COLYEL & role[CMD_TEXT] & COLRED &" name")
    cur_script_num=0 --This probably isn't needed
  end if

  previous_script=current_script
  current_script=full_name --name[CMD_TEXT]

  --Parse arguments
  arglist={}
  while true do
    if get_cmd_pointer>length(cmd) then
      src_error(sprintf_utf("%s "&COLYEL&"%s"&COLRED&" is missing "&COLYEL&"begin"&COLRED&" or "&COLYEL&"("&COLRED,{role[CMD_TEXT],name[CMD_TEXT]}),name[CMD_POS])
    end if
    this=get_cmd()
    if compare("begin",this[CMD_TEXT])=0 then
      exit--break the while
    end if
    --Note that arglist isn't the actual list of arguments, it's just a string of tokens right now (including defaults).
    --The actual arglist is built in process_arglist, while compiling each script.
    arglist=append(arglist,this)
  end while

  --Create all_scripts entry now for recursive calls; SCRIPT_BODY_TOKS and SCRIPT_END_POS filled in later,
  --and more fields are appended in compile_a_script
  all_scripts=append(all_scripts,{
           role
          ,name[CMD_TEXT]
          ,name[CMD_POS]
          ,full_name
          ,arglist
          ,{}  --SCRIPT_BODY_TOKS
          ,parent_idx
          ,nest_depth
          ,attributes
          ,0  --SCRIPT_END_POS
  })
  idx=length(all_scripts)

  --Read the body
  --Every script is nested inside a big fat do() block
  body={{"do",virtual_pos(name[CMD_POS])}}
  depth=0
  subscript_attributes={}
  while true do
    --If we just read some attribute statements, they must precede a subscript
    if length(subscript_attributes)>0 and equal("subscript",this[CMD_TEXT])=0 then
      src_error(
        sprintf_utf(
          "Expected a subscript to follow function attribute "&COLYEL&"%s"&COLRED&", but found "&COLYEL&"%s"&COLRED
          ,{subscript_attributes[$][CMD_TEXT],this[CMD_TEXT]}
        )
        , this[CMD_POS])
    end if

    body=append(body,this)
    if compare("end",this[CMD_TEXT])=0 then
      depth-=1
      if depth=0 then
        all_scripts[idx][SCRIPT_END_POS]=this[CMD_POS]
        exit--break while
      end if
    elsif compare("begin",this[CMD_TEXT])=0 then
      depth+=1
    elsif compare("subscript",this[CMD_TEXT])=0 then
      --Recurse, so body of subscript doesn't appear in this script.
      --The subscript node stays, for syntax checking, but is removed in normalize_flow_control
      parse_script(this,full_name,idx,subscript_attributes)
      subscript_attributes={}
      body&={{"begin",this[CMD_POS]},{"end",this[CMD_POS]}}
    else
      sym=map:get(global_scope,this[CMD_TEXT],nil_sym)
      temp=sym[SYM_KIND]
      if temp=KIND_ATTRIBUTE then
        --Read all subscript attributes, and don't put them in this script's body
        body=body[1..$-1]
        attrs_and_ptr=parse_attributes(cmd,get_cmd_pointer-1)
        subscript_attributes=attrs_and_ptr[1]
        get_cmd_pointer=attrs_and_ptr[2]
      elsif temp>KIND_LAST_VALID_IN_SCRIPT then
        err_string=sprintf_utf(
          "%s "&COLYEL&"%s"&COLRED&" is not permitted inside a script.",
          {KIND_LONGNAMES[temp], this[CMD_TEXT]}
        )
        if temp=KIND_TOPLEVEL then
          err_string&=sprintf_utf(" Perhaps "&COLYEL&"%s"&COLRED&" has an extra "&COLYEL&"begin"&COLRED&" or "&COLYEL&"("&COLRED&" or is missing a "&COLYEL&")"&COLRED&" or "&COLYEL&"end"&COLRED&".",{name[CMD_TEXT]})
        end if
        src_error(err_string,this[CMD_POS])
      end if
    end if
    if get_cmd_pointer>length(cmd) then
      src_error(
        sprintf_utf(
           "%s "&COLYEL&"%s"&COLRED&" is missing "&COLYEL&"end"&COLRED&" or "&COLYEL&")"&COLRED
          ,{role[CMD_TEXT],name[CMD_TEXT]}
        )
        ,name[CMD_POS]
      )
    end if
    this=get_cmd()
  end while
  all_scripts[idx][SCRIPT_BODY_TOKS]=body

  current_script=previous_script
  return name
end function

---------------------------------------------------------------------------

procedure parse_top_level()
  Token this
  sequence roles, attributes
  sequence attrs_and_ptr
  integer roleidx
  enter_timing_zone("Top level pass")
  color_print("parsing top-level\n",{})
  roles=column(script_role_list,PAIR_NAME)
  attributes={}
  get_cmd_pointer=1
  while get_cmd_pointer<=length(cmd) do
    --read a top-level command
    this=get_cmd()
    roleidx=find(this[CMD_TEXT],roles)

    --If we just read some attribute statements, they must precede a script
    if length(attributes)>0 and roleidx=0 then
      src_error(
        sprintf_utf(
          "Expected a script to follow function attribute "&COLYEL&"%s"&COLRED&", but found "&COLYEL&"%s"&COLRED
          ,{attributes[$][CMD_TEXT],this[CMD_TEXT]}
        )
        , this[CMD_POS])
    end if

    if compare("defineconstant",this[CMD_TEXT])=0 then
      get_cmd_block(true)
    elsif compare("definerole",this[CMD_TEXT])=0 then
      get_cmd_block(true)
    elsif compare("definetrigger",this[CMD_TEXT])=0 then
      get_cmd_block(true)
    elsif compare("globalvariable",this[CMD_TEXT])=0 then
      parse_global_block(get_cmd_block(true))
    elsif compare("defineoperator",this[CMD_TEXT])=0 then
      parse_operator_block(get_cmd_block(true))
    elsif compare("definefunction",this[CMD_TEXT])=0 then
      function_list=parse_define_block(get_cmd_block_nestable(true),function_list,KIND_FUNCTION)
    elsif compare("definescript",this[CMD_TEXT])=0 then
      script_list=parse_define_block(get_cmd_block(true),script_list,KIND_SCRIPT)
    elsif compare("plotscrversion",this[CMD_TEXT])=0 then
      --ignore
      get_cmd_block(false)
    elsif roleidx>0 then
      --"script"/etc. Negative role IDs are subscripts
      if script_role_list[roleidx][PAIR_NUM]<0 then
        src_error(
          sprintf_utf(
            COLYEL&"%s"&COLRED&" can only occur inside another script. Use "&COLYEL&"script"&COLRED&" instead for regular scripts."
            ,{this[CMD_TEXT]}
          )
          ,this[CMD_POS]
        )
      else
        parse_script(this,{},0,attributes)
        attributes={}
      end if
    elsif this[CMD_TEXT][1]='@' then
      --This will keep reading all consecutive attributes until there are no more
      attrs_and_ptr=parse_attributes(cmd,get_cmd_pointer-1)
      attributes=attrs_and_ptr[1]
      get_cmd_pointer=attrs_and_ptr[2]
    else
      check_for_reserved(this[CMD_TEXT],this[CMD_POS],"top-level declaration")
      src_error(
        sprintf_utf(
          "Expected top-level declaration but found "&COLYEL&"%s"&COLRED
          ,{this[CMD_TEXT]}
        )
        ,this[CMD_POS]
      )
    end if
  end while
  if length(attributes)>0 then
    --If we just read some attribute statements, they must precede a script
    src_error("Expected a script to follow function attribute, but file ended", this[CMD_POS])
  end if

  cmd={}  --Free memory
  exit_timing_zone()
end procedure

---------------------------------------------------------------------------

procedure dump_script_and_function_info(integer fh, sequence list)
  sequence this
  string id_string
  sequence src_position
  for i=1 to length(list) do
    this=list[i]
    if this[PAIR_NUM]>autonumber_id then
      id_string=sprintf("AUTONUMBER=%d",{this[PAIR_NUM]})
    else
      id_string=sprintf("ID=%d",{this[PAIR_NUM]})
    end if
    src_position=decode_srcpos(this[FUNC_POS])
    print_utf(fh,"%s %d\t%s\t%s(",{
       src_position[POS_FILENAME]
      ,src_position[POS_LINE]
      ,id_string
      ,this[PAIR_NAME]
    })
    if equal(this[FUNC_ARGS],VAR_ARGS) then
      print_utf(fh,"VARIABLE ARGS",{})
    else
      for j=1 to length(this[FUNC_ARGS]) do
        if j>1 then
          print_utf(fh,",",{})
        end if
        if equal(this[FUNC_ARGS][j],NO_DEFAULT) then
          print_utf(fh,"REQ",{})
        else
          print_utf(fh,"%d",{this[FUNC_ARGS][j]})
        end if
      end for
    end if
    print_utf(fh,")\n",{})
  end for
end procedure

---------------------------------------------------------------------------

function seek_string_by_id(integer id, sequence list, string name)
  integer at
  at=find_in_column(id,list,PAIR_NUM)
  if at then
    return(list[at][PAIR_NAME])
  else
    simple_error(sprintf_utf("decompiler couldnt find %s ID "&COLYEL&"%d"&COLRED,{name,id}))
  end if
  return("")
end function

---------------------------------------------------------------------------

--Used while dumping script binary
function name_lookup(sequence pair, VarList locals)
  integer at
  integer frame,id
  if pair[1]=KIND_NUMBER then
    return(sprintf("%d",{pair[2]}))
  elsif pair[1]=KIND_LOCAL or pair[1]=KIND_NONLOCAL then
    frame=and_bits(pair[2],#FF00)/#100
    id=and_bits(pair[2],#FF)
    for i=1 to length(locals) do
      if locals[i][VAR_FRAME]=frame and locals[i][VAR_ID]=id then
        return locals[i][CMD_TEXT]
      end if
    end for
    simple_error(sprintf_utf("HSpeak bug: decompiler found illegal variable ID "&COLYEL&"%d*256+%d"&COLRED,{frame,id}))
  elsif pair[1]=KIND_GLOBAL then
    at=find(pair[2],global_list[PAIR_NUM])
    if at then
      return(global_list[PAIR_NAME][at])
    else
      simple_error(sprintf_utf("decompiler couldnt find global variable ID "&COLYEL&"%d"&COLRED,{pair[2]}))
    end if
  elsif pair[1]=KIND_FLOW then
    return(seek_string_by_id(pair[2],flow_list,"flow control structure"))
  elsif pair[1]=KIND_SCRIPT then
    return(seek_string_by_id(pair[2],script_list,"user script"))
  elsif pair[1]=KIND_FUNCTION then
    return(seek_string_by_id(pair[2],function_list,"hardcoded function"))
  elsif pair[1]=KIND_MATH then
    return(seek_string_by_id(pair[2],math_list,"built-in function"))
  else
    simple_error(sprintf_utf("HSpeak bug: decompiler found illegal kind "&COLYEL&"%d"&COLRED,{pair[1]}))
  end if
end function

---------------------------------------------------------------------------

function binstring_to_int(sequence encoded)
  --bytes_to_int is NOT the opposite of int_to_bytes, it can't handle negative numbers, which int_to_bytes mangles
  atom temp
  temp=and_bits(encoded[1],#FF)+and_bits(encoded[2],#FF)*#100+and_bits(encoded[3],#FF)*#10000+and_bits(encoded[4],#FF)*#1000000
  if and_bits(temp,#80000000) then
    return(temp-#100000000)
  end if
  return(temp)
end function

---------------------------------------------------------------------------

function read_word(sequence encoded)
  --opposite of output_word. encoded should be length 2 or more
  integer temp
  temp=and_bits(encoded[1],#FF)+and_bits(encoded[2],#FF)*#100
  if and_bits(temp,#8000) then
    return(temp-#10000)
  end if
  return(temp)
end function

---------------------------------------------------------------------------

--Convenience wrapper around read_word, to read an int16 with offset given
--in int16 words and starting from 0 instead of 1.
function read_int16(sequence encoded, integer offset)
  return read_word(encoded[1+2*offset..2+2*offset])
end function

---------------------------------------------------------------------------

function dump_script_binary(sequence bin, integer offset, integer depth, VarList locals)
  string result
  sequence kind_and_id
  integer kind
  integer argcount
  integer new_offset
  result=""
  kind_and_id={binstring_to_int(bin[offset*4+1..offset*4+4]),binstring_to_int(bin[offset*4+5..offset*4+8])}
  kind=kind_and_id[1]
  result&=sprintf_utf("%s%s",{
     repeat(' ',depth)  --indent
    ,name_lookup(kind_and_id,locals)
  })
  if kind=KIND_FLOW or kind=KIND_SCRIPT or kind=KIND_FUNCTION or kind=KIND_MATH then
    argcount=binstring_to_int(bin[1+offset*4+8..1+offset*4+11])
    if argcount then
      result&="(\n"
      for i=0 to argcount-1 do
        new_offset=binstring_to_int(bin[1+(offset+3+i)*4..1+(offset+3+i)*4+3])
        result&=dump_script_binary(bin,new_offset,depth+2,locals)
      end for
      result&=repeat(' ',depth)&")\n"
    else
      result&="()\n"
    end if
  else
    result&="\n"
  end if

  return(result)
end function

---------------------------------------------------------------------------

function dump_script_tree(NodeList tree, integer depth)
  string result
  result=""
    for i=1 to length(tree)  do
      result&=sprintf_utf("%s%s",{
         repeat(' ',depth)--indent
        ,tree[i][TREE_TRUNK][CMD_TEXT]
      })
      if length(tree[i][TREE_BRANCHES])>0 then
        result&="(\n"
        result&=dump_script_tree(tree[i][TREE_BRANCHES],depth+2)
        result&=repeat(' ',depth)&")\n"
      else
        result&="\n"
      end if
    end for
  return(result)
end function

---------------------------------------------------------------------------

function dump_script_strings(sequence bin)
  string result
  integer table_start
  integer offset
  integer len
  result=""
  table_start=binstring_to_int(bin[9..12])
  if table_start=0 then
    return("")
  end if
  bin=bin[table_start+1..$]
  offset=1
  while offset<length(bin) do
    len=binstring_to_int(bin[offset..offset+3])
    result&=sprintf("string offset %-4d: \"",{offset/4})
    result&=escape_string(bin[offset+4..offset+4+len-1]) & "\"\n"
    offset+=4+len
    if remainder(len,4) then
      offset+=4-remainder(len,4)
    end if
  end while
  return(result)
end function

---------------------------------------------------------------------------

procedure dump_debug_report()
  integer fh
  string debug_file
  sequence src_position
  Script script
  integer idx
  VarList locals
  --only do this if the -d debug option was on the command line
  if find('d',optlist) then
    enter_timing_zone("Writing hs_debug.txt")
    if length(path_only(dest_file))>1 then
      debug_file=normalize_filename(path_only(dest_file)&"hs_debug.txt")
    else
      debug_file="hs_debug.txt"
    end if
    fh=open(debug_file,"w")
    if fh!=failure then
      wrap_print("writing debug report file "&COLBWHI&"%s"&COLWHI&"\n",{debug_file})
      -------------------------------------
      print_utf(fh,"[Scripts]\n",{})
      dump_script_and_function_info(fh,script_list)
      print_utf(fh,"\n",{})
      -------------------------------------
      print_utf(fh,"[Global Variables]\n",{})
      for i=1 to length(global_list[PAIR_NUM]) do
        src_position=decode_srcpos(global_list[GLB_POS][i])
        print_utf(fh,"%s %d\tID=%d\t%s\n",{
           src_position[POS_FILENAME]
          ,src_position[POS_LINE]
          ,global_list[PAIR_NUM][i]
          ,global_list[PAIR_NAME][i]
        })
      end for
      print_utf(fh,"\n",{})
      -------------------------------------
      print_utf(fh,"[Builtin Functions]\n",{})
      dump_script_and_function_info(fh,function_list)
      print_utf(fh,"\n",{})
      -------------------------------------
      print_utf(fh,"[Operators]\n",{})
      for i=1 to length(operator_list) do
        src_position=decode_srcpos(operator_list[i][OPER_POS])
        print_utf(fh,"%s %d\t%s\t%s\tPriority=%d\n",{
           src_position[POS_FILENAME]
          ,src_position[POS_LINE]
          ,operator_list[i][PAIR_NAME]
          ,operator_list[i][OPER_TRUENAME]
          ,operator_list[i][PAIR_NUM]
        })
      end for
      print_utf(fh,"\n",{})
      -------------------------------------
      print_utf(fh,"[Script Dumps]\n",{})
      for i=1 to length(all_scripts) do
        script=all_scripts[i]
        src_position=decode_srcpos(script[SCRIPT_POS])
        print_utf(fh,"%s %d\tID=%d\t%s (%s)\n",{
           src_position[POS_FILENAME]
          ,src_position[POS_LINE]
          ,script[SCRIPT_ID]
          ,script[SCRIPT_NAME]
          ,script[SCRIPT_FULL_NAME]
        })
        idx=script[SCRIPT_PARENT_IDX]
        if idx then
          src_position=decode_srcpos(script[SCRIPT_POS])
          print_utf(fh,"%s %d\tparent=ID %d\t%s (access to %d nonlocals)\n",{
             src_position[POS_FILENAME]
            ,src_position[POS_LINE]
            ,all_scripts[idx][SCRIPT_ID]
            ,all_scripts[idx][SCRIPT_NAME]
            ,script[SCRIPT_NUM_NONLOCALS]
          })
        end if
        src_position=decode_srcpos(script[SCRIPT_ROLE_TOK][CMD_POS])
        print_utf(fh,"%s %d\tRole=%d\t%s\n",{
           src_position[POS_FILENAME]
          ,src_position[POS_LINE]
          ,script[SCRIPT_ROLE_ID]
          ,script[SCRIPT_ROLE_TOK][CMD_TEXT]
        })
        locals=script[SCRIPT_VARIABLES]
        for j=1 to length(locals) do
          src_position=decode_srcpos(locals[j][CMD_POS])
          print_utf(fh,"%s %d\tvar(frame %d id %d)=%s\n",{
             src_position[POS_FILENAME]
            ,src_position[POS_LINE]
            ,locals[j][VAR_FRAME]
            ,locals[j][VAR_ID]
            ,locals[j][CMD_TEXT]
          })
        end for
        print_utf(fh,"%d bytes compiled\n",{length(script[SCRIPT_BINARY])})
--        print_utf(fh,"%s\n\n",{dump_script_tree(script[SCRIPT_AST],0)})
        print_utf(fh,"%s",{dump_script_binary(script[SCRIPT_BINARY][CODE_START_BYTE_OFFSET+1..$],0,0,script[SCRIPT_VARIABLES])})
        print_utf(fh,"%s\n\n",{dump_script_strings(script[SCRIPT_BINARY])})
      end for
      print_utf(fh,"\n",{})
      -------------------------------------
      close(fh)
    else
      wrap_print("Error opening debug report file "&COLBWHI&"%s"&COLRED&"\n",{debug_file})
    end if
    exit_timing_zone()
  end if
end procedure

---------------------------------------------------------------------------

--Look up the name of a [sub]script in all current scopes, returning all_scripts
--index if found, or 0 if not
function lookup_scoped_script_name(string name)
  string s
  integer at
  integer idx
  idx=cur_script_num
  while true do
    if idx then
      s=all_scripts[idx][SCRIPT_FULL_NAME]&"<-"&name
    else
      s=name
    end if
    at=find_in_column(s,all_scripts,SCRIPT_FULL_NAME)
    if at then
      return at
    end if

    if idx=0 then
      return 0
    end if
    idx=all_scripts[idx][SCRIPT_PARENT_IDX]
  end while
end function

---------------------------------------------------------------------------

--identify the kind and id of a text command. Does not support untranslated operators or floaty parethesis
function what_kind_and_id(Token command, VarList local_vars, integer look_for_operators)
  integer kind
  integer at
  atom id
  Symbol sym
  string s
  s=command[CMD_TEXT]
  if length(s)=0 then
    kind=KIND_PARENS
    id=0
  elsif (s[1] >= '0' and s[1] <= '9') or s[1] = '-' then
    kind=KIND_NUMBER
    id=string_to_object(s,{})
  elsif look_for_operators and find_in_column(s,operator_list,PAIR_NAME) then
    kind=KIND_OPERATOR --this MUST go before KIND_MATH, because some operators and math functions have the same name
    id=0
  else
    sym=map:get(global_scope,s,nil_sym)
    if sym[SYM_KIND] then
      kind=sym[SYM_KIND]
      id=sym[SYM_ID]
    elsif s[1] = '@' then
      kind=KIND_REFERENCE
      id=0 -- ID always resolves to 0 for references here, since it is too early to know all
           -- script IDs (really? Surely false). The real work is done in binary_compile_recurse
    elsif s[1] = '"' then
      src_error(
        sprintf_utf(
          "The string "&COLYEL&"%s"&COLRED&" is illegal here: strings may only be used as part of a $...=\"...\" or $...+\"...\" construct",
          {shorten_string(s,15)}),
        command[CMD_POS]
      )
    else
      --Local variables can't shadow any names in global scope, they only shadow
      --nonlocal variables. So cen check this last
      at=find_in_column(s,local_vars,CMD_TEXT)
      if at then
        if local_vars[at][VAR_FRAME]=0 then
          kind=KIND_LOCAL
        else
          kind=KIND_NONLOCAL
        end if
        id=local_vars[at][VAR_ID] + 256*local_vars[at][VAR_FRAME]
      else
        --It may be a subscript, in which case the scoped name needs to be looked up
        at=lookup_scoped_script_name(s)
        if at then
          kind=KIND_SCRIPT
          id=all_scripts[at][SCRIPT_ID]
        else
          src_error(sprintf_utf("Unrecognised name "&COLYEL&"%s"&COLRED&". It has not been defined as script, constant, variable, or anything else",{s}),command[CMD_POS])
        end if
      end if
    end if
  end if
  return({kind,id})
end function

---------------------------------------------------------------------------

--Check whether a math operator is not an assignment, a compare operator, or 'random'
function is_simple_math_op(integer id)
  return (id >= 1 and id <= 9) or id >= 19
end function

---------------------------------------------------------------------------

--Given name (CMD_TEXT) of a Node, return whether it is a block: all its arguments are
--statements as opposed to expressions (if, for, while, switch, which take a mix need special handling)
function block_command(string name)
  return compare("do",name)=0 or compare("then",name)=0 or compare("else",name)=0
end function

---------------------------------------------------------------------------

procedure check_is_expression(Node node, string parent)
  Symbol sym
  Kind kind
  --Local variables are always expressions
  sym=map:get(global_scope,node[TREE_TRUNK][CMD_TEXT],nil_sym)
  kind=sym[SYM_KIND]
  --This function is always called after convert_macros, so we don't need to
  --worry about whether a particular macro is an expression
  if kind=KIND_FLOW or kind=KIND_KEYWORD then
    src_error(
      sprintf_utf(COLYEL&"%s"&COLRED&" may not be used as part of an expression (found as an argument to "&COLYEL&"%s"&COLRED&")"
                  ,{node[TREE_TRUNK][CMD_TEXT],parent})
      ,node[TREE_TRUNK][CMD_POS])
  end if
end procedure

---------------------------------------------------------------------------

--this function not used anywhere
function how_many_args(string name, integer kind)
  integer result
  integer at
  if kind=KIND_PARENS then
    result=-1 --parens support (n,operator,n) but if one of n is an operator, it comes out to be more :P
  elsif kind=KIND_FLOW then
    result=-1 --flow supports an unknown number of args
  elsif kind=KIND_OPERATOR then
    result=0 -- its important that operators behave as zero-arg-thingamabobs before they are translated into builtin math functions
  elsif kind=KIND_MATH then
    at=find_in_column(name[CMD_TEXT],math_list,PAIR_NAME)
    result=length(math_list[at][FUNC_ARGS])
  elsif kind=KIND_FUNCTION then
    at=find_in_column(name[CMD_TEXT],function_list,PAIR_NAME)
    if equal(function_list[at][FUNC_ARGS],VAR_ARGS) then
      result=-1
    else
      result=length(function_list[at][FUNC_ARGS])
    end if
  elsif kind=KIND_SCRIPT then
    at=find_in_column(name[CMD_TEXT],script_list,PAIR_NAME)
    result=length(script_list[at][FUNC_ARGS])
  elsif kind=KIND_MACRO then
    result=-1 --unknown number of args
  else
    --numbers, variables, etc do not permit args
    result=0
  end if
  return(result)
end function

---------------------------------------------------------------------------

--Something that potentially takes args
function takes_args(integer kind)
  if kind=KIND_PARENS or kind=KIND_FLOW or kind=KIND_MATH or kind=KIND_FUNCTION or kind=KIND_SCRIPT or kind=KIND_MACRO or kind=KIND_KEYWORD then
    return(true)
  else
    return(false)
  end if
end function

---------------------------------------------------------------------------

--Get next AST node from a list of tokens by pairing up begin,end
--Returns {new_ptr,{token,children}} where children is a TokenList not a NodeList
function get_script_node(integer ptr, TokenList data, VarList vars)
  Token command
  sequence ptr_and_block
  TokenList block
  sequence temp
  integer kind
  integer followed_by_begin
  block={}
  command=data[ptr]
  ptr+=1
  if compare("end",command[CMD_TEXT])=0 then
    src_error(COLYEL&"end"&COLRED&" or "&COLYEL&")"&COLRED&" without "&COLYEL&"begin"&COLRED&" or "&COLYEL&"("&COLRED,command[CMD_POS])
  elsif compare("begin",command[CMD_TEXT])=0 then
    --floaty brackets for order-of-operations-enforcement
    ptr-=1
    command[CMD_TEXT]=""
  end if

  temp=what_kind_and_id(command,vars,true)  --check for KIND_OPERATOR too
  kind=temp[1]
  followed_by_begin=false
  if ptr<=length(data) then
    --there is room for args
    followed_by_begin=equal("begin",data[ptr][CMD_TEXT])

    --distinguishing between functions with and without args means wait() would be ok but noop() would not
    if takes_args(kind) then
      if followed_by_begin then
        --yes, it has args
        ptr+=1--only increment the pointer when we have args
        ptr_and_block=get_cmd_depth(ptr,data,1)
        ptr=ptr_and_block[1]
        block=ptr_and_block[2]
        if length(block)=0 and kind=KIND_PARENS then
          src_error("found empty parentheses not associated with a function call",command[CMD_POS])
        end if
      end if
    end if
  end if

  if kind=KIND_FLOW then
    --Require certain flow control types to be followed by parentheses.
    --We have to check this here or earlier, because after building the parse tree
    --there will be no difference between "()" and omitted parentheses.
    --(Note that several later checks in normalize_flow_control are redundant to this)
    --FIXME: Ideally we wouldn't actually check anything here, but instead preserve presence
    --of empty parentheses to check later (it will matter in future anyway according to typing plan)
    --FIXME: excludes else, because of 'case(else)'
    if find(command[CMD_TEXT],flow_requiring_brackets) then
      if not followed_by_begin then
        src_error(sprintf_utf(COLYEL&"%s"&COLRED&" must be followed by "&COLYEL&"begin"&COLRED&" or "&COLYEL&"("&COLRED,{command[CMD_TEXT]}),command[CMD_POS])
      end if
    end if

    --else has a special check for 'else,if' mistake.
    --'not followed_by_begin' excludes 'else(...)if'
    if equal("else",command[CMD_TEXT]) and ptr<=length(data) and equal("if",data[ptr][CMD_TEXT]) and not followed_by_begin then
      src_error(COLYEL&"else if"&COLRED&" may not be written with a separator in-between",command[CMD_POS])
      --temp=get_script_node(ptr, data, vars)  --hack to allow if necessary
      --temp[2][1][CMD_TEXT]="elseif"
      --return temp
    end if
  end if

  return({ptr,{command,block}})
end function

---------------------------------------------------------------------------

--Returns a NodeList
function build_ast(TokenList script_body_toks, VarList vars)
  integer ptr
  sequence ptr_and_seminode
  sequence seminode  --Not a Node, has a TokenList instead of NodeList
  Node node
  NodeList result
  result={}
  ptr=1
  while true do
    ptr_and_seminode=get_script_node(ptr,script_body_toks,vars)
    ptr=ptr_and_seminode[1]
    seminode=ptr_and_seminode[2]
    if length(seminode[TREE_BRANCHES])>0 then
      --this seminode has arguments that need parsing
      node={seminode[TREE_TRUNK],build_ast(seminode[TREE_BRANCHES],vars)}
    else
      node=seminode
    end if
    result=append(result,node)
    if ptr>length(script_body_toks) then
      exit --break out of while when there is no more data
    end if
  end while
  return(result)
end function

---------------------------------------------------------------------------

--When variables are inherited by a subscript all frame numbers need to be incremented
function shift_variables_frame(VarList vars)
  for i=1 to length(vars) do
    vars[i][VAR_FRAME]+=1
  end for
  return vars
end function

---------------------------------------------------------------------------

--Given a VarList with all local & nonlocal variables, returns a VarList
--of just the locals, in-order
function filter_local_variables(VarList vars)
  sequence ret
  integer next_idx
  ret={}
  next_idx=0
  for i=length(vars) to 1 by -1 do
    if vars[i][VAR_FRAME]=0 then
      --Is local
      if vars[i][VAR_ID]!=next_idx then
        --This is really an assumption, not a bug
        simple_error("compiler bug! Local vars are not in order")
      end if
      next_idx+=1
      ret=append(ret,vars[i])
    end if
  end for
  return ret
end function

---------------------------------------------------------------------------

procedure add_local_variable(Token var)
  Script script
  VarList vars
  integer id
  script=all_scripts[cur_script_num]
  vars=script[SCRIPT_VARIABLES]
  --First check it's not already defined at global scope
  check_undefined_string(var,"local variable name")
  --Always add to scope of current script (frame == 0)
  id=length(vars)-script[SCRIPT_NUM_NONLOCALS]
  --Extend the Token into a VarToken, and prefix to the list, so that it takes
  --precedence over shadowed variables
  all_scripts[cur_script_num][SCRIPT_VARIABLES]={var & {0,id}} & vars
end procedure

---------------------------------------------------------------------------

--Find the variable declarations in a script
procedure gather_local_vars(TokenList data)
  Token this
  integer ptr
  ptr=1
  while true do
    this=data[ptr]
    ptr+=1
    if compare("variable",this[CMD_TEXT])=0 then
      if ptr>length(data) then
        src_error(sprintf_utf(COLYEL&"variable"&COLRED&" should be followed by "&COLYEL&"(name)"&COLRED,{}),this[CMD_POS])
      end if
      this=data[ptr]
      ptr+=1
      if compare("begin",this[CMD_TEXT])=0 then
        while true do
          if ptr>length(data) then
            src_error(sprintf_utf(COLYEL&"variable"&COLRED&" should be followed by "&COLYEL&"(name)"&COLRED,{}),this[CMD_POS])
          end if
          this=data[ptr]
          ptr+=1
          if compare("end",this[CMD_TEXT])=0 then
            exit--break the while
          end if
          add_local_variable(this)
        end while
      else
        src_error(sprintf_utf(COLYEL&"variable"&COLRED&" should be followed by "&COLYEL&"(name)"&COLRED,{}),this[CMD_POS])
      end if
    end if
    if ptr>length(data) then
      exit --break out of the while
    end if
  end while
end procedure

---------------------------------------------------------------------------

--There are only two, hardcoded, macros right now: tracevalue, assert.
function expand_macros(NodeList tree)
  string cmd
  string tracecmd
  NodeList newtree
  NodeList newargs
  string new_string
  Node string_node, assertstr_node
  sequence src_position
  sequence temp
  srcpos pos, vpos
  integer ptr
  ptr=1
  while ptr<=length(tree) do
    --recurse first, because tree[ptr] might be split up (as in 'assert')
    if length(tree[ptr][TREE_BRANCHES]) then
      tree[ptr][TREE_BRANCHES]=expand_macros(tree[ptr][TREE_BRANCHES])
    end if

    cmd=tree[ptr][TREE_TRUNK][CMD_TEXT]

    if equal(cmd,"tracevalue") or equal(cmd,"tracevalueof") then
      tracecmd="tracevalueinternal"
    elsif equal(cmd,"showvalueof") then
      tracecmd="showvalueofinternal"
    else
      tracecmd=""
    end if
    if length(tracecmd) then
      newargs={}
      tree[ptr][TREE_TRUNK][CMD_TEXT]=tracecmd
      pos=tree[ptr][TREE_TRUNK][CMD_POS]
      for i=1 to length(tree[ptr][TREE_BRANCHES]) do
        new_string=tree_original_text(tree[ptr][TREE_BRANCHES][i])
        string_list=append(string_list,new_string)
        string_node={ {sprintf("@$string%d",{length(string_list)}),virtual_pos(pos)}, {} }
        newargs&={string_node,tree[ptr][TREE_BRANCHES][i]}
      end for
      tree[ptr][TREE_BRANCHES]=newargs
    end if

    if equal(cmd,"assert") then
      --assert(condition)  -->  if (not(condition)) then ($assert expression string="condition", assertfailure)
      -- and
      --assert(x == y)  -->  if(_asserteq(x, y, assert expression string, "condition")) then (assertfailure)
      pos=tree[ptr][TREE_TRUNK][CMD_POS]
      vpos=virtual_pos(pos)
      src_position=decode_srcpos(pos)
      if length(tree[ptr][TREE_BRANCHES])!=1 then
        src_error(sprintf_utf(COLYEL&"assert"&COLRED&" statement takes exactly one argument: a condition. It has %d",{length(tree[ptr][TREE_BRANCHES])}),pos)
      end if

      new_string=sprintf_utf("%s:%d: %s",{src_position[POS_FILENAME],src_position[POS_LINE],tree_original_text(tree[ptr][TREE_BRANCHES][1])})
      string_list=append(string_list,new_string)
      string_node={ {sprintf("@$string%d",{length(string_list)}),vpos}, {} }

      assertstr_node={ {enforce_constants("assertexpressionstring"),vpos}, {} }

      newtree={{{"if",vpos},{}}, {{"then",vpos},{}}}

      if equal(tree[ptr][TREE_BRANCHES][1][TREE_TRUNK][CMD_TEXT],"equal") then
        --Use _asserteq

        sequence x,y
        temp=tree[ptr][TREE_BRANCHES][1][TREE_BRANCHES]  --x, y
        x=temp[1]
        y=temp[2]
        --if(...)
        newtree[1][TREE_BRANCHES]={{ {"_asserteq",vpos}, {x,y,assertstr_node,string_node} }}
        --then(assertfailure)
        newtree[2][TREE_BRANCHES]={{ {"assertfailure",vpos}, {} }}

      else
        --if(not(condition))
        newtree[1][TREE_BRANCHES]={{ {"not",vpos}, {tree[ptr][TREE_BRANCHES][1]} }}

        temp={{{"setstringfromtable",vpos},{}}, {{"assertfailure",vpos},{}}}
        temp[1][TREE_BRANCHES]={assertstr_node,string_node}  --stringnum, string
        --then(...)
        newtree[2][TREE_BRANCHES]=temp
      end if

      tree=replace_slice(tree,ptr,ptr,newtree)  --tree[ptr..ptr]=newtree
      ptr+=1
    end if
    ptr+=1
  end while
  return(tree)
end function

---------------------------------------------------------------------------

--tree[ptr] is a partially constructed if Node (lacking else child), followed either by an else or elseif Node.
--Handle else/elseif, parenting to tree[pt], and return the new tree.
function build_else_node(NodeList tree, integer ptr)
  NodeList elseargs
  string nextcmd
  integer eptr
  srcpos pos

  nextcmd=tree[ptr+1][TREE_TRUNK][CMD_TEXT]
  pos=tree[ptr+1][TREE_TRUNK][CMD_POS]
  if equal("else",nextcmd) then
    --found else
    tree[ptr][TREE_BRANCHES]&={tree[ptr+1]}
    tree=delete_element(tree,ptr+1)
  else  -- equal("elseif",nextcmd)
    --Split off the if
    elseargs={ {{"if",pos},tree[ptr+1][TREE_BRANCHES]} }

    --Grab the rest of this if,elseif,...,else chain, to put inside the else
    eptr=ptr+2
    while eptr<=length(tree) do
      nextcmd=tree[eptr][TREE_TRUNK][CMD_TEXT]
      --Stop when we see an else but otherwise we don't check correctness until we recurse
      if equal(nextcmd,"else") then
        eptr+=1
        exit
      elsif find(nextcmd,{"elseif","then"}) then
        --continue
      else
        exit
      end if
      eptr+=1
    end while
    elseargs&=tree[ptr+2..eptr-1]
    tree=tree[1..ptr]&tree[eptr..$]
    tree[ptr][TREE_BRANCHES]&={ {{"else",pos},elseargs} }
  end if
  return tree
end function

---------------------------------------------------------------------------

--Build switch AST Nodes, return new tree
function build_switch_node(NodeList tree, VarList vars, integer ptr)
  srcpos pos
  srcpos argpos
  NodeList args
  Token thiscmd
  NodeList rawargs
  NodeList caseargs
  Token casecmd
  string lastnodename
  sequence collected  --either a Node or {}
  sequence temp
  integer have_else
  srcpos elsepos
  integer expect_case
  integer kind
  atom id
  string else_error_msg
  else_error_msg=COLYEL&"else"&COLRED&" case should be placed last inside a "&COLYEL&"switch"&COLRED&" block"

  pos=tree[ptr][TREE_TRUNK][CMD_POS]
  args=tree[ptr][TREE_BRANCHES]  --start with the condition, length 1

  if length(args)>1 then
    src_error(sprintf_utf(
                  COLYEL&"switch"&COLRED&" statement has %d expressions. It should have only one. (The body of the switch should go in its "&COLYEL&"do(...)"&COLRED&" block instead.)"
                  ,{length(args)}
                ),args[2][TREE_TRUNK][CMD_POS])
  elsif length(args)=0 then
    src_error(COLYEL&"switch"&COLRED&" statement has no expression to match! Write "&COLYEL&"switch (expression) do (...)"&COLRED,pos)
  end if
  check_is_expression(args[1],"switch")
  if ptr>=length(tree) then
    src_error(COLYEL&"switch"&COLRED&" should be followed by "&COLYEL&"do"&COLRED,pos)
  end if
  thiscmd=tree[ptr+1][TREE_TRUNK]
  if equal("do",thiscmd[CMD_TEXT])=0 then
    src_error(sprintf_utf(COLYEL&"switch"&COLRED&" should be followed by "&COLYEL&"do"&COLRED&", not by "&COLYEL&"%s"&COLRED&".",{thiscmd[CMD_TEXT]}),thiscmd[CMD_POS])
  end if

  --found do, processing starts here (build arguments to switch, after the expression)
  rawargs=tree[ptr+1][TREE_BRANCHES]  --contents of the 'do'
  lastnodename=""
  have_else=false
  expect_case=false
  collected={}

  for j=1 to length(rawargs) do
    thiscmd=rawargs[j][TREE_TRUNK]
    argpos=thiscmd[CMD_POS]
    if j=1 and equal("case",thiscmd[CMD_TEXT])=0 then
      src_error(sprintf_utf(COLYEL&"switch() do("&COLRED&" should be followed with a "&COLYEL&"case"&COLRED&", not with "&COLYEL&"%s"&COLRED&"."
                        ,{thiscmd[CMD_TEXT]}),argpos)
    end if
    --to resolve the ambiguity of an else, we always suppose that they belong to an 'if' (or elseif) if possible
    if equal("else",thiscmd[CMD_TEXT]) and find(lastnodename,{"if","then","elseif"})=0 then
      --Old syntax else(...) block
      if length(collected) then
        args&={collected}
        collected={}
      end if
      if have_else then
        src_error(else_error_msg,elsepos)
      end if
      expect_case=false

      if length(args) and equal(args[$][TREE_TRUNK][CMD_TEXT],"do")=false then
        --Last case is new-style syntax and wasn't followed by any statements
        --Lets just disallow this to prevent a little confusion
        src_error(COLYEL&"case(...) else(...)"&COLRED&" is ambiguous. "&
                  "Write either "&COLYEL&"case(..., else) ..."&COLRED&" or "&COLYEL&"case(...) do() else(...)"&COLRED&" as fits your intentions."
                  ,rawargs[j-1][TREE_TRUNK][CMD_POS])
      end if

      if j!=length(rawargs) then
        if length(rawargs[j][TREE_BRANCHES])=0 then
          else_error_msg&=". Did you forget to enclose the else block with brackets, like "&COLYEL&"else(...)"&COLRED&"?"
        end if
        src_error(else_error_msg,argpos)
      end if
      --convert it to a do
      args&={ {{"do",argpos},rawargs[j][TREE_BRANCHES]} }
      elsepos=argpos
      have_else=true

    elsif equal("case",thiscmd[CMD_TEXT]) then
      if length(collected) then
        args&={collected}
        collected={}
      end if
      if have_else then
        --Note we disallow  case(else) case(1)  but allow  case(else,1)
        src_error(else_error_msg,elsepos)
      end if
      expect_case=false

      caseargs=rawargs[j][TREE_BRANCHES]

      --Call a couple passes early here, so that constant expressions are allowed
      caseargs=collapse_floaty_brackets(caseargs)
      caseargs=optimize_script(caseargs,vars)

      --Check contents are only either integers, or "else", and append to args
      for k=1 to length(caseargs) do
        casecmd=caseargs[k][TREE_TRUNK]
        if equal(casecmd[CMD_TEXT],"else") then
          if have_else then
            src_error(COLYEL&"else"&COLRED&" appears multiple times inside this "&COLYEL&"switch"&COLRED&" block",casecmd[CMD_POS])
          end if
          have_else=true
          elsepos=argpos
          --don't emit anything: next do is the 'else' one
        else
          temp=what_kind_and_id(casecmd,vars,false)
          kind=temp[1]
          id=temp[2]
          if kind=KIND_FLOW or (kind=KIND_MATH and is_simple_math_op(id)=false) then
            src_error(sprintf_utf(COLYEL&"%s"&COLRED&" is not allowed inside a "&COLYEL&"case"&COLRED
                          ,{casecmd[CMD_TEXT]}),casecmd[CMD_POS])
          end if
          args&={caseargs[k]}
        end if
      end for
    else
      --Disallow "case() do() garbage"
      if expect_case then
        src_error(sprintf_utf("Expected "&COLYEL&"case"&COLRED&" or "&COLYEL&"else"&COLRED&" to follow "&COLYEL&"case(...) do(...)"&COLRED&" but found "&COLYEL&"%s"&COLRED,{thiscmd[CMD_TEXT]}),argpos)
      end if
      if length(collected)=0 then
        --Start collecting into a do. But if it is a do (old syntax), don't double encapsulate it
        if equal("do",thiscmd[CMD_TEXT]) then
          args&={rawargs[j]}
          expect_case=true
        else
          collected={{"do",argpos},{rawargs[j]}}
        end if
      else
        --Continue collecting
        collected[TREE_BRANCHES]&={rawargs[j]}
      end if
    end if
    lastnodename=thiscmd[CMD_TEXT]
  end for
  if length(collected) then
    args&={collected}
  end if
  if length(args)>1 and equal(args[$][TREE_TRUNK][CMD_TEXT],"do")=false then
    --Last case (possibly an else) is new-style syntax and wasn't followed by any statements,
    --so add the missing do. Don't need to do this, but I'd like to keep things tidy
    --(srcpos is of the last case)
    args&={ {{"do",virtual_pos(argpos)},{}} }
  end if
  if have_else=false then
    --Insert a dummy do default block since else has been left out
    args&={ {{"do",virtual_pos(pos)},{}} }
  end if

  tree[ptr][TREE_BRANCHES]=args
  --delete the do block
  return delete_element(tree,ptr+1)
end function

---------------------------------------------------------------------------

--Given a variable token for 'for' or 'setvariable', etc. (parent) and list of locals/non-locals 'vars',
--return a an integer ID token, or throw an error if not a variable.
function convert_variable_to_id(Token var, VarList locals, string parent)
  sequence kind_and_id
  atom id
  integer argkind
  integer var_at
  kind_and_id=what_kind_and_id(var,locals,false)
  argkind=kind_and_id[1]
  id=kind_and_id[2]
  if argkind=KIND_LOCAL or argkind=KIND_NONLOCAL then
    id=-1-id
  elsif argkind=KIND_GLOBAL then
    --id unmodified
  else
    --It's not a variable. bad!
    src_error(sprintf_utf(
      "first argument of "&COLYEL&"%s"&COLRED&" must be a variable, not %s "&COLYEL&"%s"&COLRED
      ,{parent,KIND_LONGNAMES[argkind],var[CMD_TEXT]}
    ),var[CMD_POS])
  end if
  return {sprintf("%d",{id}),var[CMD_POS]}
end function

---------------------------------------------------------------------------

--parse the script tree and make if absorb then and else, for and while absorb do, switch absorb stuff, check correctness of flow statements
--Note that several of these checks are now redundant to the check for 'begin' performed in get_script_node
function normalize_flow_control(NodeList tree, VarList vars, string parent)
  integer ptr
  string s
  string nextcmd
  NodeList args
  Token ctr
  srcpos pos
  Symbol sym
  Kind kind
  sequence temp
  integer var_at
  ptr=1

  while ptr<=length(tree) do
    s=tree[ptr][TREE_TRUNK][CMD_TEXT]
    pos=tree[ptr][TREE_TRUNK][CMD_POS]
    args=tree[ptr][TREE_BRANCHES]

    sym=map:get(global_scope,s,nil_sym)
    kind=sym[SYM_KIND]
    if kind=KIND_FLOW or kind=KIND_KEYWORD then
      if equal(s,"then") or equal(s,"else") or equal(s,"do") then
        --these are checked for correct parents below.
      elsif block_command(parent)=false then
        src_error(COLYEL&s&COLRED&" may not be used as part of an expression (found as an argument to "&COLYEL&parent&COLRED&")",pos)
      end if
    end if

    if kind=KIND_FLOW then
      if compare("if",s)=0 then
        if length(args)>1 then
          src_error(sprintf_utf(
                        COLYEL&"if"&COLRED&" statement has %d conditions. It should have only one. Use "&COLYEL&"&&"&COLRED&" and "&COLYEL&"||"&COLRED&" to combine multiple conditions"
                        ,{length(args)}
                      ),args[2][TREE_TRUNK][CMD_POS])
        elsif length(args)=0 then
          src_error(sprintf_utf(COLYEL&"if"&COLRED&" statement has no condition. It should have one.",{}),pos)
        end if
        check_is_expression(args[1],s)
        if ptr<length(tree) then
          --there is room
          nextcmd=tree[ptr+1][TREE_TRUNK][CMD_TEXT]
          if compare("then",nextcmd)=0 then
            tree[ptr][TREE_BRANCHES]&={tree[ptr+1]}
            tree=delete_element(tree,ptr+1)
            if ptr<length(tree) then
              --there is room for else
              nextcmd=tree[ptr+1][TREE_TRUNK][CMD_TEXT]
              if equal("else",nextcmd) or equal("elseif",nextcmd) then
                tree=build_else_node(tree,ptr)
              else
                --no else found, but thats okay.
                --add dummy else
                tree[ptr][TREE_BRANCHES]&={ {{"else",virtual_pos(pos)},{}} }
              end if
            else
              --add dummy else
              tree[ptr][TREE_BRANCHES]&={ {{"else",virtual_pos(pos)},{}} }
            end if
          elsif equal("else",nextcmd) or equal("elseif",nextcmd) then
            --add dummy then before else
            tree[ptr][TREE_BRANCHES]&={ {{"then",virtual_pos(pos)},{}} }
            tree=build_else_node(tree,ptr)
          else
            --found neither then nor else
            src_error(sprintf_utf("expected "&COLYEL&"then"&COLRED&" or "&COLYEL&"else"&COLRED&" but found "&COLYEL&"%s"&COLRED,{nextcmd}),tree[ptr+1][TREE_TRUNK][CMD_POS])
          end if
        else
          --no room for then or else
          src_error(COLYEL&"if"&COLRED&" should be followed by "&COLYEL&"then"&COLRED&" or "&COLYEL&"else"&COLRED,pos)
        end if

      elsif compare("then",s)=0 then
        if compare("if",parent)!=0 or ptr!=2 then
          src_error(COLYEL&"then"&COLRED&" should follow an "&COLYEL&"if"&COLRED&" or "&COLYEL&"else if"&COLRED&" block",pos)
        end if

      elsif compare("else",s)=0 then
        if compare("if",parent)!=0 or ptr!=3 then
          src_error(COLYEL&"else"&COLRED&" should follow an "&COLYEL&"if"&COLRED&" or "&COLYEL&"then"&COLRED&" or "&COLYEL&"else if"&COLRED&" block",pos)
        end if

      elsif compare("elseif",s)=0 then
        --Should be absorbed by now
        src_error(COLYEL&"else if"&COLRED&" should follow an "&COLYEL&"if"&COLRED&" or "&COLYEL&"then"&COLRED&" block",pos)

      elsif compare("do",s)=0 then
        if equal(parent,"")=false and block_command(parent)=false then
          --These check their arguments are expressions, so a do which is a child of one of these is correct
          if equal(parent,"for")=false and equal(parent,"while")=false and equal(parent,"switch")=false then
            src_error(COLYEL&s&COLRED&" may not be used as part of an expression (found as an argument to "&COLYEL&parent&COLRED&")",pos)
          end if
        end if

      elsif compare("while",s)=0 then
        if length(args)>1 then
          src_error(sprintf_utf(
                    COLYEL&"while"&COLRED&" statement has %d conditions. It should have only one. Use "&COLYEL&"&&"&COLRED&" and "&COLYEL&"||"&COLRED&" to combine multiple conditions"
                    ,{length(args)}
                    ),args[2][TREE_TRUNK][CMD_POS])
        elsif length(args)=0 then
          src_error(sprintf_utf(COLYEL&"while"&COLRED&" statement has no condition. It should have one.",{}),pos)
        end if
        check_is_expression(args[1],s)
        if ptr<length(tree) then
          --there is room
          if compare("do",tree[ptr+1][TREE_TRUNK][CMD_TEXT])=0 then
            --found do
            tree[ptr][TREE_BRANCHES]&={tree[ptr+1]}
            tree=delete_element(tree,ptr+1)
          else
            src_error(sprintf_utf(COLYEL&"while"&COLRED&" should be followed by "&COLYEL&"do"&COLRED&", not by "&COLYEL&"%s"&COLRED&".",{tree[ptr+1][TREE_TRUNK][CMD_TEXT]}),tree[ptr+1][TREE_TRUNK][CMD_POS])
          end if
        else
          src_error(sprintf_utf(COLYEL&"while"&COLRED&" should be followed by "&COLYEL&"do"&COLRED,{}),pos)
        end if

      elsif compare("for",s)=0 then
        --Handle regular arguments
        if length(args)<3 then
          src_error(sprintf_utf(COLYEL&"for"&COLRED&" statement needs three or four arguments",{}),pos)
        elsif length(args)>4 then
          src_error(sprintf_utf(COLYEL&"for"&COLRED&" statement has too many arguments (%d)",{length(args)}),args[5][TREE_TRUNK][CMD_POS])
        elsif length(args)=3 then
          --append default step value
          args&={ {{"1",virtual_pos(pos)},{}} }
        end if
        ctr=args[1][TREE_TRUNK]
        temp=what_kind_and_id(ctr,vars,false)
        kind=temp[1]
        if kind=KIND_LOCAL then
          map:put(used_locals,temp[2],true)
        elsif kind=KIND_GLOBAL then
          --warn, then translate into a numeric reference to a variable
          src_warn(sprintf_utf(
            "Using global variable "&COLYEL&"%s"&COLRED&" as the counter in a "&COLYEL&"for"&COLRED&" loop"
           ,{ctr[CMD_TEXT]}
          ),ctr[CMD_POS])
        end if
        args[1][TREE_TRUNK]=convert_variable_to_id(ctr,vars,"for")
        check_is_expression(args[2],s)
        check_is_expression(args[3],s)
        check_is_expression(args[4],s)

        --Handle "do"
        if ptr<length(tree) then
          --there is room
          if compare("do",tree[ptr+1][TREE_TRUNK][CMD_TEXT])=0 then
            --found do
            args&={tree[ptr+1]}
            tree=delete_element(tree,ptr+1)
          else
            src_error(sprintf_utf(COLYEL&"for"&COLRED&" should be followed by "&COLYEL&"do"&COLRED&", not by "&COLYEL&"%s"&COLRED&".",{tree[ptr+1][TREE_TRUNK][CMD_TEXT]}),tree[ptr+1][TREE_TRUNK][CMD_POS])
          end if
        else
          src_error(sprintf_utf(COLYEL&"for"&COLRED&" should be followed by "&COLYEL&"do"&COLRED,{}),pos)
        end if
        tree[ptr][TREE_BRANCHES]=args

      elsif compare("exit",s)=0 then
        if length(args)>1 then
          src_error(sprintf_utf(
                        COLYEL&s&COLRED&" statement has %d arguments. It should have only zero or one."
                        ,{length(args)}
                      ),args[2][TREE_TRUNK][CMD_POS])
        elsif length(args)=1 then
          tree[ptr][TREE_TRUNK][CMD_TEXT]="exitreturning"
        elsif length(args)=0 then
          tree[ptr][TREE_TRUNK][CMD_TEXT]="exitscript"
        end if

      elsif compare("return",s)=0 or compare("exitreturning",s)=0 then
        if length(args)>1 then
          src_error(sprintf_utf(
                        COLYEL&s&COLRED&" statement has %d arguments. It should have only one."
                        ,{length(args)}
                      ),args[2][TREE_TRUNK][CMD_POS])
        elsif length(args)=0 then
          src_error(sprintf_utf(COLYEL&s&COLRED&" statement has no argument. It should have one. Prehaps you meant to use "&COLYEL&"exit"&COLRED&" or "&COLYEL&"exit script"&COLRED,{}),pos)
        end if

      elsif compare("break",s)=0 or compare("continue",s)=0 then
        if length(args)>1 then
          src_error(sprintf_utf(
                        COLYEL&s&COLRED&" statement has %d arguments. It should have no more than one."
                        ,{length(args)}
                      ),args[2][TREE_TRUNK][CMD_POS])
        elsif length(args)=0 then
          --append default value
          tree[ptr][TREE_BRANCHES]={{{"1",virtual_pos(pos)},{}}}
        end if

      elsif compare("exitscript",s)=0 then
        if length(args)>0 then
          src_error(sprintf_utf(
                        COLYEL&s&COLRED&" statement has %d arguments. It should have none. Prehaps you meant to use "&COLYEL&"exit"&COLRED&" or "&COLYEL&"exit returning"&COLRED
                        ,{length(args)}
                      ),args[1][TREE_TRUNK][CMD_POS])
        end if

      elsif compare("switch",s)=0 then
        tree=build_switch_node(tree,vars,ptr)

      elsif compare("case",s)=0 then
        src_error(COLYEL&"case"&COLRED&" is not allowed outside of "&COLYEL&"switch"&COLRED,pos)
      end if

    elsif kind=KIND_KEYWORD then

      if compare("subscript",s)=0 or compare("variable",s)=0 then
        --Does nothing; remove. (Kept until now to check they isn't placed in a silly place)
        --(Note: any attributes prefixing a subscript have already been removed in
        --parse_script())
        tree=delete_element(tree,ptr)
        continue
      end if

    end if

    if equal(s,"") then
      --Floaty brackets (they haven't been removed yet). Look to parent instead.
      s=parent
    end if
    tree[ptr][TREE_BRANCHES]=normalize_flow_control(tree[ptr][TREE_BRANCHES],vars,s)
    ptr+=1
  end while
  return(tree)
end function

---------------------------------------------------------------------------

--A modification of Dijkstra's shunting-yard algorithm
--(This could probably subsume build_ast too)
function convert_operators(NodeList tree)
  NodeList new_tree
  sequence stack   --{int,Node} pairs
  Node opnode
  integer ptr
  integer at
  integer priority
  integer nonoperator_before
  stack={}
  new_tree={}
  ptr=1
  nonoperator_before=false
  while ptr<=length(tree) do
    --for each peer branch on the tree
    at=find_in_column(tree[ptr][TREE_TRUNK][CMD_TEXT],operator_list,PAIR_NAME)

    if at>0 then
      if nonoperator_before=false then
        --there is no room for the before-operand. Bad!
        src_error(sprintf_utf("operator "&COLYEL&"%s"&COLRED&" is missing its left-side operand (did not expect to see an operator here)",{tree[ptr][TREE_TRUNK][CMD_TEXT]}),tree[ptr][TREE_TRUNK][CMD_POS])
      elsif ptr=length(tree) then
        --there is no room for the after-operand. Bad!
        src_error(sprintf_utf("operator "&COLYEL&"%s"&COLRED&" is missing its right-side operand",{tree[ptr][TREE_TRUNK][CMD_TEXT]}),tree[ptr][TREE_TRUNK][CMD_POS])
      end if

      priority=operator_list[at][PAIR_NUM]
      --convert the operator to its true function name (which might be the same)
      tree[ptr][TREE_TRUNK][CMD_TEXT]=operator_list[at][OPER_TRUENAME]
      while length(stack) and priority>=stack[$][1] do
        --pop the operator from the stack and "apply" it to the tree
        opnode=stack[$][2]
        stack=stack[1..$-1]
        opnode[TREE_BRANCHES]=new_tree[$-1..$]
        new_tree=new_tree[1..$-2]&{opnode}
      end while
      stack&={{priority,tree[ptr]}}
      nonoperator_before=false
    else
      if nonoperator_before then
        --Two non-ops in a row means moved onto the new argument in this argument list, so finish processing operators first
        while length(stack) do
          --pop the operator from the stack and "apply" it to the tree
          opnode=stack[$][2]
          stack=stack[1..$-1]
          opnode[TREE_BRANCHES]=new_tree[$-1..$]
          new_tree=new_tree[1..$-2]&{opnode}
        end while
      end if
      tree[ptr][TREE_BRANCHES]=convert_operators(tree[ptr][TREE_BRANCHES])
      new_tree&={tree[ptr]}
      nonoperator_before=true
    end if

    ptr+=1
  end while

  --copy of above
  while length(stack) do
    --pop the operator from the stack and "apply" it to the tree
    opnode=stack[$][2]
    stack=stack[1..$-1]
    opnode[TREE_BRANCHES]=new_tree[$-1..$]
    new_tree=new_tree[1..$-2]&{opnode}
  end while

  return new_tree
end function

---------------------------------------------------------------------------

--Get the parameters for a certain attribute of a script or function, if it exists
--func_defn: an element of script_list or function_list
--Returns a NodeList, possible empty
function attribute_params(string name, sequence func_defn)
  integer attridx
  attridx=find_in_column(name,func_defn[FUNC_ATTRS],1)
  if attridx=0 then
    return {}
  else
    return func_defn[FUNC_ATTRS][attridx][TREE_BRANCHES]
  end if
end function

---------------------------------------------------------------------------

--Ensure correct number of arguments, add defaults, and translate variables to IDs in assignments
--And also some extra warnings...
function fix_arguments(Node tree, integer kind, integer id, sequence list, VarList vars)
  integer at
  integer argnum,maxargs
  NodeList args, params
  integer fatal
  string message, param
  string funcname
  srcpos funcpos
  funcname=tree[TREE_TRUNK][CMD_TEXT]
  funcpos=tree[TREE_TRUNK][CMD_POS]
  args=tree[TREE_BRANCHES]
  argnum=length(args)
  --Lookup ID because name might be scoped
  at=find_in_column(id,list,PAIR_NUM)
  if equal(list[at][FUNC_ARGS],VAR_ARGS) then
    return(args)
  else
    maxargs=length(list[at][FUNC_ARGS])
  end if
  if maxargs < argnum then
    src_error(sprintf_utf(
      "%s "&COLYEL&"%s"&COLRED&" takes at most %d arguments but is being passed %d arguments"
      ,{KIND_LONGNAMES[kind],funcname,maxargs,argnum}
    ),args[maxargs+1][TREE_TRUNK][CMD_POS])
  elsif maxargs > argnum then
    --add defaults if not enough args are present
    if kind=KIND_MATH then
      --special processing for math
      if list[at][PAIR_NUM]<=15 or list[at][PAIR_NUM]>=19 then
        --math shouldnt have defaults
        src_error(sprintf_utf(
          "math function "&COLYEL&"%s"&COLRED&" is being passed %d arguments but it should always have %d"
          ,{funcname,argnum,maxargs}
        ),funcpos)
      else
        --variable assignment commands can have defaults
        if argnum = 0 then
          --no defaults for first argument of variable function
          src_error(sprintf_utf(
            "variable manipulation function "&COLYEL&"%s"&COLRED&" has %d arguments - it needs at least 1"
            ,{funcname,argnum}
          ),funcpos)
        elsif argnum = 1 then
          --make defaults for second arg of variable function
          if list[at][PAIR_NUM]=16 then
            --setvariable
            args=append(args,{
               {"0",virtual_pos(funcpos)}
              ,{}
            })
          else
            --increment and decrement
            args=append(args,{
               {"1",virtual_pos(funcpos)}
              ,{}
            })
          end if
        end if
      end if
    else
      --normal processing for script and function
      for i=argnum+1 to maxargs do
        if equal(list[at][FUNC_ARGS][i],NO_DEFAULT) then
          src_error(sprintf_utf(
            "%s "&COLYEL&"%s"&COLRED&" has no default for missing argument %d"
            ,{KIND_LONGNAMES[kind],funcname,i}
          ),funcpos)
        end if
        args=append(args,{
           {sprintf("%d",{list[at][FUNC_ARGS][i]}),virtual_pos(funcpos)}
          ,{}
        })
      end for
    end if
  end if
  --Translate variables in the variable manipulation functions
  if kind=KIND_MATH and list[at][PAIR_NUM]>=16 and list[at][PAIR_NUM]<=18 then
    args[1][TREE_TRUNK]=convert_variable_to_id(args[1][TREE_TRUNK],vars,funcname)
  end if

  --Obsolescence warnings
  --(This seems as good a spot to do this as any, because we've looked up the function in 'list' already)
  --Syntax: @obsolete([error,] [replacement_cmd,] ["message"])  (arg order can var)
  if and_bits(list[at][FUNC_FLAGS],FLAG_OBSOLETE)!=0 then
    params=attribute_params("@obsolete",list[at])
    message=""
    fatal=false
    for i=1 to length(params) do
      param=params[i][CMD_TEXT]
      if equal(param,"error") then
        fatal=true
      elsif param[1]='"' then
        message&=param[2..$-1]
      else
        message&=sprintf_utf("Use replacement function "&COLYEL&"%s"&COLRED&" instead. ",{param})
      end if
    end for
    if fatal then
      message=sprintf_utf("Function "&COLYEL&"%s"&COLRED&" is obsolete and can no longer be used. %s",{funcname,message})
      src_error(message,funcpos)
    else
      message=sprintf_utf("Function "&COLYEL&"%s"&COLRED&" is obsolete; avoid it. %s",{funcname,message})
      src_warn(message,funcpos)
    end if
  end if

  return(args)
end function

---------------------------------------------------------------------------

--Calls fix_arguments on each non-flow node with arguments
function normalize_arguments(NodeList tree, VarList vars)
  sequence kind_and_id
  integer kind
  atom id
  --Unlike the flow normalization and operator translation we do not insert/delete elements from
  --the current level, so we can use a "for" safely, and dont need a "while"
  for i=1 to length(tree) do
    kind_and_id=what_kind_and_id(tree[i][TREE_TRUNK],vars,false)
    kind=kind_and_id[1]
    id=kind_and_id[2]
    if kind=KIND_SCRIPT then
      tree[i][TREE_BRANCHES]=fix_arguments(tree[i],kind,id,script_list,vars)
    elsif kind=KIND_FUNCTION then
      tree[i][TREE_BRANCHES]=fix_arguments(tree[i],kind,id,function_list,vars)
    elsif kind=KIND_MATH then
      tree[i][TREE_BRANCHES]=fix_arguments(tree[i],kind,id,math_list,vars)
    end if --number, flow, global, local, parens need no argchecking
    if length(tree[i][TREE_BRANCHES]) then
      --if there are sub-arguments, recurse
      tree[i][TREE_BRANCHES]=normalize_arguments(tree[i][TREE_BRANCHES],vars)
    end if
  end for
  return(tree)
end function

---------------------------------------------------------------------------

--returns a two-char string that represents a 16-bit word in least-signifigant-byte-first order
function output_word(integer n)
  integer b1,b2
  b1=and_bits(n,#FF)
  b2=floor(and_bits(n,#FFFF)/256)
  return({b1,b2})
end function

---------------------------------------------------------------------------

function convert_to_bytes(sequence s)
  sequence result
  result={}
  for i=1 to length(s) do
    result&=int_to_bytes(s[i])
  end for
  return(result)
end function

---------------------------------------------------------------------------

--Encode a unicode (UTF32/native Euphoria) string in the format the engine
--requires, which is currently Latin-1
function encode_ohr(string string, integer maxbytes=0)
  for i=1 to length(string) do
    if string[i]>=256 then
      string[i]='?'
    end if
  end for
  if maxbytes and maxbytes<length(string) then
    string=string[1..maxbytes]
  end if
  return string
end function

---------------------------------------------------------------------------

--Returns byte sequence of "32bitstring"-encoded string:
--32 bit length followed one-char-per-byte padded to 4 byte multiple
function encode_32bitstring(string string)
  sequence ret
  integer len
  string=encode_ohr(string)
  len=length(string)
  ret=int_to_bytes(len)&string
  if remainder(len,4) then
    ret&=repeat(0,4-remainder(len,4))
  end if
  return ret
end function

---------------------------------------------------------------------------

--add a string to the table for this script, return its offset
function table_string(integer id)
  integer offset
  offset=length(string_table)/4
  string_table&=encode_32bitstring(string_list[id])
  return(offset)
end function

---------------------------------------------------------------------------

--Used to turn the local var list into a string table.
--vars must exclude nonlocals, and be in order.
function variable_names_to_table(VarList vars)
  string varname
  sequence result
  result={}
  for i=1 to length(vars) do
    --varname=vars[i][CMD_TEXT]
    varname=get_srcpos_text(vars[i][CMD_POS])
    result&=encode_32bitstring(varname)
  end for
  return(result)
end function

---------------------------------------------------------------------------

--returns the offset where this node was either added, or references an existing node
function binary_compile_recurse(Node tree, VarList vars)
  sequence result
  integer kind
  atom id
  integer numargs
  integer at
  string s
  sequence kind_and_id
  sequence value_temp
  string str_temp
  integer recurse_result
  integer can_reference  --whether can return a pointer to an earlier node
  integer nodeoffset
  srcpos cmdpos
  result={}
  can_reference=true
  nodeoffset=length(compiled_data)

  kind_and_id=what_kind_and_id(tree[TREE_TRUNK],vars,false)
  kind=kind_and_id[1]
  id=kind_and_id[2]
  s=tree[TREE_TRUNK][CMD_TEXT]
  cmdpos=tree[TREE_TRUNK][CMD_POS]

  if kind=KIND_REFERENCE then
    str_temp = s[2..length(s)]
    --is it a global variable?
    at=find(str_temp,global_list[PAIR_NAME])
    if at then
      --yes, it is a global, compile to global ID
      id=global_list[PAIR_NUM][at]
    else
      --is it a script?
      at=lookup_scoped_script_name(str_temp)
      if at then
        --Yes, it is a script. Compile to a script ID unless it's a reference to a subscript, as
        --I want to eventually make subscript handles closures (without which subscript handles can't work)
        if all_scripts[at][SCRIPT_PARENT_IDX] then
          src_error("References to subscripts haven't been implemented yet. Use a regular script instead if you need its ID.",cmdpos)
        end if
        id=all_scripts[at][SCRIPT_ID]
      else
        --is it a string literal?
        if length(str_temp)>7 and equal("$string",str_temp[1..7]) then
          value_temp=value(str_temp[8..length(str_temp)])
          id=table_string(value_temp[2])
        else
          src_error(sprintf_utf("Reference "&COLYEL&"@%s"&COLRED&" not understood: references must be the name of a global variable or a script",{str_temp}),cmdpos)
        end if
      end if
    end if
    kind=KIND_NUMBER
  end if

  result&=kind
  result&=id
  if kind=KIND_NUMBER then
    --No children and no debug info
  elsif kind=KIND_GLOBAL or kind=KIND_LOCAL or kind=KIND_NONLOCAL then
    --No children, debug info
    if debug_info then
      result&=cmdpos-script_position
    end if
  elsif kind=KIND_SCRIPT or kind=KIND_FUNCTION or kind=KIND_FLOW or kind=KIND_MATH then
    --Use id from what_kind_and_id
    if kind=KIND_FUNCTION then
      if max_used_function<id then
        max_used_function=id
      end if
    end if
    numargs=length(tree[TREE_BRANCHES])
    if kind!=KIND_FLOW and numargs>MAX_ARGS then
      src_error(sprintf_utf("Number of arguments being passed (%d) is more than allowed (%d)",{numargs,MAX_ARGS}),cmdpos)
    end if
    result&=numargs
    --Add placeholders for each argoffset
    result&=repeat(0,numargs)

    if debug_info then
      result&=cmdpos-script_position
    end if

    if nodeoffset=0 then
      --Special case: Most nodes are added after their children, but the root
      --node needs to have offset 0, so append it already
      compiled_data&=result
    end if

    for i=1 to numargs do
      --actually evaluate each argument and set the real offsets
      recurse_result=binary_compile_recurse(tree[TREE_BRANCHES][i],vars)
      if recurse_result >= nodeoffset then
        can_reference=false
      end if
      result[3+i]=recurse_result
    end for

    if nodeoffset=0 then
      --Root node: replace the dummy argument offsets, and we're done.
      compiled_data[1..length(result)]=result
      return(nodeoffset)
    end if

    nodeoffset=length(compiled_data)

  else
    src_error(sprintf_utf("Compiler Bug! Illegal kind "&COLYEL&"%d"&COLRED&" for "&COLYEL&"%s"&COLRED,{kind,s}),cmdpos)
  end if

  --If we've have multiple copies of the exact same node (subtree), deduplicate them.
  --Don't bother with nodes with >4 children: unlikely to repeat.
  --The integer(result[2]) test here is to work around a bug in Euphoria (at least in 4.0.3 32-bit):
  --map:hash throws an error if given an int which doesn't fit in a 31-bit integer
  if not fast_mode and length(result)<=7 and integer(result[2]) then
    if can_reference then  --If false, this node must be unique, so map:get won't find anything.
      at=map:get(node_lookup,result,-1)
      if at>-1 then
        return at
      end if
    end if
    map:put(node_lookup,result,nodeoffset)
  end if

  --append data directly
  compiled_data&=result
  return(nodeoffset)
end function

---------------------------------------------------------------------------

function get_parent_id(Script script)
  integer parent_idx
  parent_idx=script[SCRIPT_PARENT_IDX]
  if parent_idx=0 then
    return(0)
  else
    return(all_scripts[parent_idx][SCRIPT_ID])
  end if
end function

---------------------------------------------------------------------------

function binary_compile(Script script)
  NodeList tree
  sequence result
  integer recurse_ret
  sequence localvars

  string_table={}
  compiled_data={}
  node_lookup=map:new()

  --binary data is in a mix of 16-bit and 32-bit signed words.
  --the header is (mostly) 16-bit and the data (script format version 1+) is 32-bit.

  --output header (0-based offsets given here)
  --0..1: the zero-rooted byte-offset of the first executable code byte
  result=output_word(CODE_START_BYTE_OFFSET)
  --2..3: the number of local variables (including args but not nonlocals)
  result&=output_word(length(script[SCRIPT_VARIABLES]) - script[SCRIPT_NUM_NONLOCALS])
  --4..5: the number of arguments the script takes (also in SCRIPTS.TXT)
  result&=output_word(length(script[SCRIPT_ARG_TOKS]))
  --6..7: the format of the command data (presently used to indicate 32-bit encoding)
  result&=output_word(HSZ_FORMAT_VERSION)
  --8..11: a 32bit offset to the string literal table (in bytes), we don't know it yet
  result&=output_word(0)
  result&=output_word(0)
  --12..13: parent script ID or 0 if none
  result&=output_word(get_parent_id(script))
  --14..15: Nesting depth
  result&=output_word(script[SCRIPT_NEST_DEPTH])
  --16..17: number of nonlocals
  result&=output_word(script[SCRIPT_NUM_NONLOCALS])
  --18..21: the length of the string table in 32-bit words, also unknown
  result&=output_word(0)
  result&=output_word(0)
  --22..23: a bitfield detailing optional features.
  if debug_info then
    --First bit: non-leaf cmd nodes appended with srcpos
    result&=output_word(1)
  else
    result&=output_word(0)
  end if
  --24..27: the offset of the local variable name table, in 32-bit words
  --after the header, or 0 if not present. Currently unknown.
  result&=output_word(0)
  result&=output_word(0)
  --28..31: the srcpos offset of the start of the script
  integer script_start
  script_start=srcpos_offset(script[SCRIPT_ROLE_TOK][CMD_POS])
  result&=int_to_bytes(script_start)
  script_position=script_start*power(2,9) --aka encode_srcpos(0,script_start-1,0)

  --what follows is command data in the format [kindID,Value,argcount,argpointerlist]
  --numbers and variables have no argcount or argpointerlist
  --an argpointer is the zero-rooted word-offset of the argument relative
  --to the start of the executable commands. I realise that this format is
  --unnecessarily complicated. I had hoped to get benefits of being able to
  --store frequently reused commands only once and then just point to them,
  --but in actual practice, it isnt worth the trouble, since the only
  --commands that tend to be redundant are the really short ones.
  --the first command is always a "do". there can be only one top-level command
  tree=script[SCRIPT_AST]
  if length(tree)!=1 then
    simple_error(sprintf_utf("compiler bug! script tree has %s root nodes",{length(tree)}))
  end if
  reenter_timing_zone("binary_compile_recurse")
  recurse_ret=binary_compile_recurse(tree[1],script[SCRIPT_VARIABLES])
  if recurse_ret!=0 then
    simple_error(sprintf_utf("compiler bug! Root binary_compile_recurse call returned %d",{recurse_ret}))
  end if
  exit_timing_zone()
  result&=convert_to_bytes(compiled_data)
  compiled_data={}
  --append with a table of string literals and give its offset and length
  if length(string_table)>0 then
    if remainder((length(result)-CODE_START_BYTE_OFFSET),4) != 0 then
      simple_error("compiler bug! string table not aligned")
    end if
    if remainder(length(string_table),4) != 0 then
      simple_error("compiler bug! string table not padded")
    end if
    result[9..12]=int_to_bytes(length(result))
    result[19..22]=int_to_bytes(length(string_table)/4)
    result&=string_table
  end if
  if debug_info then
    --append local variable names table
    if remainder(length(result)-CODE_START_BYTE_OFFSET,4) != 0 then
      simple_error("compiler bug! varname table not aligned")
    end if
    localvars=filter_local_variables(script[SCRIPT_VARIABLES])
    if length(localvars) then
      result[25..28]=int_to_bytes((length(result)-CODE_START_BYTE_OFFSET)/4)
      --Could use seek_string_by_id instead of filter_local_variables
      result&=variable_names_to_table(localvars)
    end if
    --Otherwise remains 0
  end if
  return(result)
end function

---------------------------------------------------------------------------

--floaty brackets are un-needed after the operators have been translated.
function collapse_floaty_brackets(NodeList tree)
  integer i
  NodeList graft
  i=1
  while i<=length(tree) do
    if length(tree[i][TREE_TRUNK][CMD_TEXT])=0 then
      --found a floaty-bracket
      graft=tree[i][TREE_BRANCHES]
      if length(graft)!=1 then
        src_error(sprintf_utf("Found unexpected pair of brackets containing %d expressions. Either the brackets should not exist at all, or should only enclose a single expression",{length(graft)}),tree[i][TREE_TRUNK][CMD_POS])
      end if
      tree[i]=graft[1]
      --delete_element(tree,i)
      --tree=insert_sequence(tree,graft,i)
    else
      if length(tree[i][TREE_BRANCHES]) then
        tree[i][TREE_BRANCHES]=collapse_floaty_brackets(tree[i][TREE_BRANCHES])
      end if
      i+=1
    end if
  end while
  return(tree)
end function

---------------------------------------------------------------------------

--parent is CMD_TEXT of parent node
function sanity_check(NodeList tree, VarList vars, string parent)
  string s
  sequence kind_and_id
  integer kind
  atom id
  srcpos pos
  for i=1 to length(tree) do
    s=tree[i][TREE_TRUNK][CMD_TEXT]
    pos=tree[i][TREE_TRUNK][CMD_POS]
    kind_and_id=what_kind_and_id(tree[i][TREE_TRUNK],vars,false)
    kind=kind_and_id[1]
    id=kind_and_id[2]
    if i=1 and equal("if",parent) then
      if kind=KIND_NUMBER then
        if id then
          src_warn(sprintf_utf("Condition is always true ("&COLYEL&"%d"&COLRED&")",{id}),pos)
        else
          src_warn("Condition is always false",pos)
        end if
      end if
    elsif block_command(parent) then
      if kind=KIND_NUMBER then
        src_warn(sprintf_utf("Expected script, function, or flow control, but found an expression with value "&COLYEL&"%d"&COLRED&". It will do nothing here."
                 ,{id}),pos)
      elsif kind=KIND_GLOBAL then
        src_warn(sprintf_utf("Expected script, function, or flow control, but found global variable "&COLYEL&"%s"&COLRED&". It will do nothing here."
                 ,{s}),pos)
      elsif kind=KIND_LOCAL or kind=KIND_NONLOCAL then
        src_warn(sprintf_utf("Expected script, function, or flow control, but found local variable "&COLYEL&"%s"&COLRED&". It will do nothing here."
                 ,{s}),pos)
      elsif kind=KIND_MATH and (id<=15 or id=19 or id>=22) then
        -- setvariable, increment, decrement, logand, logor have side effects
        src_warn(sprintf_utf("Expected a statement but found built-in function "&COLYEL&"%s"&COLRED&", returning a value that is being discarded"
                 ,{s}),pos)
      end if
    end if
    if kind=KIND_GLOBAL then
      map:put(used_globals,id,true)
    elsif kind=KIND_LOCAL then
      map:put(used_locals,id,true)
    end if
    if length(tree[i][TREE_BRANCHES]) then
      --if there are sub-arguments, recurse
      tree[i][TREE_BRANCHES]=sanity_check(tree[i][TREE_BRANCHES],vars,tree[i][TREE_TRUNK][CMD_TEXT])
    end if
  end for
  return(tree)
end function

---------------------------------------------------------------------------

--simulate a result overflowing a signed 32 bit register
function overflow_int32(atom val)
  --maybe check whether val is so large that this is could be inaccurate?
  atom ret
  ret=mod(val,#100000000)
  if ret>2147483647 then
    ret-=#100000000
  end if
  return(ret)
end function

---------------------------------------------------------------------------

function optimized_arg(Node tree, VarList vars)
  sequence kind_and_id
  integer kind
  atom id
  object arg1,arg2
  kind_and_id=what_kind_and_id(tree[TREE_TRUNK],vars,false)
  kind=kind_and_id[1]
  id=kind_and_id[2]
  if kind=KIND_NUMBER then
    return(id)
  elsif kind=KIND_MATH and (id<=15 or id>=19) then
    arg1=optimized_arg(tree[TREE_BRANCHES][1],vars)
    if equal(arg1,{}) then
      arg1=tree[TREE_BRANCHES][1]
    end if
    if length(tree[TREE_BRANCHES])>=2 then
      arg2=optimized_arg(tree[TREE_BRANCHES][2],vars)
    else
      arg2=0
    end if
    if equal(arg2,{}) then
      arg2=tree[TREE_BRANCHES][2]
    end if
    if atom(arg1) and atom(arg2) then
       if id=0 then
         --random
         if arg1=arg2 then
           return(arg1)
         end if
       elsif id=1 then
         --exponent
         if arg2>0 then
           --if too large, Euphoria will signal an overflow, but I'm also worried
           --about overflow_int32 giving inaccurate results
           if log(abs(arg1)+1)+log(abs(arg2)+1)<log(1e14) then
             return(overflow_int32(power(arg1,arg2)))
           end if
         elsif arg2=0 then
           --FB takes 0^0=1 (the most useful definition), Euphoria throws an error
           return(1)
         elsif arg2<0 then
           if arg1=0 then
             src_error(sprintf_utf("Found the expression (or equivalent) "&COLYEL&"0 ^ %d"&COLRED&". This is division by zero.",{arg2}),tree[TREE_TRUNK][CMD_POS])
           elsif arg1=1 or arg1=-1 then
             return(power(arg1,arg2))
           else
             return(0)
           end if
         end if
       elsif id=2 then
         --modulus
         if arg2=0 then
           src_error(sprintf_utf("Found the expression (or equivalent) "&COLYEL&"%d, mod, 0"&COLRED&". This is division by zero.",{arg1}),tree[TREE_TRUNK][CMD_POS])
         end if
         return(floor(remainder(arg1,arg2)))
       elsif id=3 then
         --divide
         if arg2=0 then
           src_error(sprintf_utf("Found the expression (or equivalent) "&COLYEL&"%d / 0"&COLRED,{arg1}),tree[TREE_TRUNK][CMD_POS])
         end if
         --Euphoria doesn't have a truncating function?
         if arg1*arg2<0 then
           return(-floor(-arg1/arg2))
         else
           return(floor(arg1/arg2))
         end if
       elsif id=4 then
         --multiply
         return(overflow_int32(arg1*arg2))
       elsif id=5 then
         --subtract
         return(overflow_int32(arg1-arg2))
       elsif id=6 then
         --add
         return(overflow_int32(arg1+arg2))
       elsif id=7 then
         --xor
         return(overflow_int32(xor_bits(arg1,arg2)))
       elsif id=8 then
         --or
         return(overflow_int32(or_bits(arg1,arg2)))
       elsif id=9 then
         --and
         return(overflow_int32(and_bits(arg1,arg2)))
       elsif id=10 then
         --equal
         return(arg1=arg2)
       elsif id=11 then
         --notequal
         return(arg1!=arg2)
       elsif id=12 then
         --lessthan
         return(arg1<arg2)
       elsif id=13 then
         --greaterthan
         return(arg1>arg2)
       elsif id=14 then
         --lessthanorequalto
         return(arg1<=arg2)
       elsif id=15 then
         --greaterthanorequalto
         return(arg1>=arg2)
       elsif id=19 then
         --not
         return(arg1=0)
       elsif id=22 then
         --logxor
         return((arg1=0)!=(arg2=0))
       elsif id=23 then
         --abs
         return(overflow_int32(abs(arg1)))
       elsif id=24 then
         --sign
         return((arg1>0)-(arg1<0))
       elsif id=25 then
         --sqrt
         if arg1<0 then
           src_error(sprintf_utf("Found the expression (or equivalent) "&COLYEL&"sqrt(%d)"&COLRED,{arg1}),tree[TREE_TRUNK][CMD_POS])
         end if
         return(floor(sqrt(arg1)+0.5))
       end if
    end if

    --have to allow for side effects of shortcut evaluating operators by only checking first arg
    if atom(arg1) then
       if id=4 then
         --multiply
         if arg1=0 then
           return 0
         elsif arg1=1 then
           return arg2
         end if
       elsif id=6 then
         --add
         if arg1=0 then
           return arg2
         end if
       elsif id=20 then
         --logand
         if arg1=0 then
           return 0
         end if
       elsif id=21 then
         --logor
         if arg1!=0 then
           return 1
         end if
       end if
    end if

    if atom(arg2) then
       if id=4 then
         --multiply
         if arg2=0 then
           return 0
         elsif arg2=1 then
           return arg1
         end if
       elsif id=5 then
         --subtract
         if arg2=0 then
           return arg1
         end if
       elsif id=6 then
         --add
         if arg2=0 then
           return arg1
         end if
       end if
    end if
  end if
  return({})  --return nonatom
end function

---------------------------------------------------------------------------

--goes through a script simplifying expressions that always have the same value
function optimize_script(NodeList tree, VarList vars)
  object arg
  for i=1 to length(tree) do
    arg=optimized_arg(tree[i],vars)
    if atom(arg) then
      tree[i][TREE_TRUNK][CMD_TEXT]=sprintf("%d",arg)
      tree[i][TREE_BRANCHES]={}
    elsif sequence(arg) and length(arg) then
      tree[i]=arg
    end if
    if length(tree[i][TREE_BRANCHES]) then
      --if there are sub-arguments, recurse
      tree[i][TREE_BRANCHES]=optimize_script(tree[i][TREE_BRANCHES],vars)
    end if
  end for
  return(tree)
end function

---------------------------------------------------------------------------

--FIXME: if a local is used only in a subscript it is reported as unused
procedure warn_unused_locals(VarList vars)
  for i=1 to length(vars) do
    if vars[i][VAR_FRAME]=0 and not map:has(used_locals,vars[i][VAR_ID]) then
      src_warn(sprintf_utf("local variable "&COLYEL&"%s"&COLRED&" is never used",{vars[i][CMD_TEXT]}),vars[i][CMD_POS])
    end if
  end for
end procedure

---------------------------------------------------------------------------

procedure warn_unused_globals()
  integer id
  for i=1 to length(global_list[PAIR_NUM]) do
    id=global_list[PAIR_NUM][i]
    if not map:has(used_globals,id) then
      src_warn(sprintf_utf("global variable "&COLYEL&"%s"&COLRED&" ID "&COLYEL&"%d"&COLRED&" is never used",{global_list[PAIR_NAME][i],id}),global_list[GLB_POS][i])
    end if
  end for
end procedure

---------------------------------------------------------------------------

--script_idx is all_scripts index
procedure compile_a_script(integer script_idx)
  Script script
  NodeList script_tree
  VarList local_vars
  TokenList args
  integer num_nonlocals
  integer parent_idx
  integer role_idx
  integer role

  cur_script_num=script_idx
  script=all_scripts[script_idx]
  role_idx=find_in_column(script[SCRIPT_ROLE_TOK][CMD_TEXT],script_role_list,PAIR_NAME)
  role=script_role_list[role_idx][PAIR_NUM]
  current_script=script[SCRIPT_FULL_NAME]
  parent_idx=script[SCRIPT_PARENT_IDX]

  reenter_timing_zone("gather_local_vars")
  if parent_idx then
    local_vars=shift_variables_frame(all_scripts[parent_idx][SCRIPT_VARIABLES])
  else
    local_vars={}
  end if
  num_nonlocals=length(local_vars)
  script&={
     role            --SCRIPT_ROLE_ID
    ,num_nonlocals   --SCRIPT_NUM_NONLOCALS
    ,local_vars      --SCRIPT_VARIABLES
  }
  all_scripts[script_idx]=script

  --Get all locals (modifies all_scripts[cur_script_num])
  args=script[SCRIPT_ARG_TOKS] --The arguments are the first several local variables
  for i=1 to length(args) do
    --Checks for name validity
    add_local_variable(args[i])
  end for
  gather_local_vars(script[SCRIPT_BODY_TOKS])
  --script[SCRIPT_VARIABLES] is now outdated
  script=all_scripts[script_idx]
  local_vars=script[SCRIPT_VARIABLES]

  if length(local_vars)-num_nonlocals > MAX_LOCALS then
    simple_error(
      sprintf_utf("Script "&COLYEL&"%s"&COLRED&" has %d arguments and variables but at most %d are supported",
                  {script[SCRIPT_FULL_NAME],length(local_vars)-num_nonlocals,MAX_LOCALS})
    )
  end if
  exit_timing_zone()

  used_locals=map:new()
  reenter_timing_zone("build_ast")
  script_tree=build_ast(script[SCRIPT_BODY_TOKS],local_vars)
  exit_timing_zone()
  reenter_timing_zone("convert_operators")
  script_tree=convert_operators(script_tree)
  exit_timing_zone()
  reenter_timing_zone("expand_macros")
  script_tree=expand_macros(script_tree)
  exit_timing_zone()
  reenter_timing_zone("normalize_flow_control")
  script_tree=normalize_flow_control(script_tree,local_vars,"")
  exit_timing_zone()
  reenter_timing_zone("normalize_arguments")
  script_tree=normalize_arguments(script_tree,local_vars)
  exit_timing_zone()
  reenter_timing_zone("collapse_floaty_brackets")
  script_tree=collapse_floaty_brackets(script_tree)
  exit_timing_zone()
  if not fast_mode then
    reenter_timing_zone("optimize_script")
    script_tree=optimize_script(script_tree,local_vars)
    exit_timing_zone()
    reenter_timing_zone("sanity_check")
    script_tree=sanity_check(script_tree,local_vars,"")
    exit_timing_zone()
    if find('u',optlist) then
      warn_unused_locals(local_vars)
    end if
  end if

  script&={
     script_tree     --SCRIPT_AST
    ,{}              --SCRIPT_BINARY
  }
  all_scripts[script_idx]=script
  reenter_timing_zone("binary_compile")
  all_scripts[script_idx][SCRIPT_BINARY]=binary_compile(script)
  exit_timing_zone()

  current_script=""
  cur_script_num=0
end procedure

---------------------------------------------------------------------------

--Parse argument declarations (initially containing default values)
--in a script argument list, returns {arg_names_list, default_vals_list} pair
--where any default values have been removed from the argument names
function process_arglist(TokenList args)
  TokenList arglist
  sequence defaults
  integer i
  integer using_defaults
  arglist={}
  defaults={}
  using_defaults=false
  i=1
  while i<=length(args) do
    if compare("=",args[i][CMD_TEXT])=0 then
      src_error("Syntax error: spurious = in script argument list",args[i][CMD_POS])
    end if
    check_undefined_string(args[i],"argument name")
    if find(args[i][CMD_TEXT],column(arglist,CMD_TEXT)) then
      src_error(sprintf_utf("Multiple script arguments named "&COLYEL&"%s"&COLRED&" in argument list",{args[i][CMD_TEXT]}),args[i][CMD_POS])
    end if
    if i<length(args) and compare("=",args[i+1][CMD_TEXT])=0 then
      if i+2>length(args) then
        src_error(sprintf_utf("Syntax error: expected default value for script argument "&COLYEL&"%s"&COLRED,{args[i][CMD_TEXT]}),args[i+1][CMD_POS])
      end if
      arglist=append(arglist,args[i])
      defaults&=try_string_to_number({enforce_constants(args[i+2][CMD_TEXT]),args[i+2][CMD_POS]})
      using_defaults=true
      i+=3
    else
      if using_defaults=true then
        --any argument with a default must be followed with arguments with defaults
        src_error(sprintf_utf("Default value missing for argument "&COLYEL&"%s"&COLRED&": the previous argument had a default value, so all following ones must too",{args[i][CMD_TEXT]}),args[i][CMD_POS])
      end if
      arglist=append(arglist,args[i])
      defaults=append(defaults,NO_DEFAULT)
      i+=1
    end if
  end while
  return({arglist,defaults})
end function

---------------------------------------------------------------------------

--Check that every declared script has been defined, with the same number of arguments,
--and each script appears exactly once. Basically, compare script_list and all_scripts
--Also handle argument default values.
--Before this function, scripts only have IDs (stored in script_list) if they are declared in a definescript.
--Afterwards all scripts have IDs assigned (in all_scripts)
procedure check_script_declarations()
  integer at
  sequence args_and_defaults, args, defaults
  sequence scripts_found
  sequence src_position, attributes
  string fullname
  srcpos script_pos
  integer id, parent_id

  scripts_found=repeat(false,length(script_list))

  for i=1 to length(all_scripts) do
    fullname=all_scripts[i][SCRIPT_FULL_NAME]
    parent_id=get_parent_id(all_scripts[i])

    current_script=fullname  --global
    script_pos=all_scripts[i][SCRIPT_POS]
    attributes=all_scripts[i][SCRIPT_ATTRIBUTES]  --Attributes get copied to script_list, where they belong
    --at=find(fullname,column(script_list,PAIR_NAME))
    at=find_in_column(fullname,script_list,PAIR_NAME)

    args_and_defaults=process_arglist(all_scripts[i][SCRIPT_ARG_TOKS])
    args=args_and_defaults[1]
    defaults=args_and_defaults[2]

    if not at then
      --define script optional, add to script list
      id=pick_script_id(parent_id,all_scripts[i][PAIR_NAME])
      script_list=create_function(script_list,id,current_script,defaults,KIND_SCRIPT,script_pos,attributes)
      at=length(script_list)
      scripts_found&={true}
    else
      if scripts_found[at]=true then
        simple_error(sprintf_utf("Compiler bug; two scripts named %s but this error not handled properly",{current_script}))
      end if
      scripts_found[at]=true
      --The srcpos stored for this script will be from definescript. Repoint it at the actual script
      --(doesn't really matter, all_scripts would have ended up with that srcpos anyway)
      script_list[at][FUNC_POS]=script_pos
      script_list[at][FUNC_ATTRS]&=attributes

      if length(args) != length(script_list[at][FUNC_ARGS]) then
        src_error(
          sprintf_utf(
            "Script "&COLYEL&"%s"&COLRED&" has %d arguments named, but has %d arguments in its definescript declaration"
            ,{current_script,length(args),length(script_list[at][FUNC_ARGS])}
          )
          ,script_pos
        )
      end if
      for j=1 to length(script_list[at][FUNC_ARGS]) do
        if not equal(defaults[j],NO_DEFAULT) and not equal(defaults[j],script_list[at][FUNC_ARGS][j]) then
          src_error(
            sprintf_utf(
              "Default value for argument "&COLYEL&"%s"&COLRED&" does not match default given in script definition, %d"
              ,{all_scripts[i][SCRIPT_ARG_TOKS][j][CMD_TEXT],script_list[at][FUNC_ARGS][j]}
            )
            ,script_pos
          )
        end if
      end for
    end if
    if length(args)>MAX_ARGS then
      src_error(sprintf_utf("Number of arguments (%d) is more than allowed (%d)",{length(args),MAX_ARGS}),script_pos)
    end if

    all_scripts[i][SCRIPT_ARG_TOKS]=args
    all_scripts[i]&={script_list[at][PAIR_NUM]}  --append SCRIPT_ID
  end for
  current_script=""

  for i=1 to length(scripts_found) do
    if scripts_found[i]=false then
      src_error(
        sprintf_utf("Script "&COLYEL&"%s"&COLRED&" was declared using "&COLYEL&"define script"&COLRED&" but is missing.",{script_list[i][PAIR_NAME]})
        ,script_list[i][FUNC_POS]
      )
    end if
  end for
end procedure

---------------------------------------------------------------------------

procedure compile_each_script()
  sequence count
  enter_timing_zone("Compiling scripts")
  color_print("compiling scripts",{})
  count=repeat(0,length(file_list))

  enter_timing_zone("check_script_declarations")
  check_script_declarations()
  exit_timing_zone()

  for i=1 to length(all_scripts) do
   -- color_print("%s\n",{all_scripts[i][SCRIPT_NAME]})
    reenter_timing_zone("compile_a_script")
    compile_a_script(i)
    exit_timing_zone()
    count[srcpos_file_number(all_scripts[i][SCRIPT_POS])]+=1

    color_print(".",{})
  end for
  color_print("\n",{})
  if not fast_mode and find('u',optlist) then
    warn_unused_globals()
  end if
  for i=1 to length(count) do
    if count[i] then
      wrap_print("compiled %d scripts from "&COLBWHI&"%s"&COLWHI&"\n",{count[i],file_list[i][FILE_NAME]})
    end if
  end for
  exit_timing_zone()
end procedure

---------------------------------------------------------------------------

function generate_scripts_dot_txt()
  sequence result
  integer print_scripts
  result=""
  print_scripts = 0
  if find('a',optlist) then
    print_scripts = 2
  elsif find('s',optlist) then
    print_scripts = 1
  end if

  for i=1 to length(script_list) do
    result&=encode_ohr(sprintf_utf("%s\r\n%d\r\n%d\r\n",{script_list[i][PAIR_NAME],script_list[i][PAIR_NUM],length(script_list[i][FUNC_ARGS])}))
    for j=1 to length(script_list[i][FUNC_ARGS]) do
      if equal(script_list[i][FUNC_ARGS][j],NO_DEFAULT) then
        result&="0\r\n"
      else
        result&=sprintf("%d\r\n",{script_list[i][FUNC_ARGS][j]})
      end if
    end for
    if (print_scripts=1 and script_list[i][PAIR_NUM]<autonumber_id) or print_scripts=2 then
      wrap_print("%s\r\n",{script_list[i][PAIR_NAME]})
    end if
  end for
  return(result)
end function

---------------------------------------------------------------------------


function generate_scripts_dot_bin()
  sequence result
  sequence encoded_name
  --header size in bytes
  result=output_word(4)
  --record size in bytes
  result&=output_word(44)

  for i=1 to length(all_scripts) do
    result&=output_word(all_scripts[i][SCRIPT_ID])
    result&=output_word(all_scripts[i][SCRIPT_ROLE_ID])
    encoded_name=encode_ohr(all_scripts[i][SCRIPT_NAME],36)
    result&=output_word(length(encoded_name))
    result&=encoded_name
    result&=repeat(0,36-length(encoded_name))
    result&=output_word(get_parent_id(all_scripts[i]))
  end for
  return(result)
end function

---------------------------------------------------------------------------

--Returns a list of {id, {parent_id, encode_ohr(script_name)[1..36]}} pairs
function read_scripts_dot_bin(string filename)
  object data
  integer header_size
  integer rec_size
  integer offset
  sequence record, name
  integer id, parent_id
  integer name_len
  sequence ret

  data=read_file(filename)
  if equal(data,-1) then
    simple_error("Could not read "&filename)
  end if

  header_size=read_int16(data,0)
  rec_size=read_int16(data,1)
  if header_size!=4 or rec_size<42 then
    simple_error(filename&" in unrecognised format. Use the latest version of HSpeak")
  end if

  ret={}
  for i=0 to (length(data)-header_size) / rec_size - 1 do
    offset=header_size + i*rec_size
    record=data[offset+1..offset+rec_size]
    id=read_int16(record,0)
    name_len=read_int16(record,2)
    name=record[7..7+name_len-1]
    parent_id=0
    if rec_size>=44 then
      --Scripts compiled by older copies of hspeak didn't include the parent ID
      parent_id=read_int16(record,21)
    end if
    ret&={ {id, {parent_id,name}} }
  end for
  --pretty_print(stdout,ret,{3})
  return ret
end function

---------------------------------------------------------------------------

function generate_commands_dot_bin()
  sequence result
  sequence encoded_names
  integer i, id, name_num
  integer offset
  integer records
  function_list=sort(function_list)
  if length(function_list) then
    records=function_list[$][PAIR_NUM]+1
  else
    records=0
  end if
  if records>2048 then
    simple_warn(sprintf_utf("Maximum function id was %d, but will not export function names above id 2047",{records-1}))
    records=2048
  end if
  --header size in bytes (offset to location table)
  result=output_word(6)
  --file format version
  result&=output_word(0)
  --number of records in location table
  result&=output_word(records)

  offset=length(result)+records*2
  id=0
  i=1
  encoded_names={}
  while i<=length(function_list) do
    if function_list[i][PAIR_NUM]<id then
      --skip aliases
      i+=1
    elsif function_list[i][PAIR_NUM]=id then
      result&=output_word(offset)
      encoded_names&={encode_ohr(function_list[i][PAIR_NAME])}
      offset+=4+length(encoded_names[$])
      i+=1
      id+=1
    else
      --no function with this id
      result&=output_word(0)
      id+=1
    end if
  end while
  i=1
  name_num=1
  id=-1
  while i<=length(function_list) and function_list[i][PAIR_NUM]<records do
    if function_list[i][PAIR_NUM]=id then
      --skip aliases
      i+=1
      continue
    end if
    if equal(function_list[i][FUNC_ARGS],VAR_ARGS) then
      result&=output_word(-1)
    else
      result&=output_word(length(function_list[i][FUNC_ARGS]))
    end if
    result&=output_word(length(encoded_names[name_num]))
    result&=encoded_names[name_num]
    name_num+=1
    id=function_list[i][PAIR_NUM]
    i+=1
  end while
  return(result)
end function

---------------------------------------------------------------------------

procedure write_script_files(integer fh)
  string fname
  string temp, ext
  --because script files with identical names in different directories can be
  --included, append a number to lump names which would be duplicate
  integer suffix
  sequence names_used
  names_used={}
  for i=1 to length(file_list) do
    fname=file_only(file_list[i][FILE_NAME])
    ext=extension_only(fname)
    --Lump names can be at most 50 characters, so trim if longer
    if length(fname)>47 then
      temp=without_extension(fname)
      fname=temp[1..46-length(ext)]&"."&ext
    end if
    suffix=count(fname,names_used)
    names_used=append(names_used,fname)
    if suffix>0 then
      temp=without_extension(fname)  --you can't slice a function result directly! :(
      fname=sprintf_utf("%s~%d.%s",{temp[1..$-1],suffix,ext})
    end if
    file_list[i][FILE_LUMP]=fname
    --color_print("writing %d %s\n",{i,fname})
    if write_lump(fh,fname,file_list[i][FILE_TEXT])=false then
      simple_error("unable to write a script source lump")
    end if
  end for
end procedure

---------------------------------------------------------------------------

function generate_srcfiles_dot_txt()
  sequence result
  result=""
  for i=1 to length(file_list) do
    result&=sprintf_utf("file=%s\nlump=%s\noffset=%d\nlength=%d\n",
      {
        absolutize_path(file_list[i][FILE_NAME]),
        file_list[i][FILE_LUMP],
        file_list[i][FILE_OFFSET],
        length(file_list[i][FILE_TEXT])
      })
  end for
  return(result)
end function

---------------------------------------------------------------------------

procedure write_output_file()
  sequence header
  integer fh
  object lh
  enter_timing_zone("Writing output file")
  header=sprintf("HamsterSpeak\n%s\n%d\n%s\n%d\n%d\n",{COMPILER_VERSION & COMPILER_SUB_VERSION,HSP_FORMAT_VERSION,plotscr_version,HSZ_FORMAT_VERSION,max_used_function})
  if length(all_scripts) then
    fh=open(dest_file,"wb")
    dest_file_fh=fh
    if fh!=-1 then
      wrap_print("writing output file "&COLBWHI&"%s"&COLWHI&"\n",{dest_file})
      --write header and version
      if write_lump(fh,"HS",header)=false then
        simple_error("unable to write header")
      end if
      --write script index (old file)
      if write_lump(fh,"scripts.txt",generate_scripts_dot_txt())=false then
        simple_error("unable to write script index")
      end if
      --write script index (new file)
      if write_lump(fh,"scripts.bin",generate_scripts_dot_bin())=false then
        simple_error("unable to write binary script index")
      end if
      --write script commands list
      if write_lump(fh,"commands.bin",generate_commands_dot_bin())=false then
        simple_error("unable to write commands listing")
      end if
      --write each script
      for i=1 to length(all_scripts) do
        if write_lump(fh,sprintf("%d.hsz",{all_scripts[i][SCRIPT_ID]}),all_scripts[i][SCRIPT_BINARY])=false then
          simple_error(sprintf_utf("internal problem: unable to write script "&COLYEL&"%s"&COLRED,{all_scripts[i][SCRIPT_NAME]}))
        end if
      end for
      if debug_info then
        --write copy of scripts
        wrap_print("copying script source code into "&COLBWHI&"%s"&COLWHI&"\n",{dest_file})
        lh=begin_lump(fh,"source.lumped")
        if equal(lh,false) then
          simple_error("unable to write scripts source file")
        end if
        write_script_files(fh)
        if end_lump(lh)=false then
          simple_error("unable to finish write of scripts source file")
        end if
        --write source file table (must occur after write_script_files)
        if write_lump(fh,"srcfiles.txt",generate_srcfiles_dot_txt())=false then
          simple_error("unable to write source files listing")
        end if
      end if
      close(fh)
    else
      simple_error(sprintf_utf("attempt to open "&COLYEL&"%s"&COLRED&" failed",{dest_file}))
    end if
  else
    color_print("no scripts to output\n",{})
  end if
  exit_timing_zone()
end procedure

---------------------------------------------------------------------------

init()
load_and_lex_all()
show_source_info()
preliminary_parse_pass()
parse_top_level()
compile_each_script()
dump_debug_report()
write_output_file()

run_time=time()-start_time
color_print("done (%g seconds)\n",{run_time})
if find('t',optlist) then
  print_timing_data()
end if
opt_wait_for_key(was_warnings)
if was_warnings = true then
  abort(2)
end if
