1 /* Walking the heap. */
2
3 /* -------------------------- Specification ---------------------------- */
4
5 /* Walks through all objects, and calls a given function on every object. */
6 global void map_heap_objects (map_heap_function_t* fun, void* arg);
7
8 /* -------------------------- Implementation --------------------------- */
9
10 /* UP: Walks through the whole memory and calls for each
11 object obj: fun(arg,obj,bytelen) .
12 map_heap_objects(fun,arg)
13 > fun: C-function
14 > arg: arbitrary given argument */
map_heap_objects(map_heap_function_t * fun,void * arg)15 global void map_heap_objects (map_heap_function_t* fun, void* arg) {
16 /* program constants: */
17 for_all_subrs({
18 fun(arg,subr_tab_ptr_as_object(ptr),sizeof(subr_t));
19 });
20 for_all_constsyms({
21 fun(arg,symbol_tab_ptr_as_object(ptr),sizeof(symbol_));
22 });
23 #if defined(SPVW_PURE_BLOCKS) /* && defined(SINGLEMAP_MEMORY) */
24 #define varobject_typecode_at(type,p)
25 #define cons_typecode_at(type,p)
26 #define with_typecode(p) as_object(p)
27 #else
28 #ifdef SPVW_MIXED
29 #ifdef TYPECODES
30 #define varobject_typecode_at(type,p) \
31 var tint type = typecode_at(p); \
32 switch (type) { \
33 case_symbolwithflags: type = symbol_type; break; \
34 default: break; \
35 }
36 #define cons_typecode_at(type,p) var tint type = cons_type
37 #else
38 #define varobject_typecode_at(type,p) var oint type = varobject_bias
39 #define cons_typecode_at(type,p) var oint type = cons_bias
40 #endif
41 #endif
42 #ifdef SPVW_PURE
43 #define varobject_typecode_at(type,p) var tint type = heapnr
44 #define cons_typecode_at(type,p) var tint type = heapnr
45 #endif
46 #ifdef TYPECODES
47 #define with_typecode(p) type_pointer_object(type,p)
48 #else
49 #define with_typecode(p) as_object((oint)(p)+(oint)type)
50 #endif
51 #endif
52 #ifdef GENERATIONAL_GC
53 /* objects of variable length: */
54 for_each_varobject_heap(heap, {
55 var_prepare_objsize;
56 {
57 var aint p = heap->heap_gen0_start;
58 var aint p_end = heap->heap_gen0_end;
59 while (p != p_end) {
60 varobject_typecode_at(type,p);
61 var uintM laenge = objsize((Varobject)p);
62 fun(arg,with_typecode(p),laenge);
63 p += laenge;
64 }
65 }
66 {
67 var aint p = heap->heap_gen1_start;
68 var aint p_end = heap->heap_end;
69 while (p != p_end) {
70 varobject_typecode_at(type,p);
71 var uintM laenge = objsize((Varobject)p);
72 fun(arg,with_typecode(p),laenge);
73 p += laenge;
74 }
75 }
76 });
77 /* two-pointer-objects: */
78 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
79 for_each_cons_heap(heap, {
80 {
81 var aint p = heap->heap_start;
82 var aint p_end = heap->heap_gen1_end;
83 while (p != p_end) {
84 cons_typecode_at(type,p);
85 fun(arg,with_typecode(p),sizeof(cons_));
86 p += sizeof(cons_);
87 }
88 }
89 {
90 var aint p = heap->heap_gen0_start;
91 var aint p_end = heap->heap_gen0_end;
92 while (p != p_end) {
93 cons_typecode_at(type,p);
94 fun(arg,with_typecode(p),sizeof(cons_));
95 p += sizeof(cons_);
96 }
97 }
98 });
99 #else
100 for_each_cons_heap(heap, {
101 {
102 var aint p = heap->heap_gen0_start;
103 var aint p_end = heap->heap_gen0_end;
104 while (p != p_end) {
105 cons_typecode_at(type,p);
106 fun(arg,with_typecode(p),sizeof(cons_));
107 p += sizeof(cons_);
108 }
109 }
110 {
111 var aint p = heap->heap_gen1_start;
112 var aint p_end = heap->heap_end;
113 while (p != p_end) {
114 cons_typecode_at(type,p);
115 fun(arg,with_typecode(p),sizeof(cons_));
116 p += sizeof(cons_);
117 }
118 }
119 });
120 #endif /* SPVW_MIXED_BLOCKS_OPPOSITE */
121 #else
122 /* objects of variable length: */
123 for_each_varobject_page(page, {
124 var aint p = page->page_start;
125 var aint p_end = page->page_end;
126 var_prepare_objsize;
127 while (p != p_end) {
128 varobject_typecode_at(type,p);
129 var uintM laenge = objsize((Varobject)p);
130 fun(arg,with_typecode(p),laenge);
131 p += laenge;
132 }
133 });
134 /* two-pointer-objects: */
135 for_each_cons_page(page, {
136 var aint p = page->page_start;
137 var aint p_end = page->page_end;
138 while (p != p_end) {
139 cons_typecode_at(type,p);
140 fun(arg,with_typecode(p),sizeof(cons_));
141 p += sizeof(cons_);
142 }
143 });
144 #endif /* GENERATIONAL_GC */
145 #undef varobject_typecode_at
146 #undef cons_typecode_at
147 #undef with_typecode
148 }
149