'OHRRPGCE GAME
'(C) Copyright 1997-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 module contains routines to do with HamsterSpeak which are (mostly)
' independent of the specific HS interpreter in use, or abstract between interpreters.
' Implementations of script commands are in scriptcommands.bas, not here.


#include "config.bi"
#include "udts.bi"
#include "gglobals.bi"
#include "const.bi"
#include "scrconst.bi"
#include "allmodex.bi"
#include "common.bi"
#include "scriptcommands.bi"
#include "yetmore2.bi"
#include "scripting.bi"
#include "loading.bi"
#include "sliceedit.bi"
#include "string.bi" 'for format


'------------ Local functions -------------

DECLARE SUB freescripts (byval mem as integer)
DECLARE FUNCTION loadscript_open_script(n as integer, expect_exists as bool = YES) as integer
DECLARE FUNCTION loadscript_read_header(fh as integer, id as integer) as ScriptData ptr
DECLARE FUNCTION loadscript_read_data(header as ScriptData ptr, fh as integer) as bool
DECLARE FUNCTION scriptcache_find(id as integer) as ScriptData ptr
DECLARE SUB scriptcache_add(id as integer, thisscr as ScriptData ptr)

DECLARE SUB print_command_profiling(entiretime as double, timeroverhead as double)

'------------ Global variables ------------

DEFINE_VECTOR_OF_POD_TYPE(ScriptFibre ptr, ScriptFibre_ptr)

'ID of the command being timed, or 0 if not timing
DIM profiling_cmdid as integer
'The script containing the timed command, 0 if not timing
DIM profiling_cmd_in_script as ScriptData ptr
'ID of a single command to tally time spent per script, while command profiling
DIM time_specific_cmdid as integer = 0
DIM command_profiles(maxScriptCmdID) as CommandProfile

'--------- Module shared variables ---------

'Used by trigger_script
DIM SHARED trigger_script_result as RunScriptResult
DIM SHARED last_triggered_fibre as ScriptFibre ptr   'Fibre created by the last trigger_script, NULL on failure or after dequeued


'==========================================================================================
'                                   Triggering scripts
'==========================================================================================


SUB trigger_script (id as integer, numargs as integer, double_trigger_check as bool, trigger_name as string, trigger_loc as string, byref fibregroup as ScriptFibre ptr vector, priority as integer = 0)
 'Add a script to one of the script queues, unless already inside the interpreter.
 'In that case, run immediately.
 'After calling this SUB, call trigger_script_arg zero or more times to set the arguments.
 'All arguments must be given, in the right order.
 '
 'id:           either a script ID or a trigger number
 'numargs:      the number of arguments that will be provided
 'double_trigger_check:  whether "no double-triggering" should take effect
 'trigger_name: identifies the trigger (used for debugging/tracing), eg "autorun"
 'trigger_loc:  specific script trigger cause, eg "map 5"
 'fibregroup:   a vector of ScriptFibre ptrs, usually mainFibreGroup

 IF numargs > maxScriptArgs THEN
  showbug "trigger_script: too many args: " & numargs
  numargs = maxScriptArgs
 END IF

 DIM insertpos as integer
 DIM prev_fibre as ScriptFibre ptr

 IF insideinterpreter THEN
  'Always becomes the topmost fibre, priority ignored (TODO: this will change)
  insertpos = v_len(fibregroup)

  prev_fibre = hsvm.cur_fibre
  last_triggered_fibre = NEW ScriptFibre
  hsvm.cur_fibre = last_triggered_fibre

  trigger_script_result = runscript(id, YES, double_trigger_check, trigger_name)

  IF trigger_script_result = rsSuccess THEN
   hsvm.cur_fibre->root = hsvm.cur_scriptinst

   IF gam.script_log.enabled THEN
    'Can't call watched_script_triggered until after the trigger_script_args calls,
    'so get interpretloop to call it.
    hsvm.cur_scriptinst->watched = YES
    hsvm.cur_scrat->state = sttriggered
   END IF
  END IF
  'Else keep going just in case logging scripts

 ELSE
  'Script log will be handled by run_queued_script

  trigger_script_result = rsSuccess  'Can't fail until runscript actually called

  last_triggered_fibre = NEW ScriptFibre

  'Insert into the queue according to priority
  'Note that the script at the top of the queue is the first to run,
  'so ties are broken by the last triggered being the first to run.
  insertpos = -1
  FOR insertpos = v_len(fibregroup) - 1 TO 0 STEP -1
   IF fibregroup[insertpos]->priority <= priority THEN EXIT FOR
  NEXT
  insertpos += 1
 END IF

 'Note: we always add the new fibre to mainFibreGroup even if runscript failed.
 'If we didn't, then we shouldn't call delete_fibre.
 '(delete_fibre expects it as a sanity check. It wouldn't otherwise be necessary.)

 v_insert fibregroup, insertpos, last_triggered_fibre

 'Save information about this script, for use by trigger_script_arg()
 WITH *last_triggered_fibre
  id = decodetrigger(id)
  'If the script was missing, id is now 0, but still queue the script so trigger_script_arg works.
  .id = id
  .trigger_name = trigger_name
  .log_line = scriptname(id) & "("
  .trigger_loc = trigger_loc
  .double_trigger_check = double_trigger_check
  .priority = priority
  .argc = numargs
 END WITH

 IF trigger_script_result <> rsSuccess THEN
  'insideinterpreter = YES. Log failed trigger
  IF gam.script_log.enabled THEN watched_script_triggered *last_triggered_fibre

  delete_fibre hsvm.cur_fibre
  hsvm.cur_fibre = prev_fibre
  EXIT SUB
 END IF

END SUB

SUB trigger_script_arg (byval argno as integer, byval value as integer, byval argname as zstring ptr = NULL)
 'Set one of the args for a script that was just triggered. They must be in the right order, and all provided.
 'Note that after calling trigger_script, script queuing can be in three states:
 'inside interpreter, trigger_script_result = rsSuccess, last_triggered_fibre valid
 '    triggered a script which started immediately
 'inside interpreter, trigger_script_result <> rsSuccess, last_triggered_fibre = NULL
 '    triggered a script which there was an error starting
 'not inside interpreter, trigger_script_result = rsSuccess, last_triggered_fibre valid
 '    queued a script, can now set the arguments

 IF trigger_script_result <> rsSuccess ORELSE last_triggered_fibre = NULL THEN EXIT SUB

 IF insideinterpreter THEN
  setScriptArg argno, value
 END IF

 WITH *last_triggered_fibre
  BUG_IF(argno >= .argc, .trigger_name & " triggering is broken: bad arg num " & argno)
  .args(argno) = value
  IF gam.script_log.enabled THEN
   IF argno <> 0 THEN .log_line += ", "
   IF argname THEN .log_line += *argname + "="
   .log_line &= value
  END IF
 END WITH
END SUB

'If a script was triggered outside the interpreter, runscript hasn't been called yet. This does so.
'Returns true on success, false to delete the fibre
LOCAL FUNCTION run_queued_script (fibre as ScriptFibre) as bool
 'If the script is missing then .id = 0 and decodetrigger already showed an error
 IF fibre.id = 0 THEN RETURN NO

 DIM prev_fibre as ScriptFibre ptr = hsvm.cur_fibre
 hsvm.cur_fibre = @fibre

 trigger_script_result = runscript(fibre.id, YES, fibre.double_trigger_check, fibre.trigger_name)
 IF trigger_script_result = rsSuccess THEN
  FOR argno as integer = 0 TO fibre.argc - 1
   setScriptArg argno, fibre.args(argno)
  NEXT

  fibre.root = hsvm.cur_scriptinst
 ELSE
  hsvm.cur_fibre = prev_fibre
 END IF

 'Log failed triggers too
 IF gam.script_log.enabled THEN watched_script_triggered fibre

 RETURN trigger_script_result = rsSuccess
END FUNCTION

'Load queued script fibres into the interpreter (this is delayed so the order
'can change by priority)
SUB run_queued_scripts(byref fibregroup as ScriptFibre ptr vector)
 last_triggered_fibre = NULL

 DIM idx as integer = 0
 WHILE idx < v_len(fibregroup)  'Length changes during iteration
  IF fibregroup[idx]->root = NULL THEN
   'Not run yet
   IF run_queued_script(*fibregroup[idx]) = NO THEN
    'runscript failed
    delete_fibre fibregroup[idx]
    CONTINUE WHILE
   END IF
  END IF
  idx += 1
 WEND
END SUB


'==========================================================================================
'                                 Script Trigger Logging
'==========================================================================================


