/* -*-C-*-
-$Id: uxtrap.c,v 1.39 2003/05/12 20:02:55 cph Exp $
+$Id: uxtrap.c,v 1.40 2005/06/26 04:35:03 cph Exp $
Copyright 1990,1991,1992,1993,1995,1997 Massachusetts Institute of Technology
-Copyright 2000,2001,2002,2003 Massachusetts Institute of Technology
+Copyright 2000,2001,2002,2003,2005 Massachusetts Institute of Technology
This file is part of MIT/GNU Scheme.
#include "option.h"
#include "ostop.h"
+#ifdef HAS_COMPILER_SUPPORT
+# include "gccode.h"
+#endif
+
+#if defined(HAVE_STRUCT_SIGCONTEXT) && defined(HAS_COMPILER_SUPPORT) && !defined(USE_STACKLETS)
+# define ENABLE_TRAP_RECOVERY 1
+#endif
+
extern CONST char * EXFUN (find_signal_name, (int signo));
extern void EXFUN (UX_dump_core, (void));
extern PTR initial_C_stack_pointer;
+extern int EXFUN (pc_to_utility_index, (unsigned long));
+extern int EXFUN (pc_to_builtin_index, (unsigned long));
+extern SCHEME_OBJECT * EXFUN (find_constant_space_block, (SCHEME_OBJECT *));
\f
+struct ux_sig_code_desc
+{
+ int signo;
+ unsigned long code_mask;
+ unsigned long code_value;
+ char * name;
+};
+
+static struct ux_sig_code_desc ux_signal_codes [64];
+
+#define DECLARE_UX_SIGNAL_CODE(s, m, v, n) \
+{ \
+ ((ux_signal_codes [i]) . signo) = (s); \
+ ((ux_signal_codes [i]) . code_mask) = (m); \
+ ((ux_signal_codes [i]) . code_value) = (v); \
+ ((ux_signal_codes [i]) . name) = (n); \
+ i += 1; \
+}
+
+enum pc_location
+{
+ pcl_heap,
+ pcl_constant,
+ pcl_builtin,
+ pcl_utility,
+ pcl_primitive,
+ pcl_unknown
+};
+
+#ifdef TC_POSITIVE_FIXNUM
+# define FIXNUM_MARKER TC_POSITIVE_FIXNUM
+#else
+# define FIXNUM_MARKER TC_FIXNUM
+#endif
+
+#ifndef SPECIAL_SIGNAL_CODE_NAMES
+# define SPECIAL_SIGNAL_CODE_NAMES()
+#endif
+
static enum trap_state trap_state;
static enum trap_state user_trap_state;
-
static enum trap_state saved_trap_state;
static int saved_signo;
static SIGINFO_T saved_info;
-static struct FULL_SIGCONTEXT * saved_scp;
+static DECLARE_FULL_SIGCONTEXT (saved_scp);
+
+static void EXFUN
+ (continue_from_trap, (int, SIGINFO_T, FULL_SIGCONTEXT_T *));
+
+static SCHEME_OBJECT * EXFUN (find_heap_address, (unsigned long));
+static SCHEME_OBJECT * EXFUN (find_constant_address, (unsigned long));
+
+#ifdef ENABLE_TRAP_RECOVERY
+static SCHEME_OBJECT * EXFUN
+ (find_block_address_in_area, (SCHEME_OBJECT *, SCHEME_OBJECT *));
+#endif
-static void EXFUN (initialize_ux_signal_codes, (void));
static void EXFUN
- (continue_from_trap,
- (int signo, SIGINFO_T info, struct FULL_SIGCONTEXT * scp));
+ (setup_trap_frame, (int,
+ SIGINFO_T,
+ FULL_SIGCONTEXT_T *,
+ struct trap_recovery_info *,
+ SCHEME_OBJECT *));
+
+static void EXFUN (initialize_ux_signal_codes, (void));
+
+static SCHEME_OBJECT EXFUN
+ (find_signal_code_name, (int, SIGINFO_T, FULL_SIGCONTEXT_T *));
+static enum pc_location EXFUN
+ (classify_pc, (unsigned long, SCHEME_OBJECT **, unsigned int *));
+
+static void EXFUN (trap_normal_termination, (void));
+static void EXFUN (trap_immediate_termination, (void));
+static void EXFUN (trap_dump_core, (void));
+static void EXFUN (trap_recover, (void));
+\f
void
DEFUN_VOID (UX_initialize_trap_recovery)
{
return (old_trap_state);
}
-static void
-DEFUN_VOID (trap_normal_termination)
-{
- trap_state = trap_state_exitting_soft;
- termination_trap ();
-}
-
-static void
-DEFUN_VOID (trap_immediate_termination)
+void
+DEFUN (hard_reset, (scp), FULL_SIGCONTEXT_T * scp)
{
- trap_state = trap_state_exitting_hard;
- OS_restore_external_state ();
- exit (1);
+ /* 0 is an invalid signal, it means a user requested reset. */
+ continue_from_trap (0, 0, scp);
}
-static void
-DEFUN_VOID (trap_dump_core)
+void
+DEFUN_VOID (soft_reset)
{
- if (! (option_disable_core_dump))
- UX_dump_core ();
+ /* Called synchronously. */
+ struct trap_recovery_info trinfo;
+ SCHEME_OBJECT * new_stack_pointer =
+ (((sp_register <= Stack_Top) && (sp_register > Stack_Guard))
+ ? sp_register
+ : 0);
+ if ((Registers[REGBLOCK_PRIMITIVE]) != SHARP_F)
+ {
+ (trinfo . state) = STATE_PRIMITIVE;
+ (trinfo . pc_info_1) = (Registers[REGBLOCK_PRIMITIVE]);
+ (trinfo . pc_info_2) =
+ (LONG_TO_UNSIGNED_FIXNUM (Registers[REGBLOCK_LEXPR_ACTUALS]));
+ (trinfo . extra_trap_info) = SHARP_F;
+ }
else
{
- fputs (">> Core dumps are disabled - Terminating normally.\n", stdout);
- fflush (stdout);
- termination_trap ();
+ (trinfo . state) = STATE_UNKNOWN;
+ (trinfo . pc_info_1) = SHARP_F;
+ (trinfo . pc_info_2) = SHARP_F;
+ (trinfo . extra_trap_info) = SHARP_F;
}
+ if ((Free >= Heap_Top) || (Free < Heap_Bottom))
+ /* Let's hope this works. */
+ Free = MemTop;
+ setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
}
-static void
-DEFUN_VOID (trap_recover)
+SCHEME_OBJECT
+DEFUN (find_ccblock, (pc), unsigned long pc)
{
- if (WITHIN_CRITICAL_SECTION_P ())
- {
- CLEAR_CRITICAL_SECTION_HOOK ();
- EXIT_CRITICAL_SECTION ({});
- }
- reset_interruptable_extent ();
- continue_from_trap (saved_signo, saved_info, saved_scp);
+ SCHEME_OBJECT * block_addr;
+ int index;
+
+ block_addr = 0;
+ classify_pc (pc, (&block_addr), (&index));
+ return
+ ((block_addr != 0)
+ ? (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr))
+ : SHARP_F);
}
\f
void
CONST char * message AND
int signo AND
SIGINFO_T info AND
- struct FULL_SIGCONTEXT * scp)
+ FULL_SIGCONTEXT_T * scp)
{
int code = ((SIGINFO_VALID_P (info)) ? (SIGINFO_CODE (info)) : 0);
Boolean stack_overflowed_p = (STACK_OVERFLOWED_P ());
if (old_trap_state == trap_state_exitting_hard)
_exit (1);
- else if (old_trap_state == trap_state_exitting_soft)
+ if (old_trap_state == trap_state_exitting_soft)
trap_immediate_termination ();
trap_state = trap_state_trapped;
+
if (WITHIN_CRITICAL_SECTION_P ())
- {
- fprintf (stdout,
- "\n>> A %s has occurred within critical section \"%s\".\n",
- message, (CRITICAL_SECTION_NAME ()));
- fprintf (stdout, ">> [signal %d (%s), code %d]\n",
- signo, (find_signal_name (signo)), code);
- }
+ {
+ fprintf (stdout,
+ "\n>> A %s has occurred within critical section \"%s\".\n",
+ message, (CRITICAL_SECTION_NAME ()));
+ fprintf (stdout, ">> [signal %d (%s), code %d]\n",
+ signo, (find_signal_name (signo)), code);
+ }
else if (stack_overflowed_p || (old_trap_state != trap_state_recover))
- {
- fprintf (stdout, "\n>> A %s has occurred.\n", message);
- fprintf (stdout, ">> [signal %d (%s), code %d]\n",
- signo, (find_signal_name (signo)), code);
- }
+ {
+ fprintf (stdout, "\n>> A %s has occurred.\n", message);
+ fprintf (stdout, ">> [signal %d (%s), code %d]\n",
+ signo, (find_signal_name (signo)), code);
+ }
if (stack_overflowed_p)
- {
- fputs (">> The stack has overflowed overwriting adjacent memory.\n",
- stdout);
- fputs (">> This was probably caused by a runaway recursion.\n", stdout);
- }
+ {
+ fputs (">> The stack has overflowed overwriting adjacent memory.\n",
+ stdout);
+ fputs (">> This was probably caused by a runaway recursion.\n", stdout);
+ }
fflush (stdout);
switch (old_trap_state)
- {
- case trap_state_trapped:
- if ((saved_trap_state == trap_state_recover) ||
- (saved_trap_state == trap_state_query))
{
- fputs (">> The trap occurred while processing an earlier trap.\n",
- stdout);
- fprintf (stdout,
- ">> [The earlier trap raised signal %d (%s), code %d.]\n",
- saved_signo,
- (find_signal_name (saved_signo)),
- ((SIGINFO_VALID_P (saved_info))
- ? (SIGINFO_CODE (saved_info))
- : 0));
- fputs (((WITHIN_CRITICAL_SECTION_P ())
- ? ">> Successful recovery is extremely unlikely.\n"
- : ">> Successful recovery is unlikely.\n"),
- stdout);
+ case trap_state_trapped:
+ if ((saved_trap_state == trap_state_recover)
+ || (saved_trap_state == trap_state_query))
+ {
+ fprintf (stdout,
+ ">> The trap occurred while processing an earlier trap.\n");
+ fprintf (stdout,
+ ">> [The earlier trap raised signal %d (%s), code %d.]\n",
+ saved_signo,
+ (find_signal_name (saved_signo)),
+ ((SIGINFO_VALID_P (saved_info))
+ ? (SIGINFO_CODE (saved_info))
+ : 0));
+ fprintf (stdout, ">> Successful recovery is %sunlikely.\n",
+ ((WITHIN_CRITICAL_SECTION_P ()) ? "extremely " : ""));
+ }
+ else
+ trap_immediate_termination ();
break;
- }
- else
- trap_immediate_termination ();
- case trap_state_recover:
- if ((WITHIN_CRITICAL_SECTION_P ()) || stack_overflowed_p)
- {
- fputs (">> Successful recovery is unlikely.\n", stdout);
+
+ case trap_state_recover:
+ if ((WITHIN_CRITICAL_SECTION_P ()) || stack_overflowed_p)
+ fprintf (stdout, ">> Successful recovery is unlikely.\n");
+ else
+ {
+ saved_trap_state = old_trap_state;
+ saved_signo = signo;
+ saved_info = info;
+ saved_scp = scp;
+ trap_recover ();
+ }
break;
- }
- else
- {
- saved_trap_state = old_trap_state;
- saved_signo = signo;
- saved_info = info;
- saved_scp = scp;
- trap_recover ();
- }
- case trap_state_exit:
- termination_trap ();
- default:
- break;
- }
+ case trap_state_exit:
+ termination_trap ();
+ break;
+
+ default:
+ break;
+ }
fflush (stdout);
saved_trap_state = old_trap_state;
saved_scp = scp;
while (1)
- {
- static CONST char * trap_query_choices[] =
{
- "D = dump core",
- "I = terminate immediately",
- "N = terminate normally",
- "R = attempt recovery",
- "Q = terminate normally",
- 0
- };
- switch (userio_choose_option
- ("Choose one of the following actions:",
- "Action -> ",
- trap_query_choices))
- {
- case 'I':
- trap_immediate_termination ();
- case 'D':
- trap_dump_core ();
- case '\0':
- /* Error in IO. Assume everything scrod. */
- case 'N':
- case 'Q':
- trap_normal_termination ();
- case 'R':
- trap_recover ();
+ static CONST char * trap_query_choices[] =
+ {
+ "D = dump core",
+ "I = terminate immediately",
+ "N = terminate normally",
+ "R = attempt recovery",
+ "Q = terminate normally",
+ 0
+ };
+ switch (userio_choose_option
+ ("Choose one of the following actions:",
+ "Action -> ",
+ trap_query_choices))
+ {
+ case 'I':
+ trap_immediate_termination ();
+ break;
+ case 'D':
+ trap_dump_core ();
+ break;
+ case '\0':
+ /* Error in IO. Assume everything scrod. */
+ case 'N':
+ case 'Q':
+ trap_normal_termination ();
+ break;
+ case 'R':
+ trap_recover ();
+ break;
+ }
}
- }
}
\f
-struct ux_sig_code_desc
-{
- int signo;
- unsigned long code_mask;
- unsigned long code_value;
- char *name;
-};
+#ifdef ENABLE_TRAP_RECOVERY
-static struct ux_sig_code_desc ux_signal_codes [64];
+/* Heuristic recovery from Unix signals (traps).
-#define DECLARE_UX_SIGNAL_CODE(s, m, v, n) \
+ continue_from_trap attempts to:
+
+ 1) validate the trap information (pc and sp);
+ 2) determine whether compiled code was executing, a primitive was
+ executing, or execution was in the interpreter;
+ 3) guess what C global state is still valid; and
+ 4) set up a recovery frame for the interpreter so that debuggers can
+ display more information. */
+
+#define SCHEME_ALIGNMENT_MASK ((sizeof (SCHEME_OBJECT)) - 1)
+#define FREE_PARANOIA_MARGIN 0x100
+
+#define ALIGNED_P(addr) \
+ ((((unsigned long) (addr)) & SCHEME_ALIGNMENT_MASK) == 0)
+
+#define PC_ALIGNED_P(pc) ((((unsigned long) (pc)) & PC_ALIGNMENT_MASK) == 0)
+
+#define SET_RECOVERY_INFO(s, arg1, arg2) do \
{ \
- ((ux_signal_codes [i]) . signo) = (s); \
- ((ux_signal_codes [i]) . code_mask) = (m); \
- ((ux_signal_codes [i]) . code_value) = (v); \
- ((ux_signal_codes [i]) . name) = (n); \
- i += 1; \
-}
+ (recovery_info . state) = s; \
+ (recovery_info . pc_info_1) = arg1; \
+ (recovery_info . pc_info_2) = arg2; \
+} while (0)
static void
-DEFUN_VOID (initialize_ux_signal_codes)
-{
- unsigned int i = 0;
- INITIALIZE_UX_SIGNAL_CODES ();
- DECLARE_UX_SIGNAL_CODE (0, 0, 0, ((char *) 0));
-}
-
-static SCHEME_OBJECT
-DEFUN (find_signal_code_name, (signo, info, scp),
+DEFUN (continue_from_trap, (signo, info, scp),
int signo AND
SIGINFO_T info AND
- struct FULL_SIGCONTEXT * scp)
+ FULL_SIGCONTEXT_T * scp)
{
- unsigned long code = 0;
- char * name = 0;
- if (SIGINFO_VALID_P (info))
- {
- code = (SIGINFO_CODE (info));
-#ifdef SPECIAL_SIGNAL_CODE_NAMES
- SPECIAL_SIGNAL_CODE_NAMES ();
- if (name == 0)
+ unsigned long pc = (FULL_SIGCONTEXT_PC (scp));
+ SCHEME_OBJECT primitive = (Registers[REGBLOCK_PRIMITIVE]);
+ SCHEME_OBJECT * block_addr;
+ int index;
+ SCHEME_OBJECT * new_sp = 0;
+ struct trap_recovery_info recovery_info;
+
+#ifdef PC_VALUE_MASK
+ pc &= PC_VALUE_MASK;
#endif
+
+ /* Choose new SP and encode location data. */
+ switch (classify_pc (pc, (&block_addr), (&index)))
+ {
+ case pcl_primitive:
+ new_sp = sp_register;
+ SET_RECOVERY_INFO
+ (STATE_PRIMITIVE,
+ primitive,
+ (LONG_TO_UNSIGNED_FIXNUM (Registers[REGBLOCK_LEXPR_ACTUALS])));
+ break;
+
+ case pcl_heap:
+ case pcl_constant:
+ new_sp = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_SCHSP (scp)));
+ Free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
+ SET_RECOVERY_INFO
+ (STATE_COMPILED_CODE,
+ (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr)),
+ (LONG_TO_UNSIGNED_FIXNUM (pc - ((unsigned long) block_addr))));
+ break;
+
+ case pcl_utility:
+ new_sp = sp_register;
+ SET_RECOVERY_INFO
+ (STATE_UTILITY,
+ (LONG_TO_UNSIGNED_FIXNUM (index)),
+ UNSPECIFIC);
+ break;
+
+ case pcl_builtin:
+ new_sp = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_SCHSP (scp)));
+ Free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
+ SET_RECOVERY_INFO
+ (STATE_BUILTIN,
+ (LONG_TO_UNSIGNED_FIXNUM (index)),
+ UNSPECIFIC);
+ break;
+
+ case pcl_unknown:
+ new_sp = 0;
+ SET_RECOVERY_INFO
+ (STATE_UNKNOWN,
+ (LONG_TO_UNSIGNED_FIXNUM (pc)),
+ UNSPECIFIC);
+ break;
+ }
+
+ /* Sanity-check the new SP. */
+ if (! ((Stack_Bottom <= new_sp)
+ && (new_sp < Stack_Top)
+ && (ALIGNED_P (new_sp))))
+ new_sp = 0;
+
+ /* Sanity-check Free. */
+ if ((new_sp != 0)
+ && (Heap_Bottom <= Free)
+ && (Free < Heap_Top)
+ && (ALIGNED_P (Free)))
+ {
+ if (Free < MemTop)
{
- struct ux_sig_code_desc * entry = (& (ux_signal_codes [0]));
- while ((entry -> signo) != 0)
- if (((entry -> signo) == signo)
- && (((entry -> code_mask) & code) == (entry -> code_value)))
- {
- name = (entry -> name);
- break;
- }
- else
- entry += 1;
+ Free += FREE_PARANOIA_MARGIN;
+ if (Free > MemTop)
+ Free = MemTop;
}
}
- return (cons ((long_to_integer ((long) code)),
- ((name == 0) ? SHARP_F
- : (char_pointer_to_string ((unsigned char *) name)))));
+ else
+ Free = MemTop;
+
+ /* Encode the registers. */
+ (recovery_info . extra_trap_info) =
+ (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, Free));
+ (*Free++) =
+ (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + FULL_SIGCONTEXT_NREGS)));
+ (*Free++) = ((SCHEME_OBJECT) pc);
+ (*Free++) = ((SCHEME_OBJECT) (FULL_SIGCONTEXT_SP (scp)));
+ {
+ unsigned long * scan
+ = ((unsigned long *) (FULL_SIGCONTEXT_FIRST_REG (scp)));
+ unsigned long * end = (scan + FULL_SIGCONTEXT_NREGS);
+ while (scan < end)
+ (*Free++) = ((SCHEME_OBJECT) (*scan++));
+ }
+
+ setup_trap_frame (signo, info, scp, (&recovery_info), new_sp);
}
\f
-static void
-DEFUN (setup_trap_frame, (signo, info, scp, trinfo, new_stack_pointer),
- int signo AND
- SIGINFO_T info AND
- struct FULL_SIGCONTEXT * scp AND
- struct trap_recovery_info * trinfo AND
- SCHEME_OBJECT * new_stack_pointer)
+/* Find the compiled code block in area that contains `pc'.
+ This attempts to be more efficient than `find_block_address_in_area'.
+ If the pointer is in the heap, it can actually do twice as
+ much work, but it is expected to pay off on the average. */
+
+#define MINIMUM_SCAN_RANGE 2048
+
+static SCHEME_OBJECT *
+DEFUN (find_heap_address, (pc), unsigned long pc)
{
- SCHEME_OBJECT handler = SHARP_F;
- SCHEME_OBJECT signal_name, signal_code;
- int stack_recovered_p = (new_stack_pointer != 0);
- long saved_mask = (FETCH_INTERRUPT_MASK ());
- SET_INTERRUPT_MASK (0); /* To prevent GC for now. */
- if ((! (Valid_Fixed_Obj_Vector ())) ||
- ((handler = (Get_Fixed_Obj_Slot (Trap_Handler))) == SHARP_F))
+ SCHEME_OBJECT * pcp = ((SCHEME_OBJECT *) (pc &~ SCHEME_ALIGNMENT_MASK));
+ unsigned long maximum_distance = (pcp - Heap_Bottom);
+ unsigned long distance = maximum_distance;
+
+ while ((distance / 2) > MINIMUM_SCAN_RANGE)
+ distance = (distance / 2);
+ while (1)
{
- fprintf (stderr, "There is no trap handler for recovery!\n");
- fflush (stderr);
- termination_trap ();
+ SCHEME_OBJECT * block
+ = (find_block_address_in_area (pcp, (pcp - distance)));
+ distance *= 2;
+ if ((block != 0) || (distance >= maximum_distance))
+ return (block);
}
- if (Free > MemTop)
- {
- Request_GC (0);
- }
- signal_name =
- ((signo == 0)
- ? SHARP_F
- : (char_pointer_to_string
- ((unsigned char *) (find_signal_name (signo)))));
- signal_code = (find_signal_code_name (signo, info, scp));
- if (!stack_recovered_p)
+}
+
+static SCHEME_OBJECT *
+DEFUN (find_constant_address, (pc), unsigned long pc)
+{
+ SCHEME_OBJECT * pcp = ((SCHEME_OBJECT *) (pc &~ SCHEME_ALIGNMENT_MASK));
+ SCHEME_OBJECT * constant_block = (find_constant_space_block (pcp));
+ return
+ ((constant_block != 0)
+ ? (find_block_address_in_area (pcp, constant_block))
+ : 0);
+}
+
+/* Find the compiled code block in area that contains `pc_value',
+ by scanning sequentially the complete area.
+ For the time being, skip over manifest closures and linkage sections. */
+
+static SCHEME_OBJECT *
+DEFUN (find_block_address_in_area, (pcp, area_start),
+ SCHEME_OBJECT * pcp AND
+ SCHEME_OBJECT * area_start)
+{
+ SCHEME_OBJECT * first_valid = area_start;
+ SCHEME_OBJECT * area = area_start;
+
+ while (area < pcp)
{
- INITIALIZE_STACK ();
- Will_Push (CONTINUATION_SIZE);
- Store_Return (RC_END_OF_COMPUTATION);
- exp_register = SHARP_F;
- Save_Cont ();
- Pushed ();
- }
- else
- sp_register = new_stack_pointer;
- Will_Push (7 + CONTINUATION_SIZE);
- STACK_PUSH (trinfo -> extra_trap_info);
- STACK_PUSH (trinfo -> pc_info_2);
- STACK_PUSH (trinfo -> pc_info_1);
- STACK_PUSH (trinfo -> state);
- STACK_PUSH (BOOLEAN_TO_OBJECT (stack_recovered_p));
- STACK_PUSH (signal_code);
- STACK_PUSH (signal_name);
- Store_Return (RC_HARDWARE_TRAP);
- exp_register = (long_to_integer (signo));
- Save_Cont ();
- Pushed ();
- if (stack_recovered_p
- /* This may want to do it in other cases, but this may be enough. */
- && (trinfo->state == STATE_COMPILED_CODE))
- {
- Stop_History ();
- }
- history_register = (Make_Dummy_History ());
- Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
- STACK_PUSH (signal_name);
- STACK_PUSH (handler);
- STACK_PUSH (STACK_FRAME_HEADER + 1);
- Pushed ();
- SET_INTERRUPT_MASK (saved_mask);
- abort_to_interpreter (PRIM_APPLY);
-}
-\f
-/* 0 is an invalid signal, it means a user requested reset. */
+ SCHEME_OBJECT object = (*area);
+ switch (OBJECT_TYPE (object))
+ {
+ case TC_LINKAGE_SECTION:
+ {
+ switch (READ_LINKAGE_KIND (object))
+ {
+ case GLOBAL_OPERATOR_LINKAGE_KIND:
+ case OPERATOR_LINKAGE_KIND:
+ {
+ unsigned long count = (READ_OPERATOR_LINKAGE_COUNT (object));
+ area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1);
+ }
+ break;
-void
-DEFUN (hard_reset, (scp), struct FULL_SIGCONTEXT * scp)
-{
- continue_from_trap (0, 0, scp);
-}
+ default:
+ area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1);
+ break;
+ }
+ }
+ break;
-/* Called synchronously. */
+ case TC_MANIFEST_CLOSURE:
+ {
+ area += 1;
+ {
+ unsigned long count = (MANIFEST_CLOSURE_COUNT (area));
+ area = (MANIFEST_CLOSURE_END (area, count));
+ }
+ }
+ break;
-void
-DEFUN_VOID (soft_reset)
-{
- struct trap_recovery_info trinfo;
- SCHEME_OBJECT * new_stack_pointer =
- (((sp_register <= Stack_Top) && (sp_register > Stack_Guard))
- ? sp_register
- : 0);
- if ((Registers[REGBLOCK_PRIMITIVE]) != SHARP_F)
- {
- (trinfo . state) = STATE_PRIMITIVE;
- (trinfo . pc_info_1) = (Registers[REGBLOCK_PRIMITIVE]);
- (trinfo . pc_info_2) =
- (LONG_TO_UNSIGNED_FIXNUM (Registers[REGBLOCK_LEXPR_ACTUALS]));
- (trinfo . extra_trap_info) = SHARP_F;
- }
- else
- {
- (trinfo . state) = STATE_UNKNOWN;
- (trinfo . pc_info_1) = SHARP_F;
- (trinfo . pc_info_2) = SHARP_F;
- (trinfo . extra_trap_info) = SHARP_F;
+ case TC_MANIFEST_NM_VECTOR:
+ {
+ unsigned long count = (OBJECT_DATUM (object));
+ if ((area + (count + 1)) < pcp)
+ {
+ area += (count + 1);
+ first_valid = area;
+ }
+ else
+ {
+ SCHEME_OBJECT * block = (area - 1);
+ return
+ (((area != first_valid)
+ && (((OBJECT_TYPE (*block)) == TC_MANIFEST_VECTOR)
+ || ((OBJECT_TYPE (*block)) == FIXNUM_MARKER))
+ && ((OBJECT_DATUM (*block)) >= (count + 1))
+ && (PLAUSIBLE_CC_BLOCK_P (block)))
+ ? block
+ : 0);
+ }
+ }
+ break;
+
+ default:
+ area += 1;
+ break;
+ }
}
- if ((Free >= Heap_Top) || (Free < Heap_Bottom))
- /* Let's hope this works. */
- Free = MemTop;
- setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
+ return (0);
}
-
-#ifdef HAS_COMPILER_SUPPORT
-# include "gccode.h"
-#endif
-
-#if defined(HAVE_STRUCT_SIGCONTEXT) && defined(HAS_COMPILER_SUPPORT) && !defined(USE_STACKLETS)
-# define ENABLE_TRAP_RECOVERY 1
-#endif
-
-#ifndef ENABLE_TRAP_RECOVERY
+\f
+#else /* not ENABLE_TRAP_RECOVERY */
static struct trap_recovery_info dummy_recovery_info =
{
DEFUN (continue_from_trap, (signo, info, scp),
int signo AND
SIGINFO_T info AND
- struct FULL_SIGCONTEXT * scp)
+ FULL_SIGCONTEXT_T * scp)
{
if (Free < MemTop)
- {
Free = MemTop;
- }
setup_trap_frame (signo, info, scp, (&dummy_recovery_info), 0);
}
-SCHEME_OBJECT *
-DEFUN (find_block_address, (pc_value, area_start),
- char * pc_value AND
- SCHEME_OBJECT * area_start)
+static SCHEME_OBJECT *
+DEFUN (find_heap_address, (pc), unsigned long pc)
{
return (0);
}
-#else /* ENABLE_TRAP_RECOVERY */
-\f
-/* Heuristic recovery from Unix signals (traps).
-
- continue_from_trap attempts to:
-
- 1) validate the trap information (pc and sp);
- 2) determine whether compiled code was executing, a primitive was
- executing, or execution was in the interpreter;
- 3) guess what C global state is still valid; and
- 4) set up a recovery frame for the interpreter so that debuggers can
- display more information. */
-
-#define SCHEME_ALIGNMENT_MASK ((sizeof (long)) - 1)
-#define STACK_ALIGNMENT_MASK SCHEME_ALIGNMENT_MASK
-#define FREE_PARANOIA_MARGIN 0x100
-
-#define C_STACK_SIZE 0x01000000
+static SCHEME_OBJECT *
+DEFUN (find_constant_address, (pc), unsigned long pc)
+{
+ return (0);
+}
+#endif /* not ENABLE_TRAP_RECOVERY */
+\f
static void
-DEFUN (continue_from_trap, (signo, info, scp),
+DEFUN (setup_trap_frame, (signo, info, scp, trinfo, new_stack_pointer),
int signo AND
SIGINFO_T info AND
- struct FULL_SIGCONTEXT * scp)
+ FULL_SIGCONTEXT_T * scp AND
+ struct trap_recovery_info * trinfo AND
+ SCHEME_OBJECT * new_stack_pointer)
{
- int pc_in_builtin;
- int builtin_index;
- int pc_in_C;
- int pc_in_heap;
- int pc_in_constant_space;
- int pc_in_scheme;
- int pc_in_hyper_space;
- int pc_in_utility;
- int utility_index;
- int scheme_sp_valid;
- long C_sp = (FULL_SIGCONTEXT_SP (scp));
- long scheme_sp = (FULL_SIGCONTEXT_SCHSP (scp));
- long the_pc = ((FULL_SIGCONTEXT_PC (scp)) & PC_VALUE_MASK);
- SCHEME_OBJECT * new_stack_pointer;
- SCHEME_OBJECT * xtra_info;
- struct trap_recovery_info trinfo;
- extern int EXFUN (pc_to_utility_index, (unsigned long));
- extern int EXFUN (pc_to_builtin_index, (unsigned long));
+ unsigned long saved_mask = (FETCH_INTERRUPT_MASK ());
+ SCHEME_OBJECT handler;
+ SCHEME_OBJECT signal_name;
- if ((the_pc & PC_ALIGNMENT_MASK) != 0)
- {
- pc_in_builtin = 0;
- pc_in_utility = 0;
- pc_in_C = 0;
- pc_in_heap = 0;
- pc_in_constant_space = 0;
- pc_in_scheme = 0;
- pc_in_hyper_space = 1;
- }
- else
- {
- builtin_index = (pc_to_builtin_index (the_pc));
- pc_in_builtin = (builtin_index != -1);
- utility_index = (pc_to_utility_index (the_pc));
- pc_in_utility = (utility_index != -1);
- pc_in_C = ((the_pc <= ((long) (get_etext ()))) && (!pc_in_builtin));
- pc_in_heap = ADDRESS_HEAP_P ((SCHEME_OBJECT*) the_pc);
- pc_in_constant_space = ADDRESS_CONSTANT_P ((SCHEME_OBJECT*) the_pc);
- pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_builtin);
- pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
- }
-
- scheme_sp_valid =
- (pc_in_scheme
- && ((scheme_sp < ((long) Stack_Top)) &&
- (scheme_sp >= ((long) Stack_Bottom)) &&
- ((scheme_sp & STACK_ALIGNMENT_MASK) == 0)));
-
- new_stack_pointer =
- (scheme_sp_valid
- ? ((SCHEME_OBJECT *) scheme_sp)
- : (pc_in_C && (sp_register < Stack_Top)
- && (sp_register > Stack_Bottom))
- ? sp_register
- : ((SCHEME_OBJECT *) 0));
+ SET_INTERRUPT_MASK (0); /* To prevent GC for now. */
- if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
- {
- /* In hyper space. */
- (trinfo . state) = STATE_UNKNOWN;
- (trinfo . pc_info_1) = SHARP_F;
- (trinfo . pc_info_2) = SHARP_F;
- new_stack_pointer = 0;
- if ((Free < MemTop) ||
- (Free >= Heap_Top) ||
- ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
- Free = MemTop;
- }
- else if (pc_in_scheme)
- {
- /* In compiled code. */
- SCHEME_OBJECT * block_addr;
-#ifdef HAVE_FULL_SIGCONTEXT
- SCHEME_OBJECT * maybe_free;
-#endif
- block_addr =
- (pc_in_builtin
- ? ((SCHEME_OBJECT *) NULL)
- : (find_block_address (((PTR) the_pc),
- (pc_in_heap ? Heap_Bottom : Constant_Space))));
- if (block_addr != ((SCHEME_OBJECT *) NULL))
- {
- (trinfo . state) = STATE_COMPILED_CODE;
- (trinfo . pc_info_1) =
- (MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr));
- (trinfo . pc_info_2) =
- (LONG_TO_UNSIGNED_FIXNUM (the_pc - ((long) block_addr)));
- }
- else if (pc_in_builtin)
+ handler = SHARP_F;
+ if (Valid_Fixed_Obj_Vector ())
+ handler = (Get_Fixed_Obj_Slot (Trap_Handler));
+ if (handler == SHARP_F)
{
- (trinfo . state) = STATE_BUILTIN;
- (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (builtin_index));
- (trinfo . pc_info_2) = SHARP_T;
- }
- else
- {
- (trinfo . state) = STATE_PROBABLY_COMPILED;
- (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (the_pc));
- (trinfo . pc_info_2) = SHARP_F;
+ fprintf (stderr, "There is no trap handler for recovery!\n");
+ fflush (stderr);
+ termination_trap ();
}
- if ((block_addr == ((SCHEME_OBJECT *) NULL)) && (! pc_in_builtin))
- {
- if ((Free < MemTop) ||
- (Free >= Heap_Top) ||
- ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
- Free = MemTop;
- }
- else
- {
-#ifdef HAVE_FULL_SIGCONTEXT
- maybe_free = ((SCHEME_OBJECT *) (FULL_SIGCONTEXT_RFREE (scp)));
- if (((((unsigned long) maybe_free) & SCHEME_ALIGNMENT_MASK) == 0)
- && (maybe_free >= Heap_Bottom) && (maybe_free < Heap_Top))
- Free = (maybe_free + FREE_PARANOIA_MARGIN);
- else
-#endif
- if ((Free < MemTop) || (Free >= Heap_Top)
- || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0))
- Free = MemTop;
- }
- }
- else /* pc_in_C */
- {
- /* In the interpreter, a primitive, or a compiled code utility. */
+ signal_name =
+ ((signo != 0)
+ ? (char_pointer_to_string ((unsigned char *) (find_signal_name (signo))))
+ : SHARP_F);
- SCHEME_OBJECT primitive = (Registers[REGBLOCK_PRIMITIVE]);
+ if (Free > MemTop)
+ Request_GC (0);
- if (pc_in_utility)
- {
- (trinfo . state) = STATE_UTILITY;
- (trinfo . pc_info_1) = (LONG_TO_UNSIGNED_FIXNUM (utility_index));
- (trinfo . pc_info_2) = UNSPECIFIC;
- }
- else if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
- {
- (trinfo . state) = STATE_UNKNOWN;
- (trinfo . pc_info_1) = SHARP_F;
- (trinfo . pc_info_2) = SHARP_F;
- new_stack_pointer = 0;
- }
- else
+ if (new_stack_pointer != 0)
+ sp_register = new_stack_pointer;
+ else
{
- (trinfo . state) = STATE_PRIMITIVE;
- (trinfo . pc_info_1) = primitive;
- (trinfo . pc_info_2) =
- (LONG_TO_UNSIGNED_FIXNUM (Registers[REGBLOCK_LEXPR_ACTUALS]));
+ INITIALIZE_STACK ();
+ Will_Push (CONTINUATION_SIZE);
+ Store_Return (RC_END_OF_COMPUTATION);
+ exp_register = SHARP_F;
+ Save_Cont ();
+ Pushed ();
}
- if ((new_stack_pointer == 0)
- || ((((unsigned long) Free) & SCHEME_ALIGNMENT_MASK) != 0)
- || ((Free < Heap_Bottom) || (Free >= Heap_Top))
- || ((Free < MemTop) && ((Free + FREE_PARANOIA_MARGIN) >= MemTop)))
- Free = MemTop;
- else if ((Free + FREE_PARANOIA_MARGIN) < MemTop)
- Free += FREE_PARANOIA_MARGIN;
- }
- xtra_info = Free;
- Free += (1 + 2 + PROCESSOR_NREGS);
- (trinfo . extra_trap_info) =
- (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, xtra_info));
- (*xtra_info++) =
- (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + PROCESSOR_NREGS)));
- (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
- (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
- {
- int counter = FULL_SIGCONTEXT_NREGS;
- long * regs = ((long *) (FULL_SIGCONTEXT_FIRST_REG (scp)));
- while ((counter--) > 0)
- (*xtra_info++) = ((SCHEME_OBJECT) (*regs++));
- }
- /* We assume that regs,sp,pc is the order in the processor.
- Scheme can always fix this. */
- if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 0)
- (*xtra_info++) = ((SCHEME_OBJECT) C_sp);
- if ((PROCESSOR_NREGS - FULL_SIGCONTEXT_NREGS) > 1)
- (*xtra_info++) = ((SCHEME_OBJECT) the_pc);
- setup_trap_frame (signo, info, scp, (&trinfo), new_stack_pointer);
-}
-/* Find the compiled code block in area which contains `pc_value'.
- This attempts to be more efficient than `find_block_address_in_area'.
- If the pointer is in the heap, it can actually do twice as
- much work, but it is expected to pay off on the average. */
+ Will_Push (7 + CONTINUATION_SIZE);
+ STACK_PUSH (trinfo -> extra_trap_info);
+ STACK_PUSH (trinfo -> pc_info_2);
+ STACK_PUSH (trinfo -> pc_info_1);
+ STACK_PUSH (trinfo -> state);
+ STACK_PUSH (BOOLEAN_TO_OBJECT (new_stack_pointer != 0));
+ STACK_PUSH (find_signal_code_name (signo, info, scp));
+ STACK_PUSH (signal_name);
+ Store_Return (RC_HARDWARE_TRAP);
+ exp_register = (long_to_integer (signo));
+ Save_Cont ();
+ Pushed ();
-static SCHEME_OBJECT * EXFUN
- (find_block_address_in_area, (char * pc_value, SCHEME_OBJECT * area_start));
+ if ((new_stack_pointer != 0)
+ /* This may want to do it in other cases, but this may be enough. */
+ && ((trinfo -> state) == STATE_COMPILED_CODE))
+ Stop_History ();
+ history_register = (Make_Dummy_History ());
-#define MINIMUM_SCAN_RANGE 2048
+ Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
+ STACK_PUSH (signal_name);
+ STACK_PUSH (handler);
+ STACK_PUSH (STACK_FRAME_HEADER + 1);
+ Pushed ();
-SCHEME_OBJECT *
-DEFUN (find_block_address, (pc_value, area_start),
- char * pc_value AND
- SCHEME_OBJECT * area_start)
+ SET_INTERRUPT_MASK (saved_mask);
+ abort_to_interpreter (PRIM_APPLY);
+}
+\f
+static void
+DEFUN_VOID (initialize_ux_signal_codes)
{
- if (area_start == Constant_Space)
- {
- extern SCHEME_OBJECT * EXFUN
- (find_constant_space_block, (SCHEME_OBJECT *));
- SCHEME_OBJECT * constant_block =
- (find_constant_space_block
- ((SCHEME_OBJECT *)
- (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK)));
- return
- ((constant_block == 0)
- ? 0
- : (find_block_address_in_area (pc_value, constant_block)));
- }
- {
- SCHEME_OBJECT * nearest_word =
- ((SCHEME_OBJECT *)
- (((unsigned long) pc_value) &~ SCHEME_ALIGNMENT_MASK));
- long maximum_distance = (nearest_word - area_start);
- long distance = maximum_distance;
- while ((distance / 2) > MINIMUM_SCAN_RANGE)
- distance = (distance / 2);
- while ((distance * 2) < maximum_distance)
- {
- SCHEME_OBJECT * block =
- (find_block_address_in_area (pc_value, (nearest_word - distance)));
- if (block != 0)
- return (block);
- distance *= 2;
- }
- }
- return (find_block_address_in_area (pc_value, area_start));
+ unsigned int i = 0;
+ INITIALIZE_UX_SIGNAL_CODES ();
+ DECLARE_UX_SIGNAL_CODE (0, 0, 0, ((char *) 0));
}
-/*
- Find the compiled code block in area which contains `pc_value',
- by scanning sequentially the complete area.
- For the time being, skip over manifest closures and linkage sections. */
-
-static SCHEME_OBJECT *
-DEFUN (find_block_address_in_area, (pc_value, area_start),
- char * pc_value AND
- SCHEME_OBJECT * area_start)
+static SCHEME_OBJECT
+DEFUN (find_signal_code_name, (signo, info, scp),
+ int signo AND
+ SIGINFO_T info AND
+ FULL_SIGCONTEXT_T * scp)
{
- SCHEME_OBJECT * first_valid = area_start;
- SCHEME_OBJECT * area = area_start;
- while (((char *) area) < pc_value)
+ unsigned long code = 0;
+ char * name = 0;
+ if (SIGINFO_VALID_P (info))
{
- SCHEME_OBJECT object = (*area);
- switch (OBJECT_TYPE (object))
+ code = (SIGINFO_CODE (info));
+ SPECIAL_SIGNAL_CODE_NAMES ();
+ if (name == 0)
{
- case TC_LINKAGE_SECTION:
- {
- switch (READ_LINKAGE_KIND (object))
- {
- case GLOBAL_OPERATOR_LINKAGE_KIND:
- case OPERATOR_LINKAGE_KIND:
+ struct ux_sig_code_desc * entry = (& (ux_signal_codes[0]));
+ while ((entry -> signo) != 0)
+ if (((entry -> signo) == signo)
+ && (((entry -> code_mask) & code) == (entry -> code_value)))
{
- long count = (READ_OPERATOR_LINKAGE_COUNT (object));
- area = ((END_OPERATOR_LINKAGE_AREA (area, count)) + 1);
+ name = (entry -> name);
break;
}
-
- default:
-#if FALSE
- {
- gc_death (TERM_EXIT,
- "find_block_address: Unknown compiler linkage kind.",
- area, NULL);
- /*NOTREACHED*/
- }
-#else
- /* Fall through, no reason to crash here. */
-#endif
- case ASSIGNMENT_LINKAGE_KIND:
- case CLOSURE_PATTERN_LINKAGE_KIND:
- case REFERENCE_LINKAGE_KIND:
- area += ((READ_CACHE_LINKAGE_COUNT (object)) + 1);
- break;
-
+ else
+ entry += 1;
+ }
+ }
+ return
+ (cons ((ulong_to_integer (code)),
+ ((name == 0)
+ ? SHARP_F
+ : (char_pointer_to_string ((unsigned char *) name)))));
+}
+\f
+static enum pc_location
+DEFUN (classify_pc, (pc, r_block_addr, r_index),
+ unsigned long pc AND
+ SCHEME_OBJECT ** r_block_addr AND
+ unsigned int * r_index)
+{
+ if (PC_ALIGNED_P (pc))
+ {
+ if (ADDRESS_HEAP_P ((SCHEME_OBJECT *) pc))
+ {
+ SCHEME_OBJECT * block_addr = (find_heap_address (pc));
+ if (block_addr != 0)
+ {
+ if (r_block_addr != 0)
+ (*r_block_addr) = block_addr;
+ return (pcl_heap);
}
- break;
- }
- case TC_MANIFEST_CLOSURE:
- {
- area += 1;
+ }
+ else if (ADDRESS_CONSTANT_P ((SCHEME_OBJECT *) pc))
+ {
+ SCHEME_OBJECT * block_addr = (find_constant_address (pc));
+ if (block_addr != 0)
{
- long count = (MANIFEST_CLOSURE_COUNT (area));
- area = (MANIFEST_CLOSURE_END (area, count));
+ if (r_block_addr != 0)
+ (*r_block_addr) = block_addr;
+ return (pcl_constant);
}
- break;
- }
- case TC_MANIFEST_NM_VECTOR:
- {
- long count = (OBJECT_DATUM (object));
- if (((char *) (area + (count + 1))) < pc_value)
- {
- area += (count + 1);
- first_valid = area;
- break;
- }
+ }
+ else if (ADDRESS_UCODE_P (pc))
+ {
+ int index = (pc_to_builtin_index (pc));
+ if (index >= 0)
{
- SCHEME_OBJECT * block = (area - 1);
- return
- (((area == first_valid) ||
- (((OBJECT_TYPE (*block)) != TC_MANIFEST_VECTOR)
- && ((OBJECT_TYPE (*block)) !=
-#ifdef TC_POSITIVE_FIXNUM
- TC_POSITIVE_FIXNUM
-#else
- TC_FIXNUM
-#endif
- ))
- ||
- ((OBJECT_DATUM (*block)) < (count + 1)) ||
- (! (PLAUSIBLE_CC_BLOCK_P (block))))
- ? 0
- : block);
+ if (r_index != 0)
+ (*r_index) = index;
+ return (pcl_builtin);
}
- }
- default:
- {
- area += 1;
- break;
- }
+ index = (pc_to_utility_index (pc));
+ if (index >= 0)
+ {
+ if (r_index != 0)
+ (*r_index) = index;
+ return (pcl_utility);
+ }
+ if ((OBJECT_TYPE (Registers[REGBLOCK_PRIMITIVE])) == TC_PRIMITIVE)
+ return (pcl_primitive);
}
}
- return (0);
+ return (pcl_unknown);
}
-
-#endif /* ENABLE_TRAP_RECOVERY */
\f
-SCHEME_OBJECT
-DEFUN (find_ccblock, (the_pc),
- long the_pc)
+static void
+DEFUN_VOID (trap_normal_termination)
{
- int pc_in_builtin;
- int builtin_index;
- int pc_in_C;
- int pc_in_heap;
- int pc_in_constant_space;
- int pc_in_scheme;
- int pc_in_hyper_space;
- int pc_in_utility;
- int utility_index;
- extern int EXFUN (pc_to_utility_index, (unsigned long));
- extern int EXFUN (pc_to_builtin_index, (unsigned long));
-
- if ((the_pc & PC_ALIGNMENT_MASK) != 0)
- {
- pc_in_builtin = 0;
- pc_in_utility = 0;
- pc_in_C = 0;
- pc_in_heap = 0;
- pc_in_constant_space = 0;
- pc_in_scheme = 0;
- pc_in_hyper_space = 1;
- }
- else
- {
- builtin_index = (pc_to_builtin_index (the_pc));
- pc_in_builtin = (builtin_index != -1);
- utility_index = (pc_to_utility_index (the_pc));
- pc_in_utility = (utility_index != -1);
- pc_in_C = ((the_pc <= ((long) (get_etext ()))) && (!pc_in_builtin));
- pc_in_heap = ADDRESS_HEAP_P ((SCHEME_OBJECT*) the_pc);
- pc_in_constant_space = ADDRESS_CONSTANT_P ((SCHEME_OBJECT*) the_pc);
- pc_in_scheme = (pc_in_heap || pc_in_constant_space || pc_in_builtin);
- pc_in_hyper_space = ((!pc_in_C) && (!pc_in_scheme));
- }
-
- if (pc_in_hyper_space || (pc_in_scheme && ALLOW_ONLY_C))
- {
- return SHARP_F;
- }
- else if (pc_in_scheme)
- {
- /* In compiled code. */
- SCHEME_OBJECT * block_addr;
- block_addr =
- (pc_in_builtin
- ? ((SCHEME_OBJECT *) NULL)
- : (find_block_address (((PTR) the_pc),
- (pc_in_heap ? Heap_Bottom : Constant_Space))));
- if (block_addr != ((SCHEME_OBJECT *) NULL))
- {
- return MAKE_POINTER_OBJECT (TC_COMPILED_CODE_BLOCK, block_addr);
- }
- else if (pc_in_builtin)
- {
- return SHARP_F;
- }
- else
- {
- return SHARP_F;
- }
- }
- else /* pc_in_C */
- {
- /* In the interpreter, a primitive, or a compiled code utility. */
+ trap_state = trap_state_exitting_soft;
+ termination_trap ();
+}
- SCHEME_OBJECT primitive = (Registers[REGBLOCK_PRIMITIVE]);
+static void
+DEFUN_VOID (trap_immediate_termination)
+{
+ trap_state = trap_state_exitting_hard;
+ OS_restore_external_state ();
+ exit (1);
+}
- if (pc_in_utility)
- {
- return SHARP_F;
- }
- else if ((OBJECT_TYPE (primitive)) != TC_PRIMITIVE)
+static void
+DEFUN_VOID (trap_dump_core)
+{
+ if (! (option_disable_core_dump))
+ UX_dump_core ();
+ else
{
- return SHARP_F;
+ fputs (">> Core dumps are disabled - Terminating normally.\n", stdout);
+ fflush (stdout);
+ termination_trap ();
}
- else
+}
+
+static void
+DEFUN_VOID (trap_recover)
+{
+ if (WITHIN_CRITICAL_SECTION_P ())
{
- return SHARP_F;
+ CLEAR_CRITICAL_SECTION_HOOK ();
+ EXIT_CRITICAL_SECTION ({});
}
- }
+ reset_interruptable_extent ();
+ continue_from_trap (saved_signo, saved_info, saved_scp);
}
/* -*-C-*-
-$Id: uxtrap.h,v 1.33 2004/12/15 02:34:46 cph Exp $
+$Id: uxtrap.h,v 1.34 2005/06/26 04:35:11 cph Exp $
Copyright 1990,1991,1992,1993,1996,1998 Massachusetts Institute of Technology
-Copyright 2000,2001,2004 Massachusetts Institute of Technology
+Copyright 2000,2001,2004,2005 Massachusetts Institute of Technology
This file is part of MIT/GNU Scheme.
#include <machine/sendsig.h>
#include <machine/reg.h>
-#define HAVE_FULL_SIGCONTEXT
-#define PROCESSOR_NREGS 16
#define FULL_SIGCONTEXT_NREGS GPR_REGS /* Missing sp */
#define RFREE AR5
-#define SIGCONTEXT full_sigcontext
+#define SIGCONTEXT_T struct full_sigcontext
#define SIGCONTEXT_SP(scp) ((scp)->fs_context.sc_sp)
#define SIGCONTEXT_PC(scp) ((scp)->fs_context.sc_pc)
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->fs_regs[RFREE])
/* See <machine/save_state.h> included by <signal.h> */
-# define HAVE_FULL_SIGCONTEXT
-
# ifndef sc_pc
# define sc_pc sc_pcoq_head
# endif /* sc_pc */
# define FULL_SIGCONTEXT_SCHSP(scp) ((scp)->sc_sl.sl_ss.ss_schsp)
# define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_sl.sl_ss.ss_gr0))
# define FULL_SIGCONTEXT_NREGS 32
-# define PROCESSOR_NREGS 32
# define INITIALIZE_UX_SIGNAL_CODES() \
{ \
\f
#ifdef sun3
-#define HAVE_FULL_SIGCONTEXT
-#define PROCESSOR_NREGS 16
#define FULL_SIGCONTEXT_NREGS 15 /* missing sp */
struct full_sigcontext
};
#define RFREE (8 + 5) /* A5 */
-#define FULL_SIGCONTEXT full_sigcontext
+#define FULL_SIGCONTEXT_T struct full_sigcontext
#define FULL_SIGCONTEXT_SP(scp) (scp->fs_original->sc_sp)
#define FULL_SIGCONTEXT_PC(scp) (scp->fs_original->sc_pc)
#define FULL_SIGCONTEXT_RFREE(scp) (scp->fs_regs[RFREE])
#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->fs_regs[0]))
-#define DECLARE_FULL_SIGCONTEXT(name) \
- struct FULL_SIGCONTEXT name [1]
+#define DECLARE_FULL_SIGCONTEXT(name) FULL_SIGCONTEXT_T name [1]
#define INITIALIZE_FULL_SIGCONTEXT(partial, full) \
{ \
#ifdef vax
-#define HAVE_FULL_SIGCONTEXT
-#define PROCESSOR_NREGS 16
#define FULL_SIGCONTEXT_NREGS 16
struct full_sigcontext
};
#define RFREE 12 /* fp */
-#define FULL_SIGCONTEXT full_sigcontext
+#define FULL_SIGCONTEXT_T struct full_sigcontext
#define FULL_SIGCONTEXT_SP(scp) ((scp)->fs_original->sc_sp)
#define FULL_SIGCONTEXT_PC(scp) ((scp)->fs_original->sc_pc)
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->fs_regs[RFREE])
#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->fs_regs[0]))
-#define DECLARE_FULL_SIGCONTEXT(name) \
- struct FULL_SIGCONTEXT name [1]
+#define DECLARE_FULL_SIGCONTEXT(name) FULL_SIGCONTEXT_T name [1]
/* r0 has to be kludged. */
#define sc_rfree sc_regs[9]
#define sc_schsp sc_regs[3]
-#define HAVE_FULL_SIGCONTEXT
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_rfree)
#define FULL_SIGCONTEXT_SCHSP(scp) ((scp)->sc_schsp)
#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_regs[0]))
#define FULL_SIGCONTEXT_NREGS 32
-#define PROCESSOR_NREGS 32
#define INITIALIZE_UX_SIGNAL_CODES() \
{ \
#define sc_rfree sc_regs[9]
#define sc_schsp sc_regs[3]
-#define HAVE_FULL_SIGCONTEXT
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_rfree)
#define FULL_SIGCONTEXT_SCHSP(scp) ((scp)->sc_schsp)
#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_regs[0]))
#define FULL_SIGCONTEXT_NREGS 32
-#define PROCESSOR_NREGS 32
#define INITIALIZE_UX_SIGNAL_CODES() \
{ \
#define SIGINFO_VALID_P(info) ((info) != 0)
#define SIGINFO_CODE(info) ((info) -> si_code)
-#define SIGCONTEXT ucontext
+#define SIGCONTEXT_T ucontext_t
#define SIGCONTEXT_SP(scp) ((((scp) -> uc_mcontext) . gregs) [CXT_SP])
#define SIGCONTEXT_PC(scp) ((((scp) -> uc_mcontext) . gregs) [CXT_EPC])
-#define HAVE_FULL_SIGCONTEXT
#define FULL_SIGCONTEXT_RFREE(scp) ((((scp) -> uc_mcontext) . gregs) [CXT_T1])
#define FULL_SIGCONTEXT_SCHSP(scp) ((((scp) -> uc_mcontext) . gregs) [CXT_V1])
#define FULL_SIGCONTEXT_FIRST_REG(scp) (((scp) -> uc_mcontext) . gregs)
#define FULL_SIGCONTEXT_NREGS NGREG
-#define PROCESSOR_NREGS NGREG
#define INITIALIZE_UX_SIGNAL_CODES() \
{ \
#define SIGINFO_VALID_P(info) ((info) != 0)
#define SIGINFO_CODE(info) ((info) -> si_code)
-#define SIGCONTEXT sigcontext
-#define SIGCONTEXT_SP(scp) ((scp) -> esp)
-#define SIGCONTEXT_PC(scp) ((scp) -> eip)
+#define SIGCONTEXT_T ucontext_t
+#define __SIGCONTEXT_REG(scp, ir) \
+ ((unsigned long) ((((scp) -> uc_mcontext) . gregs) [(ir)]))
+
+#define SIGCONTEXT_SP(scp) (__SIGCONTEXT_REG (scp, REG_ESP))
+#define SIGCONTEXT_PC(scp) (__SIGCONTEXT_REG (scp, REG_EIP))
-#define HAVE_FULL_SIGCONTEXT
/* Grab them all. Nobody looks at them, but grab them anyway. */
-#define PROCESSOR_NREGS 19
-#define FULL_SIGCONTEXT_NREGS 19
-#define FULL_SIGCONTEXT_FIRST_REG(scp) (scp)
-#define FULL_SIGCONTEXT_RFREE(scp) ((scp) -> edi)
+#define FULL_SIGCONTEXT_NREGS NGREG
+#define FULL_SIGCONTEXT_FIRST_REG(scp) (((scp) -> uc_mcontext) . gregs)
+#define FULL_SIGCONTEXT_RFREE(scp) (__SIGCONTEXT_REG (scp, REG_EDI))
#define INITIALIZE_UX_SIGNAL_CODES() \
{ \
(SIGILL, (~ 0L), ILL_BADSTK, "bad stack trap"); \
}
-#if 0
-/* In versions of Linux prior to 2.2 (?), signal handlers are called
- with one argument -- the `signo'. There's an alleged "iBCS signal
- stack" register dump just above it. Thus, the fictitious `info'
- argument to the handler is actually the first member of this
- register dump (described by struct linux_sigcontext, below).
- Unfortunately, kludging SIGINFO_CODE to access the sc_trapno will
- fail later on when looking at the saved_info. */
-#define SIGINFO_T long
-#define SIGINFO_VALID_P(info) (0)
-#define SIGINFO_CODE(info) (0)
-
-/* Here's the "iBCS signal stack", whatever that means. */
-struct linux_sigcontext {
- long sc_gs, sc_fs, sc_es, sc_ds, sc_edi, sc_esi, sc_ebp, sc_esp, sc_ebx;
- long sc_edx, sc_ecx, sc_eax, sc_trapno, sc_err, sc_eip, sc_cs, sc_eflags;
- long sc_esp_again, sc_ss;
-};
-
-/* INITIALIZE_FULL_SIGCONTEXT gives us a chance to generate a pointer to
- the register dump, since it is used at the beginning of STD_HANDLER's.
- In terms of the expected arguments to the STD_ signal HANDLER's, the
- register dump is right above `signo', at `info', one long below `pscp',
- which is what INITIALIZE_FULL_SIGCONTEXT is getting for `partial'.
- Thus, our pointer to a `full'_SIGCONTEXT is initialized to the address
- of `partial' minus 1 long. */
-#define HAVE_FULL_SIGCONTEXT
-#define DECLARE_FULL_SIGCONTEXT(name) \
- struct FULL_SIGCONTEXT * name
-#define INITIALIZE_FULL_SIGCONTEXT(partial, full) \
- ((full) = ((struct FULL_SIGCONTEXT *) (((long *)&(partial))-1)))
-
-/* Grab them all. Nobody looks at them, but grab them anyway. */
-#define PROCESSOR_NREGS 19
-#define FULL_SIGCONTEXT_NREGS 19
-#define FULL_SIGCONTEXT_FIRST_REG(scp) (scp)
-
-#define SIGCONTEXT linux_sigcontext
-#define SIGCONTEXT_SP(scp) ((scp)->sc_esp)
-#define SIGCONTEXT_PC(scp) ((scp)->sc_eip)
-
-#define FULL_SIGCONTEXT SIGCONTEXT
-#define FULL_SIGCONTEXT_SP SIGCONTEXT_SP
-#define FULL_SIGCONTEXT_PC SIGCONTEXT_PC
-#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_edi)
-
-#endif /* 0 */
-
#endif /* __linux__ */
#ifdef _MACH_UNIX
/* The following are true for Mach (BSD 4.3 compatible).
I don't know about SCO or other versions. */
-#define HAVE_FULL_SIGCONTEXT
-#define PROCESSOR_NREGS 8
#define FULL_SIGCONTEXT_NREGS 8
-#define SIGCONTEXT sigcontext
+#define SIGCONTEXT_T struct sigcontext
#define SIGCONTEXT_SP(scp) ((scp)->sc_esp)
#define SIGCONTEXT_PC(scp) ((scp)->sc_eip)
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_edi)
#define sc_rfree sc_regs[4]
#define sc_schsp sc_regs[2]
-#define HAVE_FULL_SIGCONTEXT
#define FULL_SIGCONTEXT_RFREE(scp) ((scp)->sc_rfree)
#define FULL_SIGCONTEXT_SCHSP(scp) ((scp)->sc_schsp)
#define FULL_SIGCONTEXT_FIRST_REG(scp) (&((scp)->sc_regs[0]))
#define FULL_SIGCONTEXT_NREGS 32
-#define PROCESSOR_NREGS 32
-
#ifdef FPE_COMPLETE_FAULT
#define STUPID_FIRST_SIGNAL() \
DECLARE_UX_SIGNAL_CODE \
#ifdef _AIX
/* For now */
-# define SIGCONTEXT sigcontext
+# define SIGCONTEXT_T struct sigcontext
# define SIGCONTEXT_SP(scp) 0
# define SIGCONTEXT_PC(scp) 0
#endif /* _AIX */
struct sigcontext { long sc_sp; long sc_pc; };
#endif
-#ifndef SIGCONTEXT
-# define SIGCONTEXT sigcontext
+#ifndef SIGCONTEXT_T
+# define SIGCONTEXT_T struct sigcontext
# define SIGCONTEXT_SP(scp) ((scp) -> sc_sp)
# define SIGCONTEXT_PC(scp) ((scp) -> sc_pc)
#endif
-#ifndef FULL_SIGCONTEXT
-# define FULL_SIGCONTEXT SIGCONTEXT
+#ifndef FULL_SIGCONTEXT_T
+# define FULL_SIGCONTEXT_T SIGCONTEXT_T
# define FULL_SIGCONTEXT_SP SIGCONTEXT_SP
# define FULL_SIGCONTEXT_PC SIGCONTEXT_PC
-# define DECLARE_FULL_SIGCONTEXT(name) struct FULL_SIGCONTEXT * name
+# define DECLARE_FULL_SIGCONTEXT(name) FULL_SIGCONTEXT_T * name
# define INITIALIZE_FULL_SIGCONTEXT(partial, full) \
- ((full) = ((struct FULL_SIGCONTEXT *) (partial)))
+ ((full) = ((FULL_SIGCONTEXT_T *) (partial)))
#endif
#ifndef FULL_SIGCONTEXT_NREGS
# define FULL_SIGCONTEXT_FIRST_REG(scp) ((int *) 0)
#endif
-#ifndef PROCESSOR_NREGS
-# define PROCESSOR_NREGS 0
+#ifndef FULL_SIGCONTEXT_RFREE
+# define FULL_SIGCONTEXT_RFREE ((unsigned long) MemTop)
#endif
#ifndef FULL_SIGCONTEXT_SCHSP
#define PC_ALIGNMENT_MASK ((1 << PC_ZERO_BITS) - 1)
-/* But they may have bits that can be masked by this. */
-
-#ifndef PC_VALUE_MASK
-#define PC_VALUE_MASK (~0)
-#endif
-
-#ifdef HAS_COMPILER_SUPPORT
-# define ALLOW_ONLY_C 0
-#else
-# define ALLOW_ONLY_C 1
-# define PLAUSIBLE_CC_BLOCK_P(block) 0
+#ifndef HAS_COMPILER_SUPPORT
+# define PLAUSIBLE_CC_BLOCK_P(block) 0
#endif
#ifdef _AIX
extern int _etext;
-# define get_etext() (&_etext)
#endif
#ifdef __linux__
+ extern unsigned int _init;
extern unsigned int etext;
-# define get_etext() (&etext)
+# define ADDRESS_UCODE_P(addr) \
+ ((((unsigned int *) (addr)) >= (&_init)) \
+ && (((unsigned int *) (addr)) <= (&etext)))
#endif
#ifdef __CYGWIN__
extern unsigned int end;
-# define get_etext() (&end)
#endif
-#ifndef get_etext
- extern int etext;
-# define get_etext() (&etext)
+#ifndef ADDRESS_UCODE_P
+# define ADDRESS_UCODE_P(addr) 0
#endif
\f
/* Machine/OS-independent section */
trap_state_exitting_hard
};
-extern void EXFUN (initialize_trap_recovery, (char * C_sp));
+extern void EXFUN (UX_initialize_trap_recovery, (void));
extern enum trap_state EXFUN (OS_set_trap_state, (enum trap_state state));
-extern void EXFUN
- (trap_handler,
- (CONST char * message,
- int signo,
- SIGINFO_T info,
- struct FULL_SIGCONTEXT * scp));
-extern void EXFUN (hard_reset, (struct FULL_SIGCONTEXT * scp));
+extern void EXFUN (hard_reset, (FULL_SIGCONTEXT_T * scp));
extern void EXFUN (soft_reset, (void));
+extern void EXFUN
+ (trap_handler, (CONST char *, int, SIGINFO_T, FULL_SIGCONTEXT_T *));
+extern SCHEME_OBJECT find_ccblock (unsigned long);
#define STATE_UNKNOWN (LONG_TO_UNSIGNED_FIXNUM (0))
#define STATE_PRIMITIVE (LONG_TO_UNSIGNED_FIXNUM (1))
SCHEME_OBJECT extra_trap_info;
};
-extern SCHEME_OBJECT * EXFUN
- (find_block_address, (char * pc_value, SCHEME_OBJECT * area_start));
-
#endif /* SCM_UXTRAP_H */
projects / mit-scheme.git / commitdiff