2 * C-level stuff to implement Lisp-level PURIFY
6 * This software is part of the SBCL system. See the README file for
9 * This software is derived from the CMU CL system, which was
10 * written at Carnegie Mellon University and released into the
11 * public domain. The software is in the public domain and is
12 * provided with absolutely no warranty. See the COPYING and CREDITS
13 * files for more information.
17 #include <sys/types.h>
27 #include "interrupt.h"
31 #include "gc-internal.h"
33 #include "genesis/primitive-objects.h"
34 #include "genesis/static-symbols.h"
38 #if defined(LISP_FEATURE_GENCGC)
39 /* this is another artifact of the poor integration between gencgc and
40 * the rest of the runtime: on cheney gc there is a global
41 * dynamic_space_free_pointer which is valid whenever foreign function
42 * call is active, but in gencgc there's no such variable and we have
45 static lispobj *dynamic_space_free_pointer;
47 extern unsigned long bytes_consed_between_gcs;
50 lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
53 #define gc_assert(ex) do { \
54 if (!(ex)) gc_abort(); \
61 /* These hold the original end of the read_only and static spaces so
62 * we can tell what are forwarding pointers. */
64 static lispobj *read_only_end, *static_end;
66 static lispobj *read_only_free, *static_free;
68 static lispobj *pscav(lispobj *addr, int nwords, boolean constant);
70 #define LATERBLOCKSIZE 1020
71 #define LATERMAXCOUNT 10
80 } *later_blocks = NULL;
81 static int later_count = 0;
83 #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
84 #define NWORDS(x,y) (CEILING((x),(y)) / (y))
86 /* FIXME: Shouldn't this be defined in sbcl.h? See also notes in
90 #define FUN_RAW_ADDR_OFFSET 0
92 #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
96 forwarding_pointer_p(lispobj obj)
98 lispobj *ptr = native_pointer(obj);
100 return ((static_end <= ptr && ptr <= static_free) ||
101 (read_only_end <= ptr && ptr <= read_only_free));
105 dynamic_pointer_p(lispobj ptr)
107 #ifndef LISP_FEATURE_GENCGC
108 return (ptr >= (lispobj)current_dynamic_space
110 ptr < (lispobj)dynamic_space_free_pointer);
112 /* Be more conservative, and remember, this is a maybe. */
113 return (ptr >= (lispobj)DYNAMIC_SPACE_START
115 ptr < (lispobj)dynamic_space_free_pointer);
119 static inline lispobj *
120 newspace_alloc(int nwords, int constantp)
123 nwords=CEILING(nwords,2);
126 read_only_free+=nwords;
136 #ifdef LISP_FEATURE_X86
138 #ifdef LISP_FEATURE_GENCGC
140 * enhanced x86/GENCGC stack scavenging by Douglas Crosher
142 * Scavenging the stack on the i386 is problematic due to conservative
143 * roots and raw return addresses. Here it is handled in two passes:
144 * the first pass runs before any objects are moved and tries to
145 * identify valid pointers and return address on the stack, the second
146 * pass scavenges these.
149 static unsigned pointer_filter_verbose = 0;
151 /* FIXME: This is substantially the same code as
152 * possibly_valid_dynamic_space_pointer in gencgc.c. The only
153 * relevant difference seems to be that the gencgc code also checks
154 * for raw pointers into Code objects, whereas in purify these are
155 * checked separately in setup_i386_stack_scav - they go onto
156 * valid_stack_ra_locations instead of just valid_stack_locations */
159 valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr)
161 /* If it's not a return address then it needs to be a valid Lisp
163 if (!is_lisp_pointer((lispobj)pointer))
166 /* Check that the object pointed to is consistent with the pointer
168 switch (lowtag_of((lispobj)pointer)) {
169 case FUN_POINTER_LOWTAG:
170 /* Start_addr should be the enclosing code object, or a closure
172 switch (widetag_of(*start_addr)) {
173 case CODE_HEADER_WIDETAG:
174 /* This case is probably caught above. */
176 case CLOSURE_HEADER_WIDETAG:
177 case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
178 if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) {
179 if (pointer_filter_verbose) {
180 fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer,
181 (unsigned int) start_addr, *start_addr);
187 if (pointer_filter_verbose) {
188 fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer,
189 (unsigned int) start_addr, *start_addr);
194 case LIST_POINTER_LOWTAG:
195 if ((int)pointer != ((int)start_addr+LIST_POINTER_LOWTAG)) {
196 if (pointer_filter_verbose)
197 fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer,
198 (unsigned int) start_addr, *start_addr);
201 /* Is it plausible cons? */
202 if ((is_lisp_pointer(start_addr[0])
203 || ((start_addr[0] & 3) == 0) /* fixnum */
204 || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
205 || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
206 && (is_lisp_pointer(start_addr[1])
207 || ((start_addr[1] & 3) == 0) /* fixnum */
208 || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
209 || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) {
212 if (pointer_filter_verbose) {
213 fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer,
214 (unsigned int) start_addr, *start_addr);
218 case INSTANCE_POINTER_LOWTAG:
219 if ((int)pointer != ((int)start_addr+INSTANCE_POINTER_LOWTAG)) {
220 if (pointer_filter_verbose) {
221 fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer,
222 (unsigned int) start_addr, *start_addr);
226 if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
227 if (pointer_filter_verbose) {
228 fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer,
229 (unsigned int) start_addr, *start_addr);
234 case OTHER_POINTER_LOWTAG:
235 if ((int)pointer != ((int)start_addr+OTHER_POINTER_LOWTAG)) {
236 if (pointer_filter_verbose) {
237 fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer,
238 (unsigned int) start_addr, *start_addr);
242 /* Is it plausible? Not a cons. XXX should check the headers. */
243 if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
244 if (pointer_filter_verbose) {
245 fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer,
246 (unsigned int) start_addr, *start_addr);
250 switch (widetag_of(start_addr[0])) {
251 case UNBOUND_MARKER_WIDETAG:
252 case BASE_CHAR_WIDETAG:
253 if (pointer_filter_verbose) {
254 fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer,
255 (unsigned int) start_addr, *start_addr);
259 /* only pointed to by function pointers? */
260 case CLOSURE_HEADER_WIDETAG:
261 case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
262 if (pointer_filter_verbose) {
263 fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer,
264 (unsigned int) start_addr, *start_addr);
268 case INSTANCE_HEADER_WIDETAG:
269 if (pointer_filter_verbose) {
270 fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer,
271 (unsigned int) start_addr, *start_addr);
275 /* the valid other immediate pointer objects */
276 case SIMPLE_VECTOR_WIDETAG:
278 case COMPLEX_WIDETAG:
279 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
280 case COMPLEX_SINGLE_FLOAT_WIDETAG:
282 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
283 case COMPLEX_DOUBLE_FLOAT_WIDETAG:
285 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
286 case COMPLEX_LONG_FLOAT_WIDETAG:
288 case SIMPLE_ARRAY_WIDETAG:
289 case COMPLEX_BASE_STRING_WIDETAG:
290 case COMPLEX_VECTOR_NIL_WIDETAG:
291 case COMPLEX_BIT_VECTOR_WIDETAG:
292 case COMPLEX_VECTOR_WIDETAG:
293 case COMPLEX_ARRAY_WIDETAG:
294 case VALUE_CELL_HEADER_WIDETAG:
295 case SYMBOL_HEADER_WIDETAG:
297 case CODE_HEADER_WIDETAG:
299 case SINGLE_FLOAT_WIDETAG:
300 case DOUBLE_FLOAT_WIDETAG:
301 #ifdef LONG_FLOAT_WIDETAG
302 case LONG_FLOAT_WIDETAG:
304 case SIMPLE_ARRAY_NIL_WIDETAG:
305 case SIMPLE_BASE_STRING_WIDETAG:
306 case SIMPLE_BIT_VECTOR_WIDETAG:
307 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
308 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
309 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
310 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
311 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
312 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
313 case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
314 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
315 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
316 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
317 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
319 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
320 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
322 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
323 case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
325 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
326 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
328 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
329 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
330 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
331 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
333 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
334 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
336 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
337 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
339 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
340 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
343 case WEAK_POINTER_WIDETAG:
347 if (pointer_filter_verbose) {
348 fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer,
349 (unsigned int) start_addr, *start_addr);
355 if (pointer_filter_verbose) {
356 fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer,
357 (unsigned int) start_addr, *start_addr);
366 #define MAX_STACK_POINTERS 256
367 lispobj *valid_stack_locations[MAX_STACK_POINTERS];
368 unsigned int num_valid_stack_locations;
370 #define MAX_STACK_RETURN_ADDRESSES 128
371 lispobj *valid_stack_ra_locations[MAX_STACK_RETURN_ADDRESSES];
372 lispobj *valid_stack_ra_code_objects[MAX_STACK_RETURN_ADDRESSES];
373 unsigned int num_valid_stack_ra_locations;
375 /* Identify valid stack slots. */
377 setup_i386_stack_scav(lispobj *lowaddr, lispobj *base)
379 lispobj *sp = lowaddr;
380 num_valid_stack_locations = 0;
381 num_valid_stack_ra_locations = 0;
382 for (sp = lowaddr; sp < base; sp++) {
384 /* Find the object start address */
385 lispobj *start_addr = search_dynamic_space((void *)thing);
387 /* We need to allow raw pointers into Code objects for
388 * return addresses. This will also pick up pointers to
389 * functions in code objects. */
390 if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
391 /* FIXME asserting here is a really dumb thing to do.
392 * If we've overflowed some arbitrary static limit, we
393 * should just refuse to purify, instead of killing
394 * the whole lisp session
396 gc_assert(num_valid_stack_ra_locations <
397 MAX_STACK_RETURN_ADDRESSES);
398 valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
399 valid_stack_ra_code_objects[num_valid_stack_ra_locations++] =
400 (lispobj *)((int)start_addr + OTHER_POINTER_LOWTAG);
402 if (valid_dynamic_space_pointer((void *)thing, start_addr)) {
403 gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS);
404 valid_stack_locations[num_valid_stack_locations++] = sp;
409 if (pointer_filter_verbose) {
410 fprintf(stderr, "number of valid stack pointers = %d\n",
411 num_valid_stack_locations);
412 fprintf(stderr, "number of stack return addresses = %d\n",
413 num_valid_stack_ra_locations);
418 pscav_i386_stack(void)
422 for (i = 0; i < num_valid_stack_locations; i++)
423 pscav(valid_stack_locations[i], 1, 0);
425 for (i = 0; i < num_valid_stack_ra_locations; i++) {
426 lispobj code_obj = (lispobj)valid_stack_ra_code_objects[i];
427 pscav(&code_obj, 1, 0);
428 if (pointer_filter_verbose) {
429 fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n",
430 *valid_stack_ra_locations[i],
431 (int)(*valid_stack_ra_locations[i])
432 - ((int)valid_stack_ra_code_objects[i] - (int)code_obj),
433 (unsigned int) valid_stack_ra_code_objects[i], code_obj);
435 *valid_stack_ra_locations[i] =
436 ((int)(*valid_stack_ra_locations[i])
437 - ((int)valid_stack_ra_code_objects[i] - (int)code_obj));
445 pscav_later(lispobj *where, int count)
449 if (count > LATERMAXCOUNT) {
450 while (count > LATERMAXCOUNT) {
451 pscav_later(where, LATERMAXCOUNT);
452 count -= LATERMAXCOUNT;
453 where += LATERMAXCOUNT;
457 if (later_blocks == NULL || later_count == LATERBLOCKSIZE ||
458 (later_count == LATERBLOCKSIZE-1 && count > 1)) {
459 new = (struct later *)malloc(sizeof(struct later));
460 new->next = later_blocks;
461 if (later_blocks && later_count < LATERBLOCKSIZE)
462 later_blocks->u[later_count].ptr = NULL;
468 later_blocks->u[later_count++].count = count;
469 later_blocks->u[later_count++].ptr = where;
474 ptrans_boxed(lispobj thing, lispobj header, boolean constant)
477 lispobj result, *new, *old;
479 nwords = 1 + HeaderValue(header);
482 old = (lispobj *)native_pointer(thing);
483 new = newspace_alloc(nwords,constant);
486 bcopy(old, new, nwords * sizeof(lispobj));
488 /* Deposit forwarding pointer. */
489 result = make_lispobj(new, lowtag_of(thing));
493 pscav(new, nwords, constant);
498 /* We need to look at the layout to see whether it is a pure structure
499 * class, and only then can we transport as constant. If it is pure,
500 * we can ALWAYS transport as a constant. */
502 ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant)
504 lispobj layout = ((struct instance *)native_pointer(thing))->slots[0];
505 lispobj pure = ((struct instance *)native_pointer(layout))->slots[15];
509 return (ptrans_boxed(thing, header, 1));
511 return (ptrans_boxed(thing, header, 0));
514 /* Substructure: special case for the COMPACT-INFO-ENVs,
515 * where the instance may have a point to the dynamic
516 * space placed into it (e.g. the cache-name slot), but
517 * the lists and arrays at the time of a purify can be
518 * moved to the RO space. */
520 lispobj result, *new, *old;
522 nwords = 1 + HeaderValue(header);
525 old = (lispobj *)native_pointer(thing);
526 new = newspace_alloc(nwords, 0); /* inconstant */
529 bcopy(old, new, nwords * sizeof(lispobj));
531 /* Deposit forwarding pointer. */
532 result = make_lispobj(new, lowtag_of(thing));
536 pscav(new, nwords, 1);
542 return NIL; /* dummy value: return something ... */
547 ptrans_fdefn(lispobj thing, lispobj header)
550 lispobj result, *new, *old, oldfn;
553 nwords = 1 + HeaderValue(header);
556 old = (lispobj *)native_pointer(thing);
557 new = newspace_alloc(nwords, 0); /* inconstant */
560 bcopy(old, new, nwords * sizeof(lispobj));
562 /* Deposit forwarding pointer. */
563 result = make_lispobj(new, lowtag_of(thing));
566 /* Scavenge the function. */
567 fdefn = (struct fdefn *)new;
569 pscav(&fdefn->fun, 1, 0);
570 if ((char *)oldfn + FUN_RAW_ADDR_OFFSET == fdefn->raw_addr)
571 fdefn->raw_addr = (char *)fdefn->fun + FUN_RAW_ADDR_OFFSET;
577 ptrans_unboxed(lispobj thing, lispobj header)
580 lispobj result, *new, *old;
582 nwords = 1 + HeaderValue(header);
585 old = (lispobj *)native_pointer(thing);
586 new = newspace_alloc(nwords,1); /* always constant */
589 bcopy(old, new, nwords * sizeof(lispobj));
591 /* Deposit forwarding pointer. */
592 result = make_lispobj(new , lowtag_of(thing));
599 ptrans_vector(lispobj thing, int bits, int extra,
600 boolean boxed, boolean constant)
602 struct vector *vector;
604 lispobj result, *new;
606 vector = (struct vector *)native_pointer(thing);
607 nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5);
609 new=newspace_alloc(nwords, (constant || !boxed));
610 bcopy(vector, new, nwords * sizeof(lispobj));
612 result = make_lispobj(new, lowtag_of(thing));
613 vector->header = result;
616 pscav(new, nwords, constant);
621 #ifdef LISP_FEATURE_X86
623 apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
625 int nheader_words, ncode_words, nwords;
626 void *constants_start_addr, *constants_end_addr;
627 void *code_start_addr, *code_end_addr;
628 lispobj fixups = NIL;
629 unsigned displacement = (unsigned)new_code - (unsigned)old_code;
630 struct vector *fixups_vector;
632 ncode_words = fixnum_value(new_code->code_size);
633 nheader_words = HeaderValue(*(lispobj *)new_code);
634 nwords = ncode_words + nheader_words;
636 constants_start_addr = (void *)new_code + 5*4;
637 constants_end_addr = (void *)new_code + nheader_words*4;
638 code_start_addr = (void *)new_code + nheader_words*4;
639 code_end_addr = (void *)new_code + nwords*4;
641 /* The first constant should be a pointer to the fixups for this
642 * code objects. Check. */
643 fixups = new_code->constants[0];
645 /* It will be 0 or the unbound-marker if there are no fixups, and
646 * will be an other-pointer to a vector if it is valid. */
648 (fixups==UNBOUND_MARKER_WIDETAG) ||
649 !is_lisp_pointer(fixups)) {
650 #ifdef LISP_FEATURE_GENCGC
651 /* Check for a possible errors. */
652 sniff_code_object(new_code,displacement);
657 fixups_vector = (struct vector *)native_pointer(fixups);
659 /* Could be pointing to a forwarding pointer. */
660 if (is_lisp_pointer(fixups) && (dynamic_pointer_p(fixups))
661 && forwarding_pointer_p(*(lispobj *)fixups_vector)) {
662 /* If so then follow it. */
664 (struct vector *)native_pointer(*(lispobj *)fixups_vector);
667 if (widetag_of(fixups_vector->header) ==
668 SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
669 /* We got the fixups for the code block. Now work through the
670 * vector, and apply a fixup at each address. */
671 int length = fixnum_value(fixups_vector->length);
673 for (i=0; i<length; i++) {
674 unsigned offset = fixups_vector->data[i];
675 /* Now check the current value of offset. */
677 *(unsigned *)((unsigned)code_start_addr + offset);
679 /* If it's within the old_code object then it must be an
680 * absolute fixup (relative ones are not saved) */
681 if ((old_value>=(unsigned)old_code)
682 && (old_value<((unsigned)old_code + nwords*4)))
683 /* So add the dispacement. */
684 *(unsigned *)((unsigned)code_start_addr + offset) = old_value
687 /* It is outside the old code object so it must be a relative
688 * fixup (absolute fixups are not saved). So subtract the
690 *(unsigned *)((unsigned)code_start_addr + offset) = old_value
695 /* No longer need the fixups. */
696 new_code->constants[0] = 0;
698 #ifdef LISP_FEATURE_GENCGC
699 /* Check for possible errors. */
700 sniff_code_object(new_code,displacement);
706 ptrans_code(lispobj thing)
708 struct code *code, *new;
710 lispobj func, result;
712 code = (struct code *)native_pointer(thing);
713 nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
715 new = (struct code *)newspace_alloc(nwords,1); /* constant */
717 bcopy(code, new, nwords * sizeof(lispobj));
719 #ifdef LISP_FEATURE_X86
720 apply_code_fixups_during_purify(code,new);
723 result = make_lispobj(new, OTHER_POINTER_LOWTAG);
725 /* Stick in a forwarding pointer for the code object. */
726 *(lispobj *)code = result;
728 /* Put in forwarding pointers for all the functions. */
729 for (func = code->entry_points;
731 func = ((struct simple_fun *)native_pointer(func))->next) {
733 gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
735 *(lispobj *)native_pointer(func) = result + (func - thing);
738 /* Arrange to scavenge the debug info later. */
739 pscav_later(&new->debug_info, 1);
741 /* FIXME: why would this be a fixnum? */
742 /* "why" is a hard word, but apparently for compiled functions the
743 trace_table_offset contains the length of the instructions, as
744 a fixnum. See CODE-INST-AREA-LENGTH in
745 src/compiler/target-disassem.lisp. -- CSR, 2004-01-08 */
746 if (!(fixnump(new->trace_table_offset)))
748 pscav(&new->trace_table_offset, 1, 0);
750 new->trace_table_offset = NIL; /* limit lifetime */
753 /* Scavenge the constants. */
754 pscav(new->constants, HeaderValue(new->header)-5, 1);
756 /* Scavenge all the functions. */
757 pscav(&new->entry_points, 1, 1);
758 for (func = new->entry_points;
760 func = ((struct simple_fun *)native_pointer(func))->next) {
761 gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
762 gc_assert(!dynamic_pointer_p(func));
764 #ifdef LISP_FEATURE_X86
765 /* Temporarily convert the self pointer to a real function pointer. */
766 ((struct simple_fun *)native_pointer(func))->self
767 -= FUN_RAW_ADDR_OFFSET;
769 pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
770 #ifdef LISP_FEATURE_X86
771 ((struct simple_fun *)native_pointer(func))->self
772 += FUN_RAW_ADDR_OFFSET;
774 pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3);
781 ptrans_func(lispobj thing, lispobj header)
784 lispobj code, *new, *old, result;
785 struct simple_fun *function;
787 /* Thing can either be a function header, a closure function
788 * header, a closure, or a funcallable-instance. If it's a closure
789 * or a funcallable-instance, we do the same as ptrans_boxed.
790 * Otherwise we have to do something strange, 'cause it is buried
791 * inside a code object. */
793 if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG) {
795 /* We can only end up here if the code object has not been
796 * scavenged, because if it had been scavenged, forwarding pointers
797 * would have been left behind for all the entry points. */
799 function = (struct simple_fun *)native_pointer(thing);
802 ((native_pointer(thing) -
803 (HeaderValue(function->header))), OTHER_POINTER_LOWTAG);
805 /* This will cause the function's header to be replaced with a
806 * forwarding pointer. */
810 /* So we can just return that. */
811 return function->header;
814 /* It's some kind of closure-like thing. */
815 nwords = 1 + HeaderValue(header);
816 old = (lispobj *)native_pointer(thing);
818 /* Allocate the new one. FINs *must* not go in read_only
819 * space. Closures can; they never change */
822 (nwords,(widetag_of(header)!=FUNCALLABLE_INSTANCE_HEADER_WIDETAG));
825 bcopy(old, new, nwords * sizeof(lispobj));
827 /* Deposit forwarding pointer. */
828 result = make_lispobj(new, lowtag_of(thing));
832 pscav(new, nwords, 0);
839 ptrans_returnpc(lispobj thing, lispobj header)
843 /* Find the corresponding code object. */
844 code = thing - HeaderValue(header)*sizeof(lispobj);
846 /* Make sure it's been transported. */
847 new = *(lispobj *)native_pointer(code);
848 if (!forwarding_pointer_p(new))
849 new = ptrans_code(code);
851 /* Maintain the offset: */
852 return new + (thing - code);
855 #define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2)
858 ptrans_list(lispobj thing, boolean constant)
860 struct cons *old, *new, *orig;
863 orig = (struct cons *) newspace_alloc(0,constant);
867 /* Allocate a new cons cell. */
868 old = (struct cons *)native_pointer(thing);
869 new = (struct cons *) newspace_alloc(WORDS_PER_CONS,constant);
871 /* Copy the cons cell and keep a pointer to the cdr. */
873 thing = new->cdr = old->cdr;
875 /* Set up the forwarding pointer. */
876 *(lispobj *)old = make_lispobj(new, LIST_POINTER_LOWTAG);
878 /* And count this cell. */
880 } while (lowtag_of(thing) == LIST_POINTER_LOWTAG &&
881 dynamic_pointer_p(thing) &&
882 !(forwarding_pointer_p(*(lispobj *)native_pointer(thing))));
884 /* Scavenge the list we just copied. */
885 pscav((lispobj *)orig, length * WORDS_PER_CONS, constant);
887 return make_lispobj(orig, LIST_POINTER_LOWTAG);
891 ptrans_otherptr(lispobj thing, lispobj header, boolean constant)
893 switch (widetag_of(header)) {
894 /* FIXME: this needs a reindent */
896 case SINGLE_FLOAT_WIDETAG:
897 case DOUBLE_FLOAT_WIDETAG:
898 #ifdef LONG_FLOAT_WIDETAG
899 case LONG_FLOAT_WIDETAG:
901 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
902 case COMPLEX_SINGLE_FLOAT_WIDETAG:
904 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
905 case COMPLEX_DOUBLE_FLOAT_WIDETAG:
907 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
908 case COMPLEX_LONG_FLOAT_WIDETAG:
911 return ptrans_unboxed(thing, header);
914 case COMPLEX_WIDETAG:
915 case SIMPLE_ARRAY_WIDETAG:
916 case COMPLEX_BASE_STRING_WIDETAG:
917 case COMPLEX_BIT_VECTOR_WIDETAG:
918 case COMPLEX_VECTOR_NIL_WIDETAG:
919 case COMPLEX_VECTOR_WIDETAG:
920 case COMPLEX_ARRAY_WIDETAG:
921 return ptrans_boxed(thing, header, constant);
923 case VALUE_CELL_HEADER_WIDETAG:
924 case WEAK_POINTER_WIDETAG:
925 return ptrans_boxed(thing, header, 0);
927 case SYMBOL_HEADER_WIDETAG:
928 return ptrans_boxed(thing, header, 0);
930 case SIMPLE_ARRAY_NIL_WIDETAG:
931 return ptrans_vector(thing, 0, 0, 0, constant);
933 case SIMPLE_BASE_STRING_WIDETAG:
934 return ptrans_vector(thing, 8, 1, 0, constant);
936 case SIMPLE_BIT_VECTOR_WIDETAG:
937 return ptrans_vector(thing, 1, 0, 0, constant);
939 case SIMPLE_VECTOR_WIDETAG:
940 return ptrans_vector(thing, 32, 0, 1, constant);
942 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
943 return ptrans_vector(thing, 2, 0, 0, constant);
945 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
946 return ptrans_vector(thing, 4, 0, 0, constant);
948 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
949 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
950 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
951 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
953 return ptrans_vector(thing, 8, 0, 0, constant);
955 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
956 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
957 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
958 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
960 return ptrans_vector(thing, 16, 0, 0, constant);
962 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
963 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
964 case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
965 case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
967 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
968 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
969 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
971 return ptrans_vector(thing, 32, 0, 0, constant);
973 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
974 return ptrans_vector(thing, 32, 0, 0, constant);
976 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
977 return ptrans_vector(thing, 64, 0, 0, constant);
979 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
980 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
981 #ifdef LISP_FEATURE_X86
982 return ptrans_vector(thing, 96, 0, 0, constant);
985 return ptrans_vector(thing, 128, 0, 0, constant);
989 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
990 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
991 return ptrans_vector(thing, 64, 0, 0, constant);
994 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
995 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
996 return ptrans_vector(thing, 128, 0, 0, constant);
999 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1000 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
1001 #ifdef LISP_FEATURE_X86
1002 return ptrans_vector(thing, 192, 0, 0, constant);
1005 return ptrans_vector(thing, 256, 0, 0, constant);
1009 case CODE_HEADER_WIDETAG:
1010 return ptrans_code(thing);
1012 case RETURN_PC_HEADER_WIDETAG:
1013 return ptrans_returnpc(thing, header);
1016 return ptrans_fdefn(thing, header);
1019 /* Should only come across other pointers to the above stuff. */
1026 pscav_fdefn(struct fdefn *fdefn)
1030 fix_func = ((char *)(fdefn->fun+FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr);
1031 pscav(&fdefn->name, 1, 1);
1032 pscav(&fdefn->fun, 1, 0);
1034 fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
1035 return sizeof(struct fdefn) / sizeof(lispobj);
1038 #ifdef LISP_FEATURE_X86
1039 /* now putting code objects in static space */
1041 pscav_code(struct code*code)
1045 nwords = HeaderValue(code->header) + fixnum_value(code->code_size);
1047 /* Arrange to scavenge the debug info later. */
1048 pscav_later(&code->debug_info, 1);
1050 /* Scavenge the constants. */
1051 pscav(code->constants, HeaderValue(code->header)-5, 1);
1053 /* Scavenge all the functions. */
1054 pscav(&code->entry_points, 1, 1);
1055 for (func = code->entry_points;
1057 func = ((struct simple_fun *)native_pointer(func))->next) {
1058 gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG);
1059 gc_assert(!dynamic_pointer_p(func));
1061 #ifdef LISP_FEATURE_X86
1062 /* Temporarily convert the self pointer to a real function
1064 ((struct simple_fun *)native_pointer(func))->self
1065 -= FUN_RAW_ADDR_OFFSET;
1067 pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1);
1068 #ifdef LISP_FEATURE_X86
1069 ((struct simple_fun *)native_pointer(func))->self
1070 += FUN_RAW_ADDR_OFFSET;
1072 pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3);
1075 return CEILING(nwords,2);
1080 pscav(lispobj *addr, int nwords, boolean constant)
1082 lispobj thing, *thingp, header;
1083 int count = 0; /* (0 = dummy init value to stop GCC warning) */
1084 struct vector *vector;
1086 while (nwords > 0) {
1088 if (is_lisp_pointer(thing)) {
1089 /* It's a pointer. Is it something we might have to move? */
1090 if (dynamic_pointer_p(thing)) {
1091 /* Maybe. Have we already moved it? */
1092 thingp = (lispobj *)native_pointer(thing);
1094 if (is_lisp_pointer(header) && forwarding_pointer_p(header))
1095 /* Yep, so just copy the forwarding pointer. */
1098 /* Nope, copy the object. */
1099 switch (lowtag_of(thing)) {
1100 case FUN_POINTER_LOWTAG:
1101 thing = ptrans_func(thing, header);
1104 case LIST_POINTER_LOWTAG:
1105 thing = ptrans_list(thing, constant);
1108 case INSTANCE_POINTER_LOWTAG:
1109 thing = ptrans_instance(thing, header, constant);
1112 case OTHER_POINTER_LOWTAG:
1113 thing = ptrans_otherptr(thing, header, constant);
1117 /* It was a pointer, but not one of them? */
1125 else if (thing & 3) { /* FIXME: 3? not 2? */
1126 /* It's an other immediate. Maybe the header for an unboxed */
1128 switch (widetag_of(thing)) {
1129 case BIGNUM_WIDETAG:
1130 case SINGLE_FLOAT_WIDETAG:
1131 case DOUBLE_FLOAT_WIDETAG:
1132 #ifdef LONG_FLOAT_WIDETAG
1133 case LONG_FLOAT_WIDETAG:
1136 /* It's an unboxed simple object. */
1137 count = HeaderValue(thing)+1;
1140 case SIMPLE_VECTOR_WIDETAG:
1141 if (HeaderValue(thing) == subtype_VectorValidHashing) {
1142 *addr = (subtype_VectorMustRehash << N_WIDETAG_BITS) |
1143 SIMPLE_VECTOR_WIDETAG;
1148 case SIMPLE_ARRAY_NIL_WIDETAG:
1152 case SIMPLE_BASE_STRING_WIDETAG:
1153 vector = (struct vector *)addr;
1154 count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2);
1157 case SIMPLE_BIT_VECTOR_WIDETAG:
1158 vector = (struct vector *)addr;
1159 count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2);
1162 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
1163 vector = (struct vector *)addr;
1164 count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2);
1167 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
1168 vector = (struct vector *)addr;
1169 count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2);
1172 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
1173 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1174 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
1175 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
1177 vector = (struct vector *)addr;
1178 count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2);
1181 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
1182 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1183 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
1184 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
1186 vector = (struct vector *)addr;
1187 count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2);
1190 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
1191 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1192 case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
1193 case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
1195 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1196 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
1197 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
1199 vector = (struct vector *)addr;
1200 count = CEILING(fixnum_value(vector->length)+2,2);
1203 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
1204 vector = (struct vector *)addr;
1205 count = CEILING(fixnum_value(vector->length)+2,2);
1208 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
1209 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1210 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
1212 vector = (struct vector *)addr;
1213 count = fixnum_value(vector->length)*2+2;
1216 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1217 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
1218 vector = (struct vector *)addr;
1219 #ifdef LISP_FEATURE_X86
1220 count = fixnum_value(vector->length)*3+2;
1223 count = fixnum_value(vector->length)*4+2;
1228 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1229 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
1230 vector = (struct vector *)addr;
1231 count = fixnum_value(vector->length)*4+2;
1235 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1236 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
1237 vector = (struct vector *)addr;
1238 #ifdef LISP_FEATURE_X86
1239 count = fixnum_value(vector->length)*6+2;
1242 count = fixnum_value(vector->length)*8+2;
1247 case CODE_HEADER_WIDETAG:
1248 #ifndef LISP_FEATURE_X86
1249 gc_abort(); /* no code headers in static space */
1251 count = pscav_code((struct code*)addr);
1255 case SIMPLE_FUN_HEADER_WIDETAG:
1256 case RETURN_PC_HEADER_WIDETAG:
1257 /* We should never hit any of these, 'cause they occur
1258 * buried in the middle of code objects. */
1262 #ifdef LISP_FEATURE_X86
1263 case CLOSURE_HEADER_WIDETAG:
1264 case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
1265 /* The function self pointer needs special care on the
1266 * x86 because it is the real entry point. */
1268 lispobj fun = ((struct closure *)addr)->fun
1269 - FUN_RAW_ADDR_OFFSET;
1270 pscav(&fun, 1, constant);
1271 ((struct closure *)addr)->fun = fun + FUN_RAW_ADDR_OFFSET;
1277 case WEAK_POINTER_WIDETAG:
1278 /* Weak pointers get preserved during purify, 'cause I
1279 * don't feel like figuring out how to break them. */
1280 pscav(addr+1, 2, constant);
1285 /* We have to handle fdefn objects specially, so we
1286 * can fix up the raw function address. */
1287 count = pscav_fdefn((struct fdefn *)addr);
1296 /* It's a fixnum. */
1308 purify(lispobj static_roots, lispobj read_only_roots)
1312 struct later *laters, *next;
1313 struct thread *thread;
1315 if(all_threads->next) {
1316 /* FIXME: there should be _some_ sensible error reporting
1317 * convention. See following comment too */
1318 fprintf(stderr,"Can't purify when more than one thread exists\n");
1324 printf("[doing purification:");
1327 #ifdef LISP_FEATURE_GENCGC
1328 gc_alloc_update_all_page_tables();
1330 for_each_thread(thread)
1331 if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)) != 0) {
1332 /* FIXME: 1. What does this mean? 2. It shouldn't be reporting
1333 * its error simply by a. printing a string b. to stdout instead
1335 printf(" Ack! Can't purify interrupt contexts. ");
1340 #if defined(LISP_FEATURE_X86)
1341 dynamic_space_free_pointer =
1342 (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
1345 read_only_end = read_only_free =
1346 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
1347 static_end = static_free =
1348 (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
1355 #if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
1356 /* note this expects only one thread to be active. We'd have to
1357 * stop all the others in the same way as GC does if we wanted
1358 * PURIFY to work when >1 thread exists */
1359 setup_i386_stack_scav(((&static_roots)-2),
1360 ((void *)all_threads->control_stack_end));
1363 pscav(&static_roots, 1, 0);
1364 pscav(&read_only_roots, 1, 1);
1367 printf(" handlers");
1370 pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers,
1371 sizeof(all_threads->interrupt_data->interrupt_handlers)
1379 #ifndef LISP_FEATURE_X86
1380 pscav((lispobj *)all_threads->control_stack_start,
1381 current_control_stack_pointer -
1382 all_threads->control_stack_start,
1385 #ifdef LISP_FEATURE_GENCGC
1391 printf(" bindings");
1394 #if !defined(LISP_FEATURE_X86)
1395 pscav( (lispobj *)all_threads->binding_stack_start,
1396 (lispobj *)current_binding_stack_pointer -
1397 all_threads->binding_stack_start,
1400 for_each_thread(thread) {
1401 pscav( (lispobj *)thread->binding_stack_start,
1402 (lispobj *)SymbolValue(BINDING_STACK_POINTER,thread) -
1403 (lispobj *)thread->binding_stack_start,
1405 pscav( (lispobj *) (thread+1),
1406 fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
1407 (sizeof (struct thread))/(sizeof (lispobj)),
1414 /* The original CMU CL code had scavenge-read-only-space code
1415 * controlled by the Lisp-level variable
1416 * *SCAVENGE-READ-ONLY-SPACE*. It was disabled by default, and it
1417 * wasn't documented under what circumstances it was useful or
1418 * safe to turn it on, so it's been turned off in SBCL. If you
1419 * want/need this functionality, and can test and document it,
1420 * please submit a patch. */
1422 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != UNBOUND_MARKER_WIDETAG
1423 && SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
1424 unsigned read_only_space_size =
1425 (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
1426 (lispobj *)READ_ONLY_SPACE_START;
1428 "scavenging read only space: %d bytes\n",
1429 read_only_space_size * sizeof(lispobj));
1430 pscav( (lispobj *)READ_ONLY_SPACE_START, read_only_space_size, 0);
1438 clean = (lispobj *)STATIC_SPACE_START;
1440 while (clean != static_free)
1441 clean = pscav(clean, static_free - clean, 0);
1442 laters = later_blocks;
1443 count = later_count;
1444 later_blocks = NULL;
1446 while (laters != NULL) {
1447 for (i = 0; i < count; i++) {
1448 if (laters->u[i].count == 0) {
1450 } else if (laters->u[i].count <= LATERMAXCOUNT) {
1451 pscav(laters->u[i+1].ptr, laters->u[i].count, 1);
1454 pscav(laters->u[i].ptr, 1, 1);
1457 next = laters->next;
1460 count = LATERBLOCKSIZE;
1462 } while (clean != static_free || later_blocks != NULL);
1469 os_zero((os_vm_address_t) current_dynamic_space,
1470 (os_vm_size_t) DYNAMIC_SPACE_SIZE);
1472 /* Zero the stack. Note that the stack is also zeroed by SUB-GC
1473 * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */
1474 #ifndef LISP_FEATURE_X86
1475 os_zero((os_vm_address_t) current_control_stack_pointer,
1477 ((all_threads->control_stack_end -
1478 current_control_stack_pointer) * sizeof(lispobj)));
1481 /* It helps to update the heap free pointers so that free_heap can
1482 * verify after it's done. */
1483 SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
1484 SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
1486 #if !defined(ALLOCATION_POINTER)
1487 dynamic_space_free_pointer = current_dynamic_space;
1488 set_auto_gc_trigger(bytes_consed_between_gcs);
1490 #if defined LISP_FEATURE_GENCGC
1493 #error unsupported case /* in CMU CL, was "ibmrt using GC" */