SUB start_script_trigger_log
 safekill gam.script_log.filename
 DIM fh as integer = FREEFILE
 IF OPEN(gam.script_log.filename FOR APPEND AS #fh) THEN
  notification "Could not open " & gam.script_log.filename & ". Script logging disabled."
  gam.script_log.enabled = NO
  EXIT SUB
 END IF
 gam.script_log.enabled = YES

 print #fh, "Script trigger log for " & getdisplayname(trimpath(sourcerpg)) & ", " & DATE & " " & TIME
 print #fh,
 print #fh, "Solid lines '|' show triggered scripts which have already started running but are"
 print #fh, "waiting or paused due to either another script which was triggered (indicated by a"
 print #fh, "line to its right) or while waiting for a script they called (called scripts aren't"
 print #fh, "shown, only triggered scripts are)."
 print #fh, "Dotted lines ':' show triggered scripts which have not even had a chance to start."
 print #fh, "(...as above...) means that a script continues waiting multiple ticks for the same reason."
 print #fh,
 print #fh, " Symbols in front of script names:"
 print #fh, "+ -- A script was triggered (queued), possibly also started, possibly also finished"
 print #fh, "! -- As above, but triggered as a side effect of something the script above it did,"
 print #fh, "     such as running ""close menu"", interrupting that script."
 print #fh, "     (Note: ! is used only if the command didn't cause an implicit 'wait')"
 print #fh, "* -- A queued script was started, possibly also finished"
 print #fh, "- -- A previously started script finished"
 print #fh,
 CLOSE #fh
END SUB

'Called when resetting game (but not before the first time through a game)
SUB script_log_resetgame
 WITH gam.script_log
  ' Leave .enabled alone, continuing to log
  IF .enabled THEN
   script_log_out !"\n--- Game ended ---\n\n"
  END IF
  .tick = 0
  .wait_msg_repeats = 0
 END WITH
END SUB

SUB script_log_out (text as string)
 IF gam.script_log.enabled = NO THEN EXIT SUB
 DIM fh as integer = FREEFILE
 IF OPEN(gam.script_log.filename FOR APPEND AS #fh) THEN
  gam.script_log.enabled = NO
  EXIT SUB
 END IF
 #IFDEF __FB_WIN32__
  'FB opens files in binary mode...
  replacestr text, !"\n", !"\r\n"
 #ENDIF

 print #fh, text;
 CLOSE #fh
 gam.script_log.output_flag = YES
END SUB

FUNCTION script_log_indent (byval upto as integer = -1, byval spaces as integer = 11) as string
 DIM indent as string = SPACE(spaces)
 IF upto = -1 THEN upto = nowscript - 1
 FOR i as integer = 0 TO upto
  WITH scriptinsts(i)
   IF .watched THEN
    IF .started THEN
     indent &= "| "
    ELSE
     indent &= ": "
    END IF
   END IF
  END WITH
 NEXT
 RETURN indent
END FUNCTION

'Called after runscript when running a script which should be watched
'(Currently always a new fibre, but in future would be nice to be able to watch other scripts)
SUB watched_script_triggered(fibre as ScriptFibre)
 IF gam.script_log.last_logged ANDALSO gam.script_log.last_logged->started = NO THEN
  script_log_out " (queued)"
 END IF

 IF trigger_script_result = rsSuccess THEN
  hsvm.cur_scriptinst->watched = YES
  gam.script_log.last_logged = hsvm.cur_scriptinst
 ELSE
  gam.script_log.last_logged = NULL
 END IF

 DIM logline as string
 logline = !"\n" & script_log_indent()

 IF insideinterpreter THEN
  'Being inside the interpreter means we weren't called from run_queued_scripts,
  'therefore there was already a running script.
  IF trigger_script_result <> rsSuccess THEN
   'hsvm.cur_scriptinst is the previously running script
   logline &= "!"
  ELSEIF hsvm.cur_scriptinst->parent = NULL THEN
   'This script was triggered as a side effect of something that the previous
   'script did, such as advance a text box
   logline &= "!"
  ELSE
   'Called normally (this currently never happens)
   logline &= "\"
  END IF
 ELSE
  'Triggered normally
  logline &= "+"
 END IF

 logline &= fibre.log_line & ") " & fibre.trigger_name & " script"
 IF LEN(fibre.trigger_loc) THEN
  logline &= ", " & fibre.trigger_loc
 END IF
 IF trigger_script_result = rsIgnored THEN
  logline &= " ...did not trigger: double trigger ignored"
 ELSEIF trigger_script_result <> rsSuccess THEN
  logline &= " ...ERROR: could not run! See g_debug.txt"
 END IF

 script_log_out logline
END SUB

'nowscript has been started and resumed and has .watched = YES
SUB watched_script_resumed
 IF gam.script_log.last_logged = hsvm.cur_scriptinst THEN
  'nothing
 ELSEIF hsvm.cur_scriptinst->started THEN
  'also nothing
 ELSE
  script_log_out !"\n" & script_log_indent() & "*" & scriptname(hsvm.cur_scriptinst->id) & " started"
  gam.script_log.last_logged = hsvm.cur_scriptinst
 END IF
 hsvm.cur_scriptinst->started = YES
END SUB

'Called right before the current script terminates if it has .watched = YES
SUB watched_script_finished
 DIM logline as string
 IF gam.script_log.last_logged = hsvm.cur_scriptinst THEN
  logline = " ... finished"
 ELSE
  logline = !"\n" & script_log_indent() & "-" & scriptname(hsvm.cur_scriptinst->id) & " finished"
 END IF
 IF scriptprofiling THEN
  ' This global is set by script_return_timing()
  logline &= "  (took " & format(gam.script_log.last_script_childtime * 1e3, "0.0") & "ms)"
 END IF
 script_log_out logline

 gam.script_log.last_logged = NULL
END SUB

'Call each tick if script logging is enabled
SUB script_log_tick
 WITH gam.script_log
  DIM doprint as bool = NO
  IF .output_flag THEN doprint = YES

  DIM wait_msg as string = ""
  IF hsvm.cur_scriptinst THEN
   WITH *hsvm.cur_scriptinst
    IF .waiting = waitingOnCmd THEN
     wait_msg = "waiting on " & commandname(.curvalue) & " in " & scriptname(.id)
    ELSEIF .waiting = waitingOnTick THEN
     wait_msg = "waiting " & .waitarg & " ticks in " & scriptname(.id)
    END IF
   END WITH
   IF .last_wait_msg <> wait_msg THEN
    .last_wait_msg = wait_msg
    .wait_msg_repeats = 0
   END If
   .wait_msg_repeats += 1
   IF .wait_msg_repeats <= 2 THEN doprint = YES
   IF .wait_msg_repeats = 2 THEN wait_msg = "...as above..."
  END IF

  IF doprint THEN
 '  script_log_out !"\n" & script_log_indent(nowscript) & "   <<tick " & .tick & ">>"
   DIM logline as string
   logline =  !"\ntick " & LEFT(RIGHT(STR(.tick), 5) & "     ", 6) & script_log_indent(nowscript, 0)
   IF LEN(wait_msg) THEN logline &= "     (" & wait_msg & ")"
   script_log_out logline
   .output_flag = NO

   .last_logged = NULL
  END IF
 END WITH
END SUB


'==========================================================================================
'                                   Fibre/Script Control
'==========================================================================================

'Must be called after nowscript changes
SUB HSVMState.set_cur_script()
 IF nowscript < 0 THEN
  cur_scrat = NULL
  cur_scriptinst = NULL
  cur_script = NULL
 ELSE
  cur_scrat = @scrat(nowscript)
  cur_scriptinst = @scriptinsts(nowscript)
  cur_script = cur_scriptinst->scr
  'Used to be the case that in-use scripts could be unloaded
  BUG_IF(cur_script = NULL, "NULL ScriptData")
 END IF
 cur_slot = nowscript   'Temp
END SUB

'Delete a fibre that's been added to mainFibreGroup (or in future, any other global fibre group).
'A fibre must be deleted after any ScriptInsts that point to it!
'(Hence, this doesn't look for any ScriptInsts with a pointer to `fibre`.)
SUB delete_fibre(fibre as ScriptFibre ptr)
 '? " fibre ended " & scriptname(hsvm.cur_scriptinst->id)
 'Cleanup every global that might hold a reference
 IF hsvm.cur_fibre = fibre THEN hsvm.cur_fibre = NULL
 IF last_triggered_fibre = fibre THEN last_triggered_fibre = NULL
 'Even if runscript fails, we always add new fibres to mainFibreGroup
 DIM idx as integer = v_remove(mainFibreGroup, fibre)
 BUG_IF(idx = -1, "Missing from mainFibreGroup")
 DELETE fibre
END SUB

'Kills the currently running script fibre
SUB killscriptthread
 BUG_IF(insideinterpreter = NO ORELSE hsvm.cur_scrat = NULL, "Inappropriate call")

 debuginfo "Killing script fibre; last script = " & scriptname(hsvm.cur_scrat->id)

 'Hack: we set the state of the old script because the main loop has a stale WITH pointer.
 'Come to think of it, there's no good reason for the interpreter state to be stored in scrat instead
 'of being global.
 hsvm.cur_scrat->state = stdone

 'Remove every script in this fibre, except for the bottommost one
 WHILE hsvm.cur_scriptinst->parent
  deref_script hsvm.cur_script
  nowscript -= 1
  hsvm.set_cur_script
 WEND
 gam.script_log.last_logged = NULL
 'Won't be used, but better not to leave a stale ptr as we return to the interpreter
 nowscript_locals = @heap(hsvm.cur_scrat->frames(0).heap)

 'Let functiondone handle the fibre exit, so that we do everything properly and exit interpretloop normally
 setstackposition(scrst, hsvm.cur_scrat->stackbase)
 hsvm.cur_scrat->state = stdone
END SUB

SUB killallscripts
 'this kills all running scripts.
 'for use in cases of massive errors, quiting to titlescreen or loading a game.

 'Try to compute running times instead of corrupting the timing statistics (untested!)
 stop_fibre_timing

 'Hack, see explanation in killscriptthread
 IF hsvm.cur_scrat THEN hsvm.cur_scrat->state = stexit

 WHILE hsvm.cur_script
  IF hsvm.cur_scriptinst->parent = NULL THEN
   'TODO: in future, delete the fibre after the last script in it
   delete_fibre hsvm.cur_scriptinst->fibre
  END IF
  deref_script(hsvm.cur_script)
  nowscript -= 1
  hsvm.set_cur_script
 WEND
 nowscript_locals = NULL
 gam.script_log.last_logged = NULL

 setstackposition(scrst, 0)

 'Delete the fibres... but there should be none left.
 IF v_len(mainFibreGroup) THEN debugc errBug, "killallscripts: orphan fibres"
 IF mainFibreGroup THEN  'During startup not initialised yet?
  FOR idx as integer = v_len(mainFibreGroup) - 1 TO 0 STEP -1
   delete_fibre mainFibreGroup[idx]
  NEXT
 END IF

END SUB

SUB resetinterpreter
'unload all scripts and wipe interpreter state. use when quitting the game.

 killallscripts

 IF numloadedscr > 0 THEN
  'Also calls print_command_profiling
  IF scriptprofiling THEN print_script_profiling

  freescripts(0)
 END IF

 v_free mainFibreGroup
END SUB

' The current script fibre starts waiting due to the current command, halting execution.
' When forcing a script to wait for an 'external' reason, use script_start_waiting_ticks instead
SUB script_start_waiting(waitarg1 as integer = 0, waitarg2 as integer = 0)
 BUG_IF(insideinterpreter = NO, "called outside interpreter")
 WITH *hsvm.cur_scriptinst
  'debug commandname(curcmd->value) & ": script_start_waiting(" & waitarg1 & ", " & waitarg2 & ") on " & scriptname(.id)
  BUG_IF(hsvm.cur_scrat->state <> streturn, "called outside command handler")
  .waiting = waitingOnCmd
  .waitarg = waitarg1
  .waitarg2 = waitarg2
 END WITH
 hsvm.cur_scrat->state = stwait
END SUB

' Cause a script fibre to start waiting for some number of ticks.
' Unlike script_start_waiting this can be called from outside script_commands.
' This is NOT the implementation of the wait(x) command, but it has the same effect
' whichscript is scriptinsts() index.
SUB script_start_waiting_ticks(whichscript as integer, ticks as integer)
 WITH scriptinsts(whichscript)
  IF .started THEN
   showbug "FIXME: script_start_waiting_ticks not tested on .started scripts"
  END IF
  .waiting = waitingOnTick
  .waitarg = ticks
  .waitarg2 = 0
 END WITH
 ' Preserve value of scrat(whichscript).state
END SUB

' Current script allowed to continue.
' Can set the return value of a command if waitingOnCmd
SUB script_stop_waiting(returnval as integer = 0)
 WITH *hsvm.cur_scriptinst
  BUG_IF(.waiting = waitingOnNothing, "script isn't waiting")
  IF .waiting = waitingOnTick AND returnval <> 0 THEN
   showbug "script_stop_waiting: can't set a return value"
  END IF
  IF .waiting = waitingOnCmd THEN
   WITH *hsvm.cur_scrat
    'debug "script_stop_waiting(" & returnval & ") on " & scriptname(.id)
    IF .state <> stwait THEN
     showbug "script_stop_waiting: unexpected scrat().state = " & .state
    ELSE
     .state = streturn
     scriptret = returnval
    END IF
   END WITH
  END IF
  .waiting = waitingOnNothing
 END WITH
END SUB


'==========================================================================================
'                            Loading/Reloading/Freeing scripts
'==========================================================================================


FUNCTION runscript (id as integer, newcall as bool, double_trigger_check as bool, trigger_name as zstring ptr) as RunScriptResult
'newcall: whether this script is triggered (start a new fibre) rather than called from a script as a call
'double_trigger_check: whether "no double-triggering" should take effect
'trigger_name: type of the script (used for debugging/tracing), eg "autorun".
'     Never NULL. Is "called" or "runscriptbyid" for non-triggered scripts.

'AFAICT this only happens when executing runscriptbyid(0)
IF id = 0 THEN RETURN rsNoScript

DIM n as integer = decodetrigger(id)
IF n = 0 THEN RETURN rsFail  'decodetrigger would have shown a scripterr

BUG_IF(insideinterpreter = NO AND newcall = NO, "newcall=NO outside interpreter", rsFail)

DIM index as integer = nowscript + 1

IF index >= maxScriptRunning THEN
 scripterr "Can't load " & *trigger_name & " script " & scriptname(n) & ", too many scripts running", serrMajor
 RETURN rsFail
END IF

IF double_trigger_check ANDALSO index > 0 THEN
 IF n = scriptinsts(index - 1).id ANDALSO prefbit(10) = NO THEN  '"Permit double-triggering of scripts" off
  scripterr "Not double-triggering script " & scriptname(n), serrInfo
  RETURN rsIgnored
 END IF
END IF

'--store current command data in scriptinsts (used outside of the inner interpreter)
IF hsvm.cur_scriptinst THEN
 WITH *hsvm.cur_scriptinst
  .curkind = curcmd->kind
  .curvalue = curcmd->value
  .curargc = curcmd->argc
 END WITH
END IF

WITH scriptinsts(index)
 '-- Load the script (or return the reference if already loaded)
 .scr = loadscript(n)  'Displays error on failure
 IF .scr = NULL THEN RETURN rsFail
 IF scriptprofiling THEN .scr->numcalls += 1
 scriptctr += 1
 .scr->lastuse = scriptctr
 IF newcall THEN .scr->last_trigger_name = *trigger_name
 'increment refcount once loading is successful

 IF newcall THEN
  .parent = NULL
 ELSE
  .parent = hsvm.cur_scriptinst
 END IF
 .fibre = hsvm.cur_fibre  'If newcall, the caller will have set this
 .id = n
 .watched = NO
 .started = NO
 .waiting = waitingOnNothing
 .waitarg = 0
 .waitarg2 = 0

 'This is not needed, but clears garbage values to ease debugging
 .curkind = -1
 .curvalue = -1
 .curargc = -1

 DIM errstr as zstring ptr = oldscriptstate_init(index, .scr)
 IF errstr <> NULL THEN
  scripterr "Failed to load " + *trigger_name + " script " & n & " " & scriptname(n) & ", " & *errstr, serrError
  RETURN rsFail
 END IF

 IF newcall ANDALSO hsvm.cur_scrat THEN
  '--suspend the previous fibre
  IF scriptprofiling THEN stop_fibre_timing  'Must call before suspending
  hsvm.cur_scrat->state *= -1
 END IF

 '--we are successful, so now its safe to increment these
 nowscript = index
 hsvm.set_cur_script
 nowscript_locals = @heap(hsvm.cur_scrat->frames(0).heap)  'Should really be in oldscriptstate_init

 .scr->refcount += 1
 IF .scr->refcount = 1 THEN
  'Removed from unused scripts cache
  unused_script_cache_mem -= .scr->size
 END IF

 'debug "running " & .id & " " & scriptname(.id) & " in slot " & hsvm.cur_slot & " newcall = " _
 '      & newcall & " type " & *trigger_name & ", parent = " & .scr->parent & " numcalls = " _
 '      & .scr->numcalls & " refc = " & .scr->refcount & " lastuse = " & .scr->lastuse
END WITH

IF scriptprofiling THEN
 IF newcall THEN
  start_fibre_timing
 ELSE
  script_call_timing
 END IF
END IF

RETURN rsSuccess

END FUNCTION

'Returns an open file handle to an hsz lump, or 0 if not found (which isn't a valid handle).
LOCAL FUNCTION loadscript_open_script (n as integer, expect_exists as bool = YES) as integer
 DIM scriptfile as string = tmpdir & n & ".hsz"
 IF NOT isfile(scriptfile) THEN
  'Format 0 scripts used a different extension
  scriptfile = tmpdir & n & ".hsx"
  IF NOT isfile(scriptfile) THEN
   '--because TMC once suggested that preunlumping the .hsp lump would be a good way to reduce (SoJ) loading time
   scriptfile = workingdir & SLASH & n & ".hsx"
   IF NOT isfile(scriptfile) THEN
    IF expect_exists THEN
     'This should probably only happen with old definescript manually numbered scripts. With
     'autonumbered scripts, decodetrigger should have already noticed the script was missing.
     scripterr "script " & scriptname(n) & " does not exist. (Maybe it was renumbered, and the script trigger needs to be updated?)", serrError
    END IF
    RETURN 0
   END IF
  END IF
 END IF

 DIM fh as integer
 OPENFILE(scriptfile, FOR_BINARY + ACCESS_READ + OR_ERROR, fh)
 RETURN fh
