Example #1
0
static void
console_write_string (unsigned char * string)
{
  outf_console ("%s", string);
  outf_flush_console ();
  return;
}
Example #2
0
void
outf_flush (outf_channel chan)
{
  switch (chan)
    {
    case CONSOLE_OUTPUT: outf_flush_console (); break;
    case ERROR_OUTPUT: outf_flush_error (); break;
    case FATAL_OUTPUT: outf_flush_fatal (); break;
    }
}
Example #3
0
static void
termination_prefix (int code)
{
  attempt_termination_backout (code);
  OS_restore_external_state ();
  /* TERM_HALT is not an error condition and thus its termination
     message should be considered normal output.  */
  if (code == TERM_HALT)
    {
      if (!option_batch_mode)
	{
	  outf_console ("\n%s.\n", (term_messages[code]));
	  outf_flush_console ();
	}
    }
  else
    {
#ifdef USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
      outf_fatal ("Reason for termination:");
#endif
      outf_fatal ("\n");
      {
	const char * msg = 0;
	if ((code >= 0) && (code <= MAX_TERMINATION))
	  msg = (term_messages[code]);
	if (msg == 0)
	  outf_fatal ("Unknown termination code %#x", code);
	else
	  outf_fatal ("%s", msg);
      }
      if (WITHIN_CRITICAL_SECTION_P ())
	outf_fatal (" within critical section \"%s\"",
		    (CRITICAL_SECTION_NAME ()));
      outf_fatal (".");
#ifndef USING_MESSAGE_BOX_FOR_FATAL_OUTPUT
      outf_fatal ("\n");
#endif
    }
}
Example #4
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 ();
}