Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Functions | Variables
print.c File Reference
#include "schpriv.h"
#include "schvers.h"
#include "schmach.h"
#include "schcpt.h"
#include <ctype.h>
#include "../gc2/my_qsort.c"

Go to the source code of this file.

Classes

struct  Scheme_Print_Params

Defines

#define QUICK_ENCODE_BUFFER_SIZE   256
#define NO_COMPACT   0
#define PRINT_MAXLEN_MIN   3
#define MAX_PRINT_BUFFER   500
#define print_compact(pp, v)   print_this_string(pp, &compacts[v], 0, 1)
#define PRINTABLE_STRUCT(obj, pp)   (scheme_inspector_sees_part(obj, pp->inspector, -1))
#define SCHEME_PREFABP(obj)   (((Scheme_Structure *)(obj))->stype->prefab_key)
#define SCHEME_HASHTPx(obj)   ((SCHEME_HASHTP(obj) && !(MZ_OPT_HASH_KEY(&(((Scheme_Hash_Table *)obj)->iso)) & 0x1)))
#define HAS_SUBSTRUCT(obj, qk)
#define ssQUICK(x, isbox)   x
#define ssQUICKp(x, isbox)   (pp ? x : isbox)
#define ssALL(x, isbox)   1
#define ssALLp(x, isbox)   isbox
#define CACHE_HT_SIZE_LIMIT   32
#define SCHEME_FIRSTP(v)
#define PRINTADDRESS(pp, obj)   /* empty */

Typedefs

typedef struct Scheme_Print_Params PrintParams

Functions

static void print_to_port (char *name, Scheme_Object *obj, Scheme_Object *port, int notdisplay, long maxl, int check_honu)
static int print (Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *p)
static void print_char_string (const char *s, int l, const mzchar *us, int delta, int ul, int notdisplay, int honu_char, PrintParams *pp)
static void print_byte_string (const char *s, int delta, int l, int notdisplay, PrintParams *pp)
static void print_pair (Scheme_Object *pair, int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *pp, Scheme_Type type, int round_parens)
static void print_vector (Scheme_Object *vec, int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *pp, int as_prefab)
static void print_char (Scheme_Object *chobj, int notdisplay, PrintParams *pp)
static char * print_to_string (Scheme_Object *obj, long *volatile len, int write, Scheme_Object *port, long maxl, int check_honu)
static void custom_write_struct (Scheme_Object *s, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *pp, int notdisplay)
static Scheme_Objectwritable_struct_subs (Scheme_Object *s, int for_write, PrintParams *pp)
void scheme_init_print (Scheme_Env *env)
void scheme_init_print_buffers_places ()
Scheme_Objectscheme_make_svector (mzshort c, mzshort *a)
PrintParamscopy_print_params (PrintParams *pp)
void scheme_debug_print (Scheme_Object *obj)
static voidprint_to_port_k (void)
static void do_handled_print (Scheme_Object *obj, Scheme_Object *port, Scheme_Object *proc, long maxl)
void scheme_write_w_max (Scheme_Object *obj, Scheme_Object *port, long maxl)
void scheme_write (Scheme_Object *obj, Scheme_Object *port)
void scheme_display_w_max (Scheme_Object *obj, Scheme_Object *port, long maxl)
void scheme_display (Scheme_Object *obj, Scheme_Object *port)
void scheme_print_w_max (Scheme_Object *obj, Scheme_Object *port, long maxl)
void scheme_print (Scheme_Object *obj, Scheme_Object *port)
static voidprint_to_string_k (void)
char * scheme_write_to_string_w_max (Scheme_Object *obj, long *len, long maxl)
char * scheme_write_to_string (Scheme_Object *obj, long *len)
char * scheme_display_to_string_w_max (Scheme_Object *obj, long *len, long maxl)
char * scheme_display_to_string (Scheme_Object *obj, long *len)
char * scheme_print_to_string_w_max (Scheme_Object *obj, long *len, long maxl)
char * scheme_print_to_string (Scheme_Object *obj, long *len)
void scheme_internal_write (Scheme_Object *obj, Scheme_Object *port)
void scheme_internal_display (Scheme_Object *obj, Scheme_Object *port)
void scheme_internal_print (Scheme_Object *obj, Scheme_Object *port)
static int check_cycles (Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht, PrintParams *pp)
static int check_cycles_fast (Scheme_Object *obj, PrintParams *pp, int *fast_checker_counter)
static void setup_graph_table (Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht, int *counter, PrintParams *pp)
static Scheme_Hash_Tablesetup_datum_graph (Scheme_Object *o, int for_write, void *for_print)
static void print_this_string (PrintParams *pp, const char *str, int offset, int autolen)
static void print_utf8_string (PrintParams *pp, const char *str, int offset, int autolen)
void scheme_print_bytes (Scheme_Print_Params *pp, const char *str, int offset, int len)
void scheme_print_utf8 (Scheme_Print_Params *pp, const char *str, int offset, int len)
static void print_number (PrintParams *pp, long n)
static void print_short_number (PrintParams *pp, long n)
static void print_one_byte (PrintParams *pp, int n)
static void print_compact_number (PrintParams *pp, long n)
static void do_print_string (int compact, int notdisplay, Scheme_Print_Params *pp, const mzchar *s, int offset, int l)
void scheme_print_string (Scheme_Print_Params *pp, const mzchar *s, int offset, int l)
static void print_string_in_angle (PrintParams *pp, const char *start, const char *prefix, int slen)
static int compare_keys (const void *a, const void *b)
static void sort_referenced_keys (Scheme_Marshal_Tables *mt)
static void print_table_keys (int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *pp)
static int print_substring (Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, PrintParams *pp, char **result, long *rlen, int print_keys, long *klen)
static Scheme_Objectget_symtab_idx (Scheme_Marshal_Tables *mt, Scheme_Object *obj)
static void set_symtab_shared (Scheme_Marshal_Tables *mt, Scheme_Object *obj)
static void print_general_symtab_ref (PrintParams *pp, Scheme_Object *idx, int cpt_id)
static void print_symtab_ref (PrintParams *pp, Scheme_Object *idx)
static int add_symtab (Scheme_Marshal_Tables *mt, Scheme_Object *obj)
static void symtab_set (PrintParams *pp, Scheme_Marshal_Tables *mt, Scheme_Object *obj)
static void print_symtab_set (PrintParams *pp, Scheme_Marshal_Tables *mt, Scheme_Object *obj)
Scheme_Objectscheme_marshal_wrap_set (Scheme_Marshal_Tables *mt, Scheme_Object *obj, Scheme_Object *val)
Scheme_Objectscheme_marshal_lookup (Scheme_Marshal_Tables *mt, Scheme_Object *obj)
void scheme_marshal_using_key (Scheme_Marshal_Tables *mt, Scheme_Object *obj)
void scheme_marshal_push_refs (Scheme_Marshal_Tables *mt)
void scheme_marshal_pop_refs (Scheme_Marshal_Tables *mt, int keep)
static void print_escaped (PrintParams *pp, int notdisplay, Scheme_Object *obj, Scheme_Hash_Table *ht, Scheme_Marshal_Tables *mt, int shared)
static void cannot_print (PrintParams *pp, int notdisplay, Scheme_Object *obj, Scheme_Hash_Table *ht, int compact)
static void print_named (Scheme_Object *obj, const char *kind, const char *s, int len, PrintParams *pp)
static void always_scheme (PrintParams *pp, int reset)
Scheme_Objectscheme_protect_quote (Scheme_Object *expr)
void scheme_set_type_printer (Scheme_Type stype, Scheme_Type_Printer printer)
static Scheme_Objectaccum_write (void *_b, int argc, Scheme_Object **argv)
static void flush_from_byte_port (Scheme_Object *orig_port, PrintParams *pp)
static Scheme_Objectcustom_recur (int notdisplay, void *_vec, int argc, Scheme_Object **argv)
static Scheme_Objectcustom_write_recur (void *_vec, int argc, Scheme_Object **argv)
static Scheme_Objectcustom_display_recur (void *_vec, int argc, Scheme_Object **argv)

Variables

int(* scheme_check_print_is_obj )(Scheme_Object *o)
static THREAD_LOCAL char * quick_buffer = NULL
static THREAD_LOCAL char * quick_encode_buffer = NULL
static Scheme_Type_Printerprinters
static int printers_count
static Scheme_Hash_Tablecache_ht
static char compacts [_CPT_COUNT_]
static Scheme_Hash_Tableglobal_constants_ht
static Scheme_Objectquote_link_symbol = NULL

Class Documentation

struct Scheme_Print_Params

Definition at line 60 of file print.c.

Collaboration diagram for Scheme_Print_Params:
Class Members
char can_read_pipe_quote
char case_sens
char honu_mode
Scheme_Object * inspector
long print_allocated
char print_box
char * print_buffer
mz_jmp_buf * print_escape
char print_graph
char print_hash_table
long print_maxlen
char print_mpair_curly
long print_offset
char print_pair_curly
Scheme_Object * print_port
long print_position
MZTAG_IF_REQUIRED char print_struct
char print_unreadable
char print_vec_shorthand

Define Documentation

#define CACHE_HT_SIZE_LIMIT   32