END FUNCTION

'Loads a script (putting it in the cache) or fetchs it from the cache.
'Does not increment its refcount.
'Displays an serrError error and returns NULL on failure.
'If loaddata is false, only loads the script header.
FUNCTION loadscript (id as integer, loaddata as bool = YES) as ScriptData ptr
 'debuginfo "loadscript(" & id & " " & scriptname(id) & ", loaddata = " & loaddata & ")"

 DIM fh as integer = 0  'file handle
 DIM header as ScriptData ptr
 header = scriptcache_find(id)

 IF header = NULL THEN
  'Header not loaded yet
  fh = loadscript_open_script(id)
  IF fh = 0 THEN RETURN NULL
  header = loadscript_read_header(fh, id)
  IF header = NULL THEN
   CLOSE #fh
   RETURN NULL
  END IF
  scriptcache_add id, header
  numloadedscr += 1
 END IF

 IF loaddata ANDALSO header->ptr = NULL THEN
  'Only the header is loaded; need to load data
  IF fh = 0 THEN
   fh = loadscript_open_script(id)
   IF fh = 0 THEN RETURN NULL
  END IF
  IF loadscript_read_data(header, fh) = NO THEN
   'The script is already in the cache. Maybe mark it as corrupt?
   CLOSE #fh
   RETURN NULL
  END IF
 END IF
 IF fh THEN CLOSE #fh
 RETURN header
END FUNCTION

'Load a script header from a hsz into a new ScriptData. id is the script id.
'Returns true on success
LOCAL FUNCTION loadscript_read_header(fh as integer, id as integer) as ScriptData ptr
 DIM shortvar as short

 DIM ret as ScriptData ptr = NEW ScriptData
 WITH *ret
  .id = id
  .hash = 0
  'minimum length of a valid 16-bit .hsx
  IF LOF(fh) < 10 THEN
   scripterr "script " & id & " corrupt (too short: " & LOF(fh) & " bytes)", serrError
   DELETE ret
   RETURN NULL
  END IF

  'Get the header size in bytes
  GET #fh, 1+0, shortvar
  DIM skip as integer = shortvar
  .headerlen = skip

  IF skip < 4 THEN
   scripterr "script " & id & " is corrupt (header length " & skip & ")", serrError
   DELETE ret
   RETURN NULL
  END IF

  'Note that there is no check for the header being longer than expected. Optional
  'fields may be added to the end of the header; if they are mandatory the version number
  'should be incremented.

  GET #fh, 1+2, shortvar
  'some HSX files seem to have an illegal negative number of variables
  .vars = shortvar
  .vars = bound(.vars, 0, 256)

  IF skip >= 6 THEN
   GET #fh, 1+4, shortvar
   .args = bound(shortvar, 0, .vars)
  ELSE
   .args = 999  'Note: This is a marker value
  END IF

  IF skip >= 8 THEN
   GET #fh, 1+6, shortvar
   .scrformat = shortvar
  ELSE
   .scrformat = 0
  END IF
  IF .scrformat < 0 OR (.scrformat = 0 AND skip > 8) THEN
   'Disallow format 0 from having more recent features (it's a nuisance to support 16-bit
   'words for everything).
   scripterr "script " & id & " seems to be corrupt; invalid version " & .scrformat & " with header size " & skip, serrError
   DELETE ret
   RETURN NULL
  END IF
  IF .scrformat > CURRENT_HSZ_VERSION THEN
   scripterr "script " & id & " is in an unsupported format. Try using an up-to-date OHRRPGCE version.", serrError
   DELETE ret
   RETURN NULL
  END IF
  DIM wordsize as integer
  IF .scrformat >= 1 THEN wordsize = 4 ELSE wordsize = 2

  .size = (LOF(fh) - skip + (wordsize - 1)) \ wordsize

  IF skip >= 12 THEN
   GET #fh, 1+8, .strtable
  ELSEIF skip = 10 THEN
   GET #fh, 1+8, shortvar
   .strtable = shortvar
  ELSE
   .strtable = 0
  END IF
  IF .strtable THEN
   IF (.strtable - skip) MOD 4 THEN
    'Position must be a multiple of 4
    scripterr "script " & id & " corrupt: unaligned string table", serrError
    DELETE ret
    RETURN NULL
   END IF
   .strtable = (.strtable - skip) \ 4
  END IF

  IF skip >= 14 THEN
   GET #fh, 1+12, shortvar
   .parent = shortvar
  ELSE
   .parent = 0
  END IF
  IF skip >= 16 THEN
   GET #fh, 1+14, shortvar
   .nestdepth = shortvar
   IF .nestdepth > maxScriptNesting THEN
    scripterr "Corrupt or unsupported script data with nestdepth=" & .nestdepth & "; should be impossible", serrError
   END IF
  ELSE
   .nestdepth = 0
  END IF
  IF skip >= 18 THEN
   GET #fh, 1+16, shortvar
   .nonlocals = shortvar
  ELSE
   .nonlocals = 0
  END IF

  'String table length, which is always a multiple of 4 bytes
  IF skip >= 22 THEN
   GET #fh, 1+18, .strtablelen
  ELSE
   'By default, string table extends to end of lump
   .strtablelen = 0
   IF .strtable THEN .strtablelen = .size - .strtable
  END IF

  DIM bitsets as ushort
  IF skip >= 24 THEN
   GET #fh, 1+22, bitsets
  ELSE
   bitsets = 0
  END IF
  .hassrcpos = (bitsets AND 1) <> 0

  'We ignore the variable names here; they are loaded if needed by script_lookup_local_name
  .varnamestable = 0
  IF skip >= 28 THEN
   GET #fh, 1+24, .varnamestable
  END IF

  .script_position = 0
  IF skip >= 32 THEN
   GET #fh, 1+28, .script_position
  END IF

  IF .strtable < 0 OR .strtablelen < 0 OR .strtable + .strtablelen > .size THEN
   scripterr "Script " & id & " corrupt; bad string table offset/size", serrError
   DELETE ret
   RETURN NULL
  END IF

  IF .varnamestable < 0 OR .varnamestable >= .size THEN
   scripterr "Script " & id & " corrupt; bad variable-name table offset", serrError
   DELETE ret
   RETURN NULL
  END IF
 END WITH
 RETURN ret
END FUNCTION

