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