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