'Load the data from a file into the .ptr field of a ScriptData.
'Returns true on success.
LOCAL FUNCTION loadscript_read_data(header as ScriptData ptr, fh as integer) as bool
 DIM shortvar as short

 WITH *header
  .hash = file_hash64(fh)

  DIM wordsize as integer
  IF .scrformat >= 1 THEN wordsize = 4 ELSE wordsize = 2
  .ptr = allocate(.size * sizeof(integer))
  IF .ptr = 0 THEN
   scripterr "Could not allocate memory to load script", serrError
   RETURN NO
  END IF

  IF wordsize = 2 THEN
   FOR i as integer = .headerlen TO LOF(fh) - wordsize STEP wordsize
    GET #fh, 1 + i, shortvar
    .ptr[(i - .headerlen) \ 2] = shortvar
   NEXT
  ELSE
   GET #fh, .headerlen + 1, *.ptr, .size
  END IF

  'Sanity check: root node is a do()
  IF .size < 3 ORELSE (.ptr[0] <> 2 OR .ptr[1] <> 0 OR .ptr[2] < 0) THEN
   scripterr "Script " & .id & " corrupt; does not start with do()", serrError
   RETURN NO
  END IF
 END WITH
 RETURN YES
END FUNCTION

LOCAL FUNCTION scriptcache_find(id as integer) as ScriptData ptr
 '-- script() is a hashtable with doubly linked lists as buckets, storing the loaded scripts
 DIM as ScriptData Ptr scrnode = script(id MOD scriptTableSize)
 WHILE scrnode
  IF scrnode->id = id THEN
   RETURN scrnode
  END IF
  scrnode = scrnode->next
 WEND
 RETURN NULL
END FUNCTION

'Add a loaded ScriptData ptr to the cache.
LOCAL SUB scriptcache_add(id as integer, thisscr as ScriptData ptr)
 IF thisscr->ptr THEN
  'Script data is loaded
  totalscrmem += thisscr->size
  unused_script_cache_mem += thisscr->size  'Has refcount 0, up to caller to remove from cache
 END IF

 'append to front of doubly linked list
 DIM as ScriptData Ptr Ptr scrnodeptr = @script(id MOD scriptTableSize)
 IF *scrnodeptr THEN
  'already a script there
  (*scrnodeptr)->backptr = @thisscr->next
 END IF
 thisscr->backptr = scrnodeptr 'this is for convenience of easier deleting (in freescripts)
 thisscr->next = *scrnodeptr
 *scrnodeptr = thisscr
END SUB

'Destruct a ScriptData and remove it from the cache.
SUB delete_ScriptData (byval scriptd as ScriptData ptr)
 WITH *scriptd
  BUG_IF(.refcount, "nonzero refcount=" & .refcount & " for " & scriptname(ABS(.id)))

  IF .ptr THEN
   'debug "deallocating " & .id & " " & scriptname(ABS(.id)) & " size " & .size
   totalscrmem -= .size
   unused_script_cache_mem -= .size
   deallocate(.ptr)
  END IF
  numloadedscr -= 1
  IF .next THEN
   .next->backptr = .backptr
  END IF
  *.backptr = .next
 END WITH

 DELETE scriptd
END SUB

'Dereference script pointer
SUB deref_script(script as ScriptData ptr)
 script->refcount -= 1
 IF script->refcount = 0 THEN
  'scriptcachemem
  unused_script_cache_mem += script->size
  ' If profiling don't delete ScriptDatas, as they include the timing info
  IF scriptprofiling OR commandprofiling THEN EXIT SUB
  IF unused_script_cache_mem > scriptmemMax THEN
   'Evicting stuff from the script cache is probably pointless, but we've already got it,
   'and it may be useful for the new script interpreter...
   freescripts(scriptmemMax * 0.75)
  END IF
 END IF
END SUB

TYPE ScriptListElmt
 p as ScriptData ptr
 score as double
END TYPE

'Iterate over all loaded scripts, sort them in descending order according to score
'returned by the callback, and return number of scripts in numscripts
'(LRUlist is dynamic)
'fibres_only: only include scripts which have been triggered as the root of a fibre
SUB sort_scripts(LRUlist() as ScriptListElmt, byref numscripts as integer, scorefunc as function(scr as ScriptData) as double, fibres_only as bool = NO)
 DIM j as integer
 numscripts = 0
 REDIM LRUlist(-1 TO -1)
 ' Iterate over the linked-list buckets of the 'script' hashmap.
 FOR i as integer = 0 TO UBOUND(script)
  DIM scrp as ScriptData Ptr = script(i)
  WHILE scrp
   ' A script is a fibre root if it has been started with a call to runscript with a trigger type name.
   IF fibres_only ANDALSO LEN(scrp->last_trigger_name) = 0 THEN
    scrp = scrp->next
    CONTINUE WHILE
   END IF
   DIM score as double = scorefunc(*scrp)
   REDIM PRESERVE LRUlist(-1 TO numscripts)
   ' Insert this script into the ordered list
   FOR j = numscripts - 1 TO 0 STEP -1
    IF score >= LRUlist(j).score THEN EXIT FOR
    LRUlist(j + 1).p = LRUlist(j).p
    LRUlist(j + 1).score = LRUlist(j).score
   NEXT
   LRUlist(j + 1).p = scrp
   LRUlist(j + 1).score = score
   numscripts += 1
   scrp = scrp->next
  WEND
 NEXT
END SUB

FUNCTION freescripts_script_scorer(byref script as ScriptData) as double
 'this formula has only been given some testing, and doesn't do all that well
 DIM score as integer
 IF script.refcount THEN RETURN 1000000000
 score = script.lastuse - scriptctr
 score = iif(score > 0, -1000000000, score)  'Handle overflow
 score = iif(score > -400, score, -400) _
       - iif(script.ptr, script.size, 0) \ (scriptmemMax \ 1024)
 IF script.id < 0 THEN
  'Stale script
  score = -1000000000
 END IF
 RETURN score
END FUNCTION

'Two uses: freescripts(0) frees all scripts, otherwise
'frees unused loaded scripts until at least unused_script_cache_mem <= mem (measured in 4-byte ints) (probably a lot lower)
SUB freescripts (byval mem as integer)
 REDIM LRUlist() as ScriptListElmt
 DIM numscripts as integer

 'give each script a score (the lower, the more likely to throw) and sort them
 'this is roughly a least recently used list
 sort_scripts LRUlist(), numscripts, @freescripts_script_scorer

 FOR i as integer = 0 TO numscripts - 1
  IF mem = 0 THEN
   delete_ScriptData LRUlist(i).p
  ELSE
   IF LRUlist(i).p->refcount <> 0 THEN EXIT SUB
   IF unused_script_cache_mem <= mem THEN EXIT SUB
   'debug "unloading script " & scriptname(ABS(LRUlist(i).p->id)) & " refcount " & LRUlist(i).p->refcount
   delete_ScriptData LRUlist(i).p
  END IF
 NEXT
END SUB

' No longer used (used to be used when memory used by loaded scripts was strictly bounded,
' so even running scripts could be unloaded)
SUB reloadscript (si as ScriptInst, oss as OldScriptState, byval updatestats as bool = YES)
 WITH si
  IF .scr = NULL THEN
   .scr = loadscript(.id)
   IF .scr = NULL THEN killallscripts: EXIT SUB
   oss.scr = .scr
   oss.scrdata = .scr->ptr
   .scr->refcount += 1
   IF updatestats AND scriptprofiling THEN .scr->numcalls += 1
  END IF
  IF updatestats THEN
   'a rather hackish and not very good attempt to give .lastuse a qualitative use
   'instead of just for sorting; a priority queue is probably a much better solution
   IF .scr->lastuse <= scriptctr - 10 THEN
    scriptctr += 1
    .scr->lastuse = scriptctr
   END IF
  END IF
 END WITH
END SUB

'Re-unlump .hsp lump
SUB load_hsp ()
 DIM header as HSHeader

 IF isfile(game + ".hsp") THEN
  'TODO: should really delete all existing .hsz files, to catch missing scripts
  unlump game + ".hsp", tmpdir
  load_hsp_header tmpdir & "hs", header
 END IF

 debuginfo "plotscr.hsd version: " & header.plotscr_version
 IF LEN(header.plotscr_version) THEN
  scripts_use_cc_scancodes = strcmp(cstring(header.plotscr_version), @"3U ") >= 0
 ELSE
  scripts_use_cc_scancodes = NO
 END IF
END SUB

'Unload all scripts not in use, so they will get loaded again when used.
'force_full_message: even if the player previously asked to hide notifications
'    about reloading failing, show the error rather than just an overlay message.
'TODO: it would be preferable to keep the bookkeeping data by only deleting the script commands and strings
SUB reload_scripts (force_full_message as bool = YES)
 STATIC dont_show_again as bool = NO  'Don't pop up the full error message

 ' Delete any previously unlumped source files
 safekill tmpdir & "source.lumped"
 FOR idx as integer = 0 TO UBOUND(srcfiles)
  safekill tmpdir & srcfiles(idx).lumpname
 NEXT

 DIM unfreeable as string, still_unfreeable as string
 DIM num_unfreeable as integer

 load_hsp
 read_srcfiles_txt

 ' Iterate over the hashmap bucket chains
 FOR i as integer = 0 TO UBOUND(script)
  DIM as ScriptData Ptr scrp = script(i), nextp
  WHILE scrp
   nextp = scrp->next
   WITH *scrp
    IF .refcount = 0 THEN
     delete_ScriptData scrp
    ELSE
     ' It's in use. But has it actually been changed?
     'debug scriptname(ABS(.id)) & " in use"

     DIM fh as integer
     fh = loadscript_open_script(ABS(.id), NO)
     IF fh = 0 THEN
      debuginfo "reload_scripts: " & scriptname(ABS(.id)) & " no longer exists!"
     ELSE
      DIM newhash as ulongint = file_hash64(fh)
      CLOSE #fh

      'debug scriptname(ABS(.id)) & " old hash=" & HEX(.hash) & " new=" & HEX(newhash)
      IF newhash <> .hash THEN
       num_unfreeable += 1
       IF .id > 0 THEN
        unfreeable &= scriptname(ABS(.id)) & " "
       ELSE
        still_unfreeable &= scriptname(ABS(.id)) & " "
       END IF

       debuginfo "not reloading script " & scriptname(ABS(.id)) & " because it's in use: refcount=" & .refcount
       ' Negate the ID number. This will prevent this script data from being used when starting a new script.
       ' It won't be automatically evicted from the cache, but that's ok.
       .id = ABS(.id) * -1
      ELSEIF .id < 0 ANDALSO newhash = .hash THEN
       ' This script was previously marked as un-reloadable, but the changes were reverted.
       .id = -.id
      END IF
     END IF
    END IF
   END WITH

   scrp = nextp
  WEND
 NEXT

 DIM msg as string
 IF LEN(unfreeable) THEN
  msg = !"These scripts were modified but are in use and can't be reloaded yet:\n" & unfreeable
 END IF
 IF LEN(still_unfreeable) THEN
  IF LEN(msg) THEN msg &= !"\n"
  msg &= !"These scripts modified earlier still can't be reloaded:\n" & still_unfreeable
 END IF
 IF LEN(msg) THEN
  IF dont_show_again AND force_full_message = NO THEN
   show_overlay_message num_unfreeable & " scripts not reloaded (see F5 menu)", 2.5
  ELSE
   dont_show_again = (twochoice(msg, "OK", "Don't tell me again", 0, 0) = 1)
  END IF

  ' "Force reload scripts" is still available in the Reload menu, but
  ' selecting it has no actual effect on script data, other than re-checking, telling
  ' the user which scripts are still in use, and possibly freeing some memory.
 ELSE
  ' All modified scripts unloaded successfully.
  lump_reloading.hsp.changed = NO

  show_overlay_message "Scripts successfully reloaded", 2.5
 END IF

 'Cause the cache in scriptname() (and also in commandname()) to be dropped (yuck)
 game_unique_id = STR(randint(INT_MAX))
