## run-at--premicrothread.pkg
#
# Here we provide a mechanism for registering at-functions
# which should be invoked at startup and/or shutdown time.
#
# See Note[1] for additional overview.
#
# We define various contexts for an at-function
# -- see comments in src/lib/std/src/nj/run-at--premicrothread.api#
# Compare to:
# src/lib/src/lib/thread-kit/src/core-thread-kit/run-at.pkg# Compiled by:
# src/lib/std/src/standard-core.sublib### "No pessimist ever discovered the secret of the stars,
### or sailed to an uncharted land, or opened a new doorway
### for the human spirit."
###
### -- Helen Keller
package run_at__premicrothread
: (weak) Run_At__Premicrothread # Run_At__Premicrothread is from src/lib/std/src/nj/run-at--premicrothread.api{
When = FORK_TO_DISK # For comments on When cases see corresponding declaration in src/lib/std/src/nj/run-at--premicrothread.api | SPAWN_TO_DISK #
#
#
| STARTUP_PHASE_1_RESET_STATE_VARIABLES #
| STARTUP_PHASE_2_REOPEN_MYTHRYL_LOG #
| STARTUP_PHASE_3_REOPEN_USER_LOGS #
| STARTUP_PHASE_4_MAKE_STDIN_STDOUT_AND_STDERR #
| STARTUP_PHASE_5_CLOSE_STALE_OUTPUT_STREAMS #
| STARTUP_PHASE_6_INITIALIZE_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE #
| STARTUP_PHASE_7_RESET_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE #
| STARTUP_PHASE_8_RESET_COMPILER_STATISTICS #
| STARTUP_PHASE_9_RESET_CPU_AND_WALLCLOCK_TIMERS #
| STARTUP_PHASE_10_START_NEW_DLOPEN_ERA #
| STARTUP_PHASE_11_START_SUPPORT_HOSTTHREADS #
| STARTUP_PHASE_12_START_THREAD_SCHEDULER #
| STARTUP_PHASE_13_REDIRECT_SYSCALLS #
| STARTUP_PHASE_14_START_BASE_IMPS #
| STARTUP_PHASE_15_START_XKIT_IMPS #
| STARTUP_PHASE_16_OF_HEAP_MADE_BY_SPAWN_TO_DISK #
| STARTUP_PHASE_16_OF_HEAP_MADE_BY_FORK_TO_DISK #
| STARTUP_PHASE_17_USER_HOOKS #
#
| SHUTDOWN_PHASE_1_USER_HOOKS #
| SHUTDOWN_PHASE_3_STOP_THREAD_SCHEDULER #
| SHUTDOWN_PHASE_2_UNREDIRECT_SYSCALLS #
| SHUTDOWN_PHASE_4_STOP_SUPPORT_HOSTTHREADS #
| SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS #
| SHUTDOWN_PHASE_6_CLOSE_OPEN_FILES #
| SHUTDOWN_PHASE_6_FLUSH_OPEN_FILES #
| SHUTDOWN_PHASE_7_CLEAR_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE #
#
| NEVER_RUN
;
at_functions
=
REF ([]: List( (String, List( When ), (When -> Void)) ) );
fun when_to_string STARTUP_PHASE_1_RESET_STATE_VARIABLES => "STARTUP_PHASE_1_RESET_STATE_VARIABLES";
when_to_string STARTUP_PHASE_2_REOPEN_MYTHRYL_LOG => "STARTUP_PHASE_2_REOPEN_MYTHRYL_LOG";
when_to_string STARTUP_PHASE_3_REOPEN_USER_LOGS => "STARTUP_PHASE_3_REOPEN_USER_LOGS";
when_to_string STARTUP_PHASE_4_MAKE_STDIN_STDOUT_AND_STDERR => "STARTUP_PHASE_4_MAKE_STDIN_STDOUT_AND_STDERR";
when_to_string STARTUP_PHASE_5_CLOSE_STALE_OUTPUT_STREAMS => "STARTUP_PHASE_5_CLOSE_STALE_OUTPUT_STREAMS";
when_to_string STARTUP_PHASE_6_INITIALIZE_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => "STARTUP_PHASE_6_INITIALIZE_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE";
when_to_string STARTUP_PHASE_7_RESET_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => "STARTUP_PHASE_7_RESET_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE";
when_to_string STARTUP_PHASE_8_RESET_COMPILER_STATISTICS => "STARTUP_PHASE_8_RESET_COMPILER_STATISTICS";
when_to_string STARTUP_PHASE_9_RESET_CPU_AND_WALLCLOCK_TIMERS => "STARTUP_PHASE_9_RESET_CPU_AND_WALLCLOCK_TIMERS";
when_to_string STARTUP_PHASE_10_START_NEW_DLOPEN_ERA => "STARTUP_PHASE_10_START_NEW_DLOPEN_ERA";
when_to_string STARTUP_PHASE_11_START_SUPPORT_HOSTTHREADS => "STARTUP_PHASE_11_START_SUPPORT_HOSTTHREADS";
when_to_string STARTUP_PHASE_12_START_THREAD_SCHEDULER => "STARTUP_PHASE_12_START_THREAD_SCHEDULER";
when_to_string STARTUP_PHASE_13_REDIRECT_SYSCALLS => "STARTUP_PHASE_13_REDIRECT_SYSCALLS";
when_to_string STARTUP_PHASE_14_START_BASE_IMPS => "STARTUP_PHASE_14_START_BASE_IMPS";
when_to_string STARTUP_PHASE_15_START_XKIT_IMPS => "STARTUP_PHASE_15_START_XKIT_IMPS";
when_to_string STARTUP_PHASE_16_OF_HEAP_MADE_BY_SPAWN_TO_DISK => "STARTUP_PHASE_16_OF_HEAP_MADE_BY_SPAWN_TO_DISK";
when_to_string STARTUP_PHASE_16_OF_HEAP_MADE_BY_FORK_TO_DISK => "STARTUP_PHASE_16_OF_HEAP_MADE_BY_FORK_TO_DISK";
when_to_string STARTUP_PHASE_17_USER_HOOKS => "STARTUP_PHASE_17_USER_HOOKS";
#
when_to_string FORK_TO_DISK => "FORK_TO_DISK";
when_to_string SPAWN_TO_DISK => "SPAWN_TO_DISK";
#
when_to_string SHUTDOWN_PHASE_1_USER_HOOKS => "SHUTDOWN_PHASE_1_USER_HOOKS";
when_to_string SHUTDOWN_PHASE_3_STOP_THREAD_SCHEDULER => "SHUTDOWN_PHASE_3_STOP_THREAD_SCHEDULER";
when_to_string SHUTDOWN_PHASE_2_UNREDIRECT_SYSCALLS => "SHUTDOWN_PHASE_2_UNREDIRECT_SYSCALLS";
when_to_string SHUTDOWN_PHASE_4_STOP_SUPPORT_HOSTTHREADS => "SHUTDOWN_PHASE_4_STOP_SUPPORT_HOSTTHREADS";
when_to_string SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS => "SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS";
when_to_string SHUTDOWN_PHASE_6_CLOSE_OPEN_FILES => "SHUTDOWN_PHASE_6_CLOSE_OPEN_FILES";
when_to_string SHUTDOWN_PHASE_6_FLUSH_OPEN_FILES => "SHUTDOWN_PHASE_6_FLUSH_OPEN_FILES";
when_to_string SHUTDOWN_PHASE_7_CLEAR_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => "SHUTDOWN_PHASE_7_CLEAR_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE";
#
when_to_string NEVER_RUN => "NEVER_RUN";
end;
# This is mainly support for sorting a list by a 'When' element,
# e.g. for printing it in a human-intelligible order:
#
fun when_to_int STARTUP_PHASE_1_RESET_STATE_VARIABLES => 1;
when_to_int STARTUP_PHASE_2_REOPEN_MYTHRYL_LOG => 2;
when_to_int STARTUP_PHASE_3_REOPEN_USER_LOGS => 3;
when_to_int STARTUP_PHASE_4_MAKE_STDIN_STDOUT_AND_STDERR => 4;
when_to_int STARTUP_PHASE_5_CLOSE_STALE_OUTPUT_STREAMS => 5;
when_to_int STARTUP_PHASE_6_INITIALIZE_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => 6;
when_to_int STARTUP_PHASE_7_RESET_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => 7;
when_to_int STARTUP_PHASE_8_RESET_COMPILER_STATISTICS => 8;
when_to_int STARTUP_PHASE_9_RESET_CPU_AND_WALLCLOCK_TIMERS => 9;
when_to_int STARTUP_PHASE_10_START_NEW_DLOPEN_ERA => 10;
when_to_int STARTUP_PHASE_11_START_SUPPORT_HOSTTHREADS => 11;
when_to_int STARTUP_PHASE_12_START_THREAD_SCHEDULER => 13;
when_to_int STARTUP_PHASE_13_REDIRECT_SYSCALLS => 12;
when_to_int STARTUP_PHASE_14_START_BASE_IMPS => 14;
when_to_int STARTUP_PHASE_15_START_XKIT_IMPS => 15;
when_to_int STARTUP_PHASE_16_OF_HEAP_MADE_BY_SPAWN_TO_DISK => 16;
when_to_int STARTUP_PHASE_16_OF_HEAP_MADE_BY_FORK_TO_DISK => 17;
when_to_int STARTUP_PHASE_17_USER_HOOKS => 18;
#
when_to_int FORK_TO_DISK => 19;
when_to_int SPAWN_TO_DISK => 20;
#
when_to_int SHUTDOWN_PHASE_1_USER_HOOKS => 21;
when_to_int SHUTDOWN_PHASE_3_STOP_THREAD_SCHEDULER => 22;
when_to_int SHUTDOWN_PHASE_2_UNREDIRECT_SYSCALLS => 23;
when_to_int SHUTDOWN_PHASE_4_STOP_SUPPORT_HOSTTHREADS => 24;
when_to_int SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS => 25;
when_to_int SHUTDOWN_PHASE_6_CLOSE_OPEN_FILES => 26;
when_to_int SHUTDOWN_PHASE_6_FLUSH_OPEN_FILES => 27;
when_to_int SHUTDOWN_PHASE_7_CLEAR_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE => 28;
#
when_to_int NEVER_RUN => 29;
end;
fun when_compare (when1, when2)
=
int_guts::compare ((when_to_int when1), (when_to_int when2));
fun when_gt (when1, when2)
=
int_guts::(>) ((when_to_int when1), (when_to_int when2));
# Return the list of at-functions
# which satisfy 'when_predicate'.
#
fun filter_by_when when_predicate
=
f *at_functions
where
fun f [] => [];
#
f ((item as (_, when_list, _)) ! r)
=>
if (list::exists when_predicate when_list) item ! (f r);
else (f r);
fi;
end;
end;
# Run the at-functions for the given time.
#
# In some cases, this causes the list
# of at_functions to be redefined.
#
# NB: We reverse the order of application at startup time.
#
fun run_functions_scheduled_to_run when
=
{
# fun print_at_fns msg fns
# =
# {
# print (msg + "\n");
# fun print_at_fn (label, whens, _) = print (" (" + label + ", [" + (string_guts::join ", " (map when_to_string whens)) + "])\n");
# apply' fns print_at_fn;
# };
# print ("run_functions_scheduled_to_run(" + (when_to_string when) + ")/TOP\n");
# print_at_fns "run_functions_scheduled_to_run: at_functions initially:" *at_functions;
at_fns
=
case when
# # Here we enumerate all startup cases.
( STARTUP_PHASE_1_RESET_STATE_VARIABLES
| STARTUP_PHASE_2_REOPEN_MYTHRYL_LOG
| STARTUP_PHASE_3_REOPEN_USER_LOGS
| STARTUP_PHASE_4_MAKE_STDIN_STDOUT_AND_STDERR
| STARTUP_PHASE_5_CLOSE_STALE_OUTPUT_STREAMS
| STARTUP_PHASE_6_INITIALIZE_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE # (interprocess-signals.pkg)
| STARTUP_PHASE_7_RESET_POSIX_INTERPROCESS_SIGNAL_HANDLER_TABLE # (interprocess-signals.pkg)
| STARTUP_PHASE_8_RESET_COMPILER_STATISTICS # (compile-statistics.pkg)
| STARTUP_PHASE_9_RESET_CPU_AND_WALLCLOCK_TIMERS # make-mythryld-executable.pkg/ri
| STARTUP_PHASE_10_START_NEW_DLOPEN_ERA
| STARTUP_PHASE_11_START_SUPPORT_HOSTTHREADS #
| STARTUP_PHASE_12_START_THREAD_SCHEDULER #
| STARTUP_PHASE_13_REDIRECT_SYSCALLS #
| STARTUP_PHASE_14_START_BASE_IMPS
| STARTUP_PHASE_15_START_XKIT_IMPS
| STARTUP_PHASE_16_OF_HEAP_MADE_BY_SPAWN_TO_DISK
| STARTUP_PHASE_16_OF_HEAP_MADE_BY_FORK_TO_DISK
| STARTUP_PHASE_17_USER_HOOKS # unused by default, available for users
)
=>
list::reverse # Why 'reverse'? See Note[2].
(filter_by_when (\\ w = w == when));
_ => (filter_by_when (\\ w = w == when));
esac;
# print_at_fns "run_functions_scheduled_to_run: filtered, maybe-reversed at_fns list:" at_fns;
# Now apply the selected at-functions:
#
# list::apply
# ( \\ (_, _, f)
# =
# (f when)
# except
# _ = ()
# )
# at_fns;
list::apply
( \\ (label, _, f)
=
# {
# print ("run_functions_scheduled_to_run(" + (when_to_string when) + ") calling " + label + "\n");
(f when)
# ;}
except
_ = ()
)
at_fns;
};
# Find and remove the named at-function
# from the at-function list.
#
# Return the at-function and
# the new at-function list.
#
# Return NULL if the named
# at-function does not exist.
#
fun filter_by_name fn_name
=
remove *at_functions
where
fun remove []
=>
NULL;
remove ((at_function as (fn_name', when_list, function_proper)) ! rest)
=>
if (fn_name == fn_name')
#
THE ((when_list, function_proper), rest);
else
case (remove rest)
#
THE (at_function', rest')
=>
THE (at_function', at_function ! rest');
NULL => NULL;
esac;
fi;
end;
end;
# Add a named at-function.
# This returns the previous definition, or NULL.
#
fun schedule (at_function as (fn_name, _, _))
=
case (filter_by_name fn_name)
#
THE (old_at_function, new_at_function_list)
=>
{ at_functions := at_function ! new_at_function_list;
#
THE old_at_function;
};
NULL =>
{ at_functions := at_function ! *at_functions;
#
NULL;
};
esac;
# Remove and return the named at-function.
# Return NULL if it is not found:
#
fun deschedule fn_name
=
case (filter_by_name fn_name)
#
THE (old_at_function, at_function_list)
=>
{ at_functions := at_function_list;
#
THE old_at_function;
};
NULL => NULL;
esac;
fun get_schedule ()
=
get_scheduled_fns' (*at_functions, [])
where
fun get_scheduled_fns' ([], results)
=>
reverse results;
get_scheduled_fns' (((label, whens, _) ! rest), results)
=>
get_scheduled_fns' (rest, (label, whens) ! results);
end;
end;
}; # at
##########################################################################
# Note[1]
#
# This package exits partly to support normal at_exit() style functionality.
#
# Primarily, however, it is a secondary kludge that has grown in response
# to the primary bloodybedamned kludge of building "executable" heap
# images by starting up each compiled package in memory, then dumping
# the heap image to disk and resuming it later.
#
# The problem with the latter kludge is that each package starts
# execution in one environment and then continues execution later
# in a possibly quite different environment -- the time has changed,
# the process id has changed, the current directory has quite likely
# changed, even the current machine, IP address etc may have changed.
# In general all kernel-maintained resources such as open file
# descriptors and mutex handles will be stale and invalid after
# this heap save/reload sequence.
#
# This makes the heap save/reload kludge a perpetual bug factory:
# any package which caches any environmental information at start-up
# is liable to be broken by the heap save/reload cycle.
#
# run-at--premicrothread.pkg is a secondary kludge deployed in service to the save/reload
# primary kludge, with the idea that packages can register special
# ad hoc fixups to deal with the breakage induced by the save/reload cycle.
#
# Since in general not only must these ad hoc fixups be run reliably
# at shutdown and (mainly) startup, but must also be run in correct
# order due to dependencies between them, I have broken up the startup
# sequence into multiple phases. (SML/NJ combines them all into one,
# and trusts to God and St George to keep ordering correct. This is
# not only fragile, but also mysterious, since it is quite difficult
# to get any notion of what is actually happening during that combined
# phase.)
#
# -- 2012-07-13 CrT Yes, Friday the 13th. :-)
##########################################################################
# Note[2]
#
# The assumption by the SML/NJ authors here is that (due to dependency
# ordering) that lower-level packages load and link first and will set
# up their run-at startup and shutdown thunks at linktime.
#
# Consequently if three packages A, B, C register thunks in that order,
# the thunk list will wind up in the order
#
# [ C, B, A ]
#
# (since later entries are prepended to the list).
#
# This is a sensible order for shutdown, since presumably the highest-level
# facilities should be shut down first and lowest-level last, but at startup
# it will be the reverse of the sensible order.
#
# In general I (Cynbe) dislike this sort of implicit undocumented ordering
# constraint, so I've tried to restructure this package so as to explicitly
# document what happens in what order at startup/shutdown, so my hope at
# this point is that in general each thunklist holds only one entry, and
# none of this reverse-or-reverse-me-not stuff matters.
#
# -- 2012-07-09 CrT