Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Functions | Variables
salloc.c File Reference
#include "schpriv.h"
#include <string.h>
#include "schgc.h"

Go to the source code of this file.

Classes

struct  Scheme_Main_Data
struct  Finalization
struct  Finalizations

Defines

#define SCHEME_NO_GC_PROTO
#define MALLOC   malloc
#define CODE_HEADER_SIZE   16
#define LOG_CODE_MALLOC(lvl, s)   /* if (lvl > 1) s */
#define CODE_PAGE_OF(p)   ((void *)(((unsigned long)p) & ~(page_size - 1)))
#define MZ_PRECISE_GC_TRACE   0
#define flags   0
#define trace_for_tag   0
#define path_length_limit   1000
#define for_each_found   NULL
#define GC_get_xtagged_name   NULL
#define print_tagged_value   NULL

Typedefs

typedef struct Finalization Finalization
typedef void(* finalizer_function )(void *p, void *data)

Functions

MZ_DLLIMPORT void GC_register_late_disappearing_link (void **link, void *obj)
MZ_DLLIMPORT void GC_init ()
MZ_DLLIMPORT unsigned long GC_get_stack_base ()
void scheme_set_stack_base (void *base, int no_auto_statics)
void scheme_set_current_os_thread_stack_base (void *base)
unsigned long scheme_get_current_os_thread_stack_base ()
static int call_with_basic (void *data)
int scheme_main_setup (int no_auto_statics, Scheme_Env_Main _main, int argc, char **argv)
int scheme_main_stack_setup (int no_auto_statics, Scheme_Nested_Main _main, void *data)
void scheme_set_stack_bounds (void *base, void *deepest, int no_auto_statics)
unsigned long scheme_get_stack_base ()
void scheme_out_of_memory_abort ()
void scheme_set_report_out_of_memory (Scheme_Report_Out_Of_Memory_Proc p)
void scheme_dont_gc_ptr (void *p)
void scheme_gc_ptr_ok (void *p)
voidscheme_calloc (size_t num, size_t size)
char * scheme_strdup (const char *str)
char * scheme_strdup_eternal (const char *str)
Scheme_Objectscheme_make_cptr (void *cptr, Scheme_Object *typetag)
Scheme_Objectscheme_make_offset_cptr (void *cptr, long offset, Scheme_Object *typetag)
void ** scheme_malloc_immobile_box (void *p)
void scheme_free_immobile_box (void **b)
static void raise_out_of_memory (void)
voidscheme_malloc_fail_ok (void *(*f)(size_t), size_t s)
void scheme_end_stubborn_change (void *p)
voidscheme_malloc_eternal (size_t n)
void scheme_register_static (void *ptr, long size)
voidscheme_malloc_code (long size)
void scheme_free_code (void *p)
voidscheme_malloc_gcable_code (long size)
void scheme_notify_code_gc ()
void scheme_reset_finalizations (void)
static void do_next_finalization (void *o, void *data)
static void add_finalizer (void *v, void(*f)(void *, void *), void *data, int prim, int ext, void(**ext_oldf)(void *p, void *data), void **ext_olddata, int no_dup, int rmve)
void scheme_weak_reference (void **p)
void scheme_weak_reference_indirect (void **p, void *v)
void scheme_unweak_reference (void **p)
void scheme_add_finalizer (void *p, void(*f)(void *p, void *data), void *data)
void scheme_add_finalizer_once (void *p, void(*f)(void *p, void *data), void *data)
void scheme_subtract_finalizer (void *p, void(*f)(void *p, void *data), void *data)
void scheme_add_scheme_finalizer (void *p, void(*f)(void *p, void *data), void *data)
void scheme_add_scheme_finalizer_once (void *p, void(*f)(void *p, void *data), void *data)
void scheme_register_finalizer (void *p, void(*f)(void *p, void *data), void *data, void(**oldf)(void *p, void *data), void **olddata)
void scheme_remove_all_finalization (void *p)
void scheme_collect_garbage (void)
unsigned long scheme_get_deeper_address (void)
MZ_DLLIMPORT void GC_dump (void)
Scheme_Objectscheme_dump_gc_stats (int c, Scheme_Object *p[])

Variables

static void ** dgc_array
static intdgc_count
static int dgc_size
int scheme_num_copied_stacks
static unsigned long scheme_primordial_os_thread_stack_base
static THREAD_LOCAL unsigned long scheme_os_thread_stack_base
static
Scheme_Report_Out_Of_Memory_Proc 
more_report_out_of_memory
static int use_registered_statics
static Scheme_Hash_Tableimmobiles
static void(* save_oom )(void)
long scheme_code_page_total
static int current_lifetime
static THREAD_LOCAL int traversers_registered
static THREAD_LOCAL
Finalizations ** 
save_fns_ptr
void(* scheme_external_dump_info )(void)
void(* scheme_external_dump_arg )(Scheme_Object *arg)
char *(* scheme_external_dump_type )(void *v)

Class Documentation

struct Scheme_Main_Data

Definition at line 127 of file salloc.c.

Collaboration diagram for Scheme_Main_Data:
Class Members
Scheme_Env_Main _main
int argc
char ** argv

Define Documentation

#define CODE_HEADER_SIZE   16

Definition at line 593 of file salloc.c.

#define CODE_PAGE_OF (   p)    ((void *)(((unsigned long)p) & ~(page_size - 1)))

Definition at line 602 of file salloc.c.

#define flags   0
#define for_each_found   NULL
#define GC_get_xtagged_name   NULL
#define LOG_CODE_MALLOC (   lvl,
 
)    /* if (lvl > 1) s */

Definition at line 601 of file salloc.c.

#define MALLOC   malloc

Definition at line 39 of file salloc.c.

#define MZ_PRECISE_GC_TRACE   0

Definition at line 1466 of file salloc.c.

#define path_length_limit   1000
#define print_tagged_value   NULL

Definition at line 28 of file salloc.c.

#define trace_for_tag   0

Typedef Documentation

Definition at line 1041 of file salloc.c.


Function Documentation

