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