END SUB


'==========================================================================================
'                                    Script profiling
'==========================================================================================

' Do script profile accounting when one script calls another (including with runscriptbyid),
' but not when a new script fibre is started.
' cur_scriptinst is the new script
SUB script_call_timing
 DIM timestamp as double
 READ_TIMER(timestamp)
 'End exclusive time for calling script
 hsvm.cur_scriptinst->parent->scr->totaltime += timestamp
 WITH *hsvm.cur_script
  'debug "script_call_timing: id " & hsvm.cur_scriptinst->parent->scr->id & " called id " & .id & " calls_in_stack++ =" & .calls_in_stack
  'debug "  caller totaltime now " & hsvm.cur_scriptinst->parent->scr->totaltime
  .entered += 1
  'Exclusive time
  .totaltime -= timestamp
  'Inclusive time
  IF .calls_in_stack = 0 THEN
   .laststart = timestamp
   'debug "  set laststart=" & timestamp
  END IF
  .calls_in_stack += 1
 END WITH
END SUB

' Called when a script returns and script profiling enabled.
' hsvm.cur_script is the returning script, which may or may not have a caller.
SUB script_return_timing
 DIM timestamp as double
 READ_TIMER(timestamp)
 WITH *hsvm.cur_script
  'debug "script_return_timing: slot " & hsvm.cur_slot & " id " & .id & " calls_in_stack-- =" & .calls_in_stack & " (returning script)"
  'Exclusive time
  .totaltime += timestamp
  'debug "  id " & .id & " totaltime now " & .totaltime
  'Inclusive time
  .calls_in_stack -= 1
  IF .calls_in_stack = 0 THEN
   'Was not a recursive call, so won't be double-counting time
   .childtime += timestamp - .laststart
   IF hsvm.cur_scriptinst->watched THEN
    gam.script_log.last_script_childtime = timestamp - .laststart
   END IF
   'debug "  adding to id " & .id & " childtime: " & (timestamp - .laststart)  & " now: " & .childtime
  END IF
 END WITH

 IF hsvm.cur_scriptinst->parent THEN
  'Was called from another script; time accounting for it
  WITH *hsvm.cur_scriptinst->parent->scr
   .entered += 1
   .totaltime -= timestamp
  END WITH
 ELSE
  ' Fibre finished.
  timing_fibre = NO
 END IF
END SUB

' Call this when starting/resuming execution of a script fibre;
' used to collect timing statistics.
SUB start_fibre_timing
 'No need to restart command timing if resuming a script command.
 IF scriptprofiling = NO THEN EXIT SUB
 IF hsvm.cur_script = NULL ORELSE insideinterpreter = NO THEN EXIT SUB
 'debug "start_fibre_timing slot " & hsvm.cur_slot & " id " & hsvm.cur_script->id
 IF timing_fibre THEN EXIT SUB
 timing_fibre = YES

 hsvm.cur_script->entered += 1

 DIM timestamp as double
 READ_TIMER(timestamp)

 ' Exclusive time (in this script)
 hsvm.cur_script->totaltime -= timestamp

 ' Inclusive time (in this script and call tree descendents)
 DIM inst as ScriptInst ptr = hsvm.cur_scriptinst
 WHILE inst
  WITH *inst->scr
   ' Error checking
   IF .calls_in_stack <> 0 THEN showbug "Garbage calls_in_stack=" & .calls_in_stack & " value for script " & .id

   .calls_in_stack += 1
   .laststart = timestamp
   'debug "  set slot " & which & " id " & .id & " laststart = " & timestamp & " ++calls_in_stack = " & .calls_in_stack
  END WITH
  inst = inst->parent
 WEND
END SUB

' Call this when execution of the current script fibre stops, e.g. due to a wait
' command or a script error.
' NOTE: if script_return_timing cleans up the last script in a fibre, stop_fibre_timing doesn't get called.
SUB stop_fibre_timing
 stop_command_timing
 IF scriptprofiling = NO THEN EXIT SUB
 IF hsvm.cur_script = NULL ORELSE insideinterpreter = NO THEN EXIT SUB
 'debug "stop_fibre_timing slot " & hsvm.cur_slot & " id " & hsvm.cur_script->id
 IF timing_fibre = NO THEN EXIT SUB
 timing_fibre = NO

 DIM timestamp as double
 READ_TIMER(timestamp)

 ' Exclusive time (in this script)
 hsvm.cur_script->totaltime += timestamp
 'debug "  id " & hsvm.cur_script->id & " totaltime now " & hsvm.cur_script->totaltime

 ' Inclusive time (in this script and call tree descendents)
 DIM inst as ScriptInst ptr = hsvm.cur_scriptinst
 WHILE inst
  WITH *inst->scr
   'debug "  id " & .id & " calls_in_stack-- = " & .calls_in_stack
   .calls_in_stack -= 1
   IF .calls_in_stack = 0 THEN
    'Was not a recursive call, so won't be double-counting time
    .childtime += timestamp - .laststart
    'debug "  adding to id " & .id & " childtime: " & (timestamp - .laststart) & " now: " & .childtime
   END IF

   ' Error checking
   IF .calls_in_stack <> 0 THEN showbug "Garbage calls_in_stack=" & .calls_in_stack & " value for script " & .id
  END WITH
  inst = inst->parent
 WEND
END SUB

'Sort by total time
LOCAL FUNCTION profiling_script_totaltime_scorer(byref script as ScriptData) as double
 'RETURN (script.totaltime - script.entered * timeroverhead) * -100000
 RETURN -script.totaltime
END FUNCTION

'Sort by child time
LOCAL FUNCTION profiling_script_childtime_scorer(byref script as ScriptData) as double
 RETURN -script.childtime
END FUNCTION

'Print profiling information on scripts to g_debug.txt
SUB print_script_profiling
 DIM timeroverhead as double = measure_timer_overhead()

 REDIM LRUlist() as ScriptListElmt
 DIM numscripts as integer

 'Sort scripts by time. Ignore the reused LRUlist variable name
 sort_scripts LRUlist(), numscripts, @profiling_script_totaltime_scorer

 DIM entiretime as double
 DIM totalswitches as integer
 DIM totalcmds as integer
 FOR i as integer = 0 TO numscripts - 1
  entiretime += LRUlist(i).p->totaltime
  totalswitches += LRUlist(i).p->entered
  totalcmds += LRUlist(i).p->numcmdcalls
 NEXT

 debug "=== Script profiling information ==="
 debug "'%time' shows the percentage of the total time spent in this script."
 debug "'time' is the time spent in the script (and built-in commands it called)."
 debug "'childtime' is the time spent in a script and all scripts it called, and all"
 debug "  scripts called from those, and so on."
 debug "'cmdtime' (if command profiling) is time spent in builtin commands"
 debug "'#calls' is the number of times the script ran."
 debug "'#cmds' (if command profiling) is number of calls to builtin commands."
 'debug "'#switches' is the number of times that the interpreter switched to that"
 'debug "  script, which is the sum of #calls, how many other scripts it called and"
 'debug "  how many times it waited (switching time is relatively neglible)."
 debug "'type' (in second table) is the way that a script was last triggered"
 debug "'#calls & time for...' is shown if profiling a specific command, showing how"
 debug "  much it was used by that script"
 debug ""
 debug "ms is milliseconds (0.001 seconds), us is microseconds (0.000001 seconds)"
 debug ""
 debug "Total time recorded in interpreter: " & format(entiretime, "0.000") & "sec"
 debug "(Timer overhead = " & format(timeroverhead*1e6, "0.00") & "us per measurement)"
 debug "(Estimated time wasted script profiling: " & format(timeroverhead * totalswitches, "0.000") & "sec)"
 IF commandprofiling THEN
  debug "(Estimated time wasted command profiling: " & format(timeroverhead * 2 * totalcmds, "0.000") & "sec)"
 END IF
 debug ""
 debug "  -- All scripts sorted by time --"
 IF commandprofiling THEN
  debug " %time       time    cmdtime   childtime    time/call    #calls     #cmds  script name " _
        & IIF(time_specific_cmdid, SPACE(14) & "#calls &  time for " & commandname(time_specific_cmdid), "")
 ELSE
  debug " %time       time  childtime    time/call    #calls   script name"
 END IF

 FOR i as integer = 0 TO numscripts - 1
 ' debug i & ": " & LRUlist(i).p & " score = " & LRUlist(i).score
  WITH *LRUlist(i).p
   DIM cmdtime_line as string
   DIM numcmds_line as string
   IF commandprofiling THEN
    cmdtime_line = lpad(format(.cmdtime*1000, "0.0"), , 9) & "ms"
    numcmds_line = "  " & lpad(STR(.numcmdcalls), , 8)
   END IF

   debug lpad(format(100 * .totaltime / entiretime, "0.00"), , 6) _
       & lpad(format(.totaltime*1000, "0.0"), , 9) & "ms" _
       & cmdtime_line _
       & lpad(format(.childtime*1000, "0.0"), , 10) & "ms" _
       & lpad(format(.totaltime*1e6/.numcalls, "0"), , 11) & "us" _
       & lpad(STR(.numcalls), , 10) _
       & numcmds_line _
       _ '& lpad(STR(.entered), , 12)
       & "  " & rpad(scriptname(ABS(.id)), , 25) _
       & IIF(time_specific_cmdid, " " & lpad(STR(.specificcmdcalls), , 6), "") _
       & IIF(time_specific_cmdid, " " & lpad(format(.specificcmdtime*1000, "0.0"), , 5) & "ms", "")
      '& "  " & format(1000*(.totaltime - (.entered + 2 * .numcmdcalls) * timeroverhead), "0.00") & "ms"

  END WITH
 NEXT

 'Print fibres only
 sort_scripts LRUlist(), numscripts, @profiling_script_childtime_scorer, YES

 debug ""
 debug "  -- Triggered scripts sorted by childtime --"
 debug "%chdtime   chdtime  chdtime/call    #calls                type  script name"
 FOR i as integer = 0 TO numscripts - 1
  WITH *LRUlist(i).p
   DIM percall as string
   debug lpad(format(100 * .childtime / entiretime, "0.00"), , 6)  _
       & lpad(format(.childtime*1000, "0"), , 10) & "ms" _
       & lpad(format(.childtime*1000/.numcalls, "0.0"), , 12) & "ms" _
       & lpad(STR(.numcalls), , 10) _
       & lpad(.last_trigger_name, , 20) _
       & "  " & scriptname(ABS(.id))
  END WITH
 NEXT
 debug ""

 IF commandprofiling THEN
  entiretime -= (totalswitches + 2 * totalcmds) * timeroverhead
  print_command_profiling(entiretime, timeroverhead)
 END IF
