Example #1
0
void
soft_reset (void)
{
  /* Called synchronously. */
  struct trap_recovery_info trinfo;
  SCHEME_OBJECT * new_stack_pointer
    = ((SP_OK_P (stack_pointer)) ? stack_pointer : 0);
  if (GET_PRIMITIVE != SHARP_F)
    {
      (trinfo . state) = STATE_PRIMITIVE;
      (trinfo . pc_info_1) = GET_PRIMITIVE;
      (trinfo . pc_info_2) = (ULONG_TO_FIXNUM (GET_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;
    }
  if (!ADDRESS_IN_HEAP_P (Free))
    Free = heap_alloc_limit;	/* Let's hope this works. */
  setup_trap_frame (0, 0, 0, (&trinfo), new_stack_pointer);
}
Example #2
0
static void
start_scheme (void)
{
  SCHEME_OBJECT expr;

  if (!option_batch_mode && !option_show_version && !option_show_help)
    {
      outf_console ("MIT/GNU Scheme running under %s\n", OS_Variant);
      OS_announcement ();
      outf_console ("\n");
      outf_flush_console ();
    }
  initialize_fixed_objects_vector ();

  if (option_fasl_file != 0)
    {
#ifdef CC_IS_C
      /* (SCODE-EVAL (INITIALIZE-C-COMPILED-BLOCK <file>) GLOBAL-ENV) */
      SCHEME_OBJECT prim1 = (make_primitive ("INITIALIZE-C-COMPILED-BLOCK", 1));
#else
      /* (SCODE-EVAL (BINARY-FASLOAD <file>) GLOBAL-ENV) */
      SCHEME_OBJECT prim1 = (make_primitive ("BINARY-FASLOAD", 1));
#endif
      SCHEME_OBJECT fn_object = (char_pointer_to_string (option_fasl_file));
      SCHEME_OBJECT prim2 = (make_primitive ("SCODE-EVAL", 2));
      SCHEME_OBJECT * inner_arg = Free;
      (*Free++) = prim1;
      (*Free++) = fn_object;
      expr = (MAKE_POINTER_OBJECT (TC_PCOMB2, Free));
      (*Free++) = prim2;
      (*Free++) = (MAKE_POINTER_OBJECT (TC_PCOMB1, inner_arg));
      (*Free++) = THE_GLOBAL_ENV;
    }
  else
    {
      /* (LOAD-BAND <file>) */
      SCHEME_OBJECT prim = (make_primitive ("LOAD-BAND", 1));
      SCHEME_OBJECT fn_object = (char_pointer_to_string (option_band_file));
      expr = (MAKE_POINTER_OBJECT (TC_PCOMB1, Free));
      (*Free++) = prim;
      (*Free++) = fn_object;
    }

  /* Setup registers */
  INITIALIZE_INTERRUPTS (0);
  SET_ENV (THE_GLOBAL_ENV);
  trapping = false;

  /* Give the interpreter something to chew on, and ... */
  Will_Push (CONTINUATION_SIZE);
  SET_RC (RC_END_OF_COMPUTATION);
  SET_EXP (SHARP_F);
  SAVE_CONT ();
  Pushed ();

  SET_EXP (expr);

  /* Go to it! */
  if (! ((SP_OK_P (stack_pointer)) && (Free <= heap_alloc_limit)))
    {
      outf_fatal ("Configuration won't hold initial data.\n");
      termination_init_error ();
    }
  ENTRY_HOOK ();
  Enter_Interpreter ();
}