## runtime-signals-guts.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib# This is the internal view of the Signals package.
stipulate
package bt = base_types; # base_types is from src/lib/core/init/built-in.pkg package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkg package ig = int_guts; # int_guts is from src/lib/std/src/bind-int-32.pkg package sg = string_guts; # string_guts is from src/lib/std/src/string-guts.pkgherein
package runtime_signals_guts: (weak) api {
include Runtime_Signals; # Runtime_Signals is from src/lib/std/src/nj/runtime-signals.api #
initialize_posix_interprocess_signal_handler_table: X -> Void;
clear_posix_interprocess_signal_handler_table: X -> Void;
reset_posix_interprocess_signal_handler_table: X -> Void;
}
{
Signal = SIGNAL ci::System_Constant;
Signal_Action # WARNING! This definition must be kept synched to that in src/c/h/system-dependent-signal-stuff.h
#
= IGNORE
| DEFAULT
| HANDLER (Signal, Int, base_types::Fate( Void ))
->
base_types::Fate( Void )
;
fun cfun fun_name
=
ci::find_c_function { lib_name => "signal", fun_name }; # signal lives in src/c/lib/signal/
fun signal_to_constant (SIGNAL sc)
=
sc;
fun constant_to_signal sc
=
SIGNAL sc;
# The list of supported signals, its length, and the maximum signal code.
#
# We assume that the signal codes do not change, but that the number of
# supported signals might vary between versions of the run-time system.
Signal_Info
=
{ act: Signal_Action,
mask: Int,
signal: Signal
};
stipulate
#
list_signals' = cfun "listSignals" : Void -> List(ci::System_Constant); # listsignals def in src/c/lib/signal/listsignals.c
#
fun find_max signals
=
list::fold_left
(fn (SIGNAL (signal_id, _), id)
=
if (id < signal_id) signal_id;
else id;
fi
)
-1
signals;
herein
signal_count = REF 0;
max_signal = REF -1;
signal_list = REF ([]: List(Signal));
signal_table = REF (rw_vector::from_list []): Ref( rw_vector::Rw_Vector( Null_Or( Signal_Info ) ) );
debug = ci::find_c_function { lib_name => "heap", fun_name => "debug" } : String -> Void; # Print a string to the debug stream.
# debug def in src/c/lib/heap/debug.c
fun get_info signal_id
=
case (rw_vector::get (*signal_table, signal_id))
#
THE info => info;
#
NULL
=>
{ debug (sg::cat [ "\n*** Internal error: undefined sigTable entry for signal ",
ig::to_string signal_id, " ***\n"
]
);
raise exception null_or::NULL_OR;
};
esac;
/****
fun getInfo sigId = (case (rw_vector::get(*sigTable, sigId))
of NULL => raise exception null_or::NULL_OR
| (THE info) => info
) # end case
****/
fun set_info (signal_id, info)
=
rw_vector::set
( *signal_table,
signal_id,
THE info
);
fun reset_list ()
=
{
signal_list := list::map constant_to_signal (list_signals' ());
signal_count := list::length(*signal_list);
max_signal := find_max(*signal_list);
signal_table := rw_vector::make_rw_vector(*max_signal + 1, NULL);
};
end;
# List the signals (and their names)
# supported by this version:
#
fun list_signals ()
=
*signal_list;
# Return the name of a signal:
#
fun signal_name (SIGNAL(_, name))
=
name;
# Return the signal with the
# corresponding name.
# Return NULL if no such signal exists.
#
fun get_signal_by_name name
=
case (ci::find_system_constant (name, list::map signal_to_constant (*signal_list)))
#
NULL => NULL;
THE sc => THE (SIGNAL sc);
esac;
# These run-time functions deal with the
# state of a signal in the system:
#
get_signal_state = cfun "getSigState" : ci::System_Constant -> Int ; # getsigstate def in src/c/lib/signal/getsigstate.c
set_signal_state = cfun "setSigState" : (ci::System_Constant, Int) -> Void; # setsigstate def in src/c/lib/signal/setsigstate.c
# The states are defined as:
#
ignore_sig_state = 0;
default_sig_state = 1;
enabled_sig_state = 2;
# Clear the posix-signal handler-table:
#
fun clear_posix_interprocess_signal_handler_table _
=
rw_vector::modify (fn _ = NULL) *signal_table;
# Initialize the signal table to the inherited process dictionary
#
fun initialize_posix_interprocess_signal_handler_table _
=
{ fun initialize_posix_signal (s as (SIGNAL signal_id))
=
{ state = get_signal_state signal_id;
fun set_state st
=
set_info (#1 signal_id, { act=>st, mask=>0, signal=>s } );
if (state == ignore_sig_state)
#
set_state IGNORE;
#
elif (state == default_sig_state)
#
set_state DEFAULT;
#
else # state = enabledSigState
#
raise exception FAIL "unexpected signal handler";
fi;
};
reset_list ();
list::apply initialize_posix_signal *signal_list;
};
# Reset the signal dictionary to agree with the signal table
#
fun reset_posix_interprocess_signal_handler_table _
=
{ old_sig_table = *signal_table;
old_list = *signal_list;
fun copy (SIGNAL signal_id)
=
case (rw_vector::get (old_sig_table, #1 signal_id))
#
THE info
=>
{ set_info (#1 signal_id, info);
#
case info.act
#
IGNORE => set_signal_state (signal_id, ignore_sig_state);
DEFAULT => set_signal_state (signal_id, default_sig_state);
HANDLER _ => set_signal_state (signal_id, enabled_sig_state);
esac;
};
NULL => ();
esac
except
_ = ();
# NOTE: we should probably notify the user that old signal handlers
# are being lost, but there is no good way to do this right now.
reset_list ();
list::apply copy old_list;
};
# Signal masking:
#
Signal_Mask
= MASK_ALL
| MASK List( Signal )
;
stipulate
# Run-time system API:
# NULL -- empty mask
# THE[] -- mask all signals
# THE l -- mask the signals in l
set_sig_mask = cfun "setSigMask": Null_Or( List(ci::System_Constant) ) -> Void; # setsigmask def in src/c/lib/signal/setsigmask.c
get_sig_mask = cfun "getSigMask": Void -> Null_Or( List(ci::System_Constant) ) ; # getsigmask def in src/c/lib/signal/getsigmask.c
# Sort a list of signals, dropping duplicates:
#
fun sort_signals MASK_ALL
=>
*signal_list;
sort_signals (MASK l)
=>
list::fold_left insert [] l
where
fun insert (s as SIGNAL (id, _), []) # A simple insertion sort to eliminate duplicates.
=>
[s];
insert (s as SIGNAL (id, _), (s' as SIGNAL (id', _)) ! r)
=>
if (id < id')
#
s ! s' ! r;
else
if (id == id') s' ! r;
else s' ! insert (s, r);
fi;
fi;
end;
end;
end;
# Map a list of signals into the format
# expected by the runtime system API:
#
fun make_mask (masked, n_masked)
=
if (n_masked == 0 ) NULL;
elif (n_masked == *signal_count) THE [];
else THE masked;
fi;
#
fun is_masked (SIGNAL (id, _)) # Is the signal masked?
=
(get_info id).mask > 0;
herein
fun mask_signals mask
=
compute_new_mask (sigs, *signal_list, [], 0, 0)
where
#
sigs = sort_signals mask;
# Function for incrementing a signal mask.
fun inc_mask (SIGNAL (signal_id, _))
=
{ (get_info signal_id)
->
{ act, mask, signal };
set_info (signal_id, { act, mask=>mask+1, signal } );
};
# Scan over the sorted mask list and the list of all signals.
#
# Record which signals are masked
# and how many new signals are masked.
fun compute_new_mask ([], _, _, _, 0)
=>
list::apply inc_mask sigs; # No signals are masked, so we only update the local state.
compute_new_mask ([], [], masked, n_masked, _)
=>
{ # NOTE: we must update the OS's view of the mask before we change
# our own to avoid a race condition!
set_sig_mask (make_mask (masked, n_masked));
list::apply inc_mask sigs;
};
compute_new_mask ([], s2 ! r2, masked, n_masked, n_new)
=>
if (is_masked s2) compute_new_mask ([], r2, (signal_to_constant s2) ! masked, n_masked+1, n_new);
else compute_new_mask ([], r2, masked, n_masked, n_new);
fi;
compute_new_mask ((s1 as SIGNAL (id1, _)) ! r1, (s2 as SIGNAL (id2, _)) ! r2, masked, n_masked, n_new)
=>
if (id1 == id2)
#
n_new = if (is_masked s1) n_new; else n_new+1;fi;
compute_new_mask (r1, r2, (signal_to_constant s1) ! masked, n_masked+1, n_new);
else
if (is_masked s2) compute_new_mask (s1 ! r1, r2, (signal_to_constant s2) ! masked, n_masked+1, n_new);
else compute_new_mask (s1 ! r1, r2, masked, n_masked, n_new);
fi;
fi;
compute_new_mask (_ ! _, [], _, _, _)
=>
raise exception FAIL "computeNewMask: bogus mask (impossible)";
end;
end;
fun unmask_signals mask
=
compute_new_mask (sigs, *signal_list, [], 0, 0)
where
#
sigs = sort_signals mask;
# Function for decrementing a signal mask.
#
fun dec_mask (SIGNAL (signal_id, _))
=
{ (get_info signal_id)
->
{ act, mask, signal };
if (mask > 0)
#
set_info (signal_id, { act, mask=>mask - 1, signal } );
fi;
};
# Return TRUE if decrementing this
# signal's count will unmask it.
#
fun is_unmasked (SIGNAL (id, _))
=
(get_info id).mask <= 1;
# Scan over the sorted mask list
# and the list of all signals.
#
# Record which signals are masked and
# how many new signals are unmasked:
#
fun compute_new_mask ([], _, _, _, 0)
=>
list::apply dec_mask sigs; # No signals are unmasked, so we only update the local state.
compute_new_mask ([], [], masked, n_masked, _)
=>
{ # NB: To avoid a race condition we must
# update our local view of the mask
# before we change the OS's view.
list::apply dec_mask sigs;
set_sig_mask (make_mask (masked, n_masked));
};
compute_new_mask ([], s2 ! r2, masked, n_masked, n_new)
=>
if (is_masked s2) compute_new_mask ([], r2, (signal_to_constant s2) ! masked, n_masked+1, n_new);
else compute_new_mask ([], r2, masked, n_masked, n_new);
fi;
compute_new_mask ( (s1 as SIGNAL (id1, _)) ! r1,
(s2 as SIGNAL (id2, _)) ! r2,
masked,
n_masked,
n_new
)
=>
if (id1 == id2)
#
if (is_unmasked s1) compute_new_mask ( r1, r2, masked, n_masked, n_new+1);
else compute_new_mask ( r1, r2, (signal_to_constant s1) ! masked, n_masked+1, n_new ); # still masked
fi;
else
if (is_masked s2) compute_new_mask (s1 ! r1, r2, (signal_to_constant s2) ! masked, n_masked+1, n_new );
else compute_new_mask (s1 ! r1, r2, masked, n_masked, n_new );
fi;
fi;
compute_new_mask (_ ! _, [], _, _, _)
=>
raise exception FAIL "unmaskSignals: bogus mask (impossible)";
end;
end;
fun masked ()
=
case (get_sig_mask ())
#
NULL => MASK [];
THE [] => MASK_ALL;
THE l => MASK (list::map constant_to_signal l);
esac;
end;
# Set the handler for a signal,
# returning the previous action:
#
fun set_signal_handler (signal as (SIGNAL signal_id), act)
=
{ mask_signals MASK_ALL;
#
(get_info (#1 signal_id))
->
{ act=>old_act, mask, ... };
case (act, old_act)
#
(IGNORE, IGNORE) => ();
(DEFAULT, DEFAULT) => ();
(HANDLER _, HANDLER _)
=>
set_info (#1 signal_id, { act, mask, signal } );
(IGNORE, _)
=>
{ set_info (#1 signal_id, { act, mask, signal } );
#
set_signal_state (signal_id, ignore_sig_state);
};
(DEFAULT, _)
=>
{ set_info (#1 signal_id, { act, mask, signal } );
#
set_signal_state (signal_id, default_sig_state);
};
(HANDLER _, _)
=>
{ set_info (#1 signal_id, { act, mask, signal } );
#
set_signal_state (signal_id, enabled_sig_state);
};
esac;
unmask_signals MASK_ALL;
old_act;
};
# If a signal is not being ignored, then set the handler.
#
# This returns the previous handler (if IGNORE, then
# the current handler is still IGNORE).
fun override_signal_handler (s as (SIGNAL signal_id), act)
=
{ mask_signals MASK_ALL;
my { act=>old_act, mask, ... }
=
get_info (#1 signal_id);
case (old_act, act)
(IGNORE, _) => ();
(DEFAULT, DEFAULT) => ();
(HANDLER _, HANDLER _)
=>
set_info(#1 signal_id, { act, mask, signal=>s } );
(_, IGNORE)
=>
{ set_info(#1 signal_id, { act, mask, signal=>s } );
set_signal_state (signal_id, ignore_sig_state);
};
(_, DEFAULT)
=>
{ set_info(#1 signal_id, { act, mask, signal=>s } );
set_signal_state (signal_id, default_sig_state);
};
(_, HANDLER _)
=>
{ set_info(#1 signal_id, { act, mask, signal=>s } );
set_signal_state (signal_id, enabled_sig_state);
};
esac;
unmask_signals MASK_ALL;
old_act;
};
# Get the current action for the given signal:
#
fun get_signal_handler (SIGNAL (signal_id, _))
=
(get_info signal_id).act;
# Sleep until the next signal.
#
# If called when signals are masked,
# then signals will still be masked
# when pause returns.
#
pause = cfun "pause" : Void -> Void; # pause def in src/c/lib/signal/pause.c
# Here is the Mythryl handler that gets
# invoked by the C run-time system. The
# sequence of events is:
#
# o Posix signal gets initially noted by c_signal_handler in
#
# src/c/machine-dependent/posix-signal.c
#
# which merely increments the seen_count field for that signal.
#
# o This flag eventually gets noticed in
#
# src/c/main/run-mythryl-code-and-runtime-eventloop.c
#
# which sets the saved Mythryl state to "return" to us.
#
# It is essential that signal_handler() here never return;
# it must instead pass control to the saved 'resume_k' fate ("continuation").
#
fun root_mythryl_handler_for_posix_interprocess_signals
(
which_signal: Int, # SIGALRM or such -- ID number of POSIX signal being handled.
count: Int, # Number of times c_signal_handler has seen this signal since we last handled it here.
resume_k # Fate to resume once signal handling is complete.
)
=
case (rw_vector::get (*signal_table, which_signal))
#
THE { act=>HANDLER handler, mask=>0, signal }
=>
handler (signal, count, resume_k);
# DEBUG
# _ => raise exception FAIL "inconsistent internal signal state";
# DEBUG
info
=>
{
act = case info
#
NULL => "NULL";
THE { act=>IGNORE, ... } => "IGNORE";
THE { act=>DEFAULT, ... } => "DEFAULT";
THE { act=>HANDLER _, mask, ... }
=>
cat ["HANDLER (mask=", ig::to_string mask, "!=0)"];
esac;
msg = cat ["inconsistent state ", act,
" for signal ", ig::to_string which_signal];
raise exception FAIL msg;
};
esac;
# Install our root posix-signal handler:
/* */ my _ =
runtime::posix_interprocess_signal_handler_refcell__global
:=
root_mythryl_handler_for_posix_interprocess_signals;
# Initialize the signal list and table:
/* */ my _ =
initialize_posix_interprocess_signal_handler_table ();
# These signals should be supported
# even on non-UNIX platforms:
#
interrupt_signal = null_or::the (get_signal_by_name "INTERRUPT" ); # SIGINT.
alarm_signal = null_or::the (get_signal_by_name "ALARM"); # SIGALRM.
terminate_signal = null_or::the (get_signal_by_name "TERMINATE"); # SIGTERM. This appears to be used (only) in src/lib/core/internal/make-mythryld-executable.pkg heapcleaning_done_signal = null_or::the (get_signal_by_name "HEAPCLEANING_DONE" ); # Not a true interprocess signal; generated by runtime after doing a garbage collection.
}; # package runtime_signals_guts
end; # stipulate
## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.