'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) & " <>" 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 = call_chain + ": " + errmsg 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 debug "Scripterr(errlvl=" & errorlevel & " " & *scripterr_names(errorlevel) & "): " + 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 ' 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