Ejemplo n.º 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);
}
Ejemplo n.º 2
0
SCHEME_OBJECT
make_microcode_identification_vector (void)
{
  SCHEME_OBJECT v = (make_vector (IDENTITY_LENGTH, SHARP_F, true));
  VECTOR_SET (v, ID_RELEASE, SHARP_F);
  VECTOR_SET (v, ID_MICRO_VERSION, (char_pointer_to_string (PACKAGE_VERSION)));
  VECTOR_SET (v, ID_PRINTER_WIDTH, (ULONG_TO_FIXNUM (OS_tty_x_size ())));
  VECTOR_SET (v, ID_PRINTER_LENGTH, (ULONG_TO_FIXNUM (OS_tty_y_size ())));
  VECTOR_SET (v, ID_NEW_LINE_CHARACTER, (ASCII_TO_CHAR ('\n')));
  VECTOR_SET (v, ID_FLONUM_PRECISION, (ULONG_TO_FIXNUM (DBL_MANT_DIG)));
  VECTOR_SET (v, ID_FLONUM_EPSILON, (double_to_flonum ((double) DBL_EPSILON)));
  VECTOR_SET (v, ID_OS_NAME, (char_pointer_to_string (OS_Name)));
  VECTOR_SET (v, ID_OS_VARIANT, (char_pointer_to_string (OS_Variant)));
  VECTOR_SET (v, ID_STACK_TYPE, (char_pointer_to_string ("standard")));
  VECTOR_SET (v, ID_MACHINE_TYPE, (char_pointer_to_string (MACHINE_TYPE)));
  {
    const char * name = (cc_arch_name ());
    if (name != 0)
      VECTOR_SET (v, ID_CC_ARCH, (char_pointer_to_string (name)));
  }
  return (v);
}
Ejemplo n.º 3
0
  return (arg_ulong_index_integer (arg, (1L << TYPE_CODE_LENGTH)));
}

static unsigned long
arg_datum (int arg)
{
  return (arg_ulong_index_integer (arg, (1L << DATUM_LENGTH)));
}

/* Low level object manipulation */

DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE", Prim_prim_obj_type, 1, 1,
  "Return the type code of OBJECT as an unsigned integer.")
{
  PRIMITIVE_HEADER (1);
  PRIMITIVE_RETURN (ULONG_TO_FIXNUM (OBJECT_TYPE (ARG_REF (1))));
}

DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-TYPE?", Prim_prim_obj_type_p, 2, 2,
  "Return #T if TYPE-CODE is OBJECT's type code, else #F.")
{
  PRIMITIVE_HEADER (2);
  PRIMITIVE_RETURN
    (BOOLEAN_TO_OBJECT ((OBJECT_TYPE (ARG_REF (2))) == (arg_type (1))));
}

DEFINE_PRIMITIVE ("PRIMITIVE-OBJECT-DATUM", Prim_prim_obj_datum, 1, 1,
  "Return the datum part of OBJECT as an unsigned integer.")
{
  PRIMITIVE_HEADER (1);
  PRIMITIVE_RETURN (ulong_to_integer (OBJECT_DATUM (ARG_REF (1))));
Ejemplo n.º 4
0
static void
continue_from_trap (int signo, SIGINFO_T info, SIGCONTEXT_T * scp)
{
  unsigned long pc = (SIGCONTEXT_PC (scp));
  SCHEME_OBJECT primitive = GET_PRIMITIVE;
  SCHEME_OBJECT * block_addr;
  unsigned 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 = stack_pointer;
      SET_RECOVERY_INFO
	(STATE_PRIMITIVE, primitive, (ULONG_TO_FIXNUM (GET_LEXPR_ACTUALS)));
      break;

    case pcl_heap:
    case pcl_constant:
#ifdef CC_SUPPORT_P
      new_sp = ((SCHEME_OBJECT *) (SIGCONTEXT_SCHSP (scp)));
      Free = ((SCHEME_OBJECT *) (SIGCONTEXT_RFREE (scp)));
      SET_RECOVERY_INFO
	(STATE_COMPILED_CODE,
	 (MAKE_CC_BLOCK (block_addr)),
	 (LONG_TO_UNSIGNED_FIXNUM (pc - ((unsigned long) block_addr))));
      break;
#endif

    case pcl_utility:
#ifdef CC_SUPPORT_P
      new_sp = stack_pointer;
      SET_RECOVERY_INFO (STATE_UTILITY, (ULONG_TO_FIXNUM (index)), UNSPECIFIC);
      break;
#endif

    case pcl_builtin:
#ifdef CC_SUPPORT_P
      new_sp = ((SCHEME_OBJECT *) (SIGCONTEXT_SCHSP (scp)));
      Free = ((SCHEME_OBJECT *) (SIGCONTEXT_RFREE (scp)));
      SET_RECOVERY_INFO (STATE_BUILTIN, (ULONG_TO_FIXNUM (index)), UNSPECIFIC);
      break;
#endif

    case pcl_unknown:
      new_sp = 0;
      SET_RECOVERY_INFO
	(STATE_UNKNOWN,
	 (LONG_TO_UNSIGNED_FIXNUM (pc)),
	 UNSPECIFIC);
      break;
    }

  /* Sanity-check the new SP.  */
  if (! ((ADDRESS_IN_STACK_P (new_sp)) && (ALIGNED_P (new_sp))))
    new_sp = 0;

  /* Sanity-check Free.  */
  if ((new_sp != 0)
      && (ADDRESS_IN_HEAP_P (Free))
      && (ALIGNED_P (Free)))
    {
      if (FREE_OK_P (Free))
	{
	  Free += FREE_PARANOIA_MARGIN;
	  if (!FREE_OK_P (Free))
	    Free = heap_alloc_limit;
	}
    }
  else
    Free = heap_alloc_limit;

  /* Encode the registers.  */
  (recovery_info . extra_trap_info) =
    (MAKE_POINTER_OBJECT (TC_NON_MARKED_VECTOR, Free));
  (*Free++) =
    (MAKE_OBJECT (TC_MANIFEST_NM_VECTOR, (2 + SIGCONTEXT_NREGS)));
  (*Free++) = ((SCHEME_OBJECT) pc);
  (*Free++) = ((SCHEME_OBJECT) (SIGCONTEXT_SP (scp)));
  {
    unsigned long * scan
      = ((unsigned long *) (SIGCONTEXT_FIRST_REG (scp)));
    unsigned long * end = (scan + SIGCONTEXT_NREGS);
    while (scan < end)
      (*Free++) = ((SCHEME_OBJECT) (*scan++));
  }

  setup_trap_frame (signo, info, scp, (&recovery_info), new_sp);
}