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)