Пример #1
0
void
sprint_function(LispObj o, int depth)
{
  LispObj lfbits, header, name = lisp_nil;
  natural elements;

  header = header_of(o);
  elements = header_element_count(header);
  lfbits = deref(o, elements);

  if ((lfbits & lfbits_noname_mask) == 0) {
    name = deref(o, elements-1);
  }
  
  add_c_string("#<");
  if (name == lisp_nil) {
    add_c_string("Anonymous Function ");
  } else {
    if (lfbits & lfbits_method_mask) {
      LispObj 
	slot_vector = deref(name,3),
        method_name = deref(slot_vector, 6),
        method_qualifiers = deref(slot_vector, 2),
        method_specializers = deref(slot_vector, 3);
      add_c_string("Method-Function ");
      sprint_lisp_object(method_name, depth);
      add_char(' ');
      if (method_qualifiers != lisp_nil) {
        if (cdr(method_qualifiers) == lisp_nil) {
          sprint_lisp_object(car(method_qualifiers), depth);
        } else {
          sprint_lisp_object(method_qualifiers, depth);
        }
        add_char(' ');
      }
      sprint_specializers_list(method_specializers, depth);
      add_char(' ');
    } else if (lfbits & lfbits_gfn_mask) {
      add_c_string("Generic Function ");

#ifdef X8632
      {
	LispObj gf_slots = nth_immediate(o, 2);
	LispObj gf_name = deref(gf_slots, 2);

	sprint_lisp_object(gf_name, depth);
	add_char(' ');
      }
#endif
    } else {
      add_c_string("Function ");
      sprint_lisp_object(name, depth);
      add_char(' ');
    }
  }
  sprint_unsigned_hex(o);
  add_char('>');
}
Пример #2
0
void
sprint_tra(LispObj o, int depth)
{
#ifdef X8664
  signed sdisp;
  unsigned disp = 0;
  LispObj f = 0;

  if ((*((unsigned short *)o) == RECOVER_FN_FROM_RIP_WORD0) &&
      (*((unsigned char *)(o+2)) == RECOVER_FN_FROM_RIP_BYTE2)) {
    sdisp = (*(int *) (o+3));
    f = RECOVER_FN_FROM_RIP_LENGTH+o+sdisp;
    disp = o-f;
  }

  if (fulltag_of(f) == fulltag_function) {
    add_c_string("tagged return address: ");
    sprint_function(f, depth);
    add_c_string(" + ");
    sprint_unsigned_decimal(disp);
  } else {
    add_c_string("(tra ?) : ");
    sprint_unsigned_hex(o);
  }
#else
  LispObj f = 0;
  unsigned disp = 0;

  if (*(unsigned char *)o == RECOVER_FN_OPCODE) {
    f = (LispObj)(*((natural *)(o + 1)));
    disp = o - f;
  }

  if (f && header_subtag(header_of(f)) == subtag_function) {
    add_c_string("tagged return address: ");
    sprint_function(f, depth);
    add_c_string(" + ");
    sprint_unsigned_decimal(disp);
  } else {
    add_c_string("(tra ?) : ");
    sprint_unsigned_hex(o);
  }
#endif
}
Пример #3
0
void
sprint_lisp_object(LispObj o, int depth) 
{
  if (--depth < 0) {
    add_char('#');
  } else {
    switch (fulltag_of(o)) {
    case fulltag_even_fixnum:
    case fulltag_odd_fixnum:
      sprint_signed_decimal(unbox_fixnum(o));
      break;
    
#ifdef PPC64
    case fulltag_immheader_0:
    case fulltag_immheader_1:
    case fulltag_immheader_2:
    case fulltag_immheader_3:
    case fulltag_nodeheader_0:
    case fulltag_nodeheader_1:
    case fulltag_nodeheader_2:
    case fulltag_nodeheader_3:
#else
    case fulltag_immheader:
    case fulltag_nodeheader:
#endif      
      add_c_string("#<header ? ");
      sprint_unsigned_hex(o);
      add_c_string(">");
      break;

#ifdef PPC64
    case fulltag_imm_0:
    case fulltag_imm_1:
    case fulltag_imm_2:
    case fulltag_imm_3:
#else
    case fulltag_imm:
#endif
      if (o == unbound) {
        add_c_string("#<Unbound>");
      } else {
        if (header_subtag(o) == subtag_character) {
          unsigned c = (o >> charcode_shift);
          add_c_string("#\\");
          if ((c >= ' ') && (c < 0x7f)) {
            add_char(c);
          } else {
            sprintf(numbuf, "%o", c);
            add_c_string(numbuf);
          }
#ifdef PPC64
        } else if (header_subtag(o) == subtag_single_float) {
          sprintf(numbuf, "%f", o>>32);
          add_c_string(numbuf);
#endif
        } else {
Пример #4
0
void
sprint_random_vector(LispObj o, unsigned subtag, natural elements)
{
  add_c_string("#<");
  sprint_unsigned_decimal(elements);
  add_c_string("-element vector subtag = ");
  sprintf(numbuf, "%02X @", subtag);
  add_c_string(numbuf);
  sprint_unsigned_hex(o);
  add_c_string(" (");
  add_c_string(vector_subtag_name(subtag));
  add_c_string(")>");
}
Пример #5
0
void
sprint_function(LispObj o, int depth)
{
  LispObj lfbits, header, name = lisp_nil;
  natural elements;

  header = header_of(o);
  elements = header_element_count(header);
  lfbits = deref(o, elements);

  if ((lfbits & lfbits_noname_mask) == 0) {
    name = deref(o, elements-1);
  }
  
  add_c_string("#<");
  if (name == lisp_nil) {
    add_c_string("Anonymous Function ");
  } else {
    if (lfbits & lfbits_method_mask) {
      if (header_subtag(header_of(name)) == subtag_instance) {
        LispObj 
          slot_vector = deref(name,3),
          method_name = deref(slot_vector, 6),
          method_qualifiers = deref(slot_vector, 2),
          method_specializers = deref(slot_vector, 3);
        add_c_string("Method-Function ");
        sprint_lisp_object(method_name, depth);
        add_char(' ');
        if (method_qualifiers != lisp_nil) {
          if (cdr(method_qualifiers) == lisp_nil) {
            sprint_lisp_object(car(method_qualifiers), depth);
          } else {
            sprint_lisp_object(method_qualifiers, depth);
          }
        add_char(' ');
        }
        sprint_specializers_list(method_specializers, depth);
      } else {
        sprint_lisp_object(name, depth);
      }
      add_char(' ');
    } else {
      add_c_string("Function ");
      sprint_lisp_object(name, depth);
      add_char(' ');
    }
  }
  sprint_unsigned_hex(o);
  add_char('>');
}
Пример #6
0
void
sprint_random_vector(LispObj o, unsigned subtag, natural elements)
{
  add_c_string("#<");
  sprint_unsigned_decimal(elements);
  add_c_string("-element vector subtag = #x");
  add_char(digits[subtag>>4]);
  add_char(digits[subtag&15]);
  add_c_string(" @");
  sprint_unsigned_hex(o);
  add_c_string(" (");
  add_c_string(vector_subtag_name(subtag));
  add_c_string(")>");
}
Пример #7
0
void
sprint_gvector(LispObj o, int depth)
{
  LispObj header = header_of(o);
  unsigned 
    elements = header_element_count(header),
    subtag = header_subtag(header);
    
  switch(subtag) {
  case subtag_function:
    sprint_function(o, depth);
    break;
    
  case subtag_symbol:
    sprint_symbol(o);
    break;
    
  case subtag_struct:
  case subtag_istruct:
    add_c_string("#<");
    sprint_lisp_object(deref(o,1), depth);
    add_c_string(" @");
    sprint_unsigned_hex(o);
    add_c_string(">");
    break;
   
  case subtag_simple_vector:
    {
      int i;
      add_c_string("#(");
      for(i = 1; i <= elements; i++) {
        if (i > 1) {
          add_char(' ');
        }
        sprint_lisp_object(deref(o, i), depth);
      }
      add_char(')');
      break;
    }
      
  default:
    sprint_random_vector(o, subtag, elements);
    break;
  }
}
Пример #8
0
void
sprint_ivector(LispObj o)
{
  LispObj header = header_of(o);
  unsigned 
    elements = header_element_count(header),
    subtag = header_subtag(header);
    
  switch(subtag) {
  case subtag_simple_base_string:
    add_char('"');
    add_lisp_base_string(o);
    add_char('"');
    return;
    
  case subtag_bignum:
    if (elements == 1) {
      sprint_signed_decimal((signed_natural)(deref(o, 1)));
      return;
    }
    if ((elements == 2) && (deref(o, 2) == 0)) {
      sprint_unsigned_decimal(deref(o, 1));
      return;
    }
    break;
    
  case subtag_double_float:
    break;

  case subtag_macptr:
    add_c_string("#<MACPTR ");
    sprint_unsigned_hex(deref(o,1));
    add_c_string(">");
    break;

  default:
    sprint_random_vector(o, subtag, elements);
  }
}
Пример #9
0
void
sprint_lisp_object(LispObj o, int depth) 
{
  if (--depth < 0) {
    add_char('#');
  } else {
    switch (fulltag_of(o)) {
    case fulltag_even_fixnum:
    case fulltag_odd_fixnum:
      sprint_signed_decimal(unbox_fixnum(o));
      break;
    
#ifdef X8664
    case fulltag_immheader_0:
    case fulltag_immheader_1:
    case fulltag_immheader_2:
    case fulltag_nodeheader_0:
    case fulltag_nodeheader_1:
#else
    case fulltag_immheader:
    case fulltag_nodeheader:
#endif      
      add_c_string("#<header ? ");
      sprint_unsigned_hex(o);
      add_c_string(">");
      break;

#ifdef X8664
    case fulltag_imm_0:
    case fulltag_imm_1:
#else
    case fulltag_imm:
#endif
      if (o == unbound) {
        add_c_string("#<Unbound>");
      } else {
        if (header_subtag(o) == subtag_character) {
          unsigned c = (o >> charcode_shift);
          add_c_string("#\\");
          if ((c >= ' ') && (c < 0x7f)) {
            add_char(c);
          } else {
            sprintf(numbuf, "%#o", c);
            add_c_string(numbuf);
          }
#ifdef X8664
        } else if (header_subtag(o) == subtag_single_float) {
          LispObj xx = o;
          float f = ((float *)&xx)[1];
          sprintf(numbuf, "%f", f);
          add_c_string(numbuf);
#endif
        } else {

          add_c_string("#<imm ");
          sprint_unsigned_hex(o);
          add_c_string(">");
        }
      }
      break;

#ifdef X8664
    case fulltag_nil:
#endif
    case fulltag_cons:
      sprint_list(o, depth);
      break;
     
    case fulltag_misc:
      sprint_vector(o, depth);
      break;

#ifdef X8664
    case fulltag_symbol:
      sprint_symbol(o);
      break;

    case fulltag_function:
      sprint_function(o, depth);
      break;
#endif

#ifdef X8664
    case fulltag_tra_0:
    case fulltag_tra_1:
#else
    case fulltag_tra:
#endif
      sprint_tra(o,depth);
      break;
    }