[uim-commit] r1966 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Thu Nov 3 04:51:45 PST 2005
Author: kzk
Date: 2005-11-03 04:51:31 -0800 (Thu, 03 Nov 2005)
New Revision: 1966
Added:
branches/r5rs/sigscheme/storage-gc.c
Modified:
branches/r5rs/sigscheme/Makefile.am
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemeinternal.h
Log:
* Move GC related code from datas.c to storage-gc.c
* sigscheme/sigschemeinternal.h
- update comment
- (SigScm_InitGC, SigScm_FinalizeGC,
SigScm_NewObjFromHeap): new func
* sigscheme/datas.c
- (ScmObjHeap, gc_protected_var,
SCM_UNMARKER, SCM_INITIAL_MARKER, SCM_IS_MARKED,
SCM_IS_UNMARKED, SCM_DO_MARK, SCM_DO_UNMARK,
SCM_MARK_CORRUPTED, SCM_HEAP_SIZE,
scm_heap_num, scm_heaps, scm_freelist, scm_stack_start_pointer
scm_cur_marker, save_regs_buf, scm_gc_protect_stack,
protected_var_list, malloc_aligned, allocate_heap,
add_heap, finalize_heap, gc_preprocess, gc_mark_and_sweep,
mark_obj, is_pointer_to_heap, gc_mark_protected_var,
gc_mark_locations_n, gc_mark_locations, gc_mark,
sweep_obj, gc_sweep, finalize_protected_var,
SigScm_GC_Protect, SigScm_GC_Unprotect,
SigScm_GC_ProtectStackInternal, SigScm_GC_ProtectStack,
SigScm_GC_UnprotectStack): moved to storage-gc.c
- (SCM_NEW_OBJ_INTERNAL): removed and replaced by
SigScm_NewObjFromHeap
- (Scm_NewCons, Scm_NewInt, Scm_NewSymbol, Scm_NewChar,
Scm_NewString, Scm_NewStringCopying, Scm_NewStringWithLen,
Scm_NewFunc, Scm_NewClosure, Scm_NewVector,
Scm_NewPort, Scm_NewContinuation,
Scm_NewValuePacket, Scm_NewCPointer, Scm_NewCFuncPointer)
: use SigScm_NewObjFromHeap instead of SCM_NEW_OBJ_INTERNAL
* sigscheme/storage-gc.c
- (SigScm_InitGC, SigScm_FinalizeGC,
SigScm_NewObjFromHeap): new func
- (ScmObjHeap, gc_protected_var,
SCM_UNMARKER, SCM_INITIAL_MARKER, SCM_IS_MARKED,
SCM_IS_UNMARKED, SCM_DO_MARK, SCM_DO_UNMARK,
SCM_MARK_CORRUPTED, SCM_HEAP_SIZE,
scm_heap_num, scm_heaps, scm_freelist,
scm_cur_marker, save_regs_buf, scm_gc_protect_stack,
protected_var_list, malloc_aligned, allocate_heap,
add_heap, finalize_heap, gc_preprocess, gc_mark_and_sweep,
mark_obj, is_pointer_to_heap, gc_mark_protected_var,
gc_mark_locations_n, gc_mark_locations, gc_mark,
sweep_obj, gc_sweep, finalize_protected_var,
SigScm_GC_Protect, SigScm_GC_Unprotect,
SigScm_GC_ProtectStackInternal, SigScm_GC_ProtectStack,
SigScm_GC_UnprotectStack): moved from storage-gc.c
* sigscheme/sigscheme.h
- reorganize file section
* sigscheme/Makefile.am
- add storage-gc.c
Modified: branches/r5rs/sigscheme/Makefile.am
===================================================================
--- branches/r5rs/sigscheme/Makefile.am 2005-11-03 12:46:31 UTC (rev 1965)
+++ branches/r5rs/sigscheme/Makefile.am 2005-11-03 12:51:31 UTC (rev 1966)
@@ -1,6 +1,7 @@
noinst_LTLIBRARIES = libsscm.la
libsscm_la_SOURCES = \
datas.c debug.c \
+ storage-gc.c \
storage-symbol.c \
storage-continuation.c \
encoding.c error.c \
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-11-03 12:46:31 UTC (rev 1965)
+++ branches/r5rs/sigscheme/datas.c 2005-11-03 12:51:31 UTC (rev 1966)
@@ -32,61 +32,13 @@
* SUCH DAMAGE.
===========================================================================*/
-/*
- * Description of the Garbage Collection
- *
- * Our GC uses Mark-and-Sweep algorithm. So, we have MARK phase and SWEEP phase.
- *
- * [1] Mark phase : gc_mark()
- * - gc_mark_locations()
- * marking the Scheme object which are stored in the registers.
- *
- * - gc_mark_protected_var()
- * marking the protected Scheme object which are being hold by C
- * variables registered by SigScm_GC_Protect().
- *
- * - gc_mark_locations()
- * marking the Scheme object which are pushed to the stack, so we need to
- * traverse the stack for marking the objects.
- *
- * - gc_mark_symbol_hash()
- * marking the Scheme object which is interned by calling Scm_Intern().
- *
- * [2] Sweep phase : gc_sweep()
- * - scanning heaps and move non-marked object to the freelist.
- */
-
/*=======================================
System Include
=======================================*/
#include <string.h>
#include <stdlib.h>
-#include <setjmp.h>
/*=======================================
- Portability Coordination
-=======================================*/
-#if 0
-/* malloc.h is obsoleted by stdlib.h. At least FreeBSD generates an error. */
-#include <malloc.h>
-#endif
-
-#if 0
-#ifndef posix_memalign
-/*
- * Cited from manpage of posix_memalign(3) of glibc:
- *
- * CONFORMING TO
- * The function valloc() appeared in 3.0 BSD. It is documented as being
- * obsolete in BSD 4.3, and as legacy in SUSv2. It no longer occurs in
- * SUSv3. The function memalign() appears in SunOS 4.1.3 but not in BSD
- * 4.4. The function posix_memalign() comes from POSIX 1003.1d.
- */
-#error "posix_memalign(3) is not available in this system"
-#endif
-#endif
-
-/*=======================================
Local Include
=======================================*/
#include "sigscheme.h"
@@ -103,34 +55,10 @@
/*=======================================
File Local Struct Declarations
=======================================*/
-typedef ScmObj ScmObjHeap;
-/* Represents C variable that is holding a ScmObj to be protected from GC */
-typedef struct gc_protected_var_ gc_protected_var;
-struct gc_protected_var_ {
- ScmObj *var;
- gc_protected_var *next_var;
-};
-
/*=======================================
File Local Macro Declarations
=======================================*/
-#define SCM_NEW_OBJ_INTERNAL(VALNAME) \
- do { \
- if (NULLP(scm_freelist)) \
- gc_mark_and_sweep(); \
- VALNAME = scm_freelist; \
- scm_freelist = SCM_FREECELL_CDR(scm_freelist); \
- } while (/* CONSTCOND */ 0)
-
-#define SCM_UNMARKER 0
-#define SCM_INITIAL_MARKER (SCM_UNMARKER + 1)
-#define SCM_IS_MARKED(a) (SCM_MARK(a) == scm_cur_marker)
-#define SCM_IS_UNMARKED(a) (!SCM_IS_MARKED)
-#define SCM_DO_MARK(a) (SCM_MARK(a) = scm_cur_marker)
-#define SCM_DO_UNMARK(a) (SCM_MARK(a) = SCM_UNMARKER)
-#define SCM_MARK_CORRUPTED(a) ((unsigned)SCM_MARK(a) > (unsigned)scm_cur_marker)
-
/* special constant initialization */
#define SCM_CONSTANT_BIND_SUBSTANCE(obj, cell) \
do { \
@@ -141,93 +69,34 @@
/*=======================================
Variable Declarations
=======================================*/
-static int SCM_HEAP_SIZE = 10240;
-static int scm_heap_num = 8;
-static ScmObjHeap *scm_heaps = NULL;
-static ScmObj scm_freelist = NULL;
-
-static int scm_cur_marker = SCM_INITIAL_MARKER;
-
-static jmp_buf save_regs_buf;
-ScmObj *scm_stack_start_pointer = NULL;
-#if UIM_SCM_GCC4_READY_GC
-/* See also the comment about these variables in sigscheme.h */
-ScmObj *(*volatile scm_gc_protect_stack)(ScmObj *)
- = &SigScm_GC_ProtectStackInternal;
-#endif /* UIM_SCM_GCC4_READY_GC */
-
/* multiple values */
#if SCM_USE_VALUECONS
ScmObj SigScm_null_values;
#endif
-static gc_protected_var *protected_var_list = NULL;
-
+/* constants */
ScmObj SigScm_null, SigScm_true, SigScm_false, SigScm_eof;
ScmObj SigScm_unbound, SigScm_undef;
-
static ScmCell SigScm_null_cell, SigScm_true_cell, SigScm_false_cell, SigScm_eof_cell;
static ScmCell SigScm_unbound_cell, SigScm_undef_cell;
/* storage-continuation.c */
extern ScmObj scm_current_dynamic_extent;
-/* storage-symbol.c */
-extern ScmObj *scm_symbol_hash;
-
/*=======================================
File Local Function Declarations
=======================================*/
static void initialize_special_constants(void);
-static void *malloc_aligned(size_t size);
-static void allocate_heap(ScmObjHeap **heaps, int num_heap, int HEAP_SIZE, ScmObj *freelist);
-static void add_heap(ScmObjHeap **heaps, int *num_heap, int HEAP_SIZE, ScmObj *freelist);
-static void finalize_heap(void);
-
-static void gc_preprocess(void);
-static void gc_mark_and_sweep(void);
-
-/* GC Mark Related Functions */
-static void mark_obj(ScmObj obj);
-static int is_pointer_to_heap(ScmObj obj);
-
-static void gc_mark_protected_var();
-static void gc_mark_locations_n(ScmObj *start, int n);
-static void gc_mark_locations(ScmObj *start, ScmObj *end);
-static void gc_mark(void);
-
-/* GC Sweep Related Functions */
-static void sweep_obj(ScmObj obj);
-static void gc_sweep(void);
-
-static void finalize_protected_var(void);
-
/*=======================================
Function Implementations
=======================================*/
-/*
- * To keep storage representation abstract, the special constants
- * initialization is encapsulated in this file. Upper layers must only use
- * abstract interfaces such as SCM_NULL and SCM_NULLP().
- */
-static void initialize_special_constants(void)
-{
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_null, SigScm_null_cell);
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_true, SigScm_true_cell);
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_false, SigScm_false_cell);
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_eof, SigScm_eof_cell);
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_unbound, SigScm_unbound_cell);
- SCM_CONSTANT_BIND_SUBSTANCE(SigScm_undef, SigScm_undef_cell);
-#if SCM_COMPAT_SIOD_BUGS
- SigScm_false = SigScm_null;
-#endif
-}
-
void SigScm_InitStorage(void)
{
initialize_special_constants();
- allocate_heap(&scm_heaps, scm_heap_num, SCM_HEAP_SIZE, &scm_freelist);
+
+ SigScm_InitGC();
+
#if 0 && SCM_COMPAT_SIOD_BUGS
SigScm_GC_Protect(&SigScm_true);
SigScm_true = Scm_NewInt(1);
@@ -250,427 +119,37 @@
void SigScm_FinalizeStorage(void)
{
SigScm_FinalizeContinuation();
- finalize_heap();
SigScm_FinalizeSymbol();
- finalize_protected_var();
+ SigScm_FinalizeGC();
}
-static void *malloc_aligned(size_t size)
+/*===========================================================================
+ Scheme Constants
+===========================================================================*/
+/*
+ * To keep storage representation abstract, the special constants
+ * initialization is encapsulated in this file. Upper layers must only use
+ * abstract interfaces such as SCM_NULL and SCM_NULLP().
+ */
+static void initialize_special_constants(void)
{
- void *p;
- /* 2005/08/08 Kazuki Ohta <mover at hct.zaq.ne.jp>
- * commented out "posix_memalign"
- *
- * posix_memalign(&p, 16, size);
- */
- p = malloc(size);
- return p;
-}
-
-
-/*============================================================================
- Heap Allocator & Garbage Collector
-============================================================================*/
-static void allocate_heap(ScmObjHeap **heaps, int num_heap, int HEAP_SIZE, ScmObj *freelist)
-{
- int i = 0;
- ScmObj heap, cell;
-
- CDBG((SCM_DBG_GC, "allocate_heap num:%d size:%d", num_heap, HEAP_SIZE));
-
- /* allocate heap */
- (*heaps) = (ScmObj*)malloc(sizeof(ScmObj) * num_heap);
- (*freelist) = SCM_NULL;
-
- /* fill with zero and construct free_list */
- for (i = 0; i < num_heap; i++) {
- /* Initialize Heap */
- heap = (ScmObj)malloc_aligned(sizeof(ScmCell) * HEAP_SIZE);
- (*heaps)[i] = heap;
-
- /* link in order */
- for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
- SCM_ENTYPE_FREECELL(cell);
- SCM_DO_UNMARK(cell);
- SCM_FREECELL_SET_CDR(cell, cell+1);
- }
-
- SCM_FREECELL_SET_CDR(cell-1, (*freelist));
- /* and freelist is head of the heap */
- (*freelist) = (*heaps)[i];
- }
-}
-
-static void add_heap(ScmObjHeap **heaps, int *orig_num_heap, int HEAP_SIZE, ScmObj *freelist)
-{
- int num_heap = 0;
- ScmObj heap, cell;
-
- CDBG((SCM_DBG_GC, "add_heap current num of heaps:%d", *orig_num_heap));
-
- /* increment num_heap */
- (*orig_num_heap) += 1;
- num_heap = (*orig_num_heap);
-
- /* add heap */
- (*heaps) = (ScmObj*)realloc((*heaps), sizeof(ScmObj) * num_heap);
-
- /* allocate heap */
- heap = (ScmObj)malloc_aligned(sizeof(ScmCell) * HEAP_SIZE);
- (*heaps)[num_heap - 1] = heap;
-
- /* link in order */
- for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
- SCM_ENTYPE_FREECELL(cell);
- SCM_DO_UNMARK(cell);
- SCM_FREECELL_SET_CDR(cell, cell+1);
- }
-
- SCM_FREECELL_SET_CDR(cell-1, *freelist);
- (*freelist) = (*heaps)[num_heap - 1];
-}
-
-static void finalize_heap(void)
-{
- int i = 0;
- int j = 0;
-
- for (i = 0; i < scm_heap_num; i++) {
- for (j = 0; j < SCM_HEAP_SIZE; j++) {
- sweep_obj(&scm_heaps[i][j]);
- }
- free(scm_heaps[i]);
- }
- free(scm_heaps);
-}
-
-static void gc_preprocess(void)
-{
- ++scm_cur_marker; /* make everything unmarked */
-
- if (scm_cur_marker == SCM_UNMARKER) {
- /* We've been running long enough to do
- * (1 << (sizeof(int)*8)) - 1 GCs, yay! */
- int i = 0;
- long j = 0;
-
- scm_cur_marker = SCM_INITIAL_MARKER;
-
- /* unmark everything */
- for (i = 0; i < scm_heap_num; i++) {
- for (j = 0; j < SCM_HEAP_SIZE; j++) {
- SCM_DO_UNMARK(&scm_heaps[i][j]);
- }
- }
- }
-}
-
-static void gc_mark_and_sweep(void)
-{
- CDBG((SCM_DBG_GC, "[ gc start ]"));
-
- gc_preprocess();
- gc_mark();
- gc_sweep();
-
- /* we cannot sweep the object, so let's add new heap */
- if (NULLP(scm_freelist)) {
- CDBG((SCM_DBG_GC, "Cannot sweep the object, allocating new heap."));
- add_heap(&scm_heaps, &scm_heap_num, SCM_HEAP_SIZE, &scm_freelist);
- }
-}
-
-static void mark_obj(ScmObj obj)
-{
- int i = 0;
-
-mark_loop:
- /* no need to mark SCM_NULL */
- if (NULLP(obj))
- return;
-
- /* avoid cyclic marking */
- if (SCM_IS_MARKED(obj))
- return;
-
- /* mark this object */
- SCM_DO_MARK(obj);
-
- /* mark recursively */
- switch (SCM_TYPE(obj)) {
- case ScmCons:
- mark_obj(CAR(obj));
- obj = CDR(obj);
- goto mark_loop;
- break;
-
- case ScmSymbol:
- mark_obj(SCM_SYMBOL_VCELL(obj));
- break;
-
- case ScmClosure:
- mark_obj(SCM_CLOSURE_EXP(obj));
- obj = SCM_CLOSURE_ENV(obj);
- goto mark_loop;
- break;
-
- case ScmValuePacket:
-#if SCM_USE_VALUECONS
- mark_obj(SCM_VALUECONS_CAR(obj));
- obj = SCM_VALUECONS_CDR(obj);
-#else
- obj = SCM_VALUEPACKET_VALUES(obj);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_null, SigScm_null_cell);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_true, SigScm_true_cell);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_false, SigScm_false_cell);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_eof, SigScm_eof_cell);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_unbound, SigScm_unbound_cell);
+ SCM_CONSTANT_BIND_SUBSTANCE(SigScm_undef, SigScm_undef_cell);
+#if SCM_COMPAT_SIOD_BUGS
+ SigScm_false = SigScm_null;
#endif
- goto mark_loop;
-
- case ScmVector:
- for (i = 0; i < SCM_VECTOR_LEN(obj); i++) {
- mark_obj(SCM_VECTOR_VEC(obj)[i]);
- }
- break;
-
- default:
- break;
- }
}
-void SigScm_GC_Protect(ScmObj *var)
-{
- gc_protected_var *item;
-
- item = (gc_protected_var *)malloc(sizeof(gc_protected_var));
- item->var = var;
-
- item->next_var = protected_var_list;
- protected_var_list = item;
-}
-
-void SigScm_GC_Unprotect(ScmObj *var)
-{
- gc_protected_var **item = &protected_var_list;
- gc_protected_var *next = NULL;
- while (*item) {
- if ((*item)->var == var) {
- next = (*item)->next_var;
- free(*item);
- *item = next;
- break;
- }
- }
-}
-
-static void finalize_protected_var(void)
-{
- gc_protected_var *item = protected_var_list;
- gc_protected_var *tmp = NULL;
- while (item) {
- *item->var = NULL;
- tmp = item;
- item = item->next_var;
- free(tmp);
- }
- protected_var_list = NULL;
-}
-
-static int is_pointer_to_heap(ScmObj obj)
-{
- /* The core part of Conservative GC */
- int i = 0;
- ScmObj head = SCM_NULL;
- for (i = 0; i < scm_heap_num; i++) {
- if ((head = scm_heaps[i])
- && (head <= obj)
- && (obj < head + SCM_HEAP_SIZE)
- && ((((char*)obj - (char*)head) % sizeof(ScmCell)) == 0))
- return 1;
- }
-
- return 0;
-}
-
-static void gc_mark_protected_var(void)
-{
- gc_protected_var *item = NULL;
- for (item = protected_var_list; item; item = item->next_var) {
- mark_obj(*item->var);
- }
-}
-
-static void gc_mark_locations_n(ScmObj *start, int n)
-{
- int i = 0;
- ScmObj obj = SCM_NULL;
-
- /* mark stack */
- for (i = 0; i < n; i++) {
- obj = start[i];
-
- if (is_pointer_to_heap(obj)) {
- mark_obj(obj);
- }
- }
-
-}
-
-static void gc_mark_locations(ScmObj *start, ScmObj *end)
-{
- int size = 0;
- ScmObj *tmp = NULL;
-
- /* swap end and start if (end < start) */
- if (end < start) {
- tmp = end;
- end = start;
- start = tmp;
- }
-
- /* get size */
- size = end - start;
-
- CDBG((SCM_DBG_GC, "gc_mark_locations() : size = %d", size));
-
- gc_mark_locations_n(start, size);
-}
-
-static void gc_mark_symbol_hash(void)
-{
- int i = 0;
- for (i = 0; i < NAMEHASH_SIZE; i++) {
- mark_obj(scm_symbol_hash[i]);
- }
-}
-
-static void gc_mark(void)
-{
- ScmObj stack_end;
- void *save_regs_buf_end = (char *)save_regs_buf + sizeof(save_regs_buf);
-
- CDBG((SCM_DBG_GC, "gc_mark()"));
-
- setjmp(save_regs_buf);
- gc_mark_locations((ScmObj *)save_regs_buf, (ScmObj *)save_regs_buf_end);
- gc_mark_protected_var();
- gc_mark_locations(scm_stack_start_pointer, &stack_end);
- gc_mark_symbol_hash();
-}
-
-static void sweep_obj(ScmObj obj)
-{
- /* if the type has the pointer to free, then free it! */
- switch (SCM_TYPE(obj)) {
- case ScmInt:
- case ScmCons:
- case ScmClosure:
- break;
-
- case ScmChar:
- if (SCM_CHAR_VALUE(obj))
- free(SCM_CHAR_VALUE(obj));
- break;
-
- case ScmString:
- if (SCM_STRING_STR(obj))
- free(SCM_STRING_STR(obj));
- break;
-
- case ScmVector:
- if (SCM_VECTOR_VEC(obj))
- free(SCM_VECTOR_VEC(obj));
- break;
-
- case ScmSymbol:
- if (SCM_SYMBOL_NAME(obj))
- free(SCM_SYMBOL_NAME(obj));
- break;
-
- case ScmPort:
- if (SCM_PORT_IMPL(obj))
- SCM_PORT_CLOSE_IMPL(obj);
- break;
-
- /* rarely swept objects */
- case ScmContinuation:
- case ScmFunc:
- case ScmConstant:
- case ScmFreeCell:
- default:
- break;
- }
-}
-
-static void gc_sweep(void)
-{
- int i = 0;
- int j = 0;
- int corrected_obj_num = 0;
-
- ScmObj obj = SCM_NULL;
- ScmObj scm_new_freelist = SCM_NULL;
- /* iterate heaps */
- for (i = 0; i < scm_heap_num; i++) {
- corrected_obj_num = 0;
-
- /* iterate in heap */
- for (j = 0; j < SCM_HEAP_SIZE; j++) {
- obj = &scm_heaps[i][j];
- SCM_ASSERT(!SCM_MARK_CORRUPTED(obj));
- if (!SCM_IS_MARKED(obj)) {
- sweep_obj(obj);
-
- SCM_ENTYPE_FREECELL(obj);
- SCM_FREECELL_SET_CAR(obj, SCM_NULL);
- SCM_FREECELL_SET_CDR(obj, scm_new_freelist);
- scm_new_freelist = obj;
- corrected_obj_num++;
- }
- }
-
- CDBG((SCM_DBG_GC, "heap[%d] swept = %d", i, corrected_obj_num));
- }
- scm_freelist = scm_new_freelist;
-}
-
-#if SCM_GCC4_READY_GC
-ScmObj *SigScm_GC_ProtectStackInternal(ScmObj *designated_stack_start)
-{
- /*
- * &stack_start will be relocated to start of the frame of subsequent
- * function call
- */
- ScmObj stack_start;
-
- if (!designated_stack_start)
- designated_stack_start = &stack_start;
-
- if (!scm_stack_start_pointer)
- scm_stack_start_pointer = designated_stack_start;
-
- /* may intentionally be an invalidated local address */
- return designated_stack_start;
-}
-
-#else /* SCM_GCC4_READY_GC */
-
-void SigScm_GC_ProtectStack(ScmObj *stack_start)
-{
- if (!scm_stack_start_pointer)
- scm_stack_start_pointer = stack_start;
-}
-#endif /* SCM_GCC4_READY_GC */
-
-void SigScm_GC_UnprotectStack(ScmObj *stack_start)
-{
- if (scm_stack_start_pointer == stack_start)
- scm_stack_start_pointer = NULL;
-}
-
/*===========================================================================
Object Allocators
===========================================================================*/
ScmObj Scm_NewCons(ScmObj a, ScmObj b)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_CONS(obj);
SET_CAR(obj, a);
@@ -681,8 +160,7 @@
ScmObj Scm_NewInt(int val)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_INT(obj);
SCM_INT_SET_VALUE(obj, val);
@@ -692,8 +170,7 @@
ScmObj Scm_NewSymbol(char *name, ScmObj v_cell)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_SYMBOL(obj);
SCM_SYMBOL_SET_NAME(obj, name);
@@ -704,7 +181,7 @@
ScmObj Scm_NewChar(char *ch)
{
- ScmObj obj = SCM_FALSE;
+ ScmObj obj = SigScm_NewObjFromHeap();
int len;
len = Scm_mb_bare_c_strlen(ch);
@@ -713,8 +190,6 @@
ch, len);
}
- SCM_NEW_OBJ_INTERNAL(obj);
-
SCM_ENTYPE_CHAR(obj);
SCM_CHAR_SET_VALUE(obj, ch);
@@ -723,10 +198,8 @@
ScmObj Scm_NewString(char *str)
{
- ScmObj obj = SCM_FALSE;
+ ScmObj obj = SigScm_NewObjFromHeap();
- SCM_NEW_OBJ_INTERNAL(obj);
-
SCM_ENTYPE_STRING(obj);
SCM_STRING_SET_STR(obj, str);
SCM_STRING_SET_LEN(obj, str ? Scm_mb_bare_c_strlen(str) : 0);
@@ -736,10 +209,9 @@
ScmObj Scm_NewStringCopying(const char *str)
{
- ScmObj obj = SCM_FALSE;
+ ScmObj obj = SigScm_NewObjFromHeap();
if (!str) str = "";
- SCM_NEW_OBJ_INTERNAL(obj);
SCM_ENTYPE_STRING(obj);
SCM_STRING_SET_STR(obj, strdup(str));
@@ -750,8 +222,7 @@
ScmObj Scm_NewStringWithLen(char *str, int len)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_STRING(obj);
SCM_STRING_SET_STR(obj, str);
@@ -762,8 +233,7 @@
ScmObj Scm_NewFunc(enum ScmFuncTypeCode type, ScmFuncType func)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_FUNC(obj);
SCM_FUNC_SET_TYPECODE(obj, type);
@@ -774,8 +244,7 @@
ScmObj Scm_NewClosure(ScmObj exp, ScmObj env)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_CLOSURE(obj);
SCM_CLOSURE_SET_EXP(obj, exp);
@@ -786,8 +255,7 @@
ScmObj Scm_NewVector(ScmObj *vec, int len)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_VECTOR(obj);
SCM_VECTOR_SET_VEC(obj, vec);
@@ -798,10 +266,8 @@
ScmObj Scm_NewPort(ScmCharPort *cport, enum ScmPortFlag flag)
{
- ScmObj obj = SCM_FALSE;
+ ScmObj obj = SigScm_NewObjFromHeap();
- SCM_NEW_OBJ_INTERNAL(obj);
-
SCM_ENTYPE_PORT(obj);
if (flag & SCM_PORTFLAG_INPUT)
@@ -817,10 +283,8 @@
ScmObj Scm_NewContinuation(void)
{
- ScmObj obj = SCM_FALSE;
+ ScmObj obj = SigScm_NewObjFromHeap();
- SCM_NEW_OBJ_INTERNAL(obj);
-
SCM_ENTYPE_CONTINUATION(obj);
CONTINUATION_SET_JMPENV(obj, INVALID_CONTINUATION_JMPENV);
CONTINUATION_SET_DYNEXT(obj, scm_current_dynamic_extent);
@@ -831,8 +295,7 @@
#if !SCM_USE_VALUECONS
ScmObj Scm_NewValuePacket(ScmObj values)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_VALUEPACKET(obj);
SCM_VALUEPACKET_SET_VALUES(obj, values);
@@ -844,8 +307,7 @@
#if SCM_USE_NONSTD_FEATURES
ScmObj Scm_NewCPointer(void *data)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_C_POINTER(obj);
SCM_C_POINTER_SET_VALUE(obj, data);
@@ -855,8 +317,7 @@
ScmObj Scm_NewCFuncPointer(ScmCFunc func)
{
- ScmObj obj = SCM_FALSE;
- SCM_NEW_OBJ_INTERNAL(obj);
+ ScmObj obj = SigScm_NewObjFromHeap();
SCM_ENTYPE_C_FUNCPOINTER(obj);
SCM_C_FUNCPOINTER_SET_VALUE(obj, func);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-11-03 12:46:31 UTC (rev 1965)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-11-03 12:51:31 UTC (rev 1966)
@@ -205,7 +205,7 @@
/*=======================================
Variable Declarations
=======================================*/
-/* datas.c */
+/* storage-gc.c */
#if SCM_GCC4_READY_GC
/*
* The variable to ensure that a call of SigScm_GC_ProtectStack() is
@@ -364,24 +364,6 @@
#endif
/* datas.c */
-void SigScm_GC_Protect(ScmObj *var);
-void SigScm_GC_Unprotect(ScmObj *var);
-#if SCM_GCC4_READY_GC
-/*
- * Ordinary programs should not call these functions directly. Use
- * SCM_GC_PROTECTED_CALL*() instead.
- */
-#ifdef __GNUC__
-#define SigScm_GC_ProtectStack SigScm_GC_ProtectStackInternal
-#else /* __GNUC__ */
-#define SigScm_GC_ProtectStack (*scm_gc_protect_stack)
-#endif /* __GNUC__ */
-
-ScmObj *SigScm_GC_ProtectStackInternal(ScmObj *designated_stack_start) SCM_NOINLINE;
-#else /* SCM_GCC4_READY_GC */
-void SigScm_GC_ProtectStack(ScmObj *stack_start);
-#endif /* SCM_GCC4_READY_GC */
-void SigScm_GC_UnprotectStack(ScmObj *stack_start);
ScmObj Scm_NewCons(ScmObj a, ScmObj b);
ScmObj Scm_NewInt(int val);
ScmObj Scm_NewSymbol(char *name, ScmObj v_cell);
@@ -402,6 +384,26 @@
ScmObj Scm_NewCFuncPointer(ScmCFunc func);
#endif
+/* storage-gc.c */
+void SigScm_GC_Protect(ScmObj *var);
+void SigScm_GC_Unprotect(ScmObj *var);
+#if SCM_GCC4_READY_GC
+/*
+ * Ordinary programs should not call these functions directly. Use
+ * SCM_GC_PROTECTED_CALL*() instead.
+ */
+#ifdef __GNUC__
+#define SigScm_GC_ProtectStack SigScm_GC_ProtectStackInternal
+#else /* __GNUC__ */
+#define SigScm_GC_ProtectStack (*scm_gc_protect_stack)
+#endif /* __GNUC__ */
+
+ScmObj *SigScm_GC_ProtectStackInternal(ScmObj *designated_stack_start) SCM_NOINLINE;
+#else /* SCM_GCC4_READY_GC */
+void SigScm_GC_ProtectStack(ScmObj *stack_start);
+#endif /* SCM_GCC4_READY_GC */
+void SigScm_GC_UnprotectStack(ScmObj *stack_start);
+
/* storage-symbol.c */
ScmObj Scm_Intern(const char *name);
Modified: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-03 12:46:31 UTC (rev 1965)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-11-03 12:51:31 UTC (rev 1966)
@@ -64,9 +64,6 @@
/*=======================================
Variable Declarations
=======================================*/
-/* datas.c */
-extern ScmObj *scm_stack_start_pointer;
-
/* eval.c */
extern struct trace_frame *scm_trace_root;
@@ -82,6 +79,9 @@
extern ScmObj SigScm_null_values;
#endif
+/* storage-gc.c */
+extern ScmObj *scm_stack_start_pointer;
+
/*=======================================
Macro Declarations
=======================================*/
@@ -343,6 +343,11 @@
void SigScm_InitStorage(void);
void SigScm_FinalizeStorage(void);
+/* storage-gc.c */
+void SigScm_InitGC(void);
+void SigScm_FinalizeGC(void);
+ScmObj SigScm_NewObjFromHeap(void);
+
/* storage-continuation.c */
void SigScm_InitContinuation(void);
void SigScm_FinalizeContinuation(void);
Copied: branches/r5rs/sigscheme/storage-gc.c (from rev 1964, branches/r5rs/sigscheme/datas.c)
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-11-03 12:14:23 UTC (rev 1964)
+++ branches/r5rs/sigscheme/storage-gc.c 2005-11-03 12:51:31 UTC (rev 1966)
@@ -0,0 +1,607 @@
+/*===========================================================================
+ * FileName : storage-gc.c
+ * About : Garbage Collection
+ *
+ * Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.jp)
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+ * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+===========================================================================*/
+
+/*
+ * Description of the Garbage Collection
+ *
+ * Our GC uses Mark-and-Sweep algorithm. So, we have MARK phase and SWEEP phase.
+ *
+ * [1] Mark phase : gc_mark()
+ * - gc_mark_locations()
+ * marking the Scheme object which are stored in the registers.
+ *
+ * - gc_mark_protected_var()
+ * marking the protected Scheme object which are being hold by C
+ * variables registered by SigScm_GC_Protect().
+ *
+ * - gc_mark_locations()
+ * marking the Scheme object which are pushed to the stack, so we need to
+ * traverse the stack for marking the objects.
+ *
+ * - gc_mark_symbol_hash()
+ * marking the Scheme object which is interned by calling Scm_Intern().
+ *
+ * [2] Sweep phase : gc_sweep()
+ * - scanning heaps and move non-marked object to the freelist.
+ */
+
+/*=======================================
+ System Include
+=======================================*/
+#include <string.h>
+#include <stdlib.h>
+#include <setjmp.h>
+
+/*=======================================
+ Portability Coordination
+=======================================*/
+#if 0
+/* malloc.h is obsoleted by stdlib.h. At least FreeBSD generates an error. */
+#include <malloc.h>
+#endif
+
+#if 0
+#ifndef posix_memalign
+/*
+ * Cited from manpage of posix_memalign(3) of glibc:
+ *
+ * CONFORMING TO
+ * The function valloc() appeared in 3.0 BSD. It is documented as being
+ * obsolete in BSD 4.3, and as legacy in SUSv2. It no longer occurs in
+ * SUSv3. The function memalign() appears in SunOS 4.1.3 but not in BSD
+ * 4.4. The function posix_memalign() comes from POSIX 1003.1d.
+ */
+#error "posix_memalign(3) is not available in this system"
+#endif
+#endif
+
+/*=======================================
+ Local Include
+=======================================*/
+#include "sigscheme.h"
+#include "sigschemeinternal.h"
+
+/*=======================================
+ File Local Struct Declarations
+=======================================*/
+typedef ScmObj ScmObjHeap;
+
+/* Represents C variable that is holding a ScmObj to be protected from GC */
+typedef struct gc_protected_var_ gc_protected_var;
+struct gc_protected_var_ {
+ ScmObj *var;
+ gc_protected_var *next_var;
+};
+
+/*=======================================
+ File Local Macro Declarations
+=======================================*/
+#define SCM_UNMARKER 0
+#define SCM_INITIAL_MARKER (SCM_UNMARKER + 1)
+#define SCM_IS_MARKED(a) (SCM_MARK(a) == scm_cur_marker)
+#define SCM_IS_UNMARKED(a) (!SCM_IS_MARKED)
+#define SCM_DO_MARK(a) (SCM_MARK(a) = scm_cur_marker)
+#define SCM_DO_UNMARK(a) (SCM_MARK(a) = SCM_UNMARKER)
+#define SCM_MARK_CORRUPTED(a) ((unsigned)SCM_MARK(a) > (unsigned)scm_cur_marker)
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+static int SCM_HEAP_SIZE = 10240;
+static int scm_heap_num = 8;
+static ScmObjHeap *scm_heaps = NULL;
+static ScmObj scm_freelist = NULL;
+
+static int scm_cur_marker = SCM_INITIAL_MARKER;
+
+static jmp_buf save_regs_buf;
+ScmObj *scm_stack_start_pointer = NULL;
+#if UIM_SCM_GCC4_READY_GC
+/* See also the comment about these variables in sigscheme.h */
+ScmObj *(*volatile scm_gc_protect_stack)(ScmObj *)
+ = &SigScm_GC_ProtectStackInternal;
+#endif /* UIM_SCM_GCC4_READY_GC */
+
+static gc_protected_var *protected_var_list = NULL;
+
+/* storage-symbol.c */
+extern ScmObj *scm_symbol_hash;
+
+/*=======================================
+ File Local Function Declarations
+=======================================*/
+static void *malloc_aligned(size_t size);
+
+static void allocate_heap(ScmObjHeap **heaps, int num_heap, int HEAP_SIZE, ScmObj *freelist);
+static void add_heap(ScmObjHeap **heaps, int *num_heap, int HEAP_SIZE, ScmObj *freelist);
+static void finalize_heap(void);
+
+static void gc_preprocess(void);
+static void gc_mark_and_sweep(void);
+
+/* GC Mark Related Functions */
+static void mark_obj(ScmObj obj);
+static int is_pointer_to_heap(ScmObj obj);
+
+static void gc_mark_protected_var();
+static void gc_mark_locations_n(ScmObj *start, int n);
+static void gc_mark_locations(ScmObj *start, ScmObj *end);
+static void gc_mark(void);
+
+/* GC Sweep Related Functions */
+static void sweep_obj(ScmObj obj);
+static void gc_sweep(void);
+
+static void finalize_protected_var(void);
+
+/*=======================================
+ Function Implementations
+=======================================*/
+void SigScm_InitGC(void)
+{
+ allocate_heap(&scm_heaps, scm_heap_num, SCM_HEAP_SIZE, &scm_freelist);
+}
+
+void SigScm_FinalizeGC(void)
+{
+ finalize_heap();
+ finalize_protected_var();
+}
+
+ScmObj SigScm_NewObjFromHeap(void)
+{
+ ScmObj ret = SCM_FALSE;
+
+ if (NULLP(scm_freelist))
+ gc_mark_and_sweep();
+
+ ret = scm_freelist;
+ scm_freelist = SCM_FREECELL_CDR(scm_freelist);
+
+ return ret;
+}
+
+/*============================================================================
+ ScmObj Protection
+============================================================================*/
+void SigScm_GC_Protect(ScmObj *var)
+{
+ gc_protected_var *item;
+
+ item = (gc_protected_var *)malloc(sizeof(gc_protected_var));
+ item->var = var;
+
+ item->next_var = protected_var_list;
+ protected_var_list = item;
+}
+
+void SigScm_GC_Unprotect(ScmObj *var)
+{
+ gc_protected_var **item = &protected_var_list;
+ gc_protected_var *next = NULL;
+ while (*item) {
+ if ((*item)->var == var) {
+ next = (*item)->next_var;
+ free(*item);
+ *item = next;
+ break;
+ }
+ }
+}
+
+/*============================================================================
+ C Stack Protection
+============================================================================*/
+#if SCM_GCC4_READY_GC
+ScmObj *SigScm_GC_ProtectStackInternal(ScmObj *designated_stack_start)
+{
+ /*
+ * &stack_start will be relocated to start of the frame of subsequent
+ * function call
+ */
+ ScmObj stack_start;
+
+ if (!designated_stack_start)
+ designated_stack_start = &stack_start;
+
+ if (!scm_stack_start_pointer)
+ scm_stack_start_pointer = designated_stack_start;
+
+ /* may intentionally be an invalidated local address */
+ return designated_stack_start;
+}
+
+#else /* SCM_GCC4_READY_GC */
+
+void SigScm_GC_ProtectStack(ScmObj *stack_start)
+{
+ if (!scm_stack_start_pointer)
+ scm_stack_start_pointer = stack_start;
+}
+#endif /* SCM_GCC4_READY_GC */
+
+void SigScm_GC_UnprotectStack(ScmObj *stack_start)
+{
+ if (scm_stack_start_pointer == stack_start)
+ scm_stack_start_pointer = NULL;
+}
+
+/*============================================================================
+ Heap Allocator & Garbage Collector
+============================================================================*/
+static void *malloc_aligned(size_t size)
+{
+ void *p;
+ /* 2005/08/08 Kazuki Ohta <mover at hct.zaq.ne.jp>
+ * commented out "posix_memalign"
+ *
+ * posix_memalign(&p, 16, size);
+ */
+ p = malloc(size);
+ return p;
+}
+
+static void allocate_heap(ScmObjHeap **heaps, int num_heap, int HEAP_SIZE, ScmObj *freelist)
+{
+ int i = 0;
+ ScmObj heap, cell;
+
+ CDBG((SCM_DBG_GC, "allocate_heap num:%d size:%d", num_heap, HEAP_SIZE));
+
+ /* allocate heap */
+ (*heaps) = (ScmObj*)malloc(sizeof(ScmObj) * num_heap);
+ (*freelist) = SCM_NULL;
+
+ /* fill with zero and construct free_list */
+ for (i = 0; i < num_heap; i++) {
+ /* Initialize Heap */
+ heap = (ScmObj)malloc_aligned(sizeof(ScmCell) * HEAP_SIZE);
+ (*heaps)[i] = heap;
+
+ /* link in order */
+ for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
+ SCM_ENTYPE_FREECELL(cell);
+ SCM_DO_UNMARK(cell);
+ SCM_FREECELL_SET_CDR(cell, cell+1);
+ }
+
+ SCM_FREECELL_SET_CDR(cell-1, (*freelist));
+ /* and freelist is head of the heap */
+ (*freelist) = (*heaps)[i];
+ }
+}
+
+static void add_heap(ScmObjHeap **heaps, int *orig_num_heap, int HEAP_SIZE, ScmObj *freelist)
+{
+ int num_heap = 0;
+ ScmObj heap, cell;
+
+ CDBG((SCM_DBG_GC, "add_heap current num of heaps:%d", *orig_num_heap));
+
+ /* increment num_heap */
+ (*orig_num_heap) += 1;
+ num_heap = (*orig_num_heap);
+
+ /* add heap */
+ (*heaps) = (ScmObj*)realloc((*heaps), sizeof(ScmObj) * num_heap);
+
+ /* allocate heap */
+ heap = (ScmObj)malloc_aligned(sizeof(ScmCell) * HEAP_SIZE);
+ (*heaps)[num_heap - 1] = heap;
+
+ /* link in order */
+ for (cell=heap; cell-heap < HEAP_SIZE; cell++) {
+ SCM_ENTYPE_FREECELL(cell);
+ SCM_DO_UNMARK(cell);
+ SCM_FREECELL_SET_CDR(cell, cell+1);
+ }
+
+ SCM_FREECELL_SET_CDR(cell-1, *freelist);
+ (*freelist) = (*heaps)[num_heap - 1];
+}
+
+static void finalize_heap(void)
+{
+ int i = 0;
+ int j = 0;
+
+ for (i = 0; i < scm_heap_num; i++) {
+ for (j = 0; j < SCM_HEAP_SIZE; j++) {
+ sweep_obj(&scm_heaps[i][j]);
+ }
+ free(scm_heaps[i]);
+ }
+ free(scm_heaps);
+}
+
+static void gc_preprocess(void)
+{
+ ++scm_cur_marker; /* make everything unmarked */
+
+ if (scm_cur_marker == SCM_UNMARKER) {
+ /* We've been running long enough to do
+ * (1 << (sizeof(int)*8)) - 1 GCs, yay! */
+ int i = 0;
+ long j = 0;
+
+ scm_cur_marker = SCM_INITIAL_MARKER;
+
+ /* unmark everything */
+ for (i = 0; i < scm_heap_num; i++) {
+ for (j = 0; j < SCM_HEAP_SIZE; j++) {
+ SCM_DO_UNMARK(&scm_heaps[i][j]);
+ }
+ }
+ }
+}
+
+static void gc_mark_and_sweep(void)
+{
+ CDBG((SCM_DBG_GC, "[ gc start ]"));
+
+ gc_preprocess();
+ gc_mark();
+ gc_sweep();
+
+ /* we cannot sweep the object, so let's add new heap */
+ if (NULLP(scm_freelist)) {
+ CDBG((SCM_DBG_GC, "Cannot sweep the object, allocating new heap."));
+ add_heap(&scm_heaps, &scm_heap_num, SCM_HEAP_SIZE, &scm_freelist);
+ }
+}
+
+static void mark_obj(ScmObj obj)
+{
+ int i = 0;
+
+mark_loop:
+ /* no need to mark SCM_NULL */
+ if (NULLP(obj))
+ return;
+
+ /* avoid cyclic marking */
+ if (SCM_IS_MARKED(obj))
+ return;
+
+ /* mark this object */
+ SCM_DO_MARK(obj);
+
+ /* mark recursively */
+ switch (SCM_TYPE(obj)) {
+ case ScmCons:
+ mark_obj(CAR(obj));
+ obj = CDR(obj);
+ goto mark_loop;
+ break;
+
+ case ScmSymbol:
+ mark_obj(SCM_SYMBOL_VCELL(obj));
+ break;
+
+ case ScmClosure:
+ mark_obj(SCM_CLOSURE_EXP(obj));
+ obj = SCM_CLOSURE_ENV(obj);
+ goto mark_loop;
+ break;
+
+ case ScmValuePacket:
+#if SCM_USE_VALUECONS
+ mark_obj(SCM_VALUECONS_CAR(obj));
+ obj = SCM_VALUECONS_CDR(obj);
+#else
+ obj = SCM_VALUEPACKET_VALUES(obj);
+#endif
+ goto mark_loop;
+
+ case ScmVector:
+ for (i = 0; i < SCM_VECTOR_LEN(obj); i++) {
+ mark_obj(SCM_VECTOR_VEC(obj)[i]);
+ }
+ break;
+
+ default:
+ break;
+ }
+}
+
+static void finalize_protected_var(void)
+{
+ gc_protected_var *item = protected_var_list;
+ gc_protected_var *tmp = NULL;
+ while (item) {
+ *item->var = NULL;
+ tmp = item;
+ item = item->next_var;
+ free(tmp);
+ }
+ protected_var_list = NULL;
+}
+
+static int is_pointer_to_heap(ScmObj obj)
+{
+ /* The core part of Conservative GC */
+ int i = 0;
+ ScmObj head = SCM_NULL;
+ for (i = 0; i < scm_heap_num; i++) {
+ if ((head = scm_heaps[i])
+ && (head <= obj)
+ && (obj < head + SCM_HEAP_SIZE)
+ && ((((char*)obj - (char*)head) % sizeof(ScmCell)) == 0))
+ return 1;
+ }
+
+ return 0;
+}
+
+static void gc_mark_protected_var(void)
+{
+ gc_protected_var *item = NULL;
+ for (item = protected_var_list; item; item = item->next_var) {
+ mark_obj(*item->var);
+ }
+}
+
+static void gc_mark_locations_n(ScmObj *start, int n)
+{
+ int i = 0;
+ ScmObj obj = SCM_NULL;
+
+ /* mark stack */
+ for (i = 0; i < n; i++) {
+ obj = start[i];
+
+ if (is_pointer_to_heap(obj)) {
+ mark_obj(obj);
+ }
+ }
+
+}
+
+static void gc_mark_locations(ScmObj *start, ScmObj *end)
+{
+ int size = 0;
+ ScmObj *tmp = NULL;
+
+ /* swap end and start if (end < start) */
+ if (end < start) {
+ tmp = end;
+ end = start;
+ start = tmp;
+ }
+
+ /* get size */
+ size = end - start;
+
+ CDBG((SCM_DBG_GC, "gc_mark_locations() : size = %d", size));
+
+ gc_mark_locations_n(start, size);
+}
+
+static void gc_mark_symbol_hash(void)
+{
+ int i = 0;
+ for (i = 0; i < NAMEHASH_SIZE; i++) {
+ mark_obj(scm_symbol_hash[i]);
+ }
+}
+
+static void gc_mark(void)
+{
+ ScmObj stack_end;
+ void *save_regs_buf_end = (char *)save_regs_buf + sizeof(save_regs_buf);
+
+ CDBG((SCM_DBG_GC, "gc_mark()"));
+
+ setjmp(save_regs_buf);
+ gc_mark_locations((ScmObj *)save_regs_buf, (ScmObj *)save_regs_buf_end);
+ gc_mark_protected_var();
+ gc_mark_locations(scm_stack_start_pointer, &stack_end);
+ gc_mark_symbol_hash();
+}
+
+static void sweep_obj(ScmObj obj)
+{
+ /* if the type has the pointer to free, then free it! */
+ switch (SCM_TYPE(obj)) {
+ case ScmInt:
+ case ScmCons:
+ case ScmClosure:
+ break;
+
+ case ScmChar:
+ if (SCM_CHAR_VALUE(obj))
+ free(SCM_CHAR_VALUE(obj));
+ break;
+
+ case ScmString:
+ if (SCM_STRING_STR(obj))
+ free(SCM_STRING_STR(obj));
+ break;
+
+ case ScmVector:
+ if (SCM_VECTOR_VEC(obj))
+ free(SCM_VECTOR_VEC(obj));
+ break;
+
+ case ScmSymbol:
+ if (SCM_SYMBOL_NAME(obj))
+ free(SCM_SYMBOL_NAME(obj));
+ break;
+
+ case ScmPort:
+ if (SCM_PORT_IMPL(obj))
+ SCM_PORT_CLOSE_IMPL(obj);
+ break;
+
+ /* rarely swept objects */
+ case ScmContinuation:
+ case ScmFunc:
+ case ScmConstant:
+ case ScmFreeCell:
+ default:
+ break;
+ }
+}
+
+static void gc_sweep(void)
+{
+ int i = 0;
+ int j = 0;
+ int corrected_obj_num = 0;
+
+ ScmObj obj = SCM_NULL;
+ ScmObj scm_new_freelist = SCM_NULL;
+ /* iterate heaps */
+ for (i = 0; i < scm_heap_num; i++) {
+ corrected_obj_num = 0;
+
+ /* iterate in heap */
+ for (j = 0; j < SCM_HEAP_SIZE; j++) {
+ obj = &scm_heaps[i][j];
+ SCM_ASSERT(!SCM_MARK_CORRUPTED(obj));
+ if (!SCM_IS_MARKED(obj)) {
+ sweep_obj(obj);
+
+ SCM_ENTYPE_FREECELL(obj);
+ SCM_FREECELL_SET_CAR(obj, SCM_NULL);
+ SCM_FREECELL_SET_CDR(obj, scm_new_freelist);
+ scm_new_freelist = obj;
+ corrected_obj_num++;
+ }
+ }
+
+ CDBG((SCM_DBG_GC, "heap[%d] swept = %d", i, corrected_obj_num));
+ }
+ scm_freelist = scm_new_freelist;
+}
More information about the uim-commit
mailing list