static void add_finalizer ( void v,
void(*)(void *, void *)  f,
void data,
int  prim,
int  ext,
void(**)(void *p, void *data ext_oldf,
void **  ext_olddata,
int  no_dup,
int  rmve 
) [static]

Definition at line 1045 of file salloc.c.

{
  finalizer_function oldf;
  void *olddata;
  Finalizations *fns, **fns_ptr, *prealloced;
  Finalization *fn;

  if (!traversers_registered) {
#ifdef MZ_PRECISE_GC
    GC_REG_TRAV(scheme_rt_finalization, mark_finalization);
    GC_REG_TRAV(scheme_rt_finalizations, mark_finalizations);
    traversers_registered = 1;
#endif
    REGISTER_SO(save_fns_ptr);
  }

#ifndef MZ_PRECISE_GC
  if (v != GC_base(v))
    return;
#endif

  /* Allocate everything first so that we're not changing
     finalizations when finalizations could run: */

  if (save_fns_ptr) {
    fns_ptr = save_fns_ptr;
    save_fns_ptr = NULL;
  } else
    fns_ptr = MALLOC_ONE(Finalizations*);

  if (!ext && !rmve) {
    fn = MALLOC_ONE_RT(Finalization);
#ifdef MZTAG_REQUIRED
    fn->type = scheme_rt_finalization;
#endif
    fn->f = f;
    fn->data = data;
  } else
    fn = NULL;

  if (!rmve) {
    prealloced = MALLOC_ONE_RT(Finalizations); /* may not need this... */
#ifdef MZTAG_REQUIRED
    prealloced->type = scheme_rt_finalizations;
#endif
  } else
    prealloced = NULL;

  GC_register_eager_finalizer(v, prim ? 2 : 1, do_next_finalization, fns_ptr, &oldf, &olddata);

  if (oldf) {
    if (oldf != do_next_finalization) {
      /* This happens if an extenal use of GC_ routines conflicts with us. */
      scheme_warning("warning: non-MzScheme finalization on object dropped!");
    } else {
      *fns_ptr = *(Finalizations **)olddata;
      save_fns_ptr = (Finalizations **)olddata;
      *save_fns_ptr = NULL;
    }
  } else if (rmve) {
    GC_register_finalizer(v, NULL, NULL, NULL, NULL);
    save_fns_ptr = fns_ptr;
    return;
  }
  
  if (!(*fns_ptr)) {
    prealloced->lifetime = current_lifetime;
    *fns_ptr = prealloced;
  }
  fns = *fns_ptr;

  if (ext) {
    if (ext_oldf)
      *ext_oldf = fns->ext_f;
    fns->ext_f = f;
    if (ext_olddata)
      *ext_olddata = fns->ext_data;
    fns->ext_data = data;

    if (!f && !fns->prim_first && !fns->scheme_first) {
      /* Removed all finalization */
      GC_register_finalizer(v, NULL, NULL, NULL, NULL);
      save_fns_ptr = fns_ptr;
      *save_fns_ptr = NULL;
    }
  } else {
    if (prim) {
      if (no_dup) {
       /* Make sure it's not already here */
       Finalization *fnx;
       for (fnx = fns->prim_first; fnx; fnx = fnx->next) {
         if (fnx->f == f && fnx->data == data) {
           if (rmve) {
             if (fnx->prev)
              fnx->prev->next = fnx->next;
             else
              fns->prim_first = fnx->next;
             if (fnx->next)
              fnx->next->prev = fnx->prev;
             else
              fns->prim_last = fnx->prev;
           }
           fn = NULL;
           break;
         }
       }
      }
      if (fn) {
       fn->next = fns->prim_first;
       fns->prim_first = fn;
       if (!fn->next)
         fns->prim_last = fn;
       else
         fn->next->prev = fn;
      }
      /* Removed all finalization? */
      if (!fns->ext_f && !fns->prim_first && !fns->scheme_first) {
       GC_register_finalizer(v, NULL, NULL, NULL, NULL);
       save_fns_ptr = fns_ptr;
       *save_fns_ptr = NULL;
      }
    } else {
      fn->next = fns->scheme_first;
      fns->scheme_first = fn;
      if (!fn->next)
       fns->scheme_last = fn;
      else
       fn->next->prev = fn;
    }
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int call_with_basic ( void data) [static]

Definition at line 133 of file salloc.c.

{
  Scheme_Main_Data *ma = (Scheme_Main_Data *)data;
  Scheme_Env_Main _main = ma->_main;
  
  return _main(scheme_basic_env(), ma->argc, ma->argv);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void do_next_finalization ( void o,
void data 
) [static]

Definition at line 1006 of file salloc.c.

{
  Finalizations *fns = *(Finalizations **)data;
  Finalization *fn;

  if (fns->lifetime != current_lifetime)
    return;

  if (fns->scheme_first) {
    if (fns->scheme_first->next || fns->ext_f || fns->prim_first) {
      /* Re-install low-level finalizer and run a scheme finalizer */
      GC_register_eager_finalizer(o, fns->scheme_first->next ? 1 : 2, 
                              do_next_finalization, data, NULL, NULL);
    }

    fn = fns->scheme_first;
    fns->scheme_first = fn->next;
    if (!fn->next)
      fns->scheme_last = NULL;
    else
      fn->next->prev = NULL;

    fn->f(o, fn->data);
    return;
  }

  if (fns->ext_f)
    fns->ext_f(o, fns->ext_data);

  for (fn = fns->prim_first; fn; fn = fn->next) {
    fn->f(o, fn->data);
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1171 of file misc.c.

{
    GC_printf0("***Static roots:\n");
    GC_print_static_roots();
    GC_printf0("\n***Heap sections:\n");
    GC_print_heap_sects();
    GC_printf0("\n***Free blocks:\n");
    GC_print_hblkfreelist();
    GC_printf0("\n***Blocks in use:\n");
    GC_print_block_list();
    GC_printf0("\n***Finalization statistics:\n");
    GC_print_finalization_stats();
}

Here is the call graph for this function:

Here is the caller graph for this function:

MZ_DLLIMPORT unsigned long GC_get_stack_base ( )

Definition at line 43 of file AmigaOS.c.

{
    struct Process *proc = (struct Process*)SysBase->ThisTask;
 
    /* Reference: Amiga Guru Book Pages: 42,567,574 */
    if (proc->pr_Task.tc_Node.ln_Type==NT_PROCESS
        && proc->pr_CLI != NULL) {
       /* first ULONG is StackSize */
       /*longPtr = proc->pr_ReturnAddr;
       size = longPtr[0];*/

       return (char *)proc->pr_ReturnAddr + sizeof(ULONG);
    } else {
       return (char *)proc->pr_Task.tc_SPUpper;
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 475 of file misc.c.

{
    DCL_LOCK_STATE;
    
    DISABLE_SIGNALS();

#if defined(GC_WIN32_THREADS) && !defined(GC_PTHREADS)
    if (!GC_is_initialized) {
      BOOL (WINAPI *pfn) (LPCRITICAL_SECTION, DWORD) = NULL;
      HMODULE hK32 = GetModuleHandleA("kernel32.dll");
      if (hK32)
         pfn = (BOOL (WINAPI *) (LPCRITICAL_SECTION, DWORD))
              GetProcAddress (hK32,
                            "InitializeCriticalSectionAndSpinCount");
      if (pfn)
          pfn(&GC_allocate_ml, 4000);
      else
         InitializeCriticalSection (&GC_allocate_ml);
    }
#endif /* MSWIN32 */

    LOCK();
    GC_init_inner();
    UNLOCK();
    ENABLE_SIGNALS();

#   if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC)
       /* Make sure marker threads and started and thread local */
       /* allocation is initialized, in case we didn't get      */
       /* called from GC_init_parallel();                */
        {
         extern void GC_init_parallel(void);
         GC_init_parallel();
       }
#   endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */

#   if defined(DYNAMIC_LOADING) && defined(DARWIN)
    {
        /* This must be called WITHOUT the allocation lock held
        and before any threads are created */
        extern void GC_init_dyld();
        GC_init_dyld();
    }
#   endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 158 of file finalize.c.

Here is the call graph for this function:

Here is the caller graph for this function:

static void raise_out_of_memory ( void  ) [static]

Definition at line 395 of file salloc.c.

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_add_finalizer ( void p,
void(*)(void *p, void *data f,
void data 
)

Definition at line 1199 of file salloc.c.

{
  add_finalizer(p, f, data, 1, 0, NULL, NULL, 0, 0);
}

Here is the call graph for this function:

void scheme_add_finalizer_once ( void p,
void(*)(void *p, void *data f,
void data 
)

Definition at line 1204 of file salloc.c.

{
  add_finalizer(p, f, data, 1, 0, NULL, NULL, 1, 0);
}

Here is the call graph for this function:

void scheme_add_scheme_finalizer ( void p,
void(*)(void *p, void *data f,
void data 
)

Definition at line 1214 of file salloc.c.

{
  add_finalizer(p, f, data, 0, 0, NULL, NULL, 0, 0);
}

Here is the call graph for this function:

void scheme_add_scheme_finalizer_once ( void p,
void(*)(void *p, void *data f,
void data 
)

Definition at line 1219 of file salloc.c.

{
  add_finalizer(p, f, data, 0, 0, NULL, NULL, 1, 0);
}

Here is the call graph for this function:

void* scheme_calloc ( size_t  num,
size_t  size 
)

Definition at line 285 of file salloc.c.

{
  void *space;
  
  space = MALLOC(num*size);
  if (!space)
    scheme_raise_out_of_memory(NULL, NULL);
#ifdef NO_GC
  memset(space, 0, (num*size));
#endif

  return (space);
}

Here is the call graph for this function:

Definition at line 1236 of file salloc.c.

{
  GC_gcollect();
}

Here is the call graph for this function:

Definition at line 205 of file salloc.c.

{
  int i, oldsize;
  void **naya;
  int *nayac;

  /* look for existing: */
  for (i = 0; i < dgc_size; i++) {
    if (dgc_array[i] == p) {
      dgc_count[i]++;
      return;
    }
  }

  /* look for empty slot: */
  for (i = 0; i < dgc_size; i++) {
    if (!dgc_array[i]) {
      dgc_array[i] = p;
      dgc_count[i] = 1;
      return;
    }
  }

  /* Make more room: */
  oldsize = dgc_size;
  if (!dgc_array) {
    REGISTER_SO(dgc_array);
    REGISTER_SO(dgc_count);
    dgc_size = 50;
  } else
    dgc_size *= 2;

  naya = MALLOC_N(void*, dgc_size);
  nayac = MALLOC_N(int, dgc_size);

  for (i = 0; i < oldsize; i++) {
    naya[i] = dgc_array[i];
    nayac[i] = dgc_count[i];
  }

  for (; i < dgc_size; i++) {
    naya[i] = NULL;
    nayac[i] = 0;
  }

  dgc_array = naya;
  dgc_count = nayac;

  dgc_array[oldsize] = p;
  dgc_count[oldsize] = 1;
}

Definition at line 1715 of file salloc.c.

{
  Scheme_Object *result = scheme_void;
#ifdef USE_TAGGED_ALLOCATION
  void *initial_trace_root = NULL;
  int (*inital_root_skip)(void *, size_t) = NULL;
#endif
#if MZ_PRECISE_GC_TRACE
  int trace_for_tag = 0;
  int flags = 0;
  int path_length_limit = 1000;
  GC_for_each_found_proc for_each_found = NULL;
#else
# ifndef USE_TAGGED_ALLOCATION
#  define flags 0
#  define trace_for_tag 0
#  define path_length_limit 1000
#  define for_each_found NULL
#  define GC_get_xtagged_name NULL
#  define print_tagged_value NULL
# endif
#endif

#if 0
  /* Syntax-object debugging support: */
  if ((c == 1) && SCHEME_STXP(p[0])) {
    return scheme_explode_syntax(p[0], scheme_make_hash_table(SCHEME_hash_ptr));
  }

  if (c && SAME_TYPE(SCHEME_TYPE(p[0]), scheme_compilation_top_type)) {
    Scheme_Hash_Table *ht;
    Scheme_Compilation_Top *top;
    Scheme_Object *vec, *v, *lst = scheme_null;
    Scheme_Module *m;
    Resolve_Prefix *prefix;
    int i, j;

    ht = scheme_make_hash_table(SCHEME_hash_ptr);

    top = (Scheme_Compilation_Top *)p[0];

    j = 0;
    while (1) {
      if (j)
        m = scheme_extract_compiled_module(p[0]);
      else
        m = NULL;

      if (m) {
        if (j == 1) {
          prefix = m->prefix;
        } else {
          int k = j - 2;
          if (k >= SCHEME_VEC_SIZE(m->et_body))
            break;
          v = SCHEME_VEC_ELS(m->et_body)[k];
          prefix = (Resolve_Prefix *)SCHEME_VEC_ELS(v)[3];
        }
      } else {
        if (j)
          break;
        prefix = top->prefix;
      }
      
      vec = scheme_make_vector(prefix->num_stxes, NULL);
      for (i = 0; i < prefix->num_stxes; i++) {
        v = scheme_explode_syntax(prefix->stxes[i], ht);
        SCHEME_VEC_ELS(vec)[i] = v;
      }

      lst = scheme_make_pair(vec, lst);
      j++;
    }

    return scheme_reverse(lst);
  }
#endif

  scheme_start_atomic();

  if (scheme_external_dump_arg)
    scheme_external_dump_arg(c ? p[0] : NULL);

  scheme_console_printf("Begin Dump\n");

#ifdef USE_TAGGED_ALLOCATION
  trace_path_type = -1;
  obj_type = -1;
  if (c && SCHEME_SYMBOLP(p[0])) {
    Scheme_Object *sym;
    char *s;
    int i, maxpos, just_objects;

    sym = p[0];
    s = scheme_symbol_val(sym);

    maxpos = scheme_num_types();
    if (maxpos > NUM_TYPE_SLOTS-1)
      maxpos = NUM_TYPE_SLOTS-1;

    just_objects = ((c > 1)
                  && SCHEME_SYMBOLP(p[1])
                  && !strcmp(SCHEME_SYM_VAL(p[1]), "objects"));

    for (i = 0; i < maxpos; i++) {
      void *tn = scheme_get_type_name(i);
      if (tn && !strcmp(tn, s)) {
       if (just_objects)
         obj_type = i;
       else
         trace_path_type = i;
       break;
      }
    }
    if (SAME_OBJ(p[0], scheme_intern_symbol("stack"))) {
      trace_path_type = -2;
    }

    if ((c > 2)
       && SCHEME_SYMBOLP(p[1])
       && !strcmp(SCHEME_SYM_VAL(p[1]), "from")) {
      initial_trace_root = p[2];
      if (SCHEME_THREADP(p[2])) {
       local_thread = p[2];
       local_thread_size = 0;
       inital_root_skip = skip_foreign_thread;
      }
    }
  }

  {
    int i;
    int stack_c, roots_c, uncollectable_c, final_c;
    long total_count = 0, total_size = 0;
    long total_actual_count = 0, total_actual_size = 0;
    long traced;
    int no_walk = 0;

    no_walk = 1 /* (!c || !SAME_OBJ(p[0], scheme_true)) */;
    
    for (i = 0; i < NUM_TYPE_SLOTS; i++) {
      scheme_memory_count[i] = scheme_memory_size[i] = 0;
      scheme_memory_actual_size[i] = scheme_memory_actual_count[i] = 0;
      scheme_memory_hi[i] = scheme_memory_lo[i] = 0;
    }
    scheme_envunbox_count = scheme_envunbox_size = 0;
    bad_seeds = 0;
    for (i = 0; i <= NUM_RECORDED_APP_SIZES; i++) {
      app_sizes[i] = 0;
    }
    {
      int j, k;
      for (i = 0; i < NUM_RECORDED_APP_SIZES; i++) {
       for (j = 0; j <= i; j++) {
         for (k = 0; k <= 4; k++) {
           app_arg_kinds[i][j][k] = 0;
         }
       }
      }
    }

    traced = GC_trace_count(&stack_c, &roots_c, &uncollectable_c, &final_c);
    GC_dump();

    scheme_console_printf("\ntraced: %ld\n", traced);

    tagged = tagged_while_counting;
    
    if (!no_walk)
      smc_ht = scheme_make_hash_table(SCHEME_hash_ptr);
    
    if (tagged) 
      GC_for_each_element(real_tagged, count_tagged, NULL);
    if (tagged_eternal) 
      GC_for_each_element(tagged_eternal, count_tagged, NULL);
    if (tagged_uncollectable) 
      GC_for_each_element(tagged_uncollectable, count_tagged, NULL);
    if (tagged_atomic)
      GC_for_each_element(tagged_atomic, count_tagged, NULL);
    if (envunbox)
      GC_for_each_element(envunbox, count_envunbox, NULL);

    tagged = real_tagged;

    scheme_console_printf("Begin MzScheme\n");
    scheme_console_printf("%30.30s %10s %10s %10s %8s - %8s\n",
                       "TYPE", "COUNT", "ESTM-SIZE", "TRACE-SIZE", 
                       "LO-LOC", "HI-LOC");
    for (i = 0; i < NUM_TYPE_SLOTS; i++) {
      if (scheme_memory_count[i] || scheme_memory_actual_count[i]) {
       scheme_console_printf("%30.30s %10ld %10ld %10ld %8lx - %8lx\n",
                           (i < NUM_TYPE_SLOTS-1)
                           ? scheme_get_type_name(i)
                           : "other",
                           scheme_memory_actual_count[i],
                           scheme_memory_size[i],
                           scheme_memory_actual_size[i],
                           scheme_memory_lo[i],
                           scheme_memory_hi[i]);
       if (scheme_memory_actual_count[i] != scheme_memory_count[i]) {
         scheme_console_printf("%30.30s reach count: %10ld\n",
                            "", scheme_memory_count[i]);
       }
       total_count += scheme_memory_count[i];
       total_size += scheme_memory_size[i];
       total_actual_count += scheme_memory_actual_count[i];
       total_actual_size += scheme_memory_actual_size[i];
      }
    }

    scheme_console_printf("%30.30s %10ld %10ld          -\n",
                       "envunbox", scheme_envunbox_count, scheme_envunbox_size);
    total_count += scheme_envunbox_count;
    total_size += scheme_envunbox_size;

    scheme_console_printf("%30.30s          - %10ld          -\n",
                       "miscellaneous", 
                       scheme_misc_count + scheme_type_table_count);
    total_size += scheme_misc_count + scheme_type_table_count;

    scheme_console_printf("%30.30s          -          - %10ld\n",
                       "roots", roots_c);
    total_actual_size += roots_c;

    scheme_console_printf("%30.30s          -          - %10ld\n",
                       "stack", stack_c);
    total_actual_size += stack_c;

    scheme_console_printf("%30.30s          -          - %10ld\n",
                       "unreached-uncollectable", uncollectable_c);
    total_actual_size += uncollectable_c;

    scheme_console_printf("%30.30s          -          - %10ld\n",
                       "finalization", final_c);
    total_actual_size += final_c;

    scheme_console_printf("%30.30s %10ld %10ld %10ld\n",
                       "total", total_count, total_size, 
                       total_actual_size);
    scheme_console_printf("End MzScheme\n");

    scheme_console_printf("Begin Apps\n");
    for (i = 0; i < NUM_RECORDED_APP_SIZES; i++) {
      int j, k;
      scheme_console_printf("  %d%s: %d", i, 
                         (i == NUM_RECORDED_APP_SIZES ? "+" : ""), 
                         app_sizes[i]);
      for (j = 0; j <= i; j++) {
       scheme_console_printf(" (");
       for (k = 0; k <= 4; k++) {
         if (k)
           scheme_console_printf(",");
         scheme_console_printf("%d", app_arg_kinds[i][j][k]);
       }
       scheme_console_printf(")");
      }
      scheme_console_printf("\n");
    }
    scheme_console_printf("End Apps\n");

    {
      Scheme_Custodian *m = (Scheme_Custodian *)scheme_get_param(scheme_current_config(), MZCONFIG_CUSTODIAN);
      int c = 0, a = 0, u = 0, t = 0, ipt = 0, opt = 0, th = 0;

      while (*m->parent)
       m = *m->parent;

      count_managed(m, &c, &a, &u, &t, &ipt, &opt, &th);

      scheme_console_printf("custodians: %d  managed: actual: %d   breadth: %d   room: %d\n"
                         "                        input-ports: %d  output-ports: %d  threads: %d\n"
                         "stacks: %d\n", 
                         t, u, c, a, ipt, opt, th,
                         scheme_num_copied_stacks);
    }

    if (bad_seeds)
      scheme_console_printf("ERROR: %ld illegal tags found\n", bad_seeds);

    smc_ht = NULL;
  }

#else

# if MZ_PRECISE_GC_TRACE
  cons_accum_result = scheme_void;
  if (c && SCHEME_SYMBOLP(p[0])) {
    Scheme_Object *sym;
    char *s;
    int i, maxpos;

    sym = p[0];
    s = scheme_symbol_val(sym);

    maxpos = scheme_num_types();

    for (i = 0; i < maxpos; i++) {
      void *tn;
      tn = scheme_get_type_name(i);
      if (tn && !strcmp(tn, s)) {
       trace_for_tag = i;
       flags |= GC_DUMP_SHOW_TRACE;
       break;
      }
    }

    if (!strcmp("fnl", s))
      flags |= GC_DUMP_SHOW_FINALS;

    if (!strcmp("peek", s) && (c == 3)) {
      long n;
      scheme_end_atomic();
      if (scheme_get_int_val(p[1], &n)) {
       if (GC_is_tagged_start((void *)n)) {
         return (Scheme_Object *)n;
       } else
         return p[2];
      }
    }
    
    if (!strcmp("next", s) && (c == 2)) {
      void *pt;
      scheme_end_atomic();
      if (SCHEME_FALSEP(p[1]))
       pt = GC_next_tagged_start(NULL);
      else
       pt = GC_next_tagged_start((void *)p[1]);
      if (pt)
       return (Scheme_Object *)pt;
      else
       return scheme_false;
    }

    if (!strcmp("addr", s) && (c == 2)) {
      scheme_end_atomic();      
      return scheme_make_integer_value((long)p[1]);
    }
  } else if (c && SCHEME_INTP(p[0])) {
    trace_for_tag = SCHEME_INT_VAL(p[0]);
    flags |= GC_DUMP_SHOW_TRACE;
  } else if (c && SCHEME_THREADP(p[0])) {
    Scheme_Thread *t = (Scheme_Thread *)p[0];
    void **var_stack, *limit;
    long delta;

    scheme_console_printf("Thread: %p\n", t);
    if (t->running) {
      if (scheme_current_thread == t) {
        scheme_console_printf(" swapped in\n");
        var_stack = GC_variable_stack;
        delta = 0;
        limit = (void *)scheme_get_current_thread_stack_start();
      } else {
        scheme_console_printf(" swapped out\n");
        var_stack = (void **)t->jmpup_buf.gc_var_stack;
        delta = (long)t->jmpup_buf.stack_copy - (long)t->jmpup_buf.stack_from;
        /* FIXME: stack direction */
        limit = (char *)t->jmpup_buf.stack_copy + t->jmpup_buf.stack_size;
      }
      GC_dump_variable_stack(var_stack, delta, limit, NULL,
                             scheme_get_type_name,
                             GC_get_xtagged_name,
                             print_tagged_value);
    } else {
      scheme_console_printf(" done\n");
    }
    scheme_end_atomic();
    return scheme_void;
  }

  if ((c > 1) && SCHEME_INTP(p[1]))
    path_length_limit = SCHEME_INT_VAL(p[1]);
  else if ((c > 1) && SCHEME_SYMBOLP(p[1]) && !strcmp("cons", SCHEME_SYM_VAL(p[1]))) {
    for_each_found = cons_onto_list;
    cons_accum_result = scheme_null;
    flags -= (flags & GC_DUMP_SHOW_TRACE);
  }
  scheme_console_printf("Begin Dump\n");
#endif

# ifdef MZ_PRECISE_GC
  GC_dump_with_traces(flags, 
                    scheme_get_type_name,
                    GC_get_xtagged_name,
                    for_each_found,
                    trace_for_tag,
                    print_tagged_value,
                    path_length_limit);
# else
  GC_dump();
# endif
#endif

  if (scheme_external_dump_info)
    scheme_external_dump_info();

#ifdef USE_TAGGED_ALLOCATION
  {
    void **ps = NULL;
    int l;
    int max_w;
    Scheme_Object *w;

    GC_inital_root_skip = inital_root_skip;
    GC_initial_trace_root = initial_trace_root;
    GC_trace_path();
    GC_inital_root_skip = NULL;
    GC_initial_trace_root = NULL;
    
    w = scheme_get_param(scheme_current_config(), MZCONFIG_ERROR_PRINT_WIDTH);
    if (SCHEME_INTP(w))
      max_w = SCHEME_INT_VAL(w);
    else
      max_w = 10000;

    scheme_console_printf("Begin Paths\n");

    while ((ps = GC_get_next_path(ps, &l))) {
      int i, j;
      if (l)
       scheme_console_printf("$%s", ps[0]);
      for (i = 1, j = 2; i < l; i++, j += 2) {
       void *v = ps[j];
       unsigned long diff = (unsigned long)ps[j + 1];
       struct GC_Set *home;

       home = GC_set(v);
       if (home
           && ((home == real_tagged)
              || (home == tagged_atomic)
              || (home == tagged_uncollectable)
              || (home == tagged_eternal))) {
         print_tagged_value("\n  ->", v, 0, diff, max_w, "");
       } else
         print_tagged_value("\n  ->", v, 1, diff, max_w, "");
      }
      scheme_console_printf("\n");
    }

    GC_clear_paths();

    scheme_console_printf("End Paths\n");
  }

  scheme_console_printf("Begin Help\n");
  scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
  scheme_console_printf("   Examples: (dump-memory-stats '<pair>), (dump-memory-stats 'frame).\n");
  scheme_console_printf("   If sym is 'stack, prints paths to thread stacks.\n");
  scheme_console_printf(" (dump-memory-stats sym 'objects) - prints all instances of type named by sym.\n");
  scheme_console_printf(" (dump-memory-stats sym 'from from-v) - prints paths, paths through from-v first.\n");
  scheme_console_printf("End Help\n");

  if (obj_type >= 0) {
    result = scheme_null;
    while (obj_buffer_pos--) {
      result = scheme_make_pair((Scheme_Object *)(obj_buffer[obj_buffer_pos]), result);
    }
  }
#endif

# if MZ_PRECISE_GC_TRACE
  scheme_console_printf("Begin Help\n");
  scheme_console_printf(" (dump-memory-stats sym) - prints paths to instances of type named by sym.\n");
  scheme_console_printf("   Example: (dump-memory-stats '<pair>)\n");
  scheme_console_printf(" (dump-memory-stats 'fnl) - prints not-yet-finalized objects.\n");
  scheme_console_printf(" (dump-memory-stats num) - prints paths to objects with tag num.\n");
  scheme_console_printf(" (dump-memory-stats -num) - prints paths to objects of size num.\n");
  scheme_console_printf(" (dump-memory-stats sym/num len) - limits path to size len.\n");
  scheme_console_printf(" (dump-memory-stats sym/num 'cons) - builds list instead of showing paths.\n");
  scheme_console_printf(" (dump-memory-stats 'peek num v) - returns value if num is address of object, v otherwise.\n");
  scheme_console_printf(" (dump-memory-stats 'next v) - next tagged object after v, #f if none; start with #f.\n");
  scheme_console_printf(" (dump-memory-stats 'addr v) - returns the address of v.\n");
  scheme_console_printf(" (dump-memory-stats thread) - shows information about the thread.\n");
  scheme_console_printf("End Help\n");

  result = cons_accum_result;
  cons_accum_result = scheme_void;
# endif

  scheme_console_printf("End Dump\n");

  scheme_end_atomic();

  return result;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 413 of file salloc.c.

{
#ifndef MZ_PRECISE_GC
  GC_end_stubborn_change(p);
#endif
}

Here is the call graph for this function:

Definition at line 803 of file salloc.c.

{
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
  long size, size2, bucket, page_size;
  int per_page, n;
  void *prev;

  page_size = get_page_size();

  size = *(long *)CODE_PAGE_OF(p);
  
  if (size >= page_size) {
    /* it was a large object on its own page(s) */
    scheme_code_page_total -= size;
    LOG_CODE_MALLOC(1, printf("freeing large %p (%ld) [%ld left]\n", 
                              p, size, scheme_code_page_total));
    free_page((char *)p - CODE_HEADER_SIZE, size);
    return;
  }

  bucket = size;

  if ((bucket < 0) || (bucket >= free_list_bucket_count)) {
    printf("bad free: %p\n", (char *)p + CODE_HEADER_SIZE);
    abort();    
  }

  size2 = free_list[bucket].size;

  LOG_CODE_MALLOC(0, printf("freeing %ld / %ld\n", size2, bucket));

  /* decrement alloc count for this page: */
  per_page = (page_size - CODE_HEADER_SIZE) / size2;
  n = ((long *)CODE_PAGE_OF(p))[1];
  /* double-check: */
  if ((n < 1) || (n > per_page)) {
    printf("bad free: %p\n", (char *)p + CODE_HEADER_SIZE);
    abort();
  }
  n--;
  ((long *)CODE_PAGE_OF(p))[1] = n;
  
  /* add to free list: */
  prev = free_list[bucket].elems;
  ((void **)p)[0] = prev;
  ((void **)p)[1] = NULL;
  if (prev)
    ((void **)prev)[1] = p;
  free_list[bucket].elems = p;
  free_list[bucket].count++;

  /* Free whole page if it's completely on the free list, and if there
     are enough buckets on other pages. */
  if ((n == 0) && ((free_list[bucket].count - per_page) >= (per_page / 2))) {
    /* remove same-page elements from free list, then free page */
    int i;
    long sz;
    void *pg;

    sz = page_size - size2;
    pg = CODE_PAGE_OF(p);
    for (i = CODE_HEADER_SIZE; i <= sz; i += size2) {
      p = ((char *)pg) + i;
      prev = ((void **)p)[1];
      if (prev)
        ((void **)prev)[0] = ((void **)p)[0];
      else
        free_list[bucket].elems = ((void **)p)[0];
      prev = ((void **)p)[0];
      if (prev)
        ((void **)prev)[1] = ((void **)p)[1];
      --free_list[bucket].count;
    }
    
    scheme_code_page_total -= page_size;
    LOG_CODE_MALLOC(2, printf("freeing page at %p [%ld left]\n", 
                              CODE_PAGE_OF(p), scheme_code_page_total));
    free_page(CODE_PAGE_OF(p), page_size);
  }
#else
  free(p);
#endif
}

Definition at line 382 of file salloc.c.

{
#ifdef MZ_PRECISE_GC
  GC_free_immobile_box(b);
#else
  if (immobiles) {
    scheme_hash_set(immobiles, (Scheme_Object *)(void *)b, NULL);
  }
#endif
}

Here is the call graph for this function:

Definition at line 257 of file salloc.c.

{
  int i;
  
  for (i = 0; i < dgc_size; i++) {
    if (dgc_array[i] == p) {
      if (!(--dgc_count[i]))
       dgc_array[i] = NULL;
      break;
    }
  }
}

Definition at line 122 of file salloc.c.

Here is the caller graph for this function:

unsigned long scheme_get_deeper_address ( void  )

Definition at line 1241 of file salloc.c.

{
  int v, *vp;
  vp = &v;
  return (unsigned long)vp;
}

Here is the caller graph for this function:

unsigned long scheme_get_stack_base ( )

Definition at line 178 of file salloc.c.

{
#if !defined(MZ_PRECISE_GC) && !defined(USE_SENORA_GC)
  if (GC_stackbottom)
    return (unsigned long)GC_stackbottom;
  else
#endif
    return (unsigned long)GC_get_stack_base();
}

Here is the call graph for this function:

int scheme_main_setup ( int  no_auto_statics,
Scheme_Env_Main  _main,
int  argc,
char **  argv 
)

Definition at line 141 of file salloc.c.

{
  Scheme_Main_Data d;
  d._main = _main;
  d.argc = argc;
  d.argv = argv;
  return scheme_main_stack_setup(no_auto_statics, call_with_basic, &d);
}

Here is the call graph for this function:

Here is the caller graph for this function:

int scheme_main_stack_setup ( int  no_auto_statics,
Scheme_Nested_Main  _main,
void data 
)

Definition at line 150 of file salloc.c.

{
  void *stack_start;
  int volatile return_code;

  scheme_set_stack_base(PROMPT_STACK(stack_start), no_auto_statics);

  return_code = _main(data);

#ifdef MZ_PRECISE_GC
  /* Trick xform conversion to keep start_addr: */
  stack_start = NULL;
#endif

  return return_code;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* scheme_make_cptr ( void cptr,
Scheme_Object typetag 
)

Definition at line 329 of file salloc.c.

{
  Scheme_Object *o;

  o = (Scheme_Object *)scheme_malloc_small_tagged(sizeof(Scheme_Cptr));
  o->type = scheme_cpointer_type;
  SCHEME_CPTR_VAL(o) = cptr;
  SCHEME_CPTR_TYPE(o) = (void *)typetag;

  return o;
}
Scheme_Object* scheme_make_offset_cptr ( void cptr,
long  offset,
Scheme_Object typetag 
)

Definition at line 341 of file salloc.c.

void* scheme_malloc_code ( long  size)

Definition at line 729 of file salloc.c.

{
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
  long size2, bucket, sz, page_size;
  void *p, *pg, *prev;

  if (size < CODE_HEADER_SIZE) {
    /* ensure CODE_HEADER_SIZE alignment 
       and room for free-list pointers */
    size = CODE_HEADER_SIZE;
  }

  page_size = get_page_size();

  if (!free_list) {
    free_list = (struct free_list_entry *)malloc_page(page_size);
    scheme_code_page_total += page_size;
    init_free_list();
  }

  if (size > free_list[0].size) {
    /* allocate large object on its own page(s) */
    sz = size + CODE_HEADER_SIZE;
    sz = (sz + page_size - 1) & ~(page_size - 1);
    pg = malloc_page(sz);
    scheme_code_page_total += sz;
    *(long *)pg = sz;
    LOG_CODE_MALLOC(1, printf("allocated large %p (%ld) [now %ld]\n", 
                              pg, size + CODE_HEADER_SIZE, scheme_code_page_total));
    return ((char *)pg) + CODE_HEADER_SIZE;
  }

  bucket = free_list_find_bucket(size);
  size2 = free_list[bucket].size;

  if (!free_list[bucket].elems) {
    /* add a new page's worth of items to the free list */
    int i, count = 0;
    pg = malloc_page(page_size);
    scheme_code_page_total += page_size;
    LOG_CODE_MALLOC(2, printf("new page for %ld / %ld at %p [now %ld]\n", 
                              size2, bucket, pg, scheme_code_page_total));
    sz = page_size - size2;
    for (i = CODE_HEADER_SIZE; i <= sz; i += size2) {
      p = ((char *)pg) + i;
      prev = free_list[bucket].elems;
      ((void **)p)[0] = prev;
      ((void **)p)[1] = NULL;
      if (prev)
        ((void **)prev)[1] = p;
      free_list[bucket].elems = p;
      count++;
    }
    ((long *)pg)[0] = bucket; /* first long of page indicates bucket */
    ((long *)pg)[1] = 0; /* second long indicates number of allocated on page */
    free_list[bucket].count = count;
  }

  p = free_list[bucket].elems;
  prev = ((void **)p)[0];
  free_list[bucket].elems = prev;
  --free_list[bucket].count;
  if (prev)
    ((void **)prev)[1] = NULL;
  ((long *)CODE_PAGE_OF(p))[1] += 1;
  
  LOG_CODE_MALLOC(0, printf("allocated %ld (->%ld / %ld)\n", size, size2, bucket));

  return p;
#else
  return malloc(size); /* good luck! */
#endif
}
void* scheme_malloc_eternal ( size_t  n)

Definition at line 420 of file salloc.c.

{
#ifdef USE_SENORA_GC
  return GC_malloc_atomic_uncollectable(n);
#else
  void *s;

  s = MALLOC(n);
  if (!s) {
    if (GC_out_of_memory)
      GC_out_of_memory();
    else {
      if (scheme_console_printf)
       scheme_console_printf("out of memory\n");
      else
       printf("out of memory\n");
      exit(1);
    }
  }
       

  memset(s, 0, n);

  return s;
#endif
}

Here is the call graph for this function:

void* scheme_malloc_fail_ok ( void *(*)(size_t)  f,
size_t  s 
)

Definition at line 401 of file salloc.c.

Here is the call graph for this function:

Definition at line 898 of file salloc.c.

{
  void *p;
  p = scheme_malloc(size);
  
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
  {
    /* [This chunk of code moved from our copy of GNU lightning to here.] */
    unsigned long page, length, page_size;
    void *end;

    page_size = get_page_size();
    
    end = ((char *)p) + size;

    page = (long) p & ~(page_size - 1);
    length = ((char *) end - (char *) page + page_size - 1) & ~(page_size - 1);
    
    /* Simple-minded attempt at optimizing the common case where a single
       chunk of memory is used to compile multiple functions.  */
    if (!(page >= jit_prev_page && page + length <= jit_prev_page + jit_prev_length)) {
      
# ifdef MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC
      {
        DWORD old;
        VirtualProtect((void *)page, length, PAGE_EXECUTE_READWRITE, &old);
      }
# else
      mprotect ((void *) page, length, PROT_READ | PROT_WRITE | PROT_EXEC);
# endif

      /* See if we can extend the previously mprotect'ed memory area towards
         higher addresses: the starting address remains the same as before.  */
      if (page >= jit_prev_page && page <= jit_prev_page + jit_prev_length)
        jit_prev_length = page + length - jit_prev_page;
      
      /* See if we can extend the previously mprotect'ed memory area towards
         lower addresses: the highest address remains the same as before. */
      else if (page < jit_prev_page && page + length >= jit_prev_page 
               && page + length <= jit_prev_page + jit_prev_length)
        jit_prev_length += jit_prev_page - page, jit_prev_page = page;
      
      /* Nothing to do, replace the area.  */
      else
        jit_prev_page = page, jit_prev_length = length;
    }
  }
#endif

  return p;
}

Definition at line 362 of file salloc.c.

{
#ifdef MZ_PRECISE_GC
  return GC_malloc_immobile_box(p);
#else
  void **b;

  if (!immobiles) {
    REGISTER_SO(immobiles);
    immobiles = scheme_make_hash_table(SCHEME_hash_ptr);
  }

  b = scheme_malloc(sizeof(void *));
  *b = p;
  scheme_hash_set(immobiles, (Scheme_Object *)(void *)b, scheme_true);

  return b;
#endif
}

Here is the call graph for this function:

Definition at line 950 of file salloc.c.

{
#if defined(MZ_JIT_USE_MPROTECT) || defined(MZ_JIT_USE_WINDOWS_VIRTUAL_ALLOC)
  jit_prev_page = 0;
  jit_prev_length = 0;
#endif
}

Here is the caller graph for this function:

Definition at line 188 of file salloc.c.

{
  scheme_log_abort("PLT Scheme virtual machine has run out of memory; aborting");
  if (more_report_out_of_memory)
    more_report_out_of_memory();
  abort();
}
void scheme_register_finalizer ( void p,
void(*)(void *p, void *data f,
void data,
void(**)(void *p, void *data oldf,
void **  olddata 
)

Definition at line 1224 of file salloc.c.

{
  add_finalizer(p, f, data, 0, 1, oldf, olddata, 0, 0);
}

Here is the call graph for this function:

void scheme_register_static ( void ptr,
long  size 
)

Definition at line 461 of file salloc.c.

{
#if defined(MZ_PRECISE_GC) || defined(USE_SENORA_GC)
  /* Always register for precise and Senora GC: */
  GC_add_roots((char *)ptr, (char *)(((char *)ptr) + size + 1));
#else
# ifdef GC_MIGHT_USE_REGISTERED_STATICS
  if (use_registered_statics) {
    GC_add_roots((char *)ptr, (char *)(((char *)ptr) + size + 1));
  }
# endif
#endif
}

Here is the call graph for this function:

Definition at line 1231 of file salloc.c.

Here is the call graph for this function:

Definition at line 1001 of file salloc.c.

Here is the caller graph for this function:

Definition at line 117 of file salloc.c.

{
  scheme_os_thread_stack_base = (unsigned long) base;
}

Here is the caller graph for this function:

Definition at line 196 of file salloc.c.

Here is the caller graph for this function:

void scheme_set_stack_base ( void base,
int  no_auto_statics 
)

Definition at line 82 of file salloc.c.

{
#ifdef MZ_PRECISE_GC
  GC_init_type_tags(_scheme_last_type_, 
                    scheme_pair_type, scheme_mutable_pair_type, scheme_weak_box_type, 
                    scheme_ephemeron_type, scheme_rt_weak_array,
                    scheme_cust_box_type);
  /* We want to be able to allocate symbols early. */
  scheme_register_traversers();
#endif

  scheme_primordial_os_thread_stack_base  = (unsigned long) base;
  scheme_os_thread_stack_base             = (unsigned long) base;

#if defined(MZ_PRECISE_GC) || defined(USE_SENORA_GC)
  GC_set_stack_base(base);
  /* no_auto_statics must always be true! */
#else
  GC_stackbottom = base;
  if (no_auto_statics) {
    GC_no_dls = 1;
    GC_init();
    GC_clear_roots();
  } else {
# if (defined(__APPLE__) && defined(__MACH__)) || defined(MZ_USE_IRIX_SPROCS)
    GC_init(); /* For Darwin, CGC requires GC_init() always */
# endif
  }
#endif
  use_registered_statics = no_auto_statics;
#if defined(MZ_PRECISE_GC)
  GC_report_out_of_memory = scheme_out_of_memory_abort;
#endif
}

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_set_stack_bounds ( void base,
void deepest,
int  no_auto_statics 
)

Definition at line 167 of file salloc.c.

{
  scheme_set_stack_base(base, no_auto_statics);

#ifdef USE_STACK_BOUNDARY_VAR
  if (deepest) {
    scheme_stack_boundary = (unsigned long)deepest;
  }
#endif
}

Here is the call graph for this function:

char* scheme_strdup ( const char *  str)

Definition at line 300 of file salloc.c.

{
  char *naya;
  long len;

  len = strlen(str) + 1;
  naya = (char *)scheme_malloc_atomic (len * sizeof (char));
  memcpy (naya, str, len);

  return naya;
}
char* scheme_strdup_eternal ( const char *  str)

Definition at line 313 of file salloc.c.

{
  char *naya;
  long len;

  len = strlen(str) + 1;
  naya = (char *)scheme_malloc_eternal(len * sizeof (char));
  memcpy (naya, str, len);

  return naya;
}
void scheme_subtract_finalizer ( void p,
void(*)(void *p, void *data f,
void data 
)

Definition at line 1209 of file salloc.c.

{
  add_finalizer(p, f, data, 1, 0, NULL, NULL, 1, 1);
}

Here is the call graph for this function:

Definition at line 1193 of file salloc.c.

Here is the call graph for this function:

Definition at line 1182 of file salloc.c.

Definition at line 1187 of file salloc.c.

Here is the call graph for this function:


Variable Documentation

Definition at line 999 of file salloc.c.

void** dgc_array [static]

Definition at line 53 of file salloc.c.

int* dgc_count [static]

Definition at line 54 of file salloc.c.

int dgc_size [static]

Definition at line 55 of file salloc.c.

Definition at line 359 of file salloc.c.

Definition at line 61 of file salloc.c.

Definition at line 1043 of file salloc.c.

void(* save_oom)(void) [static]

Definition at line 393 of file salloc.c.

Definition at line 595 of file salloc.c.

Definition at line 1427 of file salloc.c.

Definition at line 1426 of file salloc.c.

Definition at line 1428 of file salloc.c.

Definition at line 85 of file setjmpup.c.

THREAD_LOCAL unsigned long scheme_os_thread_stack_base [static]

Definition at line 59 of file salloc.c.

Definition at line 58 of file salloc.c.

Definition at line 1042 of file salloc.c.

Definition at line 71 of file salloc.c.