3 /* Stop-and-copy garbage collection using Cheney's algorithm. */
5 /* #define GC_DEBUG /* */
7 INLINE void gc_debug(char* msg, CELL x) {
9 printf("%s %d\n",msg,x);
13 /* Given a pointer to a pointer to oldspace, copy it to newspace. */
14 CELL copy_untagged_object(CELL pointer, CELL size)
16 CELL newpointer = allot(size);
17 memcpy(newpointer,pointer,size);
23 Given a pointer to a tagged pointer to oldspace, copy it to newspace.
24 If the object has already been copied, return the forwarding
25 pointer address without copying anything; otherwise, install
26 a new forwarding pointer.
28 void copy_object(CELL* handle)
30 CELL pointer = *handle;
31 CELL tag = TAG(pointer);
32 CELL header, newpointer;
34 if(in_zone(active,pointer))
35 critical_error("copy_object given newspace ptr",pointer);
37 if(tag == FIXNUM_TYPE)
43 header = get(UNTAG(pointer));
45 if(TAG(header) == GC_COLLECTED)
47 newpointer = UNTAG(header);
48 gc_debug("FORWARDING",newpointer);
52 gc_debug("copy_object",pointer);
53 newpointer = copy_untagged_object(UNTAG(pointer),
54 object_size(pointer));
55 put(UNTAG(pointer),RETAG(newpointer,GC_COLLECTED));
58 if(tag == GC_COLLECTED)
59 critical_error("installing forwarding pointer in newspace",newpointer);
61 *handle = RETAG(newpointer,tag);
64 void collect_object(void)
66 CELL size = untagged_object_size(scan);
67 gc_debug("collect_object",scan);
68 gc_debug("collect_object size=",size);
70 switch(untag_header(get(scan)))
73 collect_array((ARRAY*)scan);
76 collect_vector((VECTOR*)scan);
79 collect_sbuf((SBUF*)scan);
82 collect_handle((HANDLE*)scan);
88 void collect_next(void)
90 gc_debug("collect_next",scan);
91 gc_debug("collect_next header",get(scan));
92 switch(TAG(get(scan)))
95 collect_word((WORD*)scan);
108 void copy_roots(void)
112 CELL ds_depth = env.ds - UNTAG(env.ds_bot);
113 CELL cs_depth = env.cs - UNTAG(env.cs_bot);
115 gc_debug("collect_roots",scan);
116 /* these three must be the first in the heap */
118 gc_debug("empty",empty);
123 copy_object(&env.dt);
124 copy_object(&env.ds_bot);
125 env.ds = UNTAG(env.ds_bot) + ds_depth;
126 copy_object(&env.cs_bot);
127 env.cs = UNTAG(env.cs_bot) + cs_depth;
128 copy_object(&env.cf);
129 copy_object(&env.boot);
131 for(i = 0; i < USER_ENV; i++)
132 copy_object(&env.user[i]);
135 void primitive_gc(void)
138 scan = active->here = active->base;
140 while(scan < active->here)
142 gc_debug("scan loop",scan);
145 gc_debug("gc done",0);