static void
setup_trap_frame (int signo,
SIGINFO_T info,
SIGCONTEXT_T * scp,
struct trap_recovery_info * trinfo,
SCHEME_OBJECT * new_stack_pointer)
{
unsigned long saved_mask = GET_INT_MASK;
SCHEME_OBJECT handler;
SCHEME_OBJECT signal_name;
SET_INTERRUPT_MASK (0); /* To prevent GC for now. */
handler
= ((VECTOR_P (fixed_objects))
? (VECTOR_REF (fixed_objects, TRAP_HANDLER))
: SHARP_F);
if (!INTERPRETER_APPLICABLE_P (handler))
{
fprintf (stderr, "There is no trap handler for recovery!\n");
fflush (stderr);
termination_trap ();
}
signal_name =
((signo != 0)
? (char_pointer_to_string (find_signal_name (signo)))
: SHARP_F);
if (!FREE_OK_P (Free))
REQUEST_GC (0);
if (new_stack_pointer != 0)
stack_pointer = new_stack_pointer;
else
{
INITIALIZE_STACK ();
Will_Push (CONTINUATION_SIZE);
SET_RC (RC_END_OF_COMPUTATION);
SET_EXP (SHARP_F);
SAVE_CONT ();
Pushed ();
}
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);
SET_RC (RC_HARDWARE_TRAP);
SET_EXP (long_to_integer (signo));
SAVE_CONT ();
Pushed ();
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 ());
Will_Push (STACK_ENV_EXTRA_SLOTS + 2);
STACK_PUSH (signal_name);
STACK_PUSH (handler);
PUSH_APPLY_FRAME_HEADER (1);
Pushed ();
SET_INTERRUPT_MASK (saved_mask);
abort_to_interpreter (PRIM_APPLY);
}
if (! (CHAR_TO_ASCII_P (object)))
error_bad_range_arg (n);
return (CHAR_TO_ASCII (object));
}
}
long
arg_ascii_integer (int n)
{
return (arg_index_integer (n, MAX_ASCII));
}
DEFINE_PRIMITIVE ("CHAR?", Prim_char_p, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (CHARACTER_P (ARG_REF (1))));
}
DEFINE_PRIMITIVE ("MAKE-CHAR", Prim_make_char, 2, 2, 0)
{
PRIMITIVE_HEADER (2);
PRIMITIVE_RETURN
(MAKE_CHAR ((arg_index_integer (2, MAX_BITS)),
(arg_index_integer (1, MAX_CODE))));
}
DEFINE_PRIMITIVE ("CHAR-BITS", Prim_char_bits, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
CHECK_ARG (1, CHARACTER_P);
PRIMITIVE_RETURN (LONG_TO_UNSIGNED_FIXNUM (CHAR_BITS (ARG_REF (1))));
PRIMITIVE_RETURN \
(BOOLEAN_TO_OBJECT (comparison ((ARG_REF (1)), (ARG_REF (2))))); \
}
DEFINE_PRIMITIVE ("INTEGER-EQUAL?", Prim_integer_equal_p, 2, 2, 0)
INTEGER_COMPARISON (integer_equal_p)
DEFINE_PRIMITIVE ("INTEGER-LESS?", Prim_integer_less_p, 2, 2, 0)
INTEGER_COMPARISON (integer_less_p)
DEFINE_PRIMITIVE ("INTEGER-GREATER?", Prim_integer_greater_p, 2, 2, 0)
{
PRIMITIVE_HEADER (2);
CHECK_ARG (1, INTEGER_P);
CHECK_ARG (2, INTEGER_P);
PRIMITIVE_RETURN
(BOOLEAN_TO_OBJECT (integer_less_p ((ARG_REF (2)), (ARG_REF (1)))));
}
#define INTEGER_BINARY_OPERATION(operator) \
{ \
PRIMITIVE_HEADER (2); \
CHECK_ARG (1, INTEGER_P); \
CHECK_ARG (2, INTEGER_P); \
PRIMITIVE_RETURN (operator ((ARG_REF (1)), (ARG_REF (2)))); \
}
DEFINE_PRIMITIVE ("INTEGER-ADD", Prim_integer_add, 2, 2, 0)
INTEGER_BINARY_OPERATION (integer_add)
DEFINE_PRIMITIVE ("INTEGER-SUBTRACT", Prim_integer_subtract, 2, 2, 0)
INTEGER_BINARY_OPERATION (integer_subtract)
DEFINE_PRIMITIVE ("INTEGER-MULTIPLY", Prim_integer_multiply, 2, 2, 0)