Definition at line 738 of file print.c.

#define HAS_SUBSTRUCT (   obj,
  qk 
)
Value:
(SCHEME_PAIRP(obj) \
    || SCHEME_MUTABLE_PAIRP(obj) \
    || SCHEME_VECTORP(obj) \
    || (qk(pp->print_box, 1) && SCHEME_BOXP(obj)) \
    || (qk(pp->print_struct  \
          && SCHEME_STRUCTP(obj) \
          && PRINTABLE_STRUCT(obj, pp), 0)) \
    || (qk(SCHEME_STRUCTP(obj) && scheme_is_writable_struct(obj), 0)) \
    || (qk(pp->print_hash_table, 1) && (SCHEME_HASHTPx(obj) || SCHEME_HASHTRP(obj))))

Definition at line 125 of file print.c.

#define MAX_PRINT_BUFFER   500

Definition at line 58 of file print.c.

#define NO_COMPACT   0

Definition at line 53 of file print.c.

#define print_compact (   pp,
 
)    print_this_string(pp, &compacts[v], 0, 1)

Definition at line 118 of file print.c.

#define PRINT_MAXLEN_MIN   3

Definition at line 55 of file print.c.

#define PRINTABLE_STRUCT (   obj,
  pp 
)    (scheme_inspector_sees_part(obj, pp->inspector, -1))

Definition at line 120 of file print.c.

#define PRINTADDRESS (   pp,
  obj 
)    /* empty */

Definition at line 1475 of file print.c.

#define QUICK_ENCODE_BUFFER_SIZE   256

Definition at line 37 of file print.c.

#define SCHEME_FIRSTP (   v)
#define SCHEME_HASHTPx (   obj)    ((SCHEME_HASHTP(obj) && !(MZ_OPT_HASH_KEY(&(((Scheme_Hash_Table *)obj)->iso)) & 0x1)))

Definition at line 123 of file print.c.

#define SCHEME_PREFABP (   obj)    (((Scheme_Structure *)(obj))->stype->prefab_key)

Definition at line 121 of file print.c.

#define ssALL (   x,
  isbox 
)    1

Definition at line 137 of file print.c.

#define ssALLp (   x,
  isbox 
)    isbox

Definition at line 138 of file print.c.

#define ssQUICK (   x,
  isbox 
)    x

Definition at line 135 of file print.c.

#define ssQUICKp (   x,
  isbox 
)    (pp ? x : isbox)

Definition at line 136 of file print.c.


Typedef Documentation


Function Documentation

static Scheme_Object* accum_write ( void _b,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3276 of file print.c.

Here is the caller graph for this function:

static int add_symtab ( Scheme_Marshal_Tables mt,
Scheme_Object obj 
) [static]

Definition at line 1321 of file print.c.

{
  if (!mt->pass) {
    int l;
    l = mt->symtab->count + 1;
    scheme_hash_set(mt->symtab, obj, scheme_make_integer(l));
    return l;
  } else {
    Scheme_Object *key, *l;

    key = scheme_hash_get(mt->st_refs, obj);
    for (l = mt->st_ref_stack; !key && SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
      key = scheme_hash_get((Scheme_Hash_Table *)SCHEME_CAR(l), obj);
    }

    if (!key) {
      /* There's no other reference to this object, so use dummy slot 0. */
      return 0;
    }

    key = scheme_hash_get(mt->key_map, key);

    scheme_hash_set(mt->symtab, obj, key);

    return SCHEME_INT_VAL(key);
  }
}

Here is the caller graph for this function:

static void always_scheme ( PrintParams pp,
int  reset 
) [static]

Definition at line 1494 of file print.c.

{
  if (pp->honu_mode) {
    print_utf8_string(pp, "#sx", 0, 3);
    if (reset)
      pp->honu_mode = 0;
  }
}

Here is the call graph for this function:

static void cannot_print ( PrintParams pp,
int  notdisplay,
Scheme_Object obj,
Scheme_Hash_Table ht,
int  compact 
) [static]

Definition at line 1454 of file print.c.

{
  scheme_raise_exn(MZEXN_FAIL,
                 (compact
                  ? "%s: cannot marshal constant that is embedded in compiled code: %V"
                  : "%s: printing disabled for unreadable value: %V"),
                 notdisplay ? "write" : "display",
                 obj);
}
static int check_cycles ( Scheme_Object obj,
int  for_write,
Scheme_Hash_Table ht,
PrintParams pp 
) [static]

Definition at line 417 of file print.c.

{
  Scheme_Type t;

#ifdef DO_STACK_CHECK
  {
#include "mzstkchk.h"
    {
      pp = copy_print_params(pp);
      scheme_current_thread->ku.k.p1 = (void *)obj;
      scheme_current_thread->ku.k.p2 = (void *)ht;
      scheme_current_thread->ku.k.p3 = (void *)pp;
      scheme_current_thread->ku.k.i1 = for_write;
      return SCHEME_TRUEP(scheme_handle_stack_overflow(check_cycle_k));
    }
  }
#endif
  SCHEME_USE_FUEL(1);

  t = SCHEME_TYPE(obj);

  if (SCHEME_PAIRP(obj)
      || SCHEME_MUTABLE_PAIRP(obj)
      || (pp->print_box && SCHEME_BOXP(obj))
      || SCHEME_VECTORP(obj)
      || ((SAME_TYPE(t, scheme_structure_type)
          || SAME_TYPE(t, scheme_proc_struct_type))
          && ((pp->print_struct 
              && PRINTABLE_STRUCT(obj, pp))
             || scheme_is_writable_struct(obj)))
      || (pp->print_hash_table
         && (SAME_TYPE(t, scheme_hash_table_type)
              || SAME_TYPE(t, scheme_hash_tree_type)))) {
    if (scheme_hash_get(ht, obj))
      return 1;
    scheme_hash_set(ht, obj, (Scheme_Object *)0x1);
  } else 
    return 0;

  if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj)) {
    if (check_cycles(SCHEME_CAR(obj), for_write, ht, pp))
      return 1;
    if (check_cycles(SCHEME_CDR(obj), for_write, ht, pp))
      return 1;
  } else if (SCHEME_BOXP(obj)) {
    /* got here => printable */
    if (check_cycles(SCHEME_BOX_VAL(obj), for_write, ht, pp))
      return 1;
  } else if (SCHEME_VECTORP(obj)) {
    int i, len;

    len = SCHEME_VEC_SIZE(obj);
    for (i = 0; i < len; i++) {
      if (check_cycles(SCHEME_VEC_ELS(obj)[i], for_write, ht, pp)) {
       return 1;
      }
    }
  } else if (SAME_TYPE(t, scheme_structure_type)
            || SAME_TYPE(t, scheme_proc_struct_type)) {
    if (scheme_is_writable_struct(obj)) {
      if (check_cycles(writable_struct_subs(obj, for_write, pp), for_write, ht, pp))
       return 1;
    } else {
      /* got here => printable */
      int i = SCHEME_STRUCT_NUM_SLOTS(obj);

      while (i--) {
       if (scheme_inspector_sees_part(obj, pp->inspector, i)) {
         if (check_cycles(((Scheme_Structure *)obj)->slots[i], for_write, ht, pp)) {
           return 1;
         }
       }
      }
    }
  } else if (SCHEME_HASHTPx(obj)) {
    /* got here => printable */
    Scheme_Hash_Table *t;
    Scheme_Object **keys, **vals, *val;
    int i;
    
    t = (Scheme_Hash_Table *)obj;
    keys = t->keys;
    vals = t->vals;
    for (i = t->size; i--; ) {
      if (vals[i]) {
       val = vals[i];
       if (check_cycles(keys[i], for_write, ht, pp))
         return 1;
       if (check_cycles(val, for_write, ht, pp))
         return 1;
      }
    }
  } else if (SCHEME_HASHTRP(obj)) {
    /* got here => printable */
    Scheme_Hash_Tree *t = (Scheme_Hash_Tree *)obj;
    Scheme_Object *key, *val;
    int i;
    
    i = scheme_hash_tree_next(t, -1);
    while (i != -1) {
      scheme_hash_tree_index(t, i, &key, &val);
      if (check_cycles(key, for_write, ht, pp))
        return 1;
      if (check_cycles(val, for_write, ht, pp))
        return 1;
      i = scheme_hash_tree_next(t, i);
    }
  }

  scheme_hash_set(ht, obj, NULL);

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int check_cycles_fast ( Scheme_Object obj,
PrintParams pp,
int fast_checker_counter 
) [static]

Definition at line 540 of file print.c.