END SUB

' Normally when you do multiple profiling runs, the stats are cumulative.
' This should not be called from inside the interpreter, at least not while profiling.
SUB clear_profiling_stats
 IF insideinterpreter AND scriptprofiling THEN EXIT SUB

 memset(@command_profiles(0), 0, SIZEOF(CommandProfile) * (1 + UBOUND(command_profiles)))

 FOR i as integer = 0 TO UBOUND(script)
  DIM scrp as ScriptData Ptr = script(i)
  WHILE scrp
   scrp->numcalls = 0
   scrp->totaltime = 0.
   scrp->childtime = 0.
   scrp->entered = 0
   scrp->numcmdcalls = 0
   scrp->cmdtime = 0.
   scrp->specificcmdtime = 0.
   scrp->specificcmdcalls = 0
   scrp = scrp->next
  WEND
 NEXT
END SUB

'Compare for qsort
LOCAL FUNCTION compare_command_profiles CDECL (a as const CommandProfile ptr ptr, b as const CommandProfile ptr ptr) as integer
 IF (*a)->time < (*b)->time THEN RETURN -1
 IF (*a)->time > (*b)->time THEN RETURN 1
 RETURN 0
END FUNCTION

'Wrapper around script_commands() for when commandprofiling is enabled
SUB timed_script_commands(cmdid as integer)
 'Start command timing
 IF cmdid <= maxScriptCmdID THEN
  profiling_cmdid = cmdid
  profiling_cmd_in_script = hsvm.cur_script
  profiling_cmd_in_script->numcmdcalls += 1
  WITH command_profiles(cmdid)
   .calls += 1
   .callstart = TIMER
  END WITH
 END IF

 script_commands(cmdid)

 stop_command_timing
END SUB

'Stop timing the current script command
SUB stop_command_timing
 'When commandprofile is true, profiling_cmdid may be 0 if not in the
 'interpreter or we stopped early because stop_fibre_timing was called.
 IF profiling_cmdid THEN
  WITH command_profiles(profiling_cmdid)
   DIM cmdtime as double = TIMER - .callstart
   .time += cmdtime
   'Don't use nowscript in case the script changed (e.g. runscriptbyid)
   profiling_cmd_in_script->cmdtime += cmdtime
   IF time_specific_cmdid = profiling_cmdid THEN
    profiling_cmd_in_script->specificcmdtime += cmdtime
    profiling_cmd_in_script->specificcmdcalls += 1
   END IF
  END WITH
  profiling_cmdid = 0
  profiling_cmd_in_script = 0
 END IF
END SUB

'Prompt for a command to do detailed command profiling on
FUNCTION prompt_for_profiling_cmdid() as bool
 DIM cmdidstr as string
 IF prompt_for_string(cmdidstr, "ID (see plotscr.hsd) or name of a script command to profile?", 60) THEN
  'ID input
  DIM cmdid as integer
  IF parse_int(cmdidstr, @cmdid) ANDALSO cmdid >= 0 ANDALSO cmdid <= maxScriptCmdID THEN
   time_specific_cmdid = cmdid
   RETURN YES
  END IF

  'Search by command name
  cmdidstr = LCASE(exclude(cmdidstr, " "))
  FOR cmdid = 0 TO maxScriptCmdID
   IF commandname(cmdid) = cmdidstr THEN
    time_specific_cmdid = cmdid
    RETURN YES
   END IF
  NEXT

  notification cmdidstr & " is not a builtin command name or ID. Some commands in the Dictionary are actually scripts; check plotscr.hsd."
 END IF
 time_specific_cmdid = 0
 RETURN NO
END FUNCTION

SUB print_command_profiling(entiretime as double, timeroverhead as double)
 'Subtract the estimated timing overhead from each command, because it can easily be 90% of the total time
 FOR i as integer = 0 TO UBOUND(command_profiles)
  WITH command_profiles(i)
   .time = large(0.0, .time - .calls * timeroverhead)
  END WITH
 NEXT

 DIM indices(UBOUND(command_profiles)) as integer
 qsort_indices(indices(), @command_profiles(0), , SIZEOF(CommandProfile), CAST(FnCompare, @compare_command_profiles))

 debug "=== Command profiling ==="
 debug "'%time' shows the % of total script interpreter time spent in the command."
 debug "'time' is the total time spent in the command."
 debug "'#calls' is the number of times called."
 debug ""
 debug " %time       time   time/call      #calls  command name" '     time+overhead"
 FOR i as integer = UBOUND(indices) TO 0 STEP -1
  DIM cmdid as integer = indices(i)
  WITH command_profiles(cmdid)
   IF .calls = 0 THEN EXIT FOR
   'DIM realtime as double = .time + .calls * timeroverhead

   debug lpad(format(100 * .time / entiretime, "0.00"), , 6) _
       & lpad(format(.time*1000, "0"), , 9) & "ms" _
       & lpad(format(.time*1e6/.calls, "0.00"), , 10) & "us" _
       & lpad(STR(.calls), , 12) _
       & "  " & commandname(cmdid)
      '& lpad(format(realtime*1000, "0"), , 10) & "ms"
      '& "  " & format(1000*(.calls * timeroverhead), "0") & "ms"
  END WITH
 NEXT
 debug ""
END SUB


'==========================================================================================
'                                   Script debug info
'==========================================================================================


'Parse srcfiles.txt in the .hsp lump, which lists the script source files, and put the result in srcfiles().
SUB read_srcfiles_txt()
 ERASE srcfiles

 DIM as integer fh
 IF OPENFILE(tmpdir & "srcfiles.txt", for_binary + access_read, fh) THEN RETURN

 DIM current as ScriptSourceFile ptr = NULL

 WHILE NOT EOF(fh)
  DIM as string linein
  DIM as integer at
  INPUT #fh, linein
  at = INSTR(linein, "=")
  IF at THEN
   DIM as string tag, value
   tag = LCASE(MID(linein, 1, at - 1))
   value = MID(linein, at + 1)
   IF current = NULL AND tag <> "file" THEN
    debuginfo "unexpected line in srcfiles.txt: " & linein
    CONTINUE WHILE
   END IF
   SELECT CASE tag
    CASE "file"
     REDIM PRESERVE srcfiles(UBOUND(srcfiles) + 1)
     current = @srcfiles(UBOUND(srcfiles))
     current->offset = -1
     current->length = -1
     current->filename = value
    CASE "lump"
     current->lumpname = value
    CASE "offset"
     current->offset = str2int(value)
    CASE "length"
     current->length = str2int(value)
   END SELECT
  END IF
 WEND
 CLOSE fh
END SUB

' Decodes srcpos into posdata including reading the source line; returns true on success.
' Note, uses showerror rather than scripterr to avoid infinite loops.
' If the srcpos is from a script then it is relative rather than absolute and the script's offset needs to be given.
FUNCTION decode_srcpos(posdata as ScriptTokenPos, srcpos as uinteger, script_offset as integer = 0) as bool
 DIM charpos as uinteger
 DIM lumpname as string

 IF srcpos = 0 THEN RETURN NO

 IF isfile(tmpdir & "source.lumped") = NO THEN RETURN NO

 ' Decode srcpos
 posdata.length = srcpos MOD (1 SHL 8)
 charpos = (srcpos SHR 9) + script_offset
 posdata.isvirtual = ((srcpos SHR 8) AND 1) <> 0

 'debug "decode_srcpos: srcpos " & srcpos & " script_offset " & script_offset & " charpos " & charpos & " len " & posdata.length

 ' Search srcfiles to find the file containing this charpos, and grab some info from it
 IF UBOUND(srcfiles) < 0 THEN RETURN NO
 DIM idx as integer
 FOR idx = 0 TO UBOUND(srcfiles)
  WITH srcfiles(idx)
   'Note: .offset is a reserved value
   IF charpos >= .offset ANDALSO charpos <= .offset + .length THEN
    charpos -= .offset
    'debug "...in " & .lumpname & " which has offset " & .offset & " -> charpos = " & charpos
    lumpname = .lumpname
    posdata.filename = trimpath(.filename)
    EXIT FOR
   END IF
  END WITH
 NEXT
 IF idx > UBOUND(srcfiles) THEN
  showerror "Script debug info is invalid: srcpos " & srcpos & " not found"
  RETURN NO
 END IF

 ' charpos 0 is special, refers to whole file (but this isn't used anywhere yet)
 IF charpos = 0 THEN
  posdata.linetext = "[File " & posdata.filename & "]"
  RETURN YES
 END IF
 'debug "decode_srcpos: offset in file is " & charpos

 ' Unlump that source file if not already
 DIM srcfile as string = tmpdir & lumpname
 IF isfile(srcfile) = NO THEN
  unlump tmpdir & "source.lumped", tmpdir
 END IF

 ' Read as binary to preserve newlines for exact file positions
 DIM success as bool
 DIM text as string = read_file(srcfile, , success)
 IF success = NO THEN
  showerror "Couldn't unlump " & lumpname & " from source.lumped"
  RETURN NO
 END IF

 ' Now find the line of text and line number in srcfile
 ' HSpeak 3W+ ensures the line endings are either Unix or DOS, not Mac, and
 ' that the last line ends in \n, so just look for \n.
 DIM as integer lineno = 1, linestart = 1, lineend
 DO
  lineend = INSTR(linestart, text, !"\n")
  ' charpos, string offsets, posdata.col/.linenum are all 1-based
  IF charpos <= lineend THEN
   posdata.col = charpos - linestart + 1  '1-based
   posdata.linenum = lineno
   posdata.linetext = RTRIM(MID(text, linestart, lineend - linestart), !"\r")
   RETURN YES
  END IF
  linestart = lineend + 1
  lineno += 1
 LOOP WHILE lineend

 showerror "Script debug info is invalid: offset " & charpos & " not found in " & posdata.filename
 RETURN NO
END FUNCTION

'Get information about position in the script source of the currently executing
'command of a script on the script stack (eg nowscript)
'Returns true on success (debug info is available)
FUNCTION get_script_line_info(posdata as ScriptTokenPos, which_scrat as OldScriptState ptr) as bool
 DIM srcpos as uinteger
 srcpos = script_current_srcpos(which_scrat)
 RETURN decode_srcpos(posdata, srcpos, which_scrat->scr->script_position)
END FUNCTION

'Format the line and statement that a script is currently at,
'or returns 0 if debugging information unavailable.
'maxchars is the maximum number of characters to print, if it's a very long line.
'scrinst is optionally used for its current ScriptCommand
FUNCTION highlighted_script_line(posdata as ScriptTokenPos, maxchars as integer, scrinst as ScriptInst ptr = NULL) as string
 DIM start as integer
 DIM highlightcol as integer
 DIM linepiece as string

 /'
 WITH posdata
  debug "posdata.linenum = " & posdata.linenum
  debug "posdata.col = " & posdata.col
  debug "posdata.length = " & posdata.length
  debug "posdata.linetext = " & posdata.linetext
  debug "posdata.filename = " & posdata.filename
 END WITH
 '/

 'highlightcol = IIF(posdata.isvirtual, uilook(uiSelectedDisabled + tog), uilook(uiSelectedItem + tog))
 highlightcol = IIF(posdata.isvirtual, findrgb(128, 0, 200), findrgb(0, 0, 240))

 start = large(1, posdata.col - large(4, (maxchars - posdata.length) \ 2))

 'debug "start = " & start & " mid = " & MID(posdata.linetext, start, 40)

 ' Trim the line so that it's not too long
 linepiece = MID(posdata.linetext, start, maxchars)
 ' Replace tabs. Using a single space should be fine, don't care about indentation of a single line.
 replacestr linepiece, !"\t", " "

 ' Highlight the part of linepiece indicated by posdata
 ' (Note: posdata.col and MID both count columns/characters starting at one.)
 DIM relcol as integer = posdata.col - (start - 1)
 DIM length  as integer = bound(posdata.length, 1, maxchars)
 DIM token as string = MID(linepiece, relcol, length)
 linepiece = MID(linepiece, 1, relcol - 1) & bgtag(highlightcol, token) & MID(linepiece, relcol + length)
'MID(linepiece, relcol, length) = fgtag(highlightcol, token)

 IF start > 1 THEN MID(linepiece, 1, 3) = "..."  'This can't overlap with 'token'
 IF LEN(linepiece) < LEN(posdata.linetext) - (start - 1) THEN linepiece &= "..."

 DIM prefix as string
 IF posdata.isvirtual THEN
  'For clarity, tell what this virtual node is
  IF scrinst THEN
   prefix = "Virtual " & bgtag(highlightcol, scriptcmdname(scrinst->curkind, scrinst->curvalue, *scrinst->scr)) & " on"
  ELSE
   prefix = "Virtual on"
  END IF
 ELSE
  prefix = "On"
 END IF
 RETURN prefix & " line " & posdata.linenum & " of " & posdata.filename & !":\n" & linepiece
END FUNCTION


'==========================================================================================
'                                    Name lookups
'==========================================================================================


'Read one of the strings from a script's string table.
FUNCTION script_string_constant(script as ScriptData ptr, offset as integer) as string
 WITH *script
  DIM stringp as integer ptr = .ptr + .strtable + offset
  'IF .strtable + offset >= .size ORELSE .strtable + (stringp[0] + 3) \ 4 >= .size THEN
  IF offset >= .strtablelen ORELSE offset + (stringp[0] + 3) \ 4 >= .strtablelen THEN
   scripterr "script corrupt: illegal string offset", serrError
  ELSE
   RETURN read32bitstring(stringp)
  END IF
 END WITH
END FUNCTION

'TODO: commands.bin should just be loaded into memory, which would be simpler and fix
'some script errors being extra expensive even when ignored
FUNCTION commandname (byval id as integer) as string
 'cmd_default_names array
#include "scrcommands.bi"

 STATIC cache(32) as IntStrPair
 DIM as string ret
 ret = search_string_cache(cache(), id, game_unique_id)
 IF ret <> "" THEN RETURN ret
 IF id >= 0 AND id <= UBOUND(cmd_default_names) THEN ret = cmd_default_names(id)
 IF ret = "" THEN ret = "cmd" & id

 DIM as short headersz, formatv, records, offset

 '--could check workingdir as well like we do in runscript; but doesn't seem necessary
 DIM fh as integer
 IF OPENFILE(tmpdir + "commands.bin", FOR_BINARY + ACCESS_READ, fh) THEN
  add_string_cache cache(), id, ret
  RETURN ret
 END IF

 GET #fh, , headersz
 GET #fh, , formatv
 GET #fh, , records

 IF formatv > 0 OR id < 0 OR id >= records THEN
  lazyclose fh
  add_string_cache cache(), id, ret
  RETURN ret
 END IF

 GET #fh, 1 + headersz + 2 * id, offset

 IF offset = 0 THEN
  lazyclose fh
  add_string_cache cache(), id, ret
  RETURN ret
 END IF

 DIM rec(25) as short
 GET #fh, 1 + offset + 2, rec()
 ret = readbinstring(rec(), 0, 50)
 lazyclose fh
 add_string_cache cache(), id, ret
 RETURN ret
END FUNCTION


'Read a local or nonlocal variable name from a script's variable name table if available,
'otherwise returns "".
FUNCTION script_lookup_local_name(var_id as integer, scrdat as ScriptData) as string
 WITH scrdat
  'debug "script_lookup_local_name(" & var_id & ", script " & scriptname(scrdat.id) & "), size = " & .size

  IF var_id >= 256 THEN
   'Nonlocal. Get the ScriptData for its script
   DIM frameno as integer = var_id \ 256
   var_id AND= 255
   DIM frame_scrdat as ScriptData ptr = @scrdat
   FOR idx as integer = 1 TO frameno
    frame_scrdat = loadscript(frame_scrdat->parent, YES)
    IF frame_scrdat = NULL THEN RETURN ""
   NEXT
   RETURN script_lookup_local_name(var_id, *frame_scrdat)
  END IF

  IF var_id < 0 OR var_id >= .vars THEN
   scripterr __FUNCTION__ ": illegal variable id " & var_id, serrError
   RETURN ""
  END IF
  IF .varnamestable = 0 THEN RETURN ""

  'Walk through the variable name table to reach the i-th one.
  DIM table_ptr as int32 ptr = .ptr + .varnamestable
  FOR i as integer = 0 TO var_id
   'debug "  var " & i & " offset " & table_ptr - .ptr & " len " & table_ptr[0]
   'debug "    '" & read32bitstring(table_ptr) & "'"

   DIM length_ints as integer = (table_ptr[0] + 3) \ 4
   IF table_ptr + length_ints >= .ptr + .size THEN
    scripterr "Script variable name table corrupt (too short)", serrError
    RETURN "(unknown)"
   END IF
   IF i = var_id THEN RETURN read32bitstring(table_ptr)
   table_ptr += length_ints + 1
  NEXT
 END WITH
END FUNCTION

FUNCTION localvariablename (value as integer, scrdat as ScriptData) as string
 'Get a variable name from a ScriptCommand local/nonlocal variable number
 'Locals (and args) numbered from 0

 DIM ret as string
 ret = script_lookup_local_name(value, scrdat)
 IF ret <> "" THEN RETURN ret

 'Debug info isn't available
 IF value >= 256 THEN
  RETURN "nonlocal" & (value SHR 8) & "_" & (value AND 255)
 ELSEIF scrdat.args = 999 THEN
  'old HS file: don't know the number of arguments
  RETURN "local" & value
 ELSEIF value < scrdat.args THEN
  RETURN "arg" & value
 ELSE
  'Not an arg
  RETURN "var" & (value - scrdat.args)
 END IF
END FUNCTION

FUNCTION scriptcmdname (kind as integer, id as integer, scrdat as ScriptData) as string
 'Trying to use compact names
 STATIC mathname(25) as zstring ptr = { _
         @"random", @"exponent", @"mod", @"divide", @"multiply", @"subtract", _
         @"add", @"xor", @"or", @"and", @"equal", @"<>", @"<", @">", _
         @"<=", @">=", @"setvar", @"inc", @"dec", @"not", @"&&", @"||", @"^^", _
         @"abs", @"sign", @"sqrt" _
 }

 STATIC flowname(16) as zstring ptr = { _
         @"do", @"begin", @"end", @"return", @"if", @"then", @"else", @"for", _
         @"", @"", @"while", @"break", @"continue", @"exitscript", @"exitreturn", _
         @"switch", @"case" _
 }

 SELECT CASE kind
  CASE tynumber
   RETURN STR(id)
  CASE tyflow
   IF (id >= 0 AND id <= UBOUND(flowname)) ANDALSO LEN(*flowname(id)) THEN
    RETURN *flowname(id)
   ELSE
    debug "scriptcmdname: bad flow " & id
    RETURN "unknown_flow" & id
   END IF
  CASE tyglobal
   RETURN "global" & id
  CASE tylocal
   RETURN localvariablename(id, scrdat)
  CASE tymath
   IF id >= 0 AND id <= UBOUND(mathname) THEN
    RETURN *mathname(id)
   ELSE
    debug "scriptcmdname: bad math " & id
    RETURN "unknown_math" & id
   END IF
  CASE tyfunct
   RETURN commandname(id)
  CASE tyscript
   RETURN scriptname(id)
  CASE tynonlocal
   RETURN localvariablename(id, scrdat)
 END SELECT
END FUNCTION



'Returns script command name if inside a script command handler
FUNCTION current_command_name() as string
 IF insideinterpreter = NO ORELSE curcmd->kind <> tyfunct THEN
  RETURN "(no command)"
 END IF
 RETURN commandname(curcmd->value)
END FUNCTION

'This is called for error messages occurring inside scripts, and gives a description of the current context
FUNCTION interpreter_context_name() as string
 IF insideinterpreter = NO THEN
  showbug "interpreter_context_name called outside interpreter"
 ELSEIF curcmd->kind = tyfunct THEN
  RETURN commandname(curcmd->value) + ": "
 END IF
 RETURN ""
END FUNCTION

'Returns string describing call chain.
'trim_front: if true, limit string length.
'errorlevel: optional, relevant only to scripterr
FUNCTION script_call_chain (trim_front as bool = YES, errorlevel as scriptErrEnum = 0) as string
 DIM inst as ScriptInst ptr = hsvm.cur_scriptinst
 IF inst = NULL THEN RETURN "(No scripts running)"

 DIM scriptlocation as string
 scriptlocation = scriptname(inst->id)
 WHILE inst->parent
  inst = inst->parent
  scriptlocation = scriptname(inst->id) + " -> " + scriptlocation
 WEND

 'If corrupt game data or an interpreter internal error occurred the call chain is useless,
 'and less screen space may be available
 DIM as integer cchainlimit
 cchainlimit = IIF(errorlevel >= serrError, 50, 120)
 IF trim_front AND LEN(scriptlocation) > cchainlimit THEN scriptlocation = " ..." + RIGHT(scriptlocation, cchainlimit - 4)

 RETURN scriptlocation
END FUNCTION


'==========================================================================================
'                                   Menus and Dialogues
'==========================================================================================

DIM SHARED scripterr_names(...) as zstring ptr = { _
           @"", @"info", @"warning", @"suspicious arg", @"out-of-range arg", _
           @"invalid call", @"major error", @"corrupt data", @"bug" _
}

FUNCTION should_display_error_to_user(byval errorlevel as scriptErrEnum) as bool
 IF errorlevel >= serrMajor THEN RETURN YES  'Too big to ignore, inc unreadable/unsupported data, engine bugs
 IF gen(genCurrentDebugMode) = 0 THEN 'Release mode, suppress most error display
  RETURN NO
 END IF
 ' By default Info messages are printed to g_debug.txt but not shown,
 ' since if they are so annoying then we wouldn't want to add more of them
 ' (in future we should have a dedicated script log for info and warning messages)
 RETURN errorlevel > serrInfo
END FUNCTION

DIM SHARED as integer error_ignorelist()

FUNCTION scriptcmdhash() as integer
 IF hsvm.cur_scrat THEN RETURN hsvm.cur_scrat->id * 100000 + hsvm.cur_scrat->ptr
END FUNCTION

FUNCTION error_ignorelist_contains(errmsg as zstring ptr) as bool
 'Match errors in two different ways (throw location, error message) to improve odds of the match working.
 IF hsvm.cur_scrat THEN
  IF a_find(error_ignorelist(), scriptcmdhash) <> -1 THEN RETURN YES
 END IF
 IF a_find(error_ignorelist(), strhash(*errmsg)) <> -1 THEN RETURN YES
 RETURN NO
END FUNCTION

SUB error_ignorelist_add(errmsg as zstring ptr)
 a_append error_ignorelist(), scriptcmdhash  'May be zero
 a_append error_ignorelist(), strhash(*errmsg)
END SUB

'For errorlevel scheme, see scriptErrEnum in const.bi
'NOTE: this function can get called with errors which aren't caused by scripts,
'for example findhero() called from a textbox conditional.
'context_slice is which slice to show in the slice editor
SUB scripterr (errmsg as string, byval errorlevel as scriptErrEnum = serrBadOp, context_slice as Slice ptr = NULL)
 'mechanism to handle scriptwatch throwing errors
 STATIC as integer recursivecall

 'err_suppress_lvl is always at least serrIgnore
 IF errorlevel <= err_suppress_lvl THEN EXIT SUB

 'Is the error ignored? Don't even log it, it could repeat thousands of times.
 STATIC logged_ignore as bool = NO
 IF error_ignorelist_contains(errmsg) THEN
  IF logged_ignore = NO THEN
   debug "(One or more ignored script error/warning...)"
   logged_ignore = YES
  END IF
  EXIT SUB
 END IF

 DIM display as bool = should_display_error_to_user(errorlevel)

 'Otherwise, log the error even if it isn't displayed, up to a point.
 'Logging is very slow, so we shouldn't if there are repeated errors (especially in release mode)
 STATIC error_count as integer = 0
 CONST error_count_limit = 200
 IF display = YES ORELSE error_count < error_count_limit THEN
  DIM as string call_chain
  IF insideinterpreter THEN call_chain = script_call_chain(NO)
  DIM logmsg as string = errmsg + !"\n    Call chain:  " + call_chain
  STATIC lasterror as string
  STATIC logged_repeat as bool = NO  'Logged a 'repeats' line for the last error
  IF display = YES ORELSE logmsg <> lasterror THEN
   lasterror = logmsg
   logged_repeat = NO
  ELSEIF logged_repeat THEN
   'Once only
   EXIT SUB
  ELSE
   debug "(One or more repeats of last script error/warning...)"
   logged_repeat = YES
   EXIT SUB
  END IF
  logmsg = "Scripterr(errlvl=" & errorlevel & " " & *scripterr_names(errorlevel) & "):  " + logmsg
  debug logmsg
  IF nogfx_mode ANDALSO display THEN print_stderr logmsg
  logged_ignore = NO  'Indicate when there are hidden script errors between the logged ones
 ELSEIF error_count = error_count_limit THEN
  debug "Ignoring further script errors"
 END IF
 error_count += 1

 IF display = NO THEN EXIT SUB
 IF nogfx_mode THEN EXIT SUB

 ' OK, decided to show the error
 stop_fibre_timing

 recursivecall += 1

 DIM errtext as string = errmsg

 IF errorlevel = serrError THEN errtext = "Script data may be corrupt or unsupported:" + CHR(10) + errtext

 'TODO: sometimes outside the interpreter we're still in the context of a command, e.g. processing gam.want
 'flags. We should add another global to indicate the relevance of a script.
 IF insideinterpreter THEN
  errtext &= !"\n\n  Call chain (current script last):\n" & script_call_chain(YES, errorlevel)

  IF hsvm.cur_scriptinst THEN
   DIM as ScriptTokenPos posdata
   IF get_script_line_info(posdata, hsvm.cur_scrat) THEN
    errtext &= !"\n" & fgtag(uilook(uiDescription)) & highlighted_script_line(posdata, 120, hsvm.cur_scriptinst)
   END IF
  END IF
 END IF

 DIM errsize as XYPair = textsize(errtext, rWidth - 16, , , vpage)

 DIM state as MenuState
 state.pt = 0
 DIM menu as MenuDef
 menu.anchorvert = alignTop
 menu.alignvert = alignTop
 'TODO: should change the position as the window is resized
 menu.offset.y = 28 + errsize.h
 menu.bordersize = -4

 append_menu_item menu, "Ignore once", 0
 append_menu_item menu, "Ignore permanently", 3
 IF errorlevel < serrError THEN
  append_menu_item menu, "Hide all " & *scripterr_names(errorlevel) & " messages", 8
 END IF
 append_menu_item menu, "Hide all script errors", 1
 'append_menu_item menu, "Set error suppression level to " & errorlevel, 9
 IF insideinterpreter THEN
  'Outside the interpreter there's no active fiber, can't call killscriptthread
  append_menu_item menu, "Stop this script", 2
 END IF
 'append_menu_item menu, "Exit game", 4
 IF context_slice THEN
  append_menu_item menu, "Show this slice in the slice editor", 5
 ELSE
  'append_menu_item menu, "Enter slice editor/debugger", 5
 END IF

 IF recursivecall = 1 THEN  'don't reenter the debugger if possibly already inside!
  IF gam.debug_scripts <> 0 THEN
   state.pt = append_menu_item(menu, "Return to script debugger", 6)
  ELSE
   append_menu_item menu, "Enter script debugger", 6
  END IF
  'This is useless, since scripts are reloaded automatically when possible, and though
  'running scripts can't be reloaded new instances of the script will use the new data.
  'IF running_under_Custom THEN append_menu_item menu, "Reload scripts", 7
 END IF

 state.active = YES
 init_menu_state state, menu

 push_and_reset_gfxio_state
 DO
  setwait 55
  setkeys

  IF keyval(ccCancel) > 1 THEN 'ignore
   EXIT DO
  END IF

  IF keyval(scF1) > 1 THEN show_help("game_scripterr")

  IF enter_space_click(state) THEN
   SELECT CASE menu.items[state.pt]->t
    CASE 0 'ignore
     EXIT DO
    CASE 1 'hide all errors (but not engine bugs)
     err_suppress_lvl = serrError
     EXIT DO
    CASE 2
     killscriptthread
     EXIT DO
    CASE 3 'ignore permanently
     error_ignorelist_add errmsg
     EXIT DO
    CASE 4
     debuginfo "scripterr: User opted to quit"
     exitprogram NO, 1
    CASE 5
     slice_editor SliceTable.Root, , , , , context_slice
    CASE 6 'Script debugger
     gam.debug_scripts = 2
     scriptwatcher gam.debug_scripts 'clean mode, script state view mode
     EXIT DO
    'CASE 7 'reload scripts
    ' reload_scripts
    ' EXIT DO
    CASE 8 'hide some errors
     err_suppress_lvl = errorlevel
     EXIT DO
   END SELECT
  END IF

  usemenu state

  clearpage vpage

  centerbox rCenter, 11, rWidth - 10, 14, 3, vpage
  textcolor uilook(uiText), 0
  DIM header as string
  IF errorlevel >= serrBound THEN
   header = IIF(insideinterpreter, "Script Error!", "Error!")
  ELSEIF errorlevel >= serrWarn THEN
   header = IIF(insideinterpreter, "Script Warning", "Warning")
  ELSEIF errorlevel = serrInfo THEN
   'Never actually shown
   header = IIF(insideinterpreter, "Script Diagnostic", "Diagnostic")
  END IF
  IF LEN(header) THEN
   printstr header, pCentered, 7, vpage
  END IF

  wrapprint errtext, 8, 24, , vpage, rWidth - 16
  draw_menu menu, state, vpage

  setvispage vpage

  IF autotestmode THEN
    write_checkpoint
    exitprogram NO, 1
  END IF

  dowait
 LOOP
 pop_gfxio_state
 recursivecall -= 1

 next_interpreter_check_time = TIMER + scriptCheckDelay
 start_fibre_timing

 'Note: when we resume after a script error, the keyboard state changes, which might break a script
 'Not worth worrying about this.
END SUB

'Called to interrupt interpreter if unresponsive.
'Returns true if current interpreter block (e.g. while-do) should be aborted.
'TODO: there's a lot of code duplicated between this and scripterr
FUNCTION script_interrupt () as bool
 DIM as bool ret = NO
 DIM as string errtext()
 DIM as string msg

 stop_fibre_timing

 msg = !"A script may be stuck in an infinite loop. Press F1 for more help\n\n" _
       !"  Call chain (current script last):\n" + script_call_chain()
 debug "Script interrupted: " & script_call_chain(NO)
 split(wordwrap(msg, large(80, vpages(vpage)->w - 16) \ 8), errtext())

 DIM state as MenuState
 state.pt = 0
 DIM menu as MenuDef
 menu.anchorvert = alignTop
 menu.alignvert = alignTop
 menu.offset.y = 38 + 10 * UBOUND(errtext)
 menu.bordersize = -4

 append_menu_item menu, "Continue running", 0
 'append_menu_item menu, "Exit the top-most script", 10
 append_menu_item menu, "Stop this script", 2
 append_menu_item menu, "Stop all scripts", 3
 append_menu_item menu, "Exit game", 4
 append_menu_item menu, "Enter script debugger", 5
 ' Not useful
 'IF running_under_Custom THEN append_menu_item menu, "Reload scripts", 6

 state.active = YES
 init_menu_state state, menu

 push_and_reset_gfxio_state
 DO
  setwait 55
  setkeys

  IF keyval(ccCancel) > 1 THEN 'continue
   EXIT DO
  END IF

  IF keyval(scF1) > 1 THEN show_help("game_script_interrupt")

  IF enter_space_click(state) THEN
   SELECT CASE menu.items[state.pt]->t
    CASE 0 'continue
     ret = NO
    'CASE 10 'exit topmost  ... probably not too helpful
    ' killtopscript
    ' ret = YES
    CASE 2 'exit fiber
     killscriptthread
     ret = YES
    CASE 3 'stop all fibers
     killallscripts
     ret = YES
    CASE 4 'exit
     debug "script_interrupt: User opted to quit"
     exitprogram NO, 1
    CASE 5 'script debugger
     gam.debug_scripts = 2
     scriptwatcher gam.debug_scripts 'clean mode, script state view mode
     ret = YES
    'CASE 6 'reload scripts
    ' reload_scripts
    ' ret = NO
   END SELECT
   EXIT DO
  END IF

  usemenu state

  clearpage vpage

  centerbox rCenter, 12, rWidth - 10, 15, 3, vpage
  textcolor uilook(uiText), 0
  printstr "A script is stuck", pCentered, 8, vpage

  FOR i as integer = 0 TO UBOUND(errtext)
   printstr errtext(i), 8, 25 + 10 * i, vpage
  NEXT

  draw_menu menu, state, vpage

  setvispage vpage

  dowait
 LOOP

 pop_gfxio_state
 clearpage vpage
 setvispage vpage
 next_interpreter_check_time = TIMER + scriptCheckDelay
 start_fibre_timing

 'Note: when we resume after a script interruption, the keyboard state changes, which might break a script
 'Not worth worrying about this.
 RETURN ret
END FUNCTION
