-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
#include <stdio.h>
#include <errno.h>
#include <string.h>
-#include <assert.h>
#ifdef __ia64__
#include <ucontext.h>
#include "libguile/gc.h"
#include "libguile/dynwind.h"
-#include "libguile/boehm-gc.h"
+#include "libguile/bdw-gc.h"
#ifdef GUILE_DEBUG_MALLOC
#include "libguile/debug-malloc.h"
*/
int scm_i_cell_validation_already_running ;
+/* Hash table that keeps a reference to objects the user wants to protect from
+ garbage collection. It could arguably be private but applications have come
+ to rely on it (e.g., Lilypond 2.13.9). */
+SCM scm_protects;
+
+
#if (SCM_DEBUG_CELL_ACCESSES == 1)
*/
if (scm_expensive_debug_cell_accesses_p)
scm_i_expensive_validation_check (cell);
-#if (SCM_DEBUG_MARKING_API == 0)
- if (!SCM_GC_MARK_P (cell))
- {
- fprintf (stderr,
- "scm_assert_cell_valid: this object is unmarked. \n"
- "It has been garbage-collected in the last GC run: "
- "%lux\n",
- (unsigned long) SCM_UNPACK (cell));
- abort ();
- }
-#endif /* SCM_DEBUG_MARKING_API */
-
+
scm_i_cell_validation_already_running = 0; /* re-enable */
}
}
pointer to an 8-octet aligned region). For `scm_tc3_struct', this is
handled in `scm_alloc_struct ()'. */
GC_REGISTER_DISPLACEMENT (scm_tc3_cons);
- GC_REGISTER_DISPLACEMENT (scm_tc3_closure);
+ /* GC_REGISTER_DISPLACEMENT (scm_tc3_unused); */
/* Sanity check. */
- if (!GC_is_visible (scm_sys_protects))
+ if (!GC_is_visible (&scm_protects))
abort ();
scm_c_hook_init (&scm_before_gc_c_hook, 0, SCM_C_HOOK_NORMAL);
scm_i_pthread_mutex_t scm_i_gc_admin_mutex = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-int
-scm_init_storage ()
+void
+scm_init_gc_protect_object ()
{
- size_t j;
-
- j = SCM_NUM_PROTECTS;
- while (j)
- scm_sys_protects[--j] = SCM_BOOL_F;
+ scm_protects = scm_c_make_hash_table (31);
#if 0
/* We can't have a cleanup handler since we have no thread to run it
#endif
#endif
-
- scm_stand_in_procs = scm_make_weak_key_hash_table (scm_from_int (257));
- scm_protects = scm_c_make_hash_table (31);
-
- return 0;
}
\f
return "cons (immediate car)";
case scm_tcs_cons_nimcar:
return "cons (non-immediate car)";
- case scm_tcs_closures:
- return "closures";
- case scm_tc7_pws:
- return "pws";
+ case scm_tc7_foreign:
+ return "foreign";
+ case scm_tc7_hashtable:
+ return "hashtable";
+ case scm_tc7_fluid:
+ return "fluid";
+ case scm_tc7_dynamic_state:
+ return "dynamic state";
+ case scm_tc7_frame:
+ return "frame";
+ case scm_tc7_objcode:
+ return "objcode";
+ case scm_tc7_vm:
+ return "vm";
+ case scm_tc7_vm_cont:
+ return "vm continuation";
case scm_tc7_wvect:
return "weak vector";
case scm_tc7_vector:
return "vector";
-#ifdef CCLO
- case scm_tc7_cclo:
- return "compiled closure";
-#endif
case scm_tc7_number:
switch (tag)
{
case scm_tc7_variable:
return "variable";
break;
- case scm_tcs_subrs:
- return "subrs";
- break;
case scm_tc7_port:
return "port";
break;
{
/* `GC_INIT ()' was invoked in `scm_storage_prehistory ()'. */
- scm_after_gc_hook = scm_permanent_object (scm_make_hook (SCM_INUM0));
+ scm_after_gc_hook = scm_make_hook (SCM_INUM0);
scm_c_define ("after-gc-hook", scm_after_gc_hook);
- gc_async = scm_c_make_subr ("%gc-thunk", scm_tc7_subr_0,
- gc_async_thunk);
+ gc_async = scm_c_make_gsubr ("%gc-thunk", 0, 0, 0, gc_async_thunk);
scm_c_hook_add (&scm_after_gc_c_hook, mark_gc_async, NULL, 0);
#define FUNC_NAME "scm_gc_sweep"
{
/* FIXME */
- fprintf (stderr, "%s: doing nothing\n", __FUNCTION__);
+ fprintf (stderr, "%s: doing nothing\n", FUNC_NAME);
}
-
#undef FUNC_NAME
-
-
/*
Local Variables:
c-file-style: "gnu"