{
  Scheme_Type t;
  int cycle = 0;

  t = SCHEME_TYPE(obj);
  if (t < 0)
    return 1;

  if ((*fast_checker_counter)-- < 0)
    return -1;

  if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj)) {
    obj->type = -t;
    cycle = check_cycles_fast(SCHEME_CAR(obj), pp, fast_checker_counter);
    if (!cycle)
      cycle = check_cycles_fast(SCHEME_CDR(obj), pp, fast_checker_counter);
    obj->type = t;
  } else if (pp->print_box && SCHEME_BOXP(obj)) {
    obj->type = -t;
    cycle = check_cycles_fast(SCHEME_BOX_VAL(obj), pp, fast_checker_counter);
    obj->type = t;
  } else if (SCHEME_VECTORP(obj)) {
    int i, len;

    obj->type = -t;
    len = SCHEME_VEC_SIZE(obj);
    for (i = 0; i < len; i++) {
      cycle = check_cycles_fast(SCHEME_VEC_ELS(obj)[i], pp, fast_checker_counter);
      if (cycle)
       break;
    }
    obj->type = t;
  } else if (SAME_TYPE(t, scheme_structure_type)
            || SAME_TYPE(t, scheme_proc_struct_type)) {
    if (scheme_is_writable_struct(obj)) {
      if (!pp->print_unreadable)
       cycle = 0;
      else
       /* don't bother with fast checks for writeable structs */
       cycle = -1;
    } else if (pp->print_struct && PRINTABLE_STRUCT(obj, pp)) {
      int i = SCHEME_STRUCT_NUM_SLOTS(obj);
      
      obj->type = -t;
      while (i--) {
       if (scheme_inspector_sees_part(obj, pp->inspector, i)) {
         cycle = check_cycles_fast(((Scheme_Structure *)obj)->slots[i], pp, fast_checker_counter);
         if (cycle)
           break;
       }
      }
      obj->type = t;
    } else
      cycle = 0;
  } else if (pp->print_hash_table
            && SCHEME_HASHTPx(obj)) {
    if (!((Scheme_Hash_Table *)obj)->count)
      cycle = 0;
    else
      /* don't bother with fast checks for non-empty hash tables */
      cycle = -1;
  } else if (pp->print_hash_table
            && SCHEME_HASHTRP(obj)) {
    if (!((Scheme_Hash_Tree *)obj)->count)
      cycle = 0;
    else
      /* don't bother with fast checks for non-empty hash trees */
      cycle = -1;
  } else
    cycle = 0;

  return cycle;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int compare_keys ( const void a,
const void b 
) [static]

Definition at line 1137 of file print.c.

{
  Scheme_Object *av, *bv;

  /* Atomic things first, because they could be used by
     marshaled syntax. This cuts donw on recursive reads
     at load time. */
# define SCHEME_FIRSTP(v) (SCHEME_SYMBOLP(v) \
                           || SCHEME_PATHP(v) \
                           || SCHEME_KEYWORDP(v) \
                           || SCHEME_CHAR_STRINGP(v) \
                           || SCHEME_BYTE_STRINGP(v) \
                           || SCHEME_CHARP(v) \
                           || SAME_TYPE(SCHEME_TYPE(v), scheme_module_index_type))
  av = ((Scheme_Object **)a)[0];
  bv = ((Scheme_Object **)b)[0];
  if (SCHEME_FIRSTP(av)) {
    if (!SCHEME_FIRSTP(bv))
      return -1;
  } else if (SCHEME_FIRSTP(bv))
    return 1;

  return ((long *)a)[1] - ((long *)b)[1];
}

Here is the caller graph for this function:

Definition at line 181 of file print.c.

{
  PrintParams *pp2;

  pp2 = MALLOC_ONE_RT(PrintParams);
  memcpy(pp2, pp, sizeof(PrintParams));
#ifdef MZTAG_REQUIRED
  pp2->type = scheme_rt_print_params;
#endif
  return pp2;
}

Here is the caller graph for this function:

static Scheme_Object* custom_display_recur ( void _vec,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3404 of file print.c.

{
  return custom_recur(0, _vec, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* custom_recur ( int  notdisplay,
void _vec,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3331 of file print.c.

{
  Scheme_Hash_Table *ht = (Scheme_Hash_Table *)SCHEME_VEC_ELS(_vec)[0];
  Scheme_Marshal_Tables *mt = (Scheme_Marshal_Tables *)SCHEME_VEC_ELS(_vec)[1];
  PrintParams * volatile pp = (PrintParams *)SCHEME_VEC_ELS(_vec)[2];
  Scheme_Object * volatile save_port;
  mz_jmp_buf escape, * volatile save;
  volatile long save_max;

  if (!SCHEME_OUTPORTP(argv[1])) {
    scheme_wrong_type(notdisplay ? "write/recusrive" : "display/recursive",
                    "output-port", 1, argc, argv);
    return NULL;
  }

  if (SCHEME_VEC_ELS(_vec)[3]) {
    /* Recur: */
    {
      if (pp->print_escape) {
       save = pp->print_escape;
       pp->print_escape = &escape;
      } else
       save = NULL;

      save_port = pp->print_port;
      save_max = pp->print_maxlen;
      
      if (!pp->print_escape
         || !scheme_setjmp(escape)) {
       /* If printing to string, flush it and reset first: */
       Scheme_Object *sp;
       sp = SCHEME_VEC_ELS(_vec)[4];
       if (sp) {
         flush_from_byte_port(sp, pp);
         sp = scheme_make_byte_string_output_port();
         ((Scheme_Output_Port *)SCHEME_VEC_ELS(_vec)[5])->port_data = sp;
         SCHEME_VEC_ELS(_vec)[4] = sp;
       }

       /* If printing to a different output port, flush print cache,
          first. */
       if (!SAME_OBJ(save_port, argv[1])) {
         print_this_string(pp, NULL, 0, 0);
         /* Disable maxlen, because it interferes with flushing.
            It would be good to improve on this (to avoid work),
            but it's unlikey to ever matter. */
         pp->print_maxlen = 0;
       }

       pp->print_port = argv[1];

       /* Recur */
       print(argv[0], notdisplay, 0, ht, mt, pp);

       /* Flush print cache, to ensure that future writes to the
          port go after printed data. */
       print_this_string(pp, NULL, 0, 0);
      }

      pp->print_port = save_port;
      pp->print_escape = save;
      pp->print_maxlen = save_max;
    }
  }

  return scheme_void;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* custom_write_recur ( void _vec,
int  argc,
Scheme_Object **  argv 
) [static]

Definition at line 3399 of file print.c.

{
  return custom_recur(1, _vec, argc, argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void custom_write_struct ( Scheme_Object s,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams pp,
int  notdisplay 
) [static]

Definition at line 3409 of file print.c.

{
  Scheme_Object *v, *a[3], *o, *vec, *orig_port;
  Scheme_Output_Port *op;
  Scheme_Object *recur_write, *recur_display;
  PrintParams *pp;

  v = scheme_is_writable_struct(s);

  /* In case orig_pp is on the stack: */
  pp = copy_print_params(orig_pp);

  if (pp->print_port)
    orig_port = pp->print_port;
  else
    orig_port = scheme_make_byte_string_output_port();

  o = scheme_make_redirect_output_port(orig_port);
  
  op = (Scheme_Output_Port *)o;

  vec = scheme_make_vector(6, NULL);
  SCHEME_VEC_ELS(vec)[0] = (Scheme_Object *)ht;
  SCHEME_VEC_ELS(vec)[1] = (Scheme_Object *)mt;
  SCHEME_VEC_ELS(vec)[2] = (Scheme_Object *)pp;
  SCHEME_VEC_ELS(vec)[3] = scheme_true;
  SCHEME_VEC_ELS(vec)[4] = (pp->print_port ? NULL : orig_port);
  SCHEME_VEC_ELS(vec)[5] = o;

  recur_write = scheme_make_closed_prim_w_arity(custom_write_recur,
                                          vec,
                                          "custom-write-recur-handler",
                                          2, 2);
  recur_display = scheme_make_closed_prim_w_arity(custom_display_recur,
                                            vec,
                                            "custom-display-recur-handler",
                                            2, 2);


  op->write_handler = recur_write;
  op->display_handler = recur_display;
  op->print_handler = recur_write;

  /* First, flush print cache to actual port,
     so further writes go after current writes: */
  if (pp->print_port)
    print_this_string(pp, NULL, 0, 0);

  a[0] = s;
  a[1] = o;
  a[2] = (notdisplay ? scheme_true : scheme_false);
  scheme_apply_multi(v, 3, a);

  scheme_close_output_port(o);

  memcpy(orig_pp, pp, sizeof(PrintParams));

  SCHEME_VEC_ELS(vec)[3] = NULL;

  /* This must go last, because it might escape: */
  if (!orig_pp->print_port)
    flush_from_byte_port(SCHEME_VEC_ELS(vec)[4], orig_pp);
}

Here is the call graph for this function:

static void do_handled_print ( Scheme_Object obj,
Scheme_Object port,
Scheme_Object proc,
long  maxl 
) [static]

Definition at line 215 of file print.c.

{
  Scheme_Object *a[2];

  a[0] = obj;
  
  if (maxl > 0) {
    a[1] = scheme_make_byte_string_output_port();
  } else
    a[1] = port;
  
  scheme_apply_multi(scheme_write_proc, 2, a);
  
  if (maxl > 0) {
    char *s;
    long len;

    s = scheme_get_sized_byte_string_output(a[1], &len);
    if (len > maxl)
      len = maxl;

    scheme_write_byte_string(s, len, port);
  }
}

Here is the caller graph for this function:

static void do_print_string ( int  compact,
int  notdisplay,
Scheme_Print_Params pp,
const mzchar s,
int  offset,
int  l 
) [static]

Definition at line 1046 of file print.c.

{
  int el, reset;
  char *buf;

  el = l * MAX_UTF8_CHAR_BYTES;
  if (el <= QUICK_ENCODE_BUFFER_SIZE) {
    if (quick_encode_buffer) {
      buf = quick_encode_buffer;
      quick_encode_buffer = NULL;
    } else
      buf = (char *)scheme_malloc_atomic(QUICK_ENCODE_BUFFER_SIZE);
    reset = 1;
  } else {
    buf = (char *)scheme_malloc_atomic(el);
    reset = 0;
  }

  el = scheme_utf8_encode(s, offset, offset + l, (unsigned char *)buf, 0, 0);

  if (compact) {
    print_compact(pp, CPT_CHAR_STRING);
    print_compact_number(pp, el);
    print_compact_number(pp, l);
    print_this_string(pp, buf, 0, el);
  } else {
    print_char_string(buf, el, s, offset, l, notdisplay, 0, pp);
  }

  if (reset)
    quick_encode_buffer = buf;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void flush_from_byte_port ( Scheme_Object orig_port,
PrintParams pp 
) [static]

Definition at line 3323 of file print.c.

{
  char *bytes;
  long len;
  bytes = scheme_get_sized_byte_string_output(orig_port, &len);
  print_this_string(pp, bytes, 0, len);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object* get_symtab_idx ( Scheme_Marshal_Tables mt,
Scheme_Object obj 
) [static]

Definition at line 1276 of file print.c.

{
  Scheme_Object *idx;

  idx = scheme_hash_get(mt->symtab, obj);

  if (idx) {
    if (!mt->pass) {
      /* Record that we're referencing it */
      scheme_hash_set(mt->st_refs, obj, idx);
    }
  } else {
    if (mt->pass && mt->print_now) {
      idx = scheme_hash_get(mt->st_refs, obj);
      if (idx) {
        idx = scheme_hash_get(mt->key_map, idx);
        if (SCHEME_INT_VAL(idx) != mt->print_now)
          return idx; /* due to a cycle, we're refering to
                         something before it is printed. */
        idx = NULL; /* ok to print */
      }
    }
  }

  return idx;
}

Here is the caller graph for this function:

static int print ( Scheme_Object obj,
int  notdisplay,
int  compact,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams p 
) [static]
static void print_byte_string ( const char *  s,
int  delta,
int  l,
int  notdisplay,
PrintParams pp 
) [static]

Definition at line 2911 of file print.c.

{
  char minibuf[8], *esc;
  int a, i, v;

  if (notdisplay) {
    print_utf8_string(pp, "\"", 0, 1);

    for (a = i = delta; i < delta + len; i++) {
      /* Escape-sequence handling by Eli Barzilay. */
      switch (((unsigned char *)str)[i]) {
      case '\"': esc = "\\\""; break;
      case '\\': esc = "\\\\"; break;
      case '\a': esc = "\\a";  break;
      case '\b': esc = "\\b";  break;
      case 27: esc = "\\e";  break;
      case '\f': esc = "\\f";  break;
      case '\n': esc = "\\n";  break;
      case '\r': esc = "\\r";  break;
      case '\t': esc = "\\t";  break;
      case '\v': esc = "\\v";  break;
      default:
       v = ((unsigned char *)str)[i];
       if (v > 127) {
         esc = minibuf;
       } else if (scheme_isgraphic(v) || scheme_isblank(v)) {
         esc = NULL;
       } else {
         esc = minibuf;
       }
       break;
      }

      if (esc) {
       if (esc == minibuf) {
         sprintf(minibuf,
                  ((i+1>=len) || (str[i+1] < '0') || (str[i+1] > '7')) ? "\\%o" : "\\%03o",
                  ((unsigned char *)str)[i]);
       }

        if (a < i)
         print_utf8_string(pp, str, a, i-a);
        print_utf8_string(pp, esc, 0, -1);
        a = i+1;
      }
    }
    if (a < i)
      print_utf8_string(pp, str, a, i-a);

    print_utf8_string(pp, "\"", 0, 1);
  } else if (len) {
    print_this_string(pp, str, delta, len);
  }
}

Here is the call graph for this function:

static void print_char ( Scheme_Object chobj,
int  notdisplay,
PrintParams pp 
) [static]

Definition at line 3171 of file print.c.

{
  int ch;
  char minibuf[10+MAX_UTF8_CHAR_BYTES], *str;
  int len = -1;

  ch = SCHEME_CHAR_VAL(charobj);
  if (notdisplay) {
    switch ( ch )
      {
      case '\0':
       str = "#\\nul";
       break;
      case '\n':
       str = "#\\newline";
       break;
      case '\t':
       str = "#\\tab";
       break;
      case 0xb:
       str = "#\\vtab";
       break;
      case ' ':
       str = "#\\space";
       break;
      case '\r':
       str = "#\\return";
       break;
      case '\f':
       str = "#\\page";
       break;
      case '\b':
       str = "#\\backspace";
       break;
      case 0x7f:
       str = "#\\rubout";
       break;
      default:
       if (scheme_isgraphic(ch)) {
         minibuf[0] = '#';
         minibuf[1] = '\\';
         ch = scheme_utf8_encode((unsigned int *)&ch, 0, 1,
                              (unsigned char *)minibuf, 2,
                              0);
         minibuf[2 + ch] = 0;
       } else {
         if (ch > 0xFFFF)
           sprintf(minibuf, "#\\U%.8X", ch);
         else
           sprintf(minibuf, "#\\u%.4X", ch);
       }
       str = minibuf;
       break;
      }
  } else {
    len = scheme_utf8_encode((unsigned int *)&ch, 0, 1,
                          (unsigned char *)minibuf, 0,
                          0);
    minibuf[len] = 0;
    str = minibuf;
  }

  print_utf8_string(pp, str, 0, len);
}

Here is the call graph for this function:

static void print_char_string ( const char *  s,
int  l,
const mzchar us,
int  delta,
int  ul,
int  notdisplay,
int  honu_char,
PrintParams pp 
) [static]

Definition at line 2824 of file print.c.

{
  char minibuf[12], *esc;
  int a, i, v, ui, cont_utf8 = 0, isize;

  if (notdisplay) {
    print_utf8_string(pp, honu_char ? "'" : "\"", 0, 1);

    for (a = i = ui = 0; i < len; i += isize, ui++) {
      v = ((unsigned char *)str)[i];
      isize = 1;

      switch (v) {
      case '\"': 
       if (honu_char)
         esc = NULL;
       else
         esc = "\\\""; 
       break;
      case '\'': 
       if (honu_char)
         esc = "\\'"; 
       else
         esc = NULL;
       break;
      case '\\': esc = "\\\\"; break;
      case '\a': esc = "\\a";  break;
      case '\b': esc = "\\b";  break;
      case 27: esc = "\\e";  break;
      case '\f': esc = "\\f";  break;
      case '\n': esc = "\\n";  break;
      case '\r': esc = "\\r";  break;
      case '\t': esc = "\\t";  break;
      case '\v': esc = "\\v";  break;
      default:
       if (v > 127) {
         if (cont_utf8) {
           cont_utf8--;
           ui--;
           esc = NULL;
         } else {
           int clen;
           clen = scheme_utf8_encode(ustr, ui+delta, ui+delta+1, NULL, 0, 0);
           if (scheme_isgraphic(ustr[ui+delta])
              || scheme_isblank(ustr[ui+delta])) {
             cont_utf8 = clen - 1;
             esc = NULL;
           } else {
             esc = minibuf;
             isize = clen;
           }
         }
       } else if (scheme_isgraphic(v)
                 || scheme_isblank(v)) {
         esc = NULL;
       } else {
         esc = minibuf;
       }
       break;
      }

      if (esc) {
       if (esc == minibuf) {
         if (ustr[ui+delta] > 0xFFFF) {
           sprintf(minibuf, "\\U%.8X", ustr[ui+delta]);
         } else
           sprintf(minibuf, "\\u%.4X", ustr[ui+delta]);
       }

        if (a < i)
         print_utf8_string(pp, str, a, i-a);
        print_utf8_string(pp, esc, 0, -1);
        a = i+isize;
      }
    }
    if (a < i)
      print_utf8_string(pp, str, a, i-a);

    print_utf8_string(pp, honu_char ? "'" : "\"", 0, 1);
  } else if (len) {
    print_utf8_string(pp, str, 0, len);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_compact_number ( PrintParams pp,
long  n 
) [static]

Definition at line 1016 of file print.c.

{
  unsigned char s[2];

  if (n < 0) {
    if (n > -32) {
      s[0] = (unsigned char)(0xC0 | (-n));
      print_this_string(pp, (char *)s, 0, 1);
      return;
    } else {
      n = -n;
      s[0] = 0xE0;
    }
  } else if (n < 128) {
    s[0] = (unsigned char)n;
    print_this_string(pp, (char *)s, 0, 1);
    return;
  } else if (n < 0x4000) {
    s[0] = (unsigned char)(0x80 | (n & 0x3F));
    s[1] = (unsigned char)((n >> 6) & 0xFF);
    print_this_string(pp, (char *)s, 0, 2);
    return;
  } else {
    s[0] = 0xF0;
  }

  print_this_string(pp, (char *)s, 0, 1);
  print_number(pp, n);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_escaped ( PrintParams pp,
int  notdisplay,
Scheme_Object obj,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
int  shared 
) [static]

Definition at line 1427 of file print.c.

{
  char *r;
  long len;
  Scheme_Object *idx;

  if (shared) {
    idx = get_symtab_idx(mt, obj);
    if (idx) {
      print_symtab_ref(pp, idx);
      return;
    }
  }

  print_substring(obj, notdisplay, 0, ht, NULL, pp, &r, &len, 0, NULL);

  print_compact(pp, CPT_ESCAPE);
  print_compact_number(pp, len);
  print_this_string(pp, r, 0, len);

  if (mt) {
    symtab_set(pp, mt, obj);
  }
}

Here is the call graph for this function:

static void print_general_symtab_ref ( PrintParams pp,
Scheme_Object idx,
int  cpt_id 
) [static]

Definition at line 1308 of file print.c.

{
  int l;
  print_compact(pp, cpt_id);
  l = SCHEME_INT_VAL(idx);
  print_compact_number(pp, l);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_named ( Scheme_Object obj,
const char *  kind,
const char *  s,
int  len,
PrintParams pp 
) [static]

Definition at line 1478 of file print.c.

{
  print_utf8_string(pp, "#<", 0, 2);
  print_utf8_string(pp, kind, 0, -1);

  if (s) {
    print_utf8_string(pp, ":", 0, 1);

    print_utf8_string(pp, s, 0, len);
  }
   
  PRINTADDRESS(pp, obj);
  print_utf8_string(pp, ">", 0, 1);
}

Here is the call graph for this function:

static void print_number ( PrintParams pp,
long  n 
) [static]

Definition at line 985 of file print.c.

{
  unsigned char s[4];

  s[0] = (unsigned char)(n & 0xFF);
  s[1] = (unsigned char)((n >> 8) & 0xFF);
  s[2] = (unsigned char)((n >> 16) & 0xFF);
  s[3] = (unsigned char)((n >> 24) & 0xFF);  
  
  print_this_string(pp, (char *)s, 0, 4);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_one_byte ( PrintParams pp,
int  n 
) [static]

Definition at line 1007 of file print.c.

{
  unsigned char s[1];

  s[0] = n;
  
  print_this_string(pp, (char *)s, 0, 1);
}

Here is the call graph for this function:

static void print_pair ( Scheme_Object pair,
int  notdisplay,
int  compact,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams pp,
Scheme_Type  type,
int  round_parens 
) [static]

Definition at line 2968 of file print.c.

{
  Scheme_Object *cdr;
  int super_compact = 0;

  if (compact) {
    int c = 0;
    Scheme_Object *pr;

    pr = pair;
    while (SAME_TYPE(SCHEME_TYPE(pr), pair_type)) {
      if (ht)
       if ((long)scheme_hash_get(ht, pr) != 1) {
         c = -1;
         break;
       }
      c++;
      pr = SCHEME_CDR(pr);
    }

    if (c > -1) {
      super_compact = 1;
      if (c < CPT_RANGE(SMALL_LIST)) {
       unsigned char s[1];
       s[0] = c + (SCHEME_NULLP(pr) 
                  ? CPT_SMALL_PROPER_LIST_START
                  : CPT_SMALL_LIST_START);
       print_this_string(pp, (char *)s, 0, 1);
      } else {
       print_compact(pp, CPT_LIST);
       print_compact_number(pp, c);
       super_compact = -1;
      }
    }
  } else if (pp->honu_mode) {
    /* Honu list printing */
    cdr = SCHEME_CDR(pair);
    while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
      if (ht) {
       if ((long)scheme_hash_get(ht, cdr) != 1) {
         /* This needs a tag */
         break;
       }
      }
      cdr = SCHEME_CDR(cdr);
    }
    if (SCHEME_NULLP(cdr)) {
      /* Proper list without sharing. */
      print_utf8_string(pp, "list(", 0, 5);
      (void)print(SCHEME_CAR(pair), notdisplay, compact, ht, mt, pp);
      cdr = SCHEME_CDR(pair);
      while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
       print_utf8_string(pp, ", ", 0, 2);
       (void)print(SCHEME_CAR(cdr), notdisplay, compact, ht, mt, pp);
       cdr = SCHEME_CDR(cdr);
      }
      print_utf8_string(pp, ")", 0, 1);
    } else {
      /* Use cons cells. */
      int cnt = 1;
      print_utf8_string(pp, "cons(", 0, 5);
      (void)print(SCHEME_CAR(pair), notdisplay, compact, ht, mt, pp);
      cdr = SCHEME_CDR(pair);
      while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
       print_utf8_string(pp, ", ", 0, 2);
       if (ht) {
         if ((long)scheme_hash_get(ht, cdr) != 1) {
           /* This needs a tag */
           (void)print(cdr, notdisplay, compact, ht, mt, pp);
           break;
         }
       }
        
       print_utf8_string(pp, "cons(", 0, 5);
       (void)print(SCHEME_CAR(cdr), notdisplay, compact, ht, mt, pp);
       cnt++;
       cdr = SCHEME_CDR(cdr);
      }
      print_utf8_string(pp, ", ", 0, 2);
      (void)print(cdr, notdisplay, compact, ht, mt, pp);
      while (cnt--) {
       print_utf8_string(pp, ")", 0, 1);
      }
    }
    return;
  }

  if (compact) {
    if (!super_compact)
      print_compact(pp, CPT_PAIR);
  } else {
    if (round_parens)
      print_utf8_string(pp,"(", 0, 1);
    else
      print_utf8_string(pp,"{", 0, 1);
  }

  print(SCHEME_CAR(pair), notdisplay, compact, ht, mt, pp);

  cdr = SCHEME_CDR (pair);
  while (SAME_TYPE(SCHEME_TYPE(cdr), pair_type)) {
    if (ht && !super_compact) {
      if ((long)scheme_hash_get(ht, cdr) != 1) {
       /* This needs a tag */
       if (!compact)
         print_utf8_string(pp, " . ", 0, 3);
       (void)print(cdr, notdisplay, compact, ht, mt, pp);
       if (!compact) {
          if (round_parens)
            print_utf8_string(pp, ")", 0, 1);
          else
            print_utf8_string(pp, "}", 0, 1);
        }
       return;
      }
    }
    if (compact && !super_compact)
      print_compact(pp, CPT_PAIR);
    if (!compact)
      print_utf8_string(pp, " ", 0, 1);
    print(SCHEME_CAR(cdr), notdisplay, compact, ht, mt, pp);
    cdr = SCHEME_CDR(cdr);
  }

  if (!SCHEME_NULLP(cdr)) {
    if (!compact)
      print_utf8_string(pp, " . ", 0, 3);
    print(cdr, notdisplay, compact, ht, mt, pp);
  } else if (compact && (super_compact < 1))
    print_compact(pp, CPT_NULL);

  if (!compact) {
    if (round_parens)
      print_utf8_string(pp, ")", 0, 1);
    else
      print_utf8_string(pp, "}", 0, 1);
  }
}

Here is the call graph for this function:

static void print_short_number ( PrintParams pp,
long  n 
) [static]

Definition at line 997 of file print.c.

{
  unsigned char s[2];

  s[0] = (unsigned char)(n & 0xFF);
  s[1] = (unsigned char)((n >> 8) & 0xFF);
  
  print_this_string(pp, (char *)s, 0, 2);
}

Here is the call graph for this function:

static void print_string_in_angle ( PrintParams pp,
const char *  start,
const char *  prefix,
int  slen 
) [static]

Definition at line 1085 of file print.c.

{
  /* Used to do something special for type symbols. No more. */
  print_utf8_string(pp, prefix, 0, -1);
  print_utf8_string(pp, start, 0, slen);
}

Here is the call graph for this function:

static int print_substring ( Scheme_Object obj,
int  notdisplay,
int  compact,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams pp,
char **  result,
long *  rlen,
int  print_keys,
long *  klen 
) [static]

Definition at line 1219 of file print.c.

{
  int closed;
  long save_alloc, save_pos, save_off, save_maxl;
  char *save_buf;
  Scheme_Object *save_port;

  save_alloc = pp->print_allocated;
  save_buf = pp->print_buffer;
  save_pos = pp->print_position;
  save_off = pp->print_offset;
  save_maxl = pp->print_maxlen;
  save_port = pp->print_port;
  
  /* If result is NULL, just measure the output. */
  if (result) {
    char *ca;
    pp->print_allocated = 50;
    ca = (char *)scheme_malloc_atomic(pp->print_allocated);
    pp->print_buffer = ca;
  } else {
    pp->print_allocated = 0;
    pp->print_buffer = NULL;
  }
  pp->print_position = 0;
  pp->print_offset = 0;
  pp->print_port = NULL;

  if (print_keys < 0) {
    print_table_keys(notdisplay, compact, ht, mt, pp);
    *klen = pp->print_offset;
  }

  closed = print(obj, notdisplay, compact, ht, mt, pp);
  
  if (print_keys > 0) {
    print_table_keys(notdisplay, compact, ht, mt, pp);
    *klen = pp->print_offset;
  }

  if (result)
    *result = pp->print_buffer;
  *rlen = pp->print_position;

  pp->print_allocated = save_alloc;
  pp->print_buffer = save_buf;
  pp->print_position = save_pos;
  pp->print_offset = save_off;
  pp->print_maxlen = save_maxl;
  pp->print_port = save_port;
  
  return closed;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_symtab_ref ( PrintParams pp,
Scheme_Object idx 
) [static]

Definition at line 1316 of file print.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_symtab_set ( PrintParams pp,
Scheme_Marshal_Tables mt,
Scheme_Object obj 
) [static]

Definition at line 1354 of file print.c.

{
  int l;
  l = add_symtab(mt, obj);
  print_compact_number(pp, l);
}

Here is the call graph for this function:

static void print_table_keys ( int  notdisplay,
int  compact,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams pp 
) [static]

Definition at line 1191 of file print.c.

{
  long j, size, offset;
  Scheme_Object **keys, *key, *obj;

  size = mt->sorted_keys_count;
  keys = mt->sorted_keys;

  for (j = 0; j < size; j++) {
    offset = pp->print_offset;
    mt->shared_offsets[j] = offset;
    key = keys[j << 1];
    if (mt->rn_saved) {
      obj = scheme_hash_get(mt->rn_saved, key);
    } else {
      obj = NULL;
    }
    if (!obj)
      obj = key;
    mt->print_now = j + 1;
    print(obj ? obj : key, notdisplay, compact, ht, mt, pp);
    mt->print_now = 0;
  }
}

Here is the caller graph for this function:

static void print_this_string ( PrintParams pp,
const char *  str,
int  offset,
int  autolen 
) [static]

Definition at line 899 of file print.c.

{
  long len;
  char *oldstr;

  if (!autolen) {
    if (!str)
      len = 0;
    else
      return;
  } else if (autolen > 0)
    len = autolen;
  else
    len = strlen(str XFORM_OK_PLUS offset);

  if (!pp->print_buffer) {
    /* Just getting the length */
    pp->print_position += len;
    pp->print_offset += len;
    return;
  }

  if (len + pp->print_position + 1 > pp->print_allocated) {
    if (len + 1 >= pp->print_allocated)
      pp->print_allocated = 2 * pp->print_allocated + len + 1;
    else
      pp->print_allocated = 2 * pp->print_allocated;

    oldstr = pp->print_buffer;
    {
      char *ca;
      ca = (char *)scheme_malloc_atomic(pp->print_allocated);
      pp->print_buffer = ca;
    }
    memcpy(pp->print_buffer, oldstr, pp->print_position);
  }

  memcpy(pp->print_buffer + pp->print_position, str + offset, len);
  pp->print_position += len;
  pp->print_offset += len;

  /* ----------- Do not use str after this point --------------- */
  /*  It might be quick_buffer, and another thread might try to  */
  /*  use the buffer.                                            */

  SCHEME_USE_FUEL(len);
  
  if (pp->print_maxlen > PRINT_MAXLEN_MIN) {
    if (pp->print_position > pp->print_maxlen) {
      long l = pp->print_maxlen;

      pp->print_buffer[l] = 0;
      pp->print_buffer[l - 1] = '.';
      pp->print_buffer[l - 2] = '.';
      pp->print_buffer[l - 3] = '.';

      pp->print_position = l;

      scheme_longjmp(*pp->print_escape, 1);
    }
  } else if ((pp->print_position > MAX_PRINT_BUFFER) || !str) {
    if (pp->print_port) {
      pp->print_buffer[pp->print_position] = 0;
      scheme_write_byte_string(pp->print_buffer, pp->print_position, pp->print_port);
      
      pp->print_position = 0;
    }
  }
}

Here is the caller graph for this function:

static void print_to_port ( char *  name,
Scheme_Object obj,
Scheme_Object port,
int  notdisplay,
long  maxl,
int  check_honu 
) [static]

Definition at line 884 of file print.c.

{
  Scheme_Output_Port *op;
  char *str;
  long len;
  
  op = scheme_output_port_record(port);
  if (op->closed)
    scheme_raise_exn(MZEXN_FAIL, "%s: output port is closed", name);

  str = print_to_string(obj, &len, notdisplay, port, maxl, check_honu);

  scheme_write_byte_string(str, len, port);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void* print_to_port_k ( void  ) [static]

Definition at line 200 of file print.c.

{
  Scheme_Thread *p = scheme_current_thread;
  Scheme_Object *obj, *port;

  port = (Scheme_Object *)p->ku.k.p1;
  obj = (Scheme_Object *)p->ku.k.p2;

  print_to_port(p->ku.k.i2 ? "write" : "display", 
              obj, port,
              p->ku.k.i2, p->ku.k.i1, p->ku.k.i3);

  return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static char * print_to_string ( Scheme_Object obj,
long *volatile  len,
int  write,
Scheme_Object port,
long  maxl,
int  check_honu 
) [static]

Definition at line 769 of file print.c.

{
  Scheme_Hash_Table * volatile ht;
  Scheme_Object *v;
  char *ca;
  int cycles;
  Scheme_Config *config;
  mz_jmp_buf escape;
  volatile PrintParams params;

  params.print_allocated = 50;
  ca = (char *)scheme_malloc_atomic(params.print_allocated);
  params.print_buffer = ca;
  params.print_position = 0;
  params.print_offset = 0;
  params.print_maxlen = maxl;
  params.print_port = port;

  /* Getting print params can take a while, and they're irrelevant
     for simple things like displaying numbers. So try a shortcut: */
  if (!write
      && (SCHEME_NUMBERP(obj)
         || SCHEME_BYTE_STRINGP(obj)
         || SCHEME_CHAR_STRINGP(obj)
         || SCHEME_SYMBOLP(obj))) {
    params.print_graph = 0;
    params.print_box = 0;
    params.print_struct = 0;
    params.print_vec_shorthand = 0;
    params.print_hash_table = 0;
    params.print_unreadable = 1;
    params.print_pair_curly = 0;
    params.print_mpair_curly = 1;
    params.can_read_pipe_quote = 1;
    params.case_sens = 1;
    params.honu_mode = 0;
    params.inspector = scheme_false;
  } else {
    config = scheme_current_config();

    v = scheme_get_param(config, MZCONFIG_PRINT_GRAPH);
    params.print_graph = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_PRINT_BOX);
    params.print_box = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_PRINT_STRUCT);
    params.print_struct = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_PRINT_VEC_SHORTHAND);
    params.print_vec_shorthand = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_PRINT_HASH_TABLE);
    params.print_hash_table = SCHEME_TRUEP(v);
    if (write) {
      if (maxl > 0)
       params.print_unreadable = 1;
      else {
       v = scheme_get_param(config, MZCONFIG_PRINT_UNREADABLE);
       params.print_unreadable = SCHEME_TRUEP(v);
      }
    } else
      params.print_unreadable = 1;
    v = scheme_get_param(config, MZCONFIG_PRINT_PAIR_CURLY);
    params.print_pair_curly = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_PRINT_MPAIR_CURLY);
    params.print_mpair_curly = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_CAN_READ_PIPE_QUOTE);
    params.can_read_pipe_quote = SCHEME_TRUEP(v);
    v = scheme_get_param(config, MZCONFIG_CASE_SENS);
    params.case_sens = SCHEME_TRUEP(v);
    if (check_honu) {
      v = scheme_get_param(config, MZCONFIG_HONU_MODE);
      params.honu_mode = SCHEME_TRUEP(v);
    } else
      params.honu_mode = 0;
    v = scheme_get_param(config, MZCONFIG_INSPECTOR);
    params.inspector = v;
  }

  if (params.print_graph)
    cycles = 1;
  else {
    int fast_checker_counter = 50;
    cycles = check_cycles_fast(obj, (PrintParams *)&params, &fast_checker_counter);
    if (cycles == -1) {
      ht = scheme_make_hash_table(SCHEME_hash_ptr);
      cycles = check_cycles(obj, write, ht, (PrintParams *)&params);
    }
  }

  if (cycles)
    ht = setup_datum_graph(obj, write, (PrintParams *)&params);
  else
    ht = NULL;

  if (maxl > 0)
    params.print_escape = &escape;
  else
    params.print_escape = NULL;

  if ((maxl <= PRINT_MAXLEN_MIN) 
      || !scheme_setjmp(escape))
    print(obj, write, 0, ht, NULL, (PrintParams *)&params);

  params.print_buffer[params.print_position] = '\0';

  if (len)
    *len = params.print_position;

  params.inspector = NULL;

  return params.print_buffer;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void* print_to_string_k ( void  ) [static]

Definition at line 307 of file print.c.

{
  Scheme_Thread *p = scheme_current_thread;
  Scheme_Object *obj;
  long *len, maxl;
  int iswrite, check_honu;

  obj = (Scheme_Object *)p->ku.k.p1;
  len = (long *) mzALIAS p->ku.k.p2;
  maxl = p->ku.k.i1;
  iswrite = p->ku.k.i2;
  check_honu = p->ku.k.i3;

  p->ku.k.p1 = NULL;
  p->ku.k.p2 = NULL;

  return (void *)print_to_string(obj, len, iswrite, NULL, maxl, check_honu);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_utf8_string ( PrintParams pp,
const char *  str,
int  offset,
int  autolen 
) [static]

Definition at line 970 of file print.c.

{
  print_this_string(pp, str, offset, autolen);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void print_vector ( Scheme_Object vec,
int  notdisplay,
int  compact,
Scheme_Hash_Table ht,
Scheme_Marshal_Tables mt,
PrintParams pp,
int  as_prefab 
) [static]

Definition at line 3112 of file print.c.

{
  int i, size, common = 0;
  Scheme_Object **elems;

  size = SCHEME_VEC_SIZE(vec);

  if (compact) {
    print_compact(pp, CPT_VECTOR);
    print_compact_number(pp, size);
  } else {
    elems = SCHEME_VEC_ELS(vec);
    for (i = size; i--; common++) {
      if (!i || (elems[i] != elems[i - 1]))
       break;
    }
    elems = NULL; /* Precise GC: because VEC_ELS is not aligned */
    
    if (as_prefab) {
      print_utf8_string(pp, "#s(", 0, 3);
    } else if (notdisplay && pp->print_vec_shorthand) {
      if (size == 0) {
       if (pp->honu_mode)
         print_utf8_string(pp, "vectorN(0", 0, 7);
       else
         print_utf8_string(pp, "#0(", 0, 3);
      } else {
       char buffer[100];
       sprintf(buffer, pp->honu_mode ? "vectorN(%d, " : "#%d(", size);
       print_utf8_string(pp, buffer, 0, -1);
       size -= common;
      }
    } else if (pp->honu_mode)
      print_utf8_string(pp, "vector(", 0, 7);
    else
      print_utf8_string(pp, "#(", 0, 2);
  }

  for (i = 0; i < size; i++) {
    print(SCHEME_VEC_ELS(vec)[i], notdisplay, compact, ht, mt, pp);
    if (i < (size - 1)) {
      if (!compact) {
       if (pp->honu_mode)
         print_utf8_string(pp, ", ", 0, 2);
       else
         print_utf8_string(pp, " ", 0, 1);
      }
    }
  }

  if (!compact)
    print_utf8_string(pp, ")", 0, 1);
}

Here is the call graph for this function:

Definition at line 194 of file print.c.

{
  scheme_write(obj, scheme_orig_stdout_port);
  fflush (stdout);
}

Definition at line 280 of file print.c.

{
  scheme_display_w_max(obj, port, -1);
}
char* scheme_display_to_string ( Scheme_Object obj,
long *  len 
)

Definition at line 357 of file print.c.

{
  return scheme_display_to_string_w_max(obj, len, -1);
}
char* scheme_display_to_string_w_max ( Scheme_Object obj,
long *  len,
long  maxl 
)

Definition at line 344 of file print.c.

{
  Scheme_Thread *p = scheme_current_thread;

  p->ku.k.p1 = obj;
  p->ku.k.p2 = len;
  p->ku.k.i1 = maxl;
  p->ku.k.i2 = 0;
  p->ku.k.i3 = 0;

  return (char *)scheme_top_level_do(print_to_string_k, 0);
}

Here is the call graph for this function:

void scheme_display_w_max ( Scheme_Object obj,
Scheme_Object port,
long  maxl 
)

Definition at line 263 of file print.c.

{
  if (((Scheme_Output_Port *)port)->display_handler)
    do_handled_print(obj, port, scheme_display_proc, maxl);
  else {
    Scheme_Thread *p = scheme_current_thread;
    
    p->ku.k.p1 = port;
    p->ku.k.p2 = obj;
    p->ku.k.i1 = maxl;
    p->ku.k.i2 = 0;
    p->ku.k.i3 = 0;
    
    (void)scheme_top_level_do(print_to_port_k, 0);
  }
}

Here is the call graph for this function:

Definition at line 140 of file print.c.

{
  int i;


  REGISTER_SO(quote_link_symbol);
  
  quote_link_symbol = scheme_intern_symbol("-q");
  
  for (i = 0; i < _CPT_COUNT_; i++) {
    compacts[i] = i;
  }

#ifdef MZ_PRECISE_GC
  register_traversers();
#endif

  REGISTER_SO(cache_ht);
}

Here is the caller graph for this function:

Definition at line 160 of file print.c.

Here is the caller graph for this function:

Definition at line 387 of file print.c.

{
  print_to_port("display", obj, port, 0, -1, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 393 of file print.c.

{
  print_to_port("print", obj, port, 1, -1, 1);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 381 of file print.c.

{
  print_to_port("write", obj, port, 1, -1, 0);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 169 of file print.c.

Here is the caller graph for this function:

Definition at line 1382 of file print.c.

{
  return get_symtab_idx(mt, obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1406 of file print.c.

{
  Scheme_Hash_Table *st_refs = mt->st_refs;

  mt->st_refs = (Scheme_Hash_Table *)SCHEME_CAR(mt->st_ref_stack);
  mt->st_ref_stack = SCHEME_CDR(mt->st_ref_stack);
  
  if (keep) {
    if (!mt->st_refs->count)
      mt->st_refs = st_refs;
    else {
      long i;
      for (i = 0; i < st_refs->size; i++) {
        if (st_refs->vals[i]) {
          scheme_hash_set(mt->st_refs, st_refs->keys[i], st_refs->vals[i]);
        }
      }
    }
  }
}

Here is the caller graph for this function:

Definition at line 1392 of file print.c.

Here is the caller graph for this function:

Definition at line 1387 of file print.c.

{
  set_symtab_shared(mt, obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1361 of file print.c.

{
  int l;
  l = add_symtab(mt, obj);
  if (l) {
    if (!mt->rn_saved) {
      Scheme_Hash_Table *rn_saved;
      rn_saved = scheme_make_hash_table(SCHEME_hash_ptr);
      mt->rn_saved = rn_saved;
    }
    if (mt->pass >= 2) {
      /* Done already */
    } else
      scheme_hash_set(mt->rn_saved, obj, val);

    if (mt->pass)
      return scheme_make_integer(l);
  }
  return val;
}

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_print ( Scheme_Object obj,
Scheme_Object port 
)

Definition at line 302 of file print.c.

{
  scheme_print_w_max(obj, port, -1);
}
void scheme_print_bytes ( Scheme_Print_Params pp,
const char *  str,
int  offset,
int  len 
)

Definition at line 975 of file print.c.

{
  print_this_string(pp, str, offset, len);
}

Here is the call graph for this function:

void scheme_print_string ( Scheme_Print_Params pp,
const mzchar s,
int  offset,
int  l 
)

Definition at line 1080 of file print.c.

{
  do_print_string(0, 0, pp, s, offset, l);
}

Here is the call graph for this function:

char* scheme_print_to_string ( Scheme_Object obj,
long *  len 
)

Definition at line 375 of file print.c.

{
  return scheme_print_to_string_w_max(obj, len, -1);
}
char* scheme_print_to_string_w_max ( Scheme_Object obj,
long *  len,
long  maxl 
)

Definition at line 362 of file print.c.

{
  Scheme_Thread *p = scheme_current_thread;

  p->ku.k.p1 = obj;
  p->ku.k.p2 = len;
  p->ku.k.i1 = maxl;
  p->ku.k.i2 = 1;
  p->ku.k.i3 = 1;

  return (char *)scheme_top_level_do(print_to_string_k, 0);
}

Here is the call graph for this function:

void scheme_print_utf8 ( Scheme_Print_Params pp,
const char *  str,
int  offset,
int  len 
)

Definition at line 980 of file print.c.

{
  print_utf8_string(pp, str, offset, len);
}

Here is the call graph for this function:

void scheme_print_w_max ( Scheme_Object obj,
Scheme_Object port,
long  maxl 
)

Definition at line 285 of file print.c.

{
  if (((Scheme_Output_Port *)port)->print_handler)
    do_handled_print(obj, port, scheme_print_proc, maxl);
  else {
    Scheme_Thread *p = scheme_current_thread;
    
    p->ku.k.p1 = port;
    p->ku.k.p2 = obj;
    p->ku.k.i1 = maxl;
    p->ku.k.i2 = 1;
    p->ku.k.i3 = 1;
    
    (void)scheme_top_level_do(print_to_port_k, 0);
  }
}

Here is the call graph for this function:

Definition at line 3238 of file print.c.

{
  if (HAS_SUBSTRUCT(expr, ssALLp)) {
    Scheme_Object *q;
    q = scheme_alloc_small_object();
    q->type = scheme_quote_compilation_type;
    SCHEME_PTR_VAL(q) = expr;
    return q;
  } else
    return expr;
}

Here is the caller graph for this function:

Definition at line 3254 of file print.c.

{
  if (!printers) {
    REGISTER_SO(printers);
  }

  if (stype >= printers_count) {
    Scheme_Type_Printer *naya;
    naya = MALLOC_N(Scheme_Type_Printer, stype + 10);
    memset(naya, 0, sizeof(Scheme_Type_Printer) * (stype + 10));
    memcpy(naya, printers, sizeof(Scheme_Type_Printer) * printers_count);
    printers_count = stype + 10;
    printers = naya;
  }

  printers[stype] = printer;
}
void scheme_write ( Scheme_Object obj,
Scheme_Object port 
)

Definition at line 258 of file print.c.

{
  scheme_write_w_max(obj, port, -1);
}
char* scheme_write_to_string ( Scheme_Object obj,
long *  len 
)

Definition at line 339 of file print.c.

{
  return scheme_write_to_string_w_max(obj, len, -1);
}
char* scheme_write_to_string_w_max ( Scheme_Object obj,
long *  len,
long  maxl 
)

Definition at line 326 of file print.c.

{
  Scheme_Thread *p = scheme_current_thread;

  p->ku.k.p1 = obj;
  p->ku.k.p2 = len;
  p->ku.k.i1 = maxl;
  p->ku.k.i2 = 1;
  p->ku.k.i3 = 0;

  return (char *)scheme_top_level_do(print_to_string_k, 0);
}

Here is the call graph for this function:

void scheme_write_w_max ( Scheme_Object obj,
Scheme_Object port,
long  maxl 
)

Definition at line 241 of file print.c.

{
  if (((Scheme_Output_Port *)port)->write_handler)
    do_handled_print(obj, port, scheme_write_proc, maxl);
  else {
    Scheme_Thread *p = scheme_current_thread;
    
    p->ku.k.p1 = port;
    p->ku.k.p2 = obj;
    p->ku.k.i1 = maxl;
    p->ku.k.i2 = 1;
    p->ku.k.i3 = 0;
    
    (void)scheme_top_level_do(print_to_port_k, 0);
  }
}

Here is the call graph for this function:

static void set_symtab_shared ( Scheme_Marshal_Tables mt,
Scheme_Object obj 
) [static]

Definition at line 1303 of file print.c.

{
  (void)get_symtab_idx(mt, obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Hash_Table* setup_datum_graph ( Scheme_Object o,
int  for_write,
void for_print 
) [static]

Definition at line 740 of file print.c.

{
  Scheme_Hash_Table *ht;
  int counter = 1;

  if (cache_ht) {
    ht = cache_ht;
    cache_ht = NULL;
  } else
    ht = scheme_make_hash_table(SCHEME_hash_ptr);

  setup_graph_table(o, for_write, ht, &counter, (PrintParams *)for_print);

  if (counter > 1)
    return ht;
  else {
    if (ht->size < CACHE_HT_SIZE_LIMIT) {
      int i;
      for (i = 0; i < ht->size; i++) {
       ht->keys[i] = NULL;
       ht->vals[i] = NULL;
      }
      cache_ht = ht;
    }
    return NULL;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void setup_graph_table ( Scheme_Object obj,
int  for_write,
Scheme_Hash_Table ht,
int counter,
PrintParams pp 
) [static]

Definition at line 642 of file print.c.

{
  if (HAS_SUBSTRUCT(obj, ssQUICKp)) {
    Scheme_Object *v;

#ifdef DO_STACK_CHECK
    {
# include "mzstkchk.h"
      {
       if (pp)
         pp = copy_print_params(pp);
       scheme_current_thread->ku.k.p1 = (void *)obj;
       scheme_current_thread->ku.k.p2 = (void *)ht;
       scheme_current_thread->ku.k.p3 = (void *)counter;
       scheme_current_thread->ku.k.p4 = (void *)pp;
        scheme_current_thread->ku.k.i1 = for_write;
       scheme_handle_stack_overflow(setup_graph_k);
       return;
      }
    }
#endif

    v = scheme_hash_get(ht, obj);

    if (!v)
      scheme_hash_set(ht, obj, (Scheme_Object *)0x1);
    else {
      if ((long)v == 1) {
       (*counter) += 2;
       scheme_hash_set(ht, obj, (Scheme_Object *)(long)*counter);
      }
      return;
    }
  } else
    return;

  SCHEME_USE_FUEL(1);

  if (SCHEME_PAIRP(obj) || SCHEME_MUTABLE_PAIRP(obj)) {
    setup_graph_table(SCHEME_CAR(obj), for_write, ht, counter, pp);
    setup_graph_table(SCHEME_CDR(obj), for_write, ht, counter, pp);
  } else if ((!pp || pp->print_box) && SCHEME_BOXP(obj)) {
    setup_graph_table(SCHEME_BOX_VAL(obj), for_write, ht, counter, pp);
  } else if (SCHEME_VECTORP(obj)) {
    int i, len;

    len = SCHEME_VEC_SIZE(obj);
    for (i = 0; i < len; i++) {
      setup_graph_table(SCHEME_VEC_ELS(obj)[i], for_write, ht, counter, pp);
    }
  } else if (pp && SCHEME_STRUCTP(obj)) { /* got here => printable */
    if (scheme_is_writable_struct(obj)) {
      if (pp->print_unreadable) {
       obj = writable_struct_subs(obj, for_write, pp);
       setup_graph_table(obj, for_write, ht, counter, pp);
      }
    } else {
      int i = SCHEME_STRUCT_NUM_SLOTS(obj);

      while (i--) {
       if (scheme_inspector_sees_part(obj, pp->inspector, i))
         setup_graph_table(((Scheme_Structure *)obj)->slots[i], for_write, ht, counter, pp);
      }
    }
  } else if (pp && SCHEME_HASHTPx(obj)) { /* got here => printable */
    Scheme_Hash_Table *t;
    Scheme_Object **keys, **vals, *val;
    int i;
    
    t = (Scheme_Hash_Table *)obj;
    keys = t->keys;
    vals = t->vals;
    for (i = t->size; i--; ) {
      if (vals[i]) {
       val = vals[i];
       setup_graph_table(keys[i], for_write, ht, counter, pp);
       setup_graph_table(val, for_write, ht, counter, pp);
      }
    }
  } else if (SCHEME_HASHTRP(obj)) {
    /* got here => printable */
    Scheme_Hash_Tree *t = (Scheme_Hash_Tree *)obj;
    Scheme_Object *key, *val;
    int i;
    
    i = scheme_hash_tree_next(t, -1);
    while (i != -1) {
      scheme_hash_tree_index(t, i, &key, &val);
      setup_graph_table(key, for_write, ht, counter, pp);
      setup_graph_table(val, for_write, ht, counter, pp);
      i = scheme_hash_tree_next(t, i);
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void sort_referenced_keys ( Scheme_Marshal_Tables mt) [static]

Definition at line 1162 of file print.c.

{
  long j, size, pos = 0;
  Scheme_Object **keys;
  Scheme_Hash_Table *key_map;

  size = mt->st_refs->count;
  keys = MALLOC_N(Scheme_Object *, (2 * size));

  for (j = 0; j < mt->st_refs->size; j++) {
    if (mt->st_refs->vals[j]) {
      keys[pos] = mt->st_refs->keys[j];
      keys[pos + 1] = mt->st_refs->vals[j];
      pos += 2;
    }
  }

  my_qsort(keys, size, 2 * sizeof(Scheme_Object *), compare_keys);

  key_map = scheme_make_hash_table(SCHEME_hash_ptr);
  for (j = 0; j < size; j++) {
    scheme_hash_set(key_map, keys[(j << 1) + 1], scheme_make_integer(j+1));
  }
  mt->key_map = key_map;

  mt->sorted_keys = keys;
  mt->sorted_keys_count = size;
}

Here is the call graph for this function:

static void symtab_set ( PrintParams pp,
Scheme_Marshal_Tables mt,
Scheme_Object obj 
) [static]

Definition at line 1349 of file print.c.

{
  (void)add_symtab(mt, obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static Scheme_Object * writable_struct_subs ( Scheme_Object s,
int  for_write,
PrintParams pp 
) [static]

Definition at line 3287 of file print.c.

{
  Scheme_Object *v, *o, *a[3], *b, *accum_proc;
  Scheme_Output_Port *op;

  v = scheme_is_writable_struct(s);

  o = scheme_make_null_output_port(pp->print_port
                               && ((Scheme_Output_Port *)pp->print_port)->write_special_fun);

  op = (Scheme_Output_Port *)o;
  
  b = scheme_box(scheme_null);
  accum_proc = scheme_make_closed_prim_w_arity(accum_write,
                                          b,
                                          "custom-write-recur-handler",
                                          2, 2);

  op->display_handler = accum_proc;
  op->write_handler = accum_proc;
  op->print_handler = accum_proc;

  a[0] = s;
  a[1] = o;
  a[2] = (for_write ? scheme_true : scheme_false);

  scheme_apply_multi(v, 3, a);

  scheme_close_output_port(o);

  v = SCHEME_BOX_VAL(b);
  SCHEME_BOX_VAL(b) = NULL;

  return v;
}

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

Definition at line 45 of file print.c.

char compacts[_CPT_COUNT_] [static]

Definition at line 48 of file print.c.

Definition at line 49 of file print.c.

Definition at line 42 of file print.c.

int printers_count [static]

Definition at line 43 of file print.c.

THREAD_LOCAL char* quick_buffer = NULL [static]

Definition at line 38 of file print.c.

Definition at line 39 of file print.c.

Definition at line 50 of file print.c.

Definition at line 35 of file print.c.