1 /* This file is only used when OLD_GC is defined.
2 How to maintain this file: see at the top of spvw_garcol_old.d. */
3
4 /* Memory management data structures, part 3: global data */
5
6 /* -------------------------- Specification ---------------------------- */
7
8 #ifdef TYPECODES
9 /* Number of possible typecodes. */
10 #define typecount bit(oint_type_len<=8 ? oint_type_len : 8)
11 #endif
12
13 /* Number of heaps.
14 heapcount */
15 #ifdef SPVW_MIXED
16 /* Two heaps: One for varobjects, one for two-pointer objects. */
17 #define heapcount 2
18 #endif
19 #ifdef SPVW_PURE
20 /* A heap for each possible typecode. */
21 #define heapcount typecount
22 #endif
23
24 /* Global memory management data structures. */
25 local struct {
26 /* Lower limit of big allocated memory block. */
27 aint MEMBOT;
28
29 /* now comes the Lisp STACK */
30 /* now room for the heaps containing Lisp objects. */
31 Heap heaps[heapcount];
32 #ifdef SPVW_PURE
33 sintB heaptype[heapcount];
34 /* for every typecode:
35 0 for conses
36 1 for varobjects containing object pointers
37 2 for varobjects containing no pointers (only immediate data)
38 -1 for SUBRs (gcinvariant)
39 -2 for unused or immediate typecodes */
40 #endif
41 #ifdef SPVW_MIXED
42 #define varobjects heaps[0] /* objects of various lengths */
43 #define conses heaps[1] /* conses and other two-pointer objects */
44 #endif
45 #if defined(SPVW_MIXED_BLOCKS_OPPOSITE) && !defined(TRIVIALMAP_MEMORY)
46 /* now empty, free for Lisp objects. */
47 #define MEMRES conses.heap_end
48 /* now the emergency reserve
49 Upper limit of big allocated memory block. */
50 aint MEMTOP;
51 #endif
52 /* User provided parameters, used for deciding when to start a GC. */
53 double nextgc_trigger_factor; /* influences the amount of space
54 that can be allocated until the next GC */
55 /* Statistical data, used for deciding when to start a GC. */
56 #if defined(SPVW_PURE_BLOCKS) || defined(TRIVIALMAP_MEMORY) || defined(GENERATIONAL_GC)
57 uintM total_room; /* the space that may be occupied without triggering GC */
58 #ifdef GENERATIONAL_GC
59 bool last_gc_full; /* if the last GC was a full one */
60 uintM last_gcend_space0; /* how much space was occupied after the last GC */
61 uintM last_gcend_space1; /* (from generation 0 resp. generation 1) */
62 #endif
63 #endif
64 #ifdef SPVW_PAGES
65 Pages free_pages; /* a list of free, normal-sized pages */
66 uintM total_space; /* how much space do the occupied pages contain at all */
67 uintM used_space; /* how much space is occupied just now */
68 uintM last_gcend_space; /* how much space was occupied after the last GC */
69 bool last_gc_compacted; /* if the last GC has already compacted */
70 uintM gctrigger_space; /* how much space may be occupied, until the next GC becomes necessary */
71 #endif
72 } mem;
73
74 #if defined(SPVW_MIXED_BLOCKS_OPPOSITE) && !defined(TRIVIALMAP_MEMORY) && !defined(GENERATIONAL_GC)
75 #define RESERVE 0x00800L /* 2 KByte memory as reserve */
76 #else
77 #define RESERVE 0 /* need no preallocated reserve */
78 #endif
79 #define MINIMUM_SPACE 0x10000L /* 64 KByte as minimal memory for LISP-data */
80 #ifdef TRIVIALMAP_MEMORY
81 #define RESERVE_FOR_MALLOC 0x100000L /* leave 1 MByte address space free, for malloc */
82 #endif
83
84 /* Iteration through all heaps.
85 for_each_heap(heapvar,statement);
86
87 Iteration through all heaps containing varobjects.
88 for_each_varobject_heap(heapvar,statement);
89
90 Iteration through all heaps containing conses.
91 for_each_cons_heap(heapvar,statement);
92
93 Iteration through all pages.
94 for_each_page(page, statement using 'var Page* page');
95
96 Iteration through all pages containing varobjects.
97 for_each_varobject_page(page, statement using 'var Page* page');
98
99 Iteration through all pages containing conses.
100 for_each_cons_page(page, statement using 'var Page* page');
101 for_each_cons_page_reversed(page, statement using 'var Page* page');
102
103 While iterating through all heaps (0 <= heapnr < heapcount):
104 Determine the type of a heap.
105 is_heap_containing_objects(heapnr)
106 is_varobject_heap(heapnr)
107 is_cons_heap(heapnr)
108 is_unused_heap(heapnr)
109
110 #ifdef TYPECODES
111 Determine the heap that contains objects of the given type.
112 typecode_to_heapnr(type)
113 #endif
114
115 Test for valid heap address, used only by consistency checks.
116 is_valid_varobject_address(address)
117 is_valid_cons_address(address)
118 is_valid_heap_object_address(address)
119 Likewise for stack-allocated objects, such as DYNAMIC_STRING.
120 is_valid_stack_address(address)
121
122 Consistency checks.
123 CHECK_AVL_CONSISTENCY();
124 CHECK_GC_CONSISTENCY();
125 CHECK_GC_CONSISTENCY_2();
126 CHECK_PACK_CONSISTENCY();
127
128 Initializations. */
129 #ifdef SPVW_PURE
130 local inline void init_mem_heaptypes (void);
131 #endif
132
133 /* -------------------------- Implementation --------------------------- */
134
135 /* partitioning of the whole memory (partly out-of-date):
136 1. C-program. Memory is allocated by the operating system.
137 un-movable after program start.
138 2. C-Stack. Is fetched by the C-program.
139 un-movable.
140 3. C-Heap. Is unused here.
141 #ifdef SPVW_MIXED_BLOCKS
142 4. LISP-stack and LISP-data.
143 4a. LISP-stack. un-movable.
144 4b. Objects of variable length. (Un-movable).
145 4c. Conses and similar. Movable with move_conses.
146 Memory therefore is requested from the operating system (has the
147 advantage: On EXECUTE, the whole memory that LISP currently does not
148 need can be provided to the foreign program).
149 We dispense here with a partitioning into single pages.
150 || LISP- |Objects of |-> empty <-|conses | reserve |
151 || stack |variable length ! !and similar| |
152 |STACK_BOUND | objects.end conses.start | |
153 MEMBOT objects.start conses.end MEMTOP
154 #endif
155 #ifdef SPVW_PURE_BLOCKS
156 4. LISP-stack. Un-movable.
157 5. LISP-data. For each type a large block of objects.
158 #endif
159 #ifdef SPVW_MIXED_PAGES
160 4. LISP-stack. Un-movable.
161 5. LISP-data.
162 subdivided into pages for objects of variable length and
163 pages for conses and similar.
164 #endif
165 #ifdef SPVW_PURE_PAGES
166 4. LISP-stack. Un-movable.
167 5. LISP-data. Subdivided into pages, that contain only objects
168 of the same type.
169 #endif
170 */
171
172 #ifdef SPVW_MIXED
173
174 /* Iteration through heaps. */
175 #define for_each_heap(heapvar,statement) \
176 do { \
177 var uintL heapnr; \
178 for (heapnr=0; heapnr<heapcount; heapnr++) { \
179 var Heap* heapvar = &mem.heaps[heapnr]; statement; \
180 } \
181 } while(0)
182 #define for_each_varobject_heap(heapvar,statement) \
183 do { var Heap* heapvar = &mem.varobjects; statement; } while(0)
184 #define for_each_cons_heap(heapvar,statement) \
185 do { var Heap* heapvar = &mem.conses; statement; } while(0)
186
187 /* Iteration through pages. */
188 #define for_each_page(pagevar,statement) \
189 do { \
190 var uintL heapnr; \
191 for (heapnr=0; heapnr<heapcount; heapnr++) \
192 map_heap(mem.heaps[heapnr],pagevar,statement); \
193 } while(0)
194 #define for_each_varobject_page(pagevar,statement) \
195 map_heap(mem.varobjects,pagevar,statement)
196 #define for_each_cons_page(pagevar,statement) \
197 map_heap(mem.conses,pagevar,statement)
198 #define for_each_cons_page_reversed for_each_cons_page
199
200 /* Heap classification. */
201 #define is_heap_containing_objects(heapnr) (true)
202 #define is_varobject_heap(heapnr) ((heapnr)==0)
203 #define is_cons_heap(heapnr) ((heapnr)==1)
204 #define is_unused_heap(heapnr) (false)
205
206 #endif
207
208 #ifdef SPVW_PURE
209
210 /* During iterations, `heapnr' is the number of the heap. */
211
212 /* Iteration through heaps. */
213 #define for_each_heap(heapvar,statement) \
214 do { \
215 var uintL heapnr; \
216 for (heapnr=0; heapnr<heapcount; heapnr++) \
217 if (mem.heaptype[heapnr] >= 0) { \
218 var Heap* heapvar = &mem.heaps[heapnr]; statement; \
219 } \
220 } while(0)
221 #define for_each_varobject_heap(heapvar,statement) \
222 do { \
223 var uintL heapnr; \
224 for (heapnr=0; heapnr<heapcount; heapnr++) \
225 if (mem.heaptype[heapnr] > 0) { \
226 var Heap* heapvar = &mem.heaps[heapnr]; statement; \
227 } \
228 } while(0)
229 #define for_each_cons_heap(heapvar,statement) \
230 do { \
231 var uintL heapnr; \
232 for (heapnr=0; heapnr<heapcount; heapnr++) \
233 if (mem.heaptype[heapnr] == 0) { \
234 var Heap* heapvar = &mem.heaps[heapnr]; statement; \
235 } \
236 } while(0)
237
238 /* Iteration through pages. */
239 #define for_each_page(pagevar,statement) \
240 do { \
241 var uintL heapnr; \
242 for (heapnr=0; heapnr<heapcount; heapnr++) \
243 if (mem.heaptype[heapnr] >= 0) \
244 map_heap(mem.heaps[heapnr],pagevar,statement); \
245 } while(0)
246 #define for_each_varobject_page(pagevar,statement) \
247 do { \
248 var uintL heapnr; \
249 for (heapnr=0; heapnr<heapcount; heapnr++) \
250 if (mem.heaptype[heapnr] > 0) \
251 map_heap(mem.heaps[heapnr],pagevar,statement); \
252 } while(0)
253 #define for_each_cons_page(pagevar,statement) \
254 do { \
255 var uintL heapnr; \
256 for (heapnr=0; heapnr<heapcount; heapnr++) \
257 if (mem.heaptype[heapnr] == 0) \
258 map_heap(mem.heaps[heapnr],pagevar,statement); \
259 } while(0)
260 #define for_each_cons_page_reversed(pagevar,statement) \
261 do { \
262 var uintL heapnr; \
263 for (heapnr=heapcount; heapnr-- > 0; ) \
264 if (mem.heaptype[heapnr] == 0) \
265 map_heap(mem.heaps[heapnr],pagevar,statement); \
266 } while(0)
267
268 /* Heap classification. */
269 #define is_heap_containing_objects(heapnr) ((mem.heaptype[heapnr] >= 0) && (mem.heaptype[heapnr] < 2))
270 #define is_cons_heap(heapnr) (mem.heaptype[heapnr] == 0)
271 #define is_varobject_heap(heapnr) (mem.heaptype[heapnr] > 0)
272 #define is_unused_heap(heapnr) (mem.heaptype[heapnr] < 0)
273
274 #endif
275
276 #ifdef TYPECODES
277 #if defined(SPVW_PURE)
278 #define typecode_to_heapnr(type) (type)
279 #else /* SPVW_MIXED */
280 /* Keep this consistent with the definition of 'case_pair'! */
281 #define typecode_to_heapnr(type) ((type)==cons_type) /* 1 or 0 */
282 #endif
283 #endif
284
285 #if defined(SPVW_BLOCKS) && defined(DEBUG_SPVW)
286 #ifdef SPVW_PURE
287 #define is_valid_varobject_address(address) \
288 is_varobject_heap(((aint)(address) >> oint_type_shift) & (oint_type_mask >> oint_type_shift))
289 #define is_valid_cons_address(address) \
290 is_cons_heap(((aint)(address) >> oint_type_shift) & (oint_type_mask >> oint_type_shift))
291 #define is_valid_heap_object_address(address) \
292 is_heap_containing_objects(((aint)(address) >> oint_type_shift) & (oint_type_mask >> oint_type_shift))
293 #else /* SPVW_MIXED */
294 #ifdef GENERATIONAL_GC
295 #define is_valid_varobject_address(address) \
296 ((aint)(address) >= mem.varobjects.heap_gen0_start \
297 && (aint)(address) < mem.varobjects.heap_end)
298 #ifdef SPVW_MIXED_BLOCKS_OPPOSITE
299 #define is_valid_cons_address(address) \
300 ((aint)(address) >= mem.conses.heap_start \
301 && (aint)(address) < mem.conses.heap_gen0_end)
302 #else
303 #define is_valid_cons_address(address) \
304 ((aint)(address) >= mem.conses.heap_gen0_start \
305 && (aint)(address) < mem.conses.heap_end)
306 #endif
307 #else
308 #define is_valid_varobject_address(address) \
309 ((aint)(address) >= mem.varobjects.heap_start \
310 && (aint)(address) < mem.varobjects.heap_end)
311 #define is_valid_cons_address(address) \
312 ((aint)(address) >= mem.conses.heap_start \
313 && (aint)(address) < mem.conses.heap_end)
314 #endif
315 #define is_valid_heap_object_address(address) \
316 (is_valid_varobject_address(address) || is_valid_cons_address(address))
317 #endif
318 #if !(defined(CAN_ALLOCATE_8BIT_VECTORS_ON_C_STACK) || defined(CAN_ALLOCATE_STRINGS_ON_C_STACK))
319 /* In case we do not have C stack allocated lisp objects we do not need
320 is_valid_stack_address(). Define to false in order to GC to assert
321 in case of bad object pointer. */
322 #define is_valid_stack_address(address) false
323 #else /* we have C stack allocated objects */
324 #ifdef SP_DOWN
325 #define is_in_stack_range(address,sp,sp_anchor) \
326 ((aint)(address) >= (aint)sp && (aint)(address) <= (aint)sp_anchor)
327 #endif
328 #ifdef SP_UP
329 #define is_in_stack_range(address,sp,sp_anchor) \
330 ((aint)(address) <= (aint)sp && (aint)(address) >= (aint)sp_anchor)
331 #endif
332 #define is_valid_stack_address(address) \
333 is_in_stack_range(address,SP(),SP_anchor)
334 #endif
335 #else
336 #define is_valid_varobject_address(address) true
337 #define is_valid_cons_address(address) true
338 #define is_valid_heap_object_address(address) true
339 #define is_valid_stack_address(address) true
340 #endif
341
342 /* Set during the core of GC. */
343 modexp bool inside_gc = false;
344
345 /* check of the memory content to be GC-proof: */
346 #if defined(SPVW_PAGES) && defined(DEBUG_SPVW)
347 /* check, if the administration of the pages is okay: */
348 #define CHECK_AVL_CONSISTENCY() check_avl_consistency()
check_avl_consistency(void)349 local void check_avl_consistency (void)
350 {
351 #ifdef DEBUG_AVL
352 var uintL heapnr;
353 for (heapnr=0; heapnr<heapcount; heapnr++) {
354 AVL(AVLID,check) (mem.heaps[heapnr].inuse);
355 }
356 #endif
357 }
358 /* check, if the boundaries of the pages are okay: */
359 #define CHECK_GC_CONSISTENCY() check_gc_consistency()
check_gc_consistency(void)360 local void check_gc_consistency (void)
361 {
362 for_each_page(page,
363 if ((sintM)page->page_room < 0) {
364 fprintf(stderr,"\npage overrun at address 0x%lx\n",page); abort();
365 }
366 if (page->page_start != page_start0(page) + mem.heaps[heapnr].misaligned) {
367 fprintf(stderr,"\ninconsistent page at address 0x%lx\n",page);
368 abort();
369 }
370 if (page->page_end - mem.heaps[heapnr].misaligned + page->page_room
371 != round_down(page->m_start + page->m_length,
372 varobject_alignment)) {
373 fprintf(stderr,"\ninconsistent page at address 0x%lx\n",page);
374 abort();
375 }
376 );
377 }
378 /* check, if the boundaries of the pages are okay during the compacting GC: */
379 #define CHECK_GC_CONSISTENCY_2() check_gc_consistency_2()
check_gc_consistency_2(void)380 local void check_gc_consistency_2 (void)
381 {
382 for_each_page(page,
383 if ((sintM)page->page_room < 0) {
384 fprintf(stderr,"\npage overrun at address 0x%lx\n",page); abort();
385 }
386 if (page->page_end + page->page_room
387 - (page->page_start - page_start0(page))
388 != round_down(page->m_start + page->m_length,
389 varobject_alignment)) {
390 fprintf(stderr,"\ninconsistent page at address 0x%lx\n",page);
391 abort();
392 }
393 );
394 }
395 #else
396 #define CHECK_AVL_CONSISTENCY()
397 #define CHECK_GC_CONSISTENCY()
398 #define CHECK_GC_CONSISTENCY_2()
399 #endif
400 #ifdef DEBUG_SPVW
401 /* check, if the tables of the packages are to some extent okay: */
402 #define CHECK_PACK_CONSISTENCY() check_pack_consistency()
check_pack_consistency(void)403 local void check_pack_consistency (void)
404 {
405 var object plist = O(all_packages);
406 while (consp(plist)) {
407 var object pack = Car(plist);
408 var object symtabs[2];
409 var uintC i;
410 symtabs[0] = ThePackage(pack)->pack_external_symbols;
411 symtabs[1] = ThePackage(pack)->pack_internal_symbols;
412 for (i = 0; i < 2; i++) {
413 var object symtab = symtabs[i];
414 var object table = TheSvector(symtab)->data[1];
415 var uintL index = Svector_length(table);
416 while (index!=0) {
417 var object entry = TheSvector(table)->data[--index];
418 var uintC count = 0;
419 while (consp(entry)) {
420 if (!symbolp(Car(entry)))
421 abort();
422 entry = Cdr(entry);
423 count++; if (count>=10000) abort();
424 }
425 }
426 }
427 plist = Cdr(plist);
428 }
429 }
430 #else
431 #define CHECK_PACK_CONSISTENCY()
432 #endif
433
434 /* Initializations. */
435 #ifdef SPVW_PURE
init_mem_heaptypes(void)436 local inline void init_mem_heaptypes (void)
437 {
438 var uintL heapnr;
439 for (heapnr=0; heapnr<heapcount; heapnr++) {
440 switch (heapnr) {
441 #ifndef HAVE_SMALL_SSTRING
442 case_sstring:
443 #endif
444 case_sbvector:
445 case_sb2vector:
446 case_sb4vector:
447 case_sb8vector:
448 case_sb16vector:
449 case_sb32vector:
450 case_bignum:
451 #ifndef IMMEDIATE_FFLOAT
452 case_ffloat:
453 #endif
454 case_dfloat:
455 case_lfloat:
456 mem.heaptype[heapnr] = 2; break;
457 #ifdef HAVE_SMALL_SSTRING
458 case_sstring: /* because of the reallocated simple-strings */
459 #endif
460 case_ostring:
461 case_obvector:
462 case_ob2vector:
463 case_ob4vector:
464 case_ob8vector:
465 case_ob16vector:
466 case_ob32vector:
467 case_vector:
468 case_mdarray:
469 case_record:
470 case_symbol:
471 mem.heaptype[heapnr] = 1; break;
472 case_pair:
473 mem.heaptype[heapnr] = 0; break;
474 case_subr:
475 mem.heaptype[heapnr] = -1; break;
476 default:
477 mem.heaptype[heapnr] = -2; break;
478 }
479 }
480 }
481 #endif
482