0.9.2.29:
[sbcl.git] / src / runtime / gc-common.c
1 /*
2  * Garbage Collection common functions for scavenging, moving and sizing 
3  * objects.  These are for use with both GC (stop & copy GC) and GENCGC
4  */
5
6 /*
7  * This software is part of the SBCL system. See the README file for
8  * more information.
9  *
10  * This software is derived from the CMU CL system, which was
11  * written at Carnegie Mellon University and released into the
12  * public domain. The software is in the public domain and is
13  * provided with absolutely no warranty. See the COPYING and CREDITS
14  * files for more information.
15  */
16
17 /*
18  * For a review of garbage collection techniques (e.g. generational
19  * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
20  * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
21  * had been accepted for _ACM Computing Surveys_ and was available
22  * as a PostScript preprint through
23  *   <http://www.cs.utexas.edu/users/oops/papers.html>
24  * as
25  *   <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
26  */
27
28 #include <stdio.h>
29 #include <signal.h>
30 #include <string.h>
31 #include "sbcl.h"
32 #include "runtime.h"
33 #include "os.h"
34 #include "interr.h"
35 #include "globals.h"
36 #include "interrupt.h"
37 #include "validate.h"
38 #include "lispregs.h"
39 #include "arch.h"
40 #include "fixnump.h"
41 #include "gc.h"
42 #include "genesis/primitive-objects.h"
43 #include "genesis/static-symbols.h"
44 #include "genesis/layout.h"
45 #include "gc-internal.h"
46
47 #ifdef LISP_FEATURE_SPARC
48 #define LONG_FLOAT_SIZE 4
49 #else
50 #ifdef LISP_FEATURE_X86
51 #define LONG_FLOAT_SIZE 3
52 #endif
53 #endif
54
55 inline static boolean 
56 forwarding_pointer_p(lispobj *pointer) {
57     lispobj first_word=*pointer;                             
58 #ifdef LISP_FEATURE_GENCGC
59     return (first_word == 0x01);
60 #else
61     return (is_lisp_pointer(first_word)
62             && new_space_p(first_word));
63 #endif
64 }
65
66 static inline lispobj *
67 forwarding_pointer_value(lispobj *pointer) {
68 #ifdef LISP_FEATURE_GENCGC
69     return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
70 #else
71     return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
72 #endif
73 }
74 static inline lispobj
75 set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
76 #ifdef LISP_FEATURE_GENCGC
77     pointer[0]=0x01;
78     pointer[1]=newspace_copy;
79 #else
80     pointer[0]=newspace_copy;
81 #endif
82     return newspace_copy;
83 }
84
85 long (*scavtab[256])(lispobj *where, lispobj object);
86 lispobj (*transother[256])(lispobj object);
87 long (*sizetab[256])(lispobj *where);
88 struct weak_pointer *weak_pointers;
89
90 unsigned long bytes_consed_between_gcs = 12*1024*1024;
91
92
93 /*
94  * copying objects
95  */
96
97 /* to copy a boxed object */
98 lispobj
99 copy_object(lispobj object, long nwords)
100 {
101     int tag;
102     lispobj *new;
103
104     gc_assert(is_lisp_pointer(object));
105     gc_assert(from_space_p(object));
106     gc_assert((nwords & 0x01) == 0);
107
108     /* Get tag of object. */
109     tag = lowtag_of(object);
110
111     /* Allocate space. */
112     new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK);
113
114     /* Copy the object. */
115     memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
116     return make_lispobj(new,tag);
117 }
118
119 static long scav_lose(lispobj *where, lispobj object); /* forward decl */
120
121 /* FIXME: Most calls end up going to some trouble to compute an
122  * 'n_words' value for this function. The system might be a little
123  * simpler if this function used an 'end' parameter instead. */
124 void
125 scavenge(lispobj *start, long n_words)
126 {
127     lispobj *end = start + n_words;
128     lispobj *object_ptr;
129     long n_words_scavenged;
130     for (object_ptr = start;
131
132          object_ptr < end;
133          object_ptr += n_words_scavenged) {
134
135         lispobj object = *object_ptr;
136 #ifdef LISP_FEATURE_GENCGC
137         gc_assert(!forwarding_pointer_p(object_ptr));
138 #endif
139         if (is_lisp_pointer(object)) {
140             if (from_space_p(object)) {
141                 /* It currently points to old space. Check for a
142                  * forwarding pointer. */
143                 lispobj *ptr = native_pointer(object);
144                 if (forwarding_pointer_p(ptr)) {
145                     /* Yes, there's a forwarding pointer. */
146                     *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
147                     n_words_scavenged = 1;
148                 } else {
149                     /* Scavenge that pointer. */
150                     n_words_scavenged =
151                         (scavtab[widetag_of(object)])(object_ptr, object);
152                 }
153             } else {
154                 /* It points somewhere other than oldspace. Leave it
155                  * alone. */
156                 n_words_scavenged = 1;
157             }
158         }
159 #ifndef LISP_FEATURE_GENCGC
160         /* this workaround is probably not necessary for gencgc; at least, the
161          * behaviour it describes has never been reported */
162         else if (n_words==1) {
163             /* there are some situations where an
164                other-immediate may end up in a descriptor
165                register.  I'm not sure whether this is
166                supposed to happen, but if it does then we
167                don't want to (a) barf or (b) scavenge over the
168                data-block, because there isn't one.  So, if
169                we're checking a single word and it's anything
170                other than a pointer, just hush it up */
171             int type=widetag_of(object);
172             n_words_scavenged=1;
173             
174             if ((scavtab[type]==scav_lose) ||
175                 (((scavtab[type])(start,object))>1)) {
176                 fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p.  If you can\nreproduce this warning, send a bug report (see manual page for details)\n",
177                         object,start);
178             }
179         }
180 #endif
181         else if (fixnump(object)) {
182             /* It's a fixnum: really easy.. */
183             n_words_scavenged = 1;
184         } else {
185             /* It's some sort of header object or another. */
186             n_words_scavenged =
187                 (scavtab[widetag_of(object)])(object_ptr, object);
188         }
189     }
190     gc_assert(object_ptr == end);
191 }
192
193 static lispobj trans_fun_header(lispobj object); /* forward decls */
194 static lispobj trans_boxed(lispobj object);
195
196 static long
197 scav_fun_pointer(lispobj *where, lispobj object)
198 {
199     lispobj *first_pointer;
200     lispobj copy;
201
202     gc_assert(is_lisp_pointer(object));
203
204     /* Object is a pointer into from_space - not a FP. */
205     first_pointer = (lispobj *) native_pointer(object);
206
207     /* must transport object -- object may point to either a function
208      * header, a closure function header, or to a closure header. */
209
210     switch (widetag_of(*first_pointer)) {
211     case SIMPLE_FUN_HEADER_WIDETAG:
212         copy = trans_fun_header(object);
213         break;
214     default:
215         copy = trans_boxed(object);
216         break;
217     }
218
219     if (copy != object) {
220         /* Set forwarding pointer */
221         set_forwarding_pointer(first_pointer,copy);
222     }
223
224     gc_assert(is_lisp_pointer(copy));
225     gc_assert(!from_space_p(copy));
226
227     *where = copy;
228
229     return 1;
230 }
231
232
233 static struct code *
234 trans_code(struct code *code)
235 {
236     struct code *new_code;
237     lispobj first, l_code, l_new_code;
238     long nheader_words, ncode_words, nwords;
239     unsigned long displacement;
240     lispobj fheaderl, *prev_pointer;
241
242     /* if object has already been transported, just return pointer */
243     first = code->header;
244     if (forwarding_pointer_p((lispobj *)code)) {
245 #ifdef DEBUG_CODE_GC
246         printf("Was already transported\n");
247 #endif
248         return (struct code *) forwarding_pointer_value
249             ((lispobj *)((pointer_sized_uint_t) code));
250     }
251         
252     gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG);
253
254     /* prepare to transport the code vector */
255     l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG;
256
257     ncode_words = fixnum_value(code->code_size);
258     nheader_words = HeaderValue(code->header);
259     nwords = ncode_words + nheader_words;
260     nwords = CEILING(nwords, 2);
261
262     l_new_code = copy_object(l_code, nwords);
263     new_code = (struct code *) native_pointer(l_new_code);
264
265 #if defined(DEBUG_CODE_GC)
266     printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
267            (unsigned long) code, (unsigned long) new_code);
268     printf("Code object is %d words long.\n", nwords);
269 #endif
270
271 #ifdef LISP_FEATURE_GENCGC
272     if (new_code == code)
273         return new_code;
274 #endif
275
276     displacement = l_new_code - l_code;
277
278     set_forwarding_pointer((lispobj *)code, l_new_code);
279         
280     /* set forwarding pointers for all the function headers in the */
281     /* code object.  also fix all self pointers */
282
283     fheaderl = code->entry_points;
284     prev_pointer = &new_code->entry_points;
285
286     while (fheaderl != NIL) {
287         struct simple_fun *fheaderp, *nfheaderp;
288         lispobj nfheaderl;
289                 
290         fheaderp = (struct simple_fun *) native_pointer(fheaderl);
291         gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
292
293         /* Calculate the new function pointer and the new */
294         /* function header. */
295         nfheaderl = fheaderl + displacement;
296         nfheaderp = (struct simple_fun *) native_pointer(nfheaderl);
297
298 #ifdef DEBUG_CODE_GC
299         printf("fheaderp->header (at %x) <- %x\n",
300                &(fheaderp->header) , nfheaderl);
301 #endif
302         set_forwarding_pointer((lispobj *)fheaderp, nfheaderl);
303                 
304         /* fix self pointer. */
305         nfheaderp->self =
306 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
307             FUN_RAW_ADDR_OFFSET +
308 #endif
309             nfheaderl; 
310         
311         *prev_pointer = nfheaderl;
312
313         fheaderl = fheaderp->next;
314         prev_pointer = &nfheaderp->next;
315     }
316     os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words),
317                     ncode_words * sizeof(long));
318 #ifdef LISP_FEATURE_GENCGC
319     gencgc_apply_code_fixups(code, new_code);
320 #endif
321     return new_code;
322 }
323
324 static long
325 scav_code_header(lispobj *where, lispobj object)
326 {
327     struct code *code;
328     long n_header_words, n_code_words, n_words;
329     lispobj entry_point;        /* tagged pointer to entry point */
330     struct simple_fun *function_ptr; /* untagged pointer to entry point */
331
332     code = (struct code *) where;
333     n_code_words = fixnum_value(code->code_size);
334     n_header_words = HeaderValue(object);
335     n_words = n_code_words + n_header_words;
336     n_words = CEILING(n_words, 2);
337
338     /* Scavenge the boxed section of the code data block. */
339     scavenge(where + 1, n_header_words - 1);
340
341     /* Scavenge the boxed section of each function object in the
342      * code data block. */
343     for (entry_point = code->entry_points;
344          entry_point != NIL;
345          entry_point = function_ptr->next) {
346
347         gc_assert(is_lisp_pointer(entry_point));
348
349         function_ptr = (struct simple_fun *) native_pointer(entry_point);
350         gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG);
351
352         scavenge(&function_ptr->name, 1);
353         scavenge(&function_ptr->arglist, 1);
354         scavenge(&function_ptr->type, 1);
355     }
356         
357     return n_words;
358 }
359
360 static lispobj
361 trans_code_header(lispobj object)
362 {
363     struct code *ncode;
364
365     ncode = trans_code((struct code *) native_pointer(object));
366     return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG;
367 }
368
369
370 static long
371 size_code_header(lispobj *where)
372 {
373     struct code *code;
374     long nheader_words, ncode_words, nwords;
375
376     code = (struct code *) where;
377         
378     ncode_words = fixnum_value(code->code_size);
379     nheader_words = HeaderValue(code->header);
380     nwords = ncode_words + nheader_words;
381     nwords = CEILING(nwords, 2);
382
383     return nwords;
384 }
385
386 #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64)
387 static long
388 scav_return_pc_header(lispobj *where, lispobj object)
389 {
390     lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x",
391          (unsigned long) where,
392          (unsigned long) object);
393     return 0; /* bogus return value to satisfy static type checking */
394 }
395 #endif /* LISP_FEATURE_X86 */
396
397 static lispobj
398 trans_return_pc_header(lispobj object)
399 {
400     struct simple_fun *return_pc;
401     unsigned long offset;
402     struct code *code, *ncode;
403
404     return_pc = (struct simple_fun *) native_pointer(object);
405     /* FIXME: was times 4, should it really be N_WORD_BYTES? */
406     offset = HeaderValue(return_pc->header) * N_WORD_BYTES;
407
408     /* Transport the whole code object */
409     code = (struct code *) ((unsigned long) return_pc - offset);
410     ncode = trans_code(code);
411
412     return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG;
413 }
414
415 /* On the 386, closures hold a pointer to the raw address instead of the
416  * function object, so we can use CALL [$FDEFN+const] to invoke
417  * the function without loading it into a register. Given that code
418  * objects don't move, we don't need to update anything, but we do
419  * have to figure out that the function is still live. */
420
421 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
422 static long
423 scav_closure_header(lispobj *where, lispobj object)
424 {
425     struct closure *closure;
426     lispobj fun;
427
428     closure = (struct closure *)where;
429     fun = closure->fun - FUN_RAW_ADDR_OFFSET;
430     scavenge(&fun, 1);
431 #ifdef LISP_FEATURE_GENCGC
432     /* The function may have moved so update the raw address. But
433      * don't write unnecessarily. */
434     if (closure->fun != fun + FUN_RAW_ADDR_OFFSET)
435         closure->fun = fun + FUN_RAW_ADDR_OFFSET;
436 #endif
437     return 2;
438 }
439 #endif
440
441 #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
442 static long
443 scav_fun_header(lispobj *where, lispobj object)
444 {
445     lose("attempted to scavenge a function header where=0x%08x object=0x%08x",
446          (unsigned long) where,
447          (unsigned long) object);
448     return 0; /* bogus return value to satisfy static type checking */
449 }
450 #endif /* LISP_FEATURE_X86 */
451
452 static lispobj
453 trans_fun_header(lispobj object)
454 {
455     struct simple_fun *fheader;
456     unsigned long offset;
457     struct code *code, *ncode;
458         
459     fheader = (struct simple_fun *) native_pointer(object);
460     /* FIXME: was times 4, should it really be N_WORD_BYTES? */
461     offset = HeaderValue(fheader->header) * N_WORD_BYTES;
462
463     /* Transport the whole code object */
464     code = (struct code *) ((unsigned long) fheader - offset);
465     ncode = trans_code(code);
466
467     return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG;
468 }
469
470 \f
471 /*
472  * instances
473  */
474
475 static long
476 scav_instance_pointer(lispobj *where, lispobj object)
477 {
478     lispobj copy, *first_pointer;
479
480     /* Object is a pointer into from space - not a FP. */
481     copy = trans_boxed(object);
482
483 #ifdef LISP_FEATURE_GENCGC
484     gc_assert(copy != object);
485 #endif
486
487     first_pointer = (lispobj *) native_pointer(object);
488     set_forwarding_pointer(first_pointer,copy);
489     *where = copy;
490
491     return 1;
492 }
493
494 \f
495 /*
496  * lists and conses
497  */
498
499 static lispobj trans_list(lispobj object);
500
501 static long
502 scav_list_pointer(lispobj *where, lispobj object)
503 {
504     lispobj first, *first_pointer;
505
506     gc_assert(is_lisp_pointer(object));
507
508     /* Object is a pointer into from space - not FP. */
509     first_pointer = (lispobj *) native_pointer(object);
510
511     first = trans_list(object);
512     gc_assert(first != object);
513
514     /* Set forwarding pointer */
515     set_forwarding_pointer(first_pointer, first);
516
517     gc_assert(is_lisp_pointer(first));
518     gc_assert(!from_space_p(first));
519
520     *where = first;
521     return 1;
522 }
523
524
525 static lispobj
526 trans_list(lispobj object)
527 {
528     lispobj new_list_pointer;
529     struct cons *cons, *new_cons;
530     lispobj cdr;
531
532     cons = (struct cons *) native_pointer(object);
533
534     /* Copy 'object'. */
535     new_cons = (struct cons *) 
536         gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
537     new_cons->car = cons->car;
538     new_cons->cdr = cons->cdr; /* updated later */
539     new_list_pointer = make_lispobj(new_cons,lowtag_of(object));
540
541     /* Grab the cdr: set_forwarding_pointer will clobber it in GENCGC  */
542     cdr = cons->cdr;
543
544     set_forwarding_pointer((lispobj *)cons, new_list_pointer);
545
546     /* Try to linearize the list in the cdr direction to help reduce
547      * paging. */
548     while (1) {
549         lispobj  new_cdr;
550         struct cons *cdr_cons, *new_cdr_cons;
551         
552         if(lowtag_of(cdr) != LIST_POINTER_LOWTAG ||
553            !from_space_p(cdr) ||
554            forwarding_pointer_p((lispobj *)native_pointer(cdr)))
555             break;
556         
557         cdr_cons = (struct cons *) native_pointer(cdr);
558
559         /* Copy 'cdr'. */
560         new_cdr_cons = (struct cons*)
561             gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK);
562         new_cdr_cons->car = cdr_cons->car;
563         new_cdr_cons->cdr = cdr_cons->cdr;
564         new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr));
565
566         /* Grab the cdr before it is clobbered. */
567         cdr = cdr_cons->cdr;
568         set_forwarding_pointer((lispobj *)cdr_cons, new_cdr);
569
570         /* Update the cdr of the last cons copied into new space to
571          * keep the newspace scavenge from having to do it. */
572         new_cons->cdr = new_cdr;
573
574         new_cons = new_cdr_cons;
575     }
576
577     return new_list_pointer;
578 }
579
580 \f
581 /*
582  * scavenging and transporting other pointers
583  */
584
585 static long
586 scav_other_pointer(lispobj *where, lispobj object)
587 {
588     lispobj first, *first_pointer;
589
590     gc_assert(is_lisp_pointer(object));
591
592     /* Object is a pointer into from space - not FP. */
593     first_pointer = (lispobj *) native_pointer(object);
594     first = (transother[widetag_of(*first_pointer)])(object);
595
596     if (first != object) {
597         set_forwarding_pointer(first_pointer, first);
598 #ifdef LISP_FEATURE_GENCGC
599         *where = first;
600 #endif
601     }
602 #ifndef LISP_FEATURE_GENCGC
603     *where = first;
604 #endif
605     gc_assert(is_lisp_pointer(first));
606     gc_assert(!from_space_p(first));
607
608     return 1;
609 }
610 \f
611 /*
612  * immediate, boxed, and unboxed objects
613  */
614
615 static long
616 size_pointer(lispobj *where)
617 {
618     return 1;
619 }
620
621 static long
622 scav_immediate(lispobj *where, lispobj object)
623 {
624     return 1;
625 }
626
627 static lispobj
628 trans_immediate(lispobj object)
629 {
630     lose("trying to transport an immediate");
631     return NIL; /* bogus return value to satisfy static type checking */
632 }
633
634 static long
635 size_immediate(lispobj *where)
636 {
637     return 1;
638 }
639
640
641 static long
642 scav_boxed(lispobj *where, lispobj object)
643 {
644     return 1;
645 }
646
647 static long
648 scav_instance(lispobj *where, lispobj object)
649 {
650     lispobj nuntagged;
651     long ntotal = HeaderValue(object);
652     lispobj layout = ((struct instance *)native_pointer(where))->slots[0];
653
654     if (!layout)
655         return 1;
656     if (forwarding_pointer_p(native_pointer(layout)))
657         layout = (lispobj) forwarding_pointer_value(native_pointer(layout));
658
659     nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
660     scavenge(where + 1, ntotal - fixnum_value(nuntagged));
661
662     return ntotal + 1;
663 }
664
665 static lispobj
666 trans_boxed(lispobj object)
667 {
668     lispobj header;
669     unsigned long length;
670
671     gc_assert(is_lisp_pointer(object));
672
673     header = *((lispobj *) native_pointer(object));
674     length = HeaderValue(header) + 1;
675     length = CEILING(length, 2);
676
677     return copy_object(object, length);
678 }
679
680
681 static long
682 size_boxed(lispobj *where)
683 {
684     lispobj header;
685     unsigned long length;
686
687     header = *where;
688     length = HeaderValue(header) + 1;
689     length = CEILING(length, 2);
690
691     return length;
692 }
693
694 /* Note: on the sparc we don't have to do anything special for fdefns, */
695 /* 'cause the raw-addr has a function lowtag. */
696 #ifndef LISP_FEATURE_SPARC
697 static long
698 scav_fdefn(lispobj *where, lispobj object)
699 {
700     struct fdefn *fdefn;
701
702     fdefn = (struct fdefn *)where;
703
704     /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", 
705        fdefn->fun, fdefn->raw_addr)); */
706
707     if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) 
708         == (char *)((unsigned long)(fdefn->raw_addr))) {
709         scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
710
711         /* Don't write unnecessarily. */
712         if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET))
713             fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET);
714         /* gc.c has more casts here, which may be relevant or alternatively
715            may be compiler warning defeaters.  try 
716         fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
717         */
718         return sizeof(struct fdefn) / sizeof(lispobj);
719     } else {
720         return 1;
721     }
722 }
723 #endif
724
725 static long
726 scav_unboxed(lispobj *where, lispobj object)
727 {
728     unsigned long length;
729
730     length = HeaderValue(object) + 1;
731     length = CEILING(length, 2);
732
733     return length;
734 }
735
736 static lispobj
737 trans_unboxed(lispobj object)
738 {
739     lispobj header;
740     unsigned long length;
741
742
743     gc_assert(is_lisp_pointer(object));
744
745     header = *((lispobj *) native_pointer(object));
746     length = HeaderValue(header) + 1;
747     length = CEILING(length, 2);
748
749     return copy_unboxed_object(object, length);
750 }
751
752 static long
753 size_unboxed(lispobj *where)
754 {
755     lispobj header;
756     unsigned long length;
757
758     header = *where;
759     length = HeaderValue(header) + 1;
760     length = CEILING(length, 2);
761
762     return length;
763 }
764
765 \f
766 /* vector-like objects */
767 static long
768 scav_base_string(lispobj *where, lispobj object)
769 {
770     struct vector *vector;
771     long length, nwords;
772
773     /* NOTE: Strings contain one more byte of data than the length */
774     /* slot indicates. */
775
776     vector = (struct vector *) where;
777     length = fixnum_value(vector->length) + 1;
778     nwords = CEILING(NWORDS(length, 8) + 2, 2);
779
780     return nwords;
781 }
782 static lispobj
783 trans_base_string(lispobj object)
784 {
785     struct vector *vector;
786     long length, nwords;
787
788     gc_assert(is_lisp_pointer(object));
789
790     /* NOTE: A string contains one more byte of data (a terminating
791      * '\0' to help when interfacing with C functions) than indicated
792      * by the length slot. */
793
794     vector = (struct vector *) native_pointer(object);
795     length = fixnum_value(vector->length) + 1;
796     nwords = CEILING(NWORDS(length, 8) + 2, 2);
797
798     return copy_large_unboxed_object(object, nwords);
799 }
800
801 static long
802 size_base_string(lispobj *where)
803 {
804     struct vector *vector;
805     long length, nwords;
806
807     /* NOTE: A string contains one more byte of data (a terminating
808      * '\0' to help when interfacing with C functions) than indicated
809      * by the length slot. */
810
811     vector = (struct vector *) where;
812     length = fixnum_value(vector->length) + 1;
813     nwords = CEILING(NWORDS(length, 8) + 2, 2);
814
815     return nwords;
816 }
817
818 static long
819 scav_character_string(lispobj *where, lispobj object)
820 {
821     struct vector *vector;
822     int length, nwords;
823
824     /* NOTE: Strings contain one more byte of data than the length */
825     /* slot indicates. */
826
827     vector = (struct vector *) where;
828     length = fixnum_value(vector->length) + 1;
829     nwords = CEILING(NWORDS(length, 32) + 2, 2);
830
831     return nwords;
832 }
833 static lispobj
834 trans_character_string(lispobj object)
835 {
836     struct vector *vector;
837     int length, nwords;
838
839     gc_assert(is_lisp_pointer(object));
840
841     /* NOTE: A string contains one more byte of data (a terminating
842      * '\0' to help when interfacing with C functions) than indicated
843      * by the length slot. */
844
845     vector = (struct vector *) native_pointer(object);
846     length = fixnum_value(vector->length) + 1;
847     nwords = CEILING(NWORDS(length, 32) + 2, 2);
848
849     return copy_large_unboxed_object(object, nwords);
850 }
851
852 static long
853 size_character_string(lispobj *where)
854 {
855     struct vector *vector;
856     int length, nwords;
857
858     /* NOTE: A string contains one more byte of data (a terminating
859      * '\0' to help when interfacing with C functions) than indicated
860      * by the length slot. */
861
862     vector = (struct vector *) where;
863     length = fixnum_value(vector->length) + 1;
864     nwords = CEILING(NWORDS(length, 32) + 2, 2);
865
866     return nwords;
867 }
868
869 static lispobj
870 trans_vector(lispobj object)
871 {
872     struct vector *vector;
873     long length, nwords;
874
875     gc_assert(is_lisp_pointer(object));
876
877     vector = (struct vector *) native_pointer(object);
878
879     length = fixnum_value(vector->length);
880     nwords = CEILING(length + 2, 2);
881
882     return copy_large_object(object, nwords);
883 }
884
885 static long
886 size_vector(lispobj *where)
887 {
888     struct vector *vector;
889     long length, nwords;
890
891     vector = (struct vector *) where;
892     length = fixnum_value(vector->length);
893     nwords = CEILING(length + 2, 2);
894
895     return nwords;
896 }
897
898 static long
899 scav_vector_nil(lispobj *where, lispobj object)
900 {
901     return 2;
902 }
903
904 static lispobj
905 trans_vector_nil(lispobj object)
906 {
907     gc_assert(is_lisp_pointer(object));
908     return copy_unboxed_object(object, 2);
909 }
910
911 static long
912 size_vector_nil(lispobj *where)
913 {
914     /* Just the header word and the length word */
915     return 2;
916 }
917
918 static long
919 scav_vector_bit(lispobj *where, lispobj object)
920 {
921     struct vector *vector;
922     long length, nwords;
923
924     vector = (struct vector *) where;
925     length = fixnum_value(vector->length);
926     nwords = CEILING(NWORDS(length, 1) + 2, 2);
927
928     return nwords;
929 }
930
931 static lispobj
932 trans_vector_bit(lispobj object)
933 {
934     struct vector *vector;
935     long length, nwords;
936
937     gc_assert(is_lisp_pointer(object));
938
939     vector = (struct vector *) native_pointer(object);
940     length = fixnum_value(vector->length);
941     nwords = CEILING(NWORDS(length, 1) + 2, 2);
942
943     return copy_large_unboxed_object(object, nwords);
944 }
945
946 static long
947 size_vector_bit(lispobj *where)
948 {
949     struct vector *vector;
950     long length, nwords;
951
952     vector = (struct vector *) where;
953     length = fixnum_value(vector->length);
954     nwords = CEILING(NWORDS(length, 1) + 2, 2);
955
956     return nwords;
957 }
958
959 static long
960 scav_vector_unsigned_byte_2(lispobj *where, lispobj object)
961 {
962     struct vector *vector;
963     long length, nwords;
964
965     vector = (struct vector *) where;
966     length = fixnum_value(vector->length);
967     nwords = CEILING(NWORDS(length, 2) + 2, 2);
968
969     return nwords;
970 }
971
972 static lispobj
973 trans_vector_unsigned_byte_2(lispobj object)
974 {
975     struct vector *vector;
976     long length, nwords;
977
978     gc_assert(is_lisp_pointer(object));
979
980     vector = (struct vector *) native_pointer(object);
981     length = fixnum_value(vector->length);
982     nwords = CEILING(NWORDS(length, 2) + 2, 2);
983
984     return copy_large_unboxed_object(object, nwords);
985 }
986
987 static long
988 size_vector_unsigned_byte_2(lispobj *where)
989 {
990     struct vector *vector;
991     long length, nwords;
992
993     vector = (struct vector *) where;
994     length = fixnum_value(vector->length);
995     nwords = CEILING(NWORDS(length, 2) + 2, 2);
996
997     return nwords;
998 }
999
1000 static long
1001 scav_vector_unsigned_byte_4(lispobj *where, lispobj object)
1002 {
1003     struct vector *vector;
1004     long length, nwords;
1005
1006     vector = (struct vector *) where;
1007     length = fixnum_value(vector->length);
1008     nwords = CEILING(NWORDS(length, 4) + 2, 2);
1009
1010     return nwords;
1011 }
1012
1013 static lispobj
1014 trans_vector_unsigned_byte_4(lispobj object)
1015 {
1016     struct vector *vector;
1017     long length, nwords;
1018
1019     gc_assert(is_lisp_pointer(object));
1020
1021     vector = (struct vector *) native_pointer(object);
1022     length = fixnum_value(vector->length);
1023     nwords = CEILING(NWORDS(length, 4) + 2, 2);
1024
1025     return copy_large_unboxed_object(object, nwords);
1026 }
1027 static long
1028 size_vector_unsigned_byte_4(lispobj *where)
1029 {
1030     struct vector *vector;
1031     long length, nwords;
1032
1033     vector = (struct vector *) where;
1034     length = fixnum_value(vector->length);
1035     nwords = CEILING(NWORDS(length, 4) + 2, 2);
1036
1037     return nwords;
1038 }
1039
1040
1041 static long
1042 scav_vector_unsigned_byte_8(lispobj *where, lispobj object)
1043 {
1044     struct vector *vector;
1045     long length, nwords;
1046
1047     vector = (struct vector *) where;
1048     length = fixnum_value(vector->length);
1049     nwords = CEILING(NWORDS(length, 8) + 2, 2);
1050
1051     return nwords;
1052 }
1053
1054 /*********************/
1055
1056
1057
1058 static lispobj
1059 trans_vector_unsigned_byte_8(lispobj object)
1060 {
1061     struct vector *vector;
1062     long length, nwords;
1063
1064     gc_assert(is_lisp_pointer(object));
1065
1066     vector = (struct vector *) native_pointer(object);
1067     length = fixnum_value(vector->length);
1068     nwords = CEILING(NWORDS(length, 8) + 2, 2);
1069
1070     return copy_large_unboxed_object(object, nwords);
1071 }
1072
1073 static long
1074 size_vector_unsigned_byte_8(lispobj *where)
1075 {
1076     struct vector *vector;
1077     long length, nwords;
1078
1079     vector = (struct vector *) where;
1080     length = fixnum_value(vector->length);
1081     nwords = CEILING(NWORDS(length, 8) + 2, 2);
1082
1083     return nwords;
1084 }
1085
1086
1087 static long
1088 scav_vector_unsigned_byte_16(lispobj *where, lispobj object)
1089 {
1090     struct vector *vector;
1091     long length, nwords;
1092
1093     vector = (struct vector *) where;
1094     length = fixnum_value(vector->length);
1095     nwords = CEILING(NWORDS(length, 16) + 2, 2);
1096
1097     return nwords;
1098 }
1099
1100 static lispobj
1101 trans_vector_unsigned_byte_16(lispobj object)
1102 {
1103     struct vector *vector;
1104     long length, nwords;
1105
1106     gc_assert(is_lisp_pointer(object));
1107
1108     vector = (struct vector *) native_pointer(object);
1109     length = fixnum_value(vector->length);
1110     nwords = CEILING(NWORDS(length, 16) + 2, 2);
1111
1112     return copy_large_unboxed_object(object, nwords);
1113 }
1114
1115 static long
1116 size_vector_unsigned_byte_16(lispobj *where)
1117 {
1118     struct vector *vector;
1119     long length, nwords;
1120
1121     vector = (struct vector *) where;
1122     length = fixnum_value(vector->length);
1123     nwords = CEILING(NWORDS(length, 16) + 2, 2);
1124
1125     return nwords;
1126 }
1127
1128 static long
1129 scav_vector_unsigned_byte_32(lispobj *where, lispobj object)
1130 {
1131     struct vector *vector;
1132     long length, nwords;
1133
1134     vector = (struct vector *) where;
1135     length = fixnum_value(vector->length);
1136     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1137
1138     return nwords;
1139 }
1140
1141 static lispobj
1142 trans_vector_unsigned_byte_32(lispobj object)
1143 {
1144     struct vector *vector;
1145     long length, nwords;
1146
1147     gc_assert(is_lisp_pointer(object));
1148
1149     vector = (struct vector *) native_pointer(object);
1150     length = fixnum_value(vector->length);
1151     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1152
1153     return copy_large_unboxed_object(object, nwords);
1154 }
1155
1156 static long
1157 size_vector_unsigned_byte_32(lispobj *where)
1158 {
1159     struct vector *vector;
1160     long length, nwords;
1161
1162     vector = (struct vector *) where;
1163     length = fixnum_value(vector->length);
1164     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1165
1166     return nwords;
1167 }
1168
1169 #if N_WORD_BITS == 64
1170 static long
1171 scav_vector_unsigned_byte_64(lispobj *where, lispobj object)
1172 {
1173     struct vector *vector;
1174     long length, nwords;
1175
1176     vector = (struct vector *) where;
1177     length = fixnum_value(vector->length);
1178     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1179
1180     return nwords;
1181 }
1182
1183 static lispobj
1184 trans_vector_unsigned_byte_64(lispobj object)
1185 {
1186     struct vector *vector;
1187     long length, nwords;
1188
1189     gc_assert(is_lisp_pointer(object));
1190
1191     vector = (struct vector *) native_pointer(object);
1192     length = fixnum_value(vector->length);
1193     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1194
1195     return copy_large_unboxed_object(object, nwords);
1196 }
1197
1198 static long
1199 size_vector_unsigned_byte_64(lispobj *where)
1200 {
1201     struct vector *vector;
1202     long length, nwords;
1203
1204     vector = (struct vector *) where;
1205     length = fixnum_value(vector->length);
1206     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1207
1208     return nwords;
1209 }
1210 #endif
1211
1212 static long
1213 scav_vector_single_float(lispobj *where, lispobj object)
1214 {
1215     struct vector *vector;
1216     long length, nwords;
1217
1218     vector = (struct vector *) where;
1219     length = fixnum_value(vector->length);
1220     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1221
1222     return nwords;
1223 }
1224
1225 static lispobj
1226 trans_vector_single_float(lispobj object)
1227 {
1228     struct vector *vector;
1229     long length, nwords;
1230
1231     gc_assert(is_lisp_pointer(object));
1232
1233     vector = (struct vector *) native_pointer(object);
1234     length = fixnum_value(vector->length);
1235     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1236
1237     return copy_large_unboxed_object(object, nwords);
1238 }
1239
1240 static long
1241 size_vector_single_float(lispobj *where)
1242 {
1243     struct vector *vector;
1244     long length, nwords;
1245
1246     vector = (struct vector *) where;
1247     length = fixnum_value(vector->length);
1248     nwords = CEILING(NWORDS(length, 32) + 2, 2);
1249
1250     return nwords;
1251 }
1252
1253 static long
1254 scav_vector_double_float(lispobj *where, lispobj object)
1255 {
1256     struct vector *vector;
1257     long length, nwords;
1258
1259     vector = (struct vector *) where;
1260     length = fixnum_value(vector->length);
1261     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1262
1263     return nwords;
1264 }
1265
1266 static lispobj
1267 trans_vector_double_float(lispobj object)
1268 {
1269     struct vector *vector;
1270     long length, nwords;
1271
1272     gc_assert(is_lisp_pointer(object));
1273
1274     vector = (struct vector *) native_pointer(object);
1275     length = fixnum_value(vector->length);
1276     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1277
1278     return copy_large_unboxed_object(object, nwords);
1279 }
1280
1281 static long
1282 size_vector_double_float(lispobj *where)
1283 {
1284     struct vector *vector;
1285     long length, nwords;
1286
1287     vector = (struct vector *) where;
1288     length = fixnum_value(vector->length);
1289     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1290
1291     return nwords;
1292 }
1293
1294 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1295 static long
1296 scav_vector_long_float(lispobj *where, lispobj object)
1297 {
1298     struct vector *vector;
1299     long length, nwords;
1300
1301     vector = (struct vector *) where;
1302     length = fixnum_value(vector->length);
1303     nwords = CEILING(length * 
1304                      LONG_FLOAT_SIZE
1305                      + 2, 2);
1306     return nwords;
1307 }
1308
1309 static lispobj
1310 trans_vector_long_float(lispobj object)
1311 {
1312     struct vector *vector;
1313     long length, nwords;
1314
1315     gc_assert(is_lisp_pointer(object));
1316
1317     vector = (struct vector *) native_pointer(object);
1318     length = fixnum_value(vector->length);
1319     nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1320
1321     return copy_large_unboxed_object(object, nwords);
1322 }
1323
1324 static long
1325 size_vector_long_float(lispobj *where)
1326 {
1327     struct vector *vector;
1328     long length, nwords;
1329
1330     vector = (struct vector *) where;
1331     length = fixnum_value(vector->length);
1332     nwords = CEILING(length * LONG_FLOAT_SIZE + 2, 2);
1333
1334     return nwords;
1335 }
1336 #endif
1337
1338
1339 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1340 static long
1341 scav_vector_complex_single_float(lispobj *where, lispobj object)
1342 {
1343     struct vector *vector;
1344     long length, nwords;
1345
1346     vector = (struct vector *) where;
1347     length = fixnum_value(vector->length);
1348     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1349
1350     return nwords;
1351 }
1352
1353 static lispobj
1354 trans_vector_complex_single_float(lispobj object)
1355 {
1356     struct vector *vector;
1357     long length, nwords;
1358
1359     gc_assert(is_lisp_pointer(object));
1360
1361     vector = (struct vector *) native_pointer(object);
1362     length = fixnum_value(vector->length);
1363     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1364
1365     return copy_large_unboxed_object(object, nwords);
1366 }
1367
1368 static long
1369 size_vector_complex_single_float(lispobj *where)
1370 {
1371     struct vector *vector;
1372     long length, nwords;
1373
1374     vector = (struct vector *) where;
1375     length = fixnum_value(vector->length);
1376     nwords = CEILING(NWORDS(length, 64) + 2, 2);
1377
1378     return nwords;
1379 }
1380 #endif
1381
1382 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1383 static long
1384 scav_vector_complex_double_float(lispobj *where, lispobj object)
1385 {
1386     struct vector *vector;
1387     long length, nwords;
1388
1389     vector = (struct vector *) where;
1390     length = fixnum_value(vector->length);
1391     nwords = CEILING(NWORDS(length, 128) + 2, 2);
1392
1393     return nwords;
1394 }
1395
1396 static lispobj
1397 trans_vector_complex_double_float(lispobj object)
1398 {
1399     struct vector *vector;
1400     long length, nwords;
1401
1402     gc_assert(is_lisp_pointer(object));
1403
1404     vector = (struct vector *) native_pointer(object);
1405     length = fixnum_value(vector->length);
1406     nwords = CEILING(NWORDS(length, 128) + 2, 2);
1407
1408     return copy_large_unboxed_object(object, nwords);
1409 }
1410
1411 static long
1412 size_vector_complex_double_float(lispobj *where)
1413 {
1414     struct vector *vector;
1415     long length, nwords;
1416
1417     vector = (struct vector *) where;
1418     length = fixnum_value(vector->length);
1419     nwords = CEILING(NWORDS(length, 128) + 2, 2);
1420
1421     return nwords;
1422 }
1423 #endif
1424
1425
1426 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1427 static long
1428 scav_vector_complex_long_float(lispobj *where, lispobj object)
1429 {
1430     struct vector *vector;
1431     long length, nwords;
1432
1433     vector = (struct vector *) where;
1434     length = fixnum_value(vector->length);
1435     nwords = CEILING(length * (2* LONG_FLOAT_SIZE) + 2, 2);
1436
1437     return nwords;
1438 }
1439
1440 static lispobj
1441 trans_vector_complex_long_float(lispobj object)
1442 {
1443     struct vector *vector;
1444     long length, nwords;
1445
1446     gc_assert(is_lisp_pointer(object));
1447
1448     vector = (struct vector *) native_pointer(object);
1449     length = fixnum_value(vector->length);
1450     nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1451
1452     return copy_large_unboxed_object(object, nwords);
1453 }
1454
1455 static long
1456 size_vector_complex_long_float(lispobj *where)
1457 {
1458     struct vector *vector;
1459     long length, nwords;
1460
1461     vector = (struct vector *) where;
1462     length = fixnum_value(vector->length);
1463     nwords = CEILING(length * (2*LONG_FLOAT_SIZE) + 2, 2);
1464
1465     return nwords;
1466 }
1467 #endif
1468
1469 #define WEAK_POINTER_NWORDS \
1470         CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
1471
1472 static lispobj
1473 trans_weak_pointer(lispobj object)
1474 {
1475     lispobj copy;
1476 #ifndef LISP_FEATURE_GENCGC
1477     struct weak_pointer *wp;
1478 #endif
1479     gc_assert(is_lisp_pointer(object));
1480
1481 #if defined(DEBUG_WEAK)
1482     printf("Transporting weak pointer from 0x%08x\n", object);
1483 #endif
1484
1485     /* Need to remember where all the weak pointers are that have */
1486     /* been transported so they can be fixed up in a post-GC pass. */
1487
1488     copy = copy_object(object, WEAK_POINTER_NWORDS);
1489 #ifndef LISP_FEATURE_GENCGC
1490     wp = (struct weak_pointer *) native_pointer(copy);
1491         
1492     gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1493     /* Push the weak pointer onto the list of weak pointers. */
1494     wp->next = LOW_WORD(weak_pointers);
1495     weak_pointers = wp;
1496 #endif
1497     return copy;
1498 }
1499
1500 static long
1501 size_weak_pointer(lispobj *where)
1502 {
1503     return WEAK_POINTER_NWORDS;
1504 }
1505
1506
1507 void scan_weak_pointers(void)
1508 {
1509     struct weak_pointer *wp;
1510     for (wp = weak_pointers; wp != NULL; 
1511          wp=(struct weak_pointer *)native_pointer(wp->next)) {
1512         lispobj value = wp->value;
1513         lispobj *first_pointer;
1514         gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
1515         if (!(is_lisp_pointer(value) && from_space_p(value)))
1516             continue;
1517
1518         /* Now, we need to check whether the object has been forwarded. If
1519          * it has been, the weak pointer is still good and needs to be
1520          * updated. Otherwise, the weak pointer needs to be nil'ed
1521          * out. */
1522
1523         first_pointer = (lispobj *)native_pointer(value);
1524         
1525         if (forwarding_pointer_p(first_pointer)) {
1526             wp->value=
1527                 (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer));
1528         } else {
1529             /* Break it. */
1530             wp->value = NIL;
1531             wp->broken = T;
1532         }
1533     }
1534 }
1535
1536
1537 \f
1538 /*
1539  * initialization
1540  */
1541
1542 static long
1543 scav_lose(lispobj *where, lispobj object)
1544 {
1545     lose("no scavenge function for object 0x%08x (widetag 0x%x)",
1546          (unsigned long)object,
1547          widetag_of(*(lispobj*)native_pointer(object)));
1548
1549     return 0; /* bogus return value to satisfy static type checking */
1550 }
1551
1552 static lispobj
1553 trans_lose(lispobj object)
1554 {
1555     lose("no transport function for object 0x%08x (widetag 0x%x)",
1556          (unsigned long)object,
1557          widetag_of(*(lispobj*)native_pointer(object)));
1558     return NIL; /* bogus return value to satisfy static type checking */
1559 }
1560
1561 static long
1562 size_lose(lispobj *where)
1563 {
1564     lose("no size function for object at 0x%08x (widetag 0x%x)",
1565          (unsigned long)where,
1566          widetag_of(LOW_WORD(where)));
1567     return 1; /* bogus return value to satisfy static type checking */
1568 }
1569
1570 \f
1571 /*
1572  * initialization
1573  */
1574
1575 void
1576 gc_init_tables(void)
1577 {
1578     long i;
1579
1580     /* Set default value in all slots of scavenge table.  FIXME
1581      * replace this gnarly sizeof with something based on
1582      * N_WIDETAG_BITS */
1583     for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) { 
1584         scavtab[i] = scav_lose;
1585     }
1586
1587     /* For each type which can be selected by the lowtag alone, set
1588      * multiple entries in our widetag scavenge table (one for each
1589      * possible value of the high bits).
1590      */
1591
1592     for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1593         scavtab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1594         scavtab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_fun_pointer;
1595         /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1596         scavtab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_list_pointer;
1597         scavtab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_immediate;
1598         scavtab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_instance_pointer;
1599         /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1600         scavtab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = scav_other_pointer;
1601     }
1602
1603     /* Other-pointer types (those selected by all eight bits of the
1604      * tag) get one entry each in the scavenge table. */
1605     scavtab[BIGNUM_WIDETAG] = scav_unboxed;
1606     scavtab[RATIO_WIDETAG] = scav_boxed;
1607 #if N_WORD_BITS == 64
1608     scavtab[SINGLE_FLOAT_WIDETAG] = scav_immediate;
1609 #else
1610     scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1611 #endif
1612     scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1613 #ifdef LONG_FLOAT_WIDETAG
1614     scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed;
1615 #endif
1616     scavtab[COMPLEX_WIDETAG] = scav_boxed;
1617 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1618     scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed;
1619 #endif
1620 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1621     scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed;
1622 #endif
1623 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1624     scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed;
1625 #endif
1626     scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed;
1627     scavtab[SIMPLE_BASE_STRING_WIDETAG] = scav_base_string;
1628 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1629     scavtab[SIMPLE_CHARACTER_STRING_WIDETAG] = scav_character_string;
1630 #endif
1631     scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit;
1632     scavtab[SIMPLE_ARRAY_NIL_WIDETAG] = scav_vector_nil;
1633     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1634         scav_vector_unsigned_byte_2;
1635     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1636         scav_vector_unsigned_byte_4;
1637     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1638         scav_vector_unsigned_byte_8;
1639     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1640         scav_vector_unsigned_byte_8;
1641     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1642         scav_vector_unsigned_byte_16;
1643     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1644         scav_vector_unsigned_byte_16;
1645 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1646     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1647         scav_vector_unsigned_byte_32;
1648 #endif
1649     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1650         scav_vector_unsigned_byte_32;
1651     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1652         scav_vector_unsigned_byte_32;
1653 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1654     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1655         scav_vector_unsigned_byte_64;
1656 #endif
1657 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1658     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1659         scav_vector_unsigned_byte_64;
1660 #endif
1661 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1662     scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1663         scav_vector_unsigned_byte_64;
1664 #endif
1665 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1666     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8;
1667 #endif
1668 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1669     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1670         scav_vector_unsigned_byte_16;
1671 #endif
1672 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1673     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1674         scav_vector_unsigned_byte_32;
1675 #endif
1676 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1677     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1678         scav_vector_unsigned_byte_32;
1679 #endif
1680 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1681     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1682         scav_vector_unsigned_byte_64;
1683 #endif
1684 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1685     scavtab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1686         scav_vector_unsigned_byte_64;
1687 #endif
1688     scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float;
1689     scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float;
1690 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1691     scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float;
1692 #endif
1693 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1694     scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1695         scav_vector_complex_single_float;
1696 #endif
1697 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1698     scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1699         scav_vector_complex_double_float;
1700 #endif
1701 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1702     scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1703         scav_vector_complex_long_float;
1704 #endif
1705     scavtab[COMPLEX_BASE_STRING_WIDETAG] = scav_boxed;
1706 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1707     scavtab[COMPLEX_CHARACTER_STRING_WIDETAG] = scav_boxed;
1708 #endif
1709     scavtab[COMPLEX_VECTOR_NIL_WIDETAG] = scav_boxed;
1710     scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed;
1711     scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed;
1712     scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed;
1713     scavtab[CODE_HEADER_WIDETAG] = scav_code_header;
1714 #ifndef LISP_FEATURE_GENCGC     /* FIXME ..._X86 ? */
1715     scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;
1716     scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;
1717 #endif
1718 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
1719     scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header;
1720     scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header;
1721 #else
1722     scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed;
1723     scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed;
1724 #endif
1725     scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed;
1726     scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed;
1727     scavtab[CHARACTER_WIDETAG] = scav_immediate;
1728     scavtab[SAP_WIDETAG] = scav_unboxed;
1729     scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate;
1730     scavtab[INSTANCE_HEADER_WIDETAG] = scav_instance;
1731 #ifdef LISP_FEATURE_SPARC
1732     scavtab[FDEFN_WIDETAG] = scav_boxed;
1733 #else
1734     scavtab[FDEFN_WIDETAG] = scav_fdefn;
1735 #endif
1736
1737     /* transport other table, initialized same way as scavtab */
1738     for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++)
1739         transother[i] = trans_lose;
1740     transother[BIGNUM_WIDETAG] = trans_unboxed;
1741     transother[RATIO_WIDETAG] = trans_boxed;
1742
1743 #if N_WORD_BITS == 64
1744     transother[SINGLE_FLOAT_WIDETAG] = trans_immediate;
1745 #else
1746     transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1747 #endif
1748     transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1749 #ifdef LONG_FLOAT_WIDETAG
1750     transother[LONG_FLOAT_WIDETAG] = trans_unboxed;
1751 #endif
1752     transother[COMPLEX_WIDETAG] = trans_boxed;
1753 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1754     transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed;
1755 #endif
1756 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1757     transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed;
1758 #endif
1759 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1760     transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed;
1761 #endif
1762     transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; /* but not GENCGC */
1763     transother[SIMPLE_BASE_STRING_WIDETAG] = trans_base_string;
1764 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1765     transother[SIMPLE_CHARACTER_STRING_WIDETAG] = trans_character_string;
1766 #endif
1767     transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit;
1768     transother[SIMPLE_VECTOR_WIDETAG] = trans_vector;
1769     transother[SIMPLE_ARRAY_NIL_WIDETAG] = trans_vector_nil;
1770     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1771         trans_vector_unsigned_byte_2;
1772     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1773         trans_vector_unsigned_byte_4;
1774     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1775         trans_vector_unsigned_byte_8;
1776     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1777         trans_vector_unsigned_byte_8;
1778     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1779         trans_vector_unsigned_byte_16;
1780     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1781         trans_vector_unsigned_byte_16;
1782 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1783     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1784         trans_vector_unsigned_byte_32;
1785 #endif
1786     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1787         trans_vector_unsigned_byte_32;
1788     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1789         trans_vector_unsigned_byte_32;
1790 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1791     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1792         trans_vector_unsigned_byte_64;
1793 #endif
1794 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1795     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1796         trans_vector_unsigned_byte_64;
1797 #endif
1798 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1799     transother[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1800         trans_vector_unsigned_byte_64;
1801 #endif
1802 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1803     transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] =
1804         trans_vector_unsigned_byte_8;
1805 #endif
1806 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1807     transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1808         trans_vector_unsigned_byte_16;
1809 #endif
1810 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1811     transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1812         trans_vector_unsigned_byte_32;
1813 #endif
1814 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1815     transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1816         trans_vector_unsigned_byte_32;
1817 #endif
1818 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1819     transother[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1820         trans_vector_unsigned_byte_64;
1821 #endif
1822 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1823     transother[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1824         trans_vector_unsigned_byte_64;
1825 #endif
1826     transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] =
1827         trans_vector_single_float;
1828     transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] =
1829         trans_vector_double_float;
1830 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1831     transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] =
1832         trans_vector_long_float;
1833 #endif
1834 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1835     transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1836         trans_vector_complex_single_float;
1837 #endif
1838 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1839     transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1840         trans_vector_complex_double_float;
1841 #endif
1842 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1843     transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1844         trans_vector_complex_long_float;
1845 #endif
1846     transother[COMPLEX_BASE_STRING_WIDETAG] = trans_boxed;
1847 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1848     transother[COMPLEX_CHARACTER_STRING_WIDETAG] = trans_boxed;
1849 #endif
1850     transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed;
1851     transother[COMPLEX_VECTOR_NIL_WIDETAG] = trans_boxed;
1852     transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed;
1853     transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed;
1854     transother[CODE_HEADER_WIDETAG] = trans_code_header;
1855     transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header;
1856     transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header;
1857     transother[CLOSURE_HEADER_WIDETAG] = trans_boxed;
1858     transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed;
1859     transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed;
1860     transother[SYMBOL_HEADER_WIDETAG] = trans_boxed;
1861     transother[CHARACTER_WIDETAG] = trans_immediate;
1862     transother[SAP_WIDETAG] = trans_unboxed;
1863     transother[UNBOUND_MARKER_WIDETAG] = trans_immediate;
1864     transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer;
1865     transother[INSTANCE_HEADER_WIDETAG] = trans_boxed;
1866     transother[FDEFN_WIDETAG] = trans_boxed;
1867
1868     /* size table, initialized the same way as scavtab */
1869     for (i = 0; i < ((sizeof sizetab)/(sizeof sizetab[0])); i++)
1870         sizetab[i] = size_lose;
1871     for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) {
1872         sizetab[EVEN_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1873         sizetab[FUN_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1874         /* skipping OTHER_IMMEDIATE_0_LOWTAG */
1875         sizetab[LIST_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1876         sizetab[ODD_FIXNUM_LOWTAG|(i<<N_LOWTAG_BITS)] = size_immediate;
1877         sizetab[INSTANCE_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1878         /* skipping OTHER_IMMEDIATE_1_LOWTAG */
1879         sizetab[OTHER_POINTER_LOWTAG|(i<<N_LOWTAG_BITS)] = size_pointer;
1880     }
1881     sizetab[BIGNUM_WIDETAG] = size_unboxed;
1882     sizetab[RATIO_WIDETAG] = size_boxed;
1883 #if N_WORD_BITS == 64
1884     sizetab[SINGLE_FLOAT_WIDETAG] = size_immediate;
1885 #else
1886     sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed;
1887 #endif
1888     sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1889 #ifdef LONG_FLOAT_WIDETAG
1890     sizetab[LONG_FLOAT_WIDETAG] = size_unboxed;
1891 #endif
1892     sizetab[COMPLEX_WIDETAG] = size_boxed;
1893 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
1894     sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed;
1895 #endif
1896 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
1897     sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed;
1898 #endif
1899 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
1900     sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed;
1901 #endif
1902     sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed;
1903     sizetab[SIMPLE_BASE_STRING_WIDETAG] = size_base_string;
1904 #ifdef SIMPLE_CHARACTER_STRING_WIDETAG
1905     sizetab[SIMPLE_CHARACTER_STRING_WIDETAG] = size_character_string;
1906 #endif
1907     sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit;
1908     sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector;
1909     sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil;
1910     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] =
1911         size_vector_unsigned_byte_2;
1912     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] =
1913         size_vector_unsigned_byte_4;
1914     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG] =
1915         size_vector_unsigned_byte_8;
1916     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] =
1917         size_vector_unsigned_byte_8;
1918     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG] =
1919         size_vector_unsigned_byte_16;
1920     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] =
1921         size_vector_unsigned_byte_16;
1922 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG
1923     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG] =
1924         size_vector_unsigned_byte_32;
1925 #endif
1926     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG] =
1927         size_vector_unsigned_byte_32;
1928     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] =
1929         size_vector_unsigned_byte_32;
1930 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG
1931     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG] =
1932         size_vector_unsigned_byte_64;
1933 #endif
1934 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG
1935     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG] =
1936         size_vector_unsigned_byte_64;
1937 #endif
1938 #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG
1939     sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG] =
1940         size_vector_unsigned_byte_64;
1941 #endif
1942 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
1943     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8;
1944 #endif
1945 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
1946     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] =
1947         size_vector_unsigned_byte_16;
1948 #endif
1949 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
1950     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] =
1951         size_vector_unsigned_byte_32;
1952 #endif
1953 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
1954     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] =
1955         size_vector_unsigned_byte_32;
1956 #endif
1957 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG
1958     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG] =
1959         size_vector_unsigned_byte_64;
1960 #endif
1961 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG
1962     sizetab[SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG] =
1963         size_vector_unsigned_byte_64;
1964 #endif
1965     sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float;
1966     sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float;
1967 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
1968     sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float;
1969 #endif
1970 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
1971     sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] =
1972         size_vector_complex_single_float;
1973 #endif
1974 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
1975     sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] =
1976         size_vector_complex_double_float;
1977 #endif
1978 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
1979     sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] =
1980         size_vector_complex_long_float;
1981 #endif
1982     sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed;
1983 #ifdef COMPLEX_CHARACTER_STRING_WIDETAG
1984     sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed;
1985 #endif
1986     sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed;
1987     sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed;
1988     sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed;
1989     sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed;
1990     sizetab[CODE_HEADER_WIDETAG] = size_code_header;
1991 #if 0
1992     /* We shouldn't see these, so just lose if it happens. */
1993     sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header;
1994     sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header;
1995 #endif
1996     sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed;
1997     sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed;
1998     sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed;
1999     sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed;
2000     sizetab[CHARACTER_WIDETAG] = size_immediate;
2001     sizetab[SAP_WIDETAG] = size_unboxed;
2002     sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate;
2003     sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer;
2004     sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed;
2005     sizetab[FDEFN_WIDETAG] = size_boxed;
2006 }
2007
2008 \f
2009 /* Find the code object for the given pc, or return NULL on
2010    failure. */
2011 lispobj *
2012 component_ptr_from_pc(lispobj *pc)
2013 {
2014     lispobj *object = NULL;
2015
2016     if ( (object = search_read_only_space(pc)) )
2017         ;
2018     else if ( (object = search_static_space(pc)) )
2019         ;
2020     else
2021         object = search_dynamic_space(pc);
2022
2023     if (object) /* if we found something */
2024         if (widetag_of(*object) == CODE_HEADER_WIDETAG)
2025             return(object);
2026
2027     return (NULL);
2028 }
2029
2030 /* Scan an area looking for an object which encloses the given pointer.
2031  * Return the object start on success or NULL on failure. */
2032 lispobj *
2033 gc_search_space(lispobj *start, size_t words, lispobj *pointer)
2034 {
2035     while (words > 0) {
2036         size_t count = 1;
2037         lispobj thing = *start;
2038
2039         /* If thing is an immediate then this is a cons. */
2040         if (is_lisp_pointer(thing)
2041             || (fixnump(thing))
2042             || (widetag_of(thing) == CHARACTER_WIDETAG)
2043 #if N_WORD_BITS == 64
2044             || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
2045 #endif
2046             || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2047             count = 2;
2048         else
2049             count = (sizetab[widetag_of(thing)])(start);
2050
2051         /* Check whether the pointer is within this object. */
2052         if ((pointer >= start) && (pointer < (start+count))) {
2053             /* found it! */
2054             /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2055             return(start);
2056         }
2057
2058         /* Round up the count. */
2059         count = CEILING(count,2);
2060
2061         start += count;
2062         words -= count;
2063     }
2064     return (NULL);
2065 }