/* Purify.

   This code is based on public domain codes from CMUCL. It is placed
   in the public domain and is provided as-is.

   Stack direction changes, the x86/CGC stack scavenging, and static
   blue bag feature, by Paul Werkowski, 1995, 1996.

   Bug fixes, x86 code movement support, the scavenger hook support,
   and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997,
   1998.

   */

#include <stdio.h>
#include <sys/types.h>
#include <stdlib.h>

#include <string.h>

#include "lisp.h"

#include "arch.h"

#include "os.h"
#include "internals.h"
#include "globals.h"
#include "validate.h"
#include "interrupt.h"
#include "purify.h"
#include "interr.h"

#ifdef GENCGC
#include "gencgc.h"
#endif

#undef PRINTNOISE

#if (defined(i386) || defined(__x86_64))

static lispobj *current_dynamic_space_free_pointer;
#endif

#define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
			__FILE__, __LINE__)

#if 1

#define gc_assert(ex) do { \
	if (!(ex)) gc_abort(); \
} while (0)
#else
#define gc_assert(ex)
#endif

#define assert_static_space_bounds(ptr) do { \

   if (!((lispobj*)STATIC_SPACE_START <= ptr && ptr < (lispobj*)(STATIC_SPACE_START + static_space_size))) \

      lose ("static-space overflow!  File \"%s\", line %d\n", \
			__FILE__, __LINE__); \
} while (0)

#define assert_readonly_space_bounds(ptr) do { \

   if (!((lispobj*)READ_ONLY_SPACE_START <= ptr && ptr < (lispobj*)(READ_ONLY_SPACE_START + read_only_space_size))) \

      lose ("readonly-space overflow!  File \"%s\", line %d\n", \
			__FILE__, __LINE__); \
} while (0)

/* These hold the original end of the read_only and static spaces so we can */
/* tell what are forwarding pointers. */

static lispobj *read_only_end, *static_end;

static lispobj *read_only_free, *static_free;

static lispobj *pscav(lispobj * addr, int nwords, boolean constant);

#define LATERBLOCKSIZE 1020
#define LATERMAXCOUNT 10

static struct later {
    struct later *next;
    union {

	lispobj *ptr;
	int count;

    } u[LATERBLOCKSIZE];
} *later_blocks = NULL;
static int later_count = 0;

#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
#define NWORDS(x,y) (CEILING((x),(y)) / (y))

#if defined(sparc) || (defined(DARWIN) && defined(__ppc__))

#define RAW_ADDR_OFFSET 0
#else
#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)
#endif

static boolean

forwarding_pointer_p(lispobj obj)

{
    lispobj *ptr;

    ptr = (lispobj *) obj;

    return ((static_end <= ptr && ptr <= static_free) ||

	    (read_only_end <= ptr && ptr <= read_only_free));

}

static boolean

dynamic_pointer_p(lispobj ptr)

{

#if !(defined(i386) || defined(__x86_64))

    return (ptr >= (lispobj) dynamic_0_space);

#else
    /* Be more conservative, and remember, this is a maybe */

    return (ptr >= (lispobj) current_dynamic_space
	    && ptr < (lispobj) current_dynamic_space_free_pointer);

#endif

}

#if (defined(i386) || defined(__x86_64))

#ifdef WANT_CGC
/* Original x86/CGC stack scavenging code by Paul Werkowski */

static int
maybe_can_move_p(lispobj thing)
{

    lispobj *thingp, header;

    if (dynamic_pointer_p(thing)) {	/* in dynamic space */
	thingp = (lispobj *) PTR(thing);
	header = *thingp;
	if (Pointerp(header) && forwarding_pointer_p(header))
	    return -1;		/* must change it */
	if (LowtagOf(thing) == type_ListPointer)
	    return type_ListPointer;	/* can we check this somehow */
	else if (thing & 3) {	/* not fixnum */
	    int kind = TypeOf(header);

	    /* printf(" %x %x",header,kind); */
	    switch (kind) {	/* something with a header */
	      case type_Bignum:
	      case type_SingleFloat:
	      case type_DoubleFloat:

#ifdef type_LongFloat

	      case type_LongFloat:

#endif
#ifdef type_DoubleDoubleFloat
	      case type_DoubleDoubleFloat:

#endif
	      case type_Sap:
	      case type_SimpleVector:
	      case type_SimpleString:
	      case type_SimpleBitVector:
	      case type_SimpleArrayUnsignedByte2:
	      case type_SimpleArrayUnsignedByte4:
	      case type_SimpleArrayUnsignedByte8:
	      case type_SimpleArrayUnsignedByte16:
	      case type_SimpleArrayUnsignedByte32:

#ifdef type_SimpleArraySignedByte8

	      case type_SimpleArraySignedByte8:

#endif
#ifdef type_SimpleArraySignedByte16

	      case type_SimpleArraySignedByte16:

#endif
#ifdef type_SimpleArraySignedByte30

	      case type_SimpleArraySignedByte30:

#endif
#ifdef type_SimpleArraySignedByte32

	      case type_SimpleArraySignedByte32:

#endif

	      case type_SimpleArraySingleFloat:
	      case type_SimpleArrayDoubleFloat:

#ifdef type_SimpleArrayLongFloat

	      case type_SimpleArrayLongFloat:

#endif

#ifdef type_SimpleArrayDoubleDoubleFloat
	      case type_SimpleArrayDoubleDoubleFloat:
#endif

#ifdef type_SimpleArrayComplexSingleFloat

	      case type_SimpleArrayComplexSingleFloat:

#endif
#ifdef type_SimpleArrayComplexDoubleFloat

	      case type_SimpleArrayComplexDoubleFloat:

#endif
#ifdef type_SimpleArrayComplexLongFloat

	      case type_SimpleArrayComplexLongFloat:

#endif
#ifdef type_SimpleArrayComplexDoubleDoubleFloat
	      case type_SimpleArrayComplexDoubleDoubleFloat:

#endif

	      case type_CodeHeader:
	      case type_FunctionHeader:
	      case type_ClosureFunctionHeader:
	      case type_ReturnPcHeader:
	      case type_ClosureHeader:
	      case type_FuncallableInstanceHeader:
	      case type_InstanceHeader:
	      case type_ValueCellHeader:
	      case type_ByteCodeFunction:
	      case type_ByteCodeClosure:

#ifdef type_DylanFunctionHeader

	      case type_DylanFunctionHeader:

#endif

	      case type_WeakPointer:
	      case type_Fdefn:

#ifdef type_ScavengerHook

	      case type_ScavengerHook:

#endif

		  return kind;
		  break;
	      default:
		  return 0;
	    }
	}
    }
    return 0;

}

static int pverbose = 0;

#define PVERBOSE pverbose
static void

carefully_pscav_stack(lispobj * lowaddr, lispobj * base)

{

    lispobj *sp = lowaddr;

    while (sp < base) {
	int k;
	lispobj thing = *sp;

	if ((unsigned) thing & 0x3) {	/* may be pointer */
	    /* need to check for valid float/double? */
	    k = maybe_can_move_p(thing);
	    if (PVERBOSE)
		printf("%8x %8x %d\n", sp, thing, k);
	    if (k)
		pscav(sp, 1, FALSE);

	}

	sp++;

    }
}

#endif

#if defined(GENCGC) && (defined(i386) || defined(__x86_64))

/*
 * Enhanced x86/GENCGC stack scavenging by Douglas Crosher.
 *
 * Scavenging the stack on the i386 is problematic due to conservative
 * roots and raw return addresses. Here it is handled in two passes:
 * the first pass runs before any objects are moved and tries to
 * identify valid pointers and return address on the stack, the second
 * pass scavenges these.
 */

static unsigned pointer_filter_verbose = 0;

static int

valid_dynamic_space_pointer(lispobj * pointer, lispobj * start_addr)

{

    /* If it's not a return address then it needs to be a valid lisp
       pointer. */
    if (!Pointerp((lispobj) pointer))

	return FALSE;

    /* Check that the object pointed to is consistent with the pointer
       low tag. */
    switch (LowtagOf((lispobj) pointer)) {
      case type_FunctionPointer:
	  /* Start_addr should be the enclosing code object, or a closure
	     header. */
	  switch (TypeOf(*start_addr)) {
	    case type_CodeHeader:
		/* This case is probably caught above. */
		break;
	    case type_ClosureHeader:
	    case type_FuncallableInstanceHeader:
	    case type_ByteCodeFunction:
	    case type_ByteCodeClosure:

#ifdef type_DylanFunctionHeader

	    case type_DylanFunctionHeader:

#endif

		if ((int) pointer != ((int) start_addr + type_FunctionPointer)) {
		    if (pointer_filter_verbose)
			fprintf(stderr, "*Wf2: %p %p %lx\n", pointer,
				start_addr, *start_addr);
		    return FALSE;
		}
		break;
	    default:
		if (pointer_filter_verbose)
		    fprintf(stderr, "*Wf3: %p %p %lx\n", pointer, start_addr,
			    *start_addr);
		return FALSE;
	  }
	  break;
      case type_ListPointer:
	  if ((int) pointer != ((int) start_addr + type_ListPointer)) {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wl1: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
	  /* Is it plausible cons? */
	  if ((Pointerp(start_addr[0])
	       || ((start_addr[0] & 3) == 0)	/* fixnum */
	       ||(TypeOf(start_addr[0]) == type_BaseChar)
	       || (TypeOf(start_addr[0]) == type_UnboundMarker))
	      && (Pointerp(start_addr[1])
		  || ((start_addr[1] & 3) == 0)	/* fixnum */
		  ||(TypeOf(start_addr[1]) == type_BaseChar)
		  || (TypeOf(start_addr[1]) == type_UnboundMarker)))
	      break;
	  else {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wl2: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
      case type_InstancePointer:
	  if ((int) pointer != ((int) start_addr + type_InstancePointer)) {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wi1: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
	  if (TypeOf(start_addr[0]) != type_InstanceHeader) {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wi2: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
	  break;
      case type_OtherPointer:
	  if ((int) pointer != ((int) start_addr + type_OtherPointer)) {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wo1: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
	  /* Is it plausible?  Not a cons. X should check the headers. */
	  if (Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
	      if (pointer_filter_verbose)
		  fprintf(stderr, "*Wo2: %p %p %lx\n", pointer, start_addr,
			  *start_addr);
	      return FALSE;
	  }
	  switch (TypeOf(start_addr[0])) {
	    case type_UnboundMarker:
	    case type_BaseChar:
		if (pointer_filter_verbose)
		    fprintf(stderr, "*Wo3: %p %p %lx\n", pointer, start_addr,
			    *start_addr);
		return FALSE;

		/* Only pointed to by function pointers? */
	    case type_ClosureHeader:
	    case type_FuncallableInstanceHeader:
	    case type_ByteCodeFunction:
	    case type_ByteCodeClosure:

#ifdef type_DylanFunctionHeader

	    case type_DylanFunctionHeader:

#endif

		if (pointer_filter_verbose)
		    fprintf(stderr, "*Wo4: %p %p %lx\n", pointer, start_addr,
			    *start_addr);
		return FALSE;

	    case type_InstanceHeader:
		if (pointer_filter_verbose)
		    fprintf(stderr, "*Wo5: %p %p %lx\n", pointer, start_addr,
			    *start_addr);
		return FALSE;

		/* The valid other immediate pointer objects */
	    case type_SimpleVector:
	    case type_Ratio:
	    case type_Complex:

#ifdef type_ComplexSingleFloat

	    case type_ComplexSingleFloat:

#endif
#ifdef type_ComplexDoubleFloat

	    case type_ComplexDoubleFloat:

#endif
#ifdef type_ComplexLongFloat

	    case type_ComplexLongFloat:

#endif
#ifdef type_ComplexDoubleDoubleFloat
	    case type_ComplexDoubleDoubleFloat:

#endif
	    case type_SimpleArray:
	    case type_ComplexString:
	    case type_ComplexBitVector:
	    case type_ComplexVector:
	    case type_ComplexArray:
	    case type_ValueCellHeader:
	    case type_SymbolHeader:
	    case type_Fdefn:
	    case type_CodeHeader:
	    case type_Bignum:
	    case type_SingleFloat:
	    case type_DoubleFloat:

#ifdef type_LongFloat

	    case type_LongFloat:

#endif
#ifdef type_DoubleDoubleFloat
	    case type_DoubleDoubleFloat:

#endif
	    case type_SimpleString:
	    case type_SimpleBitVector:
	    case type_SimpleArrayUnsignedByte2:
	    case type_SimpleArrayUnsignedByte4:
	    case type_SimpleArrayUnsignedByte8:
	    case type_SimpleArrayUnsignedByte16:
	    case type_SimpleArrayUnsignedByte32:

#ifdef type_SimpleArraySignedByte8

	    case type_SimpleArraySignedByte8:

#endif
#ifdef type_SimpleArraySignedByte16

	    case type_SimpleArraySignedByte16:

#endif
#ifdef type_SimpleArraySignedByte30

	    case type_SimpleArraySignedByte30:

#endif
#ifdef type_SimpleArraySignedByte32

	    case type_SimpleArraySignedByte32:

#endif

	    case type_SimpleArraySingleFloat:
	    case type_SimpleArrayDoubleFloat:

#ifdef type_SimpleArrayLongFloat

	    case type_SimpleArrayLongFloat:

#endif

#ifdef type_SimpleArrayDoubleDoubleFloat
	    case type_SimpleArrayDoubleDoubleFloat:
#endif

#ifdef type_SimpleArrayComplexSingleFloat

	    case type_SimpleArrayComplexSingleFloat:

#endif
#ifdef type_SimpleArrayComplexDoubleFloat

	    case type_SimpleArrayComplexDoubleFloat:

#endif
#ifdef type_SimpleArrayComplexLongFloat

	    case type_SimpleArrayComplexLongFloat:

#endif
#ifdef type_SimpleArrayComplexDoubleDoubleFloat
	    case type_SimpleArrayComplexDoubleDoubleFloat:

#endif

	    case type_Sap:
	    case type_WeakPointer:
	    case type_ScavengerHook:
		break;

	    default:
		if (pointer_filter_verbose)
		    fprintf(stderr, "*Wo6: %p %p %lx\n", pointer, start_addr,
			    *start_addr);
		return FALSE;
	  }
	  break;
      default:
	  if (pointer_filter_verbose)
	      fprintf(stderr, "*W?: %p %p %lx\n", pointer, start_addr,
		      *start_addr);
	  return FALSE;

    }

    /* Looks good */
    return TRUE;

}

#define MAX_STACK_POINTERS 1024

lispobj *valid_stack_locations[MAX_STACK_POINTERS];
unsigned int num_valid_stack_locations;

#define MAX_STACK_RETURN_ADDRESSES 128
lispobj *valid_stack_ra_locations[MAX_STACK_RETURN_ADDRESSES];
lispobj *valid_stack_ra_code_objects[MAX_STACK_RETURN_ADDRESSES];
unsigned int num_valid_stack_ra_locations;

/*
 * Identify valid stack slots.
 */

static void
setup_i386_stack_scav(lispobj * lowaddr, lispobj * base)

{

    lispobj *sp = lowaddr;

    num_valid_stack_locations = 0;
    num_valid_stack_ra_locations = 0;

    for (sp = lowaddr; sp < base; sp++) {
	lispobj thing = *sp;
	lispobj *start_addr;

	/* Find the object start address */
	if ((start_addr = search_dynamic_space((void *) thing)) != NULL) {
	    /*
	     * Need to allow raw pointers into Code objects for return
	     * addresses. This will also pickup pointers to functions in code
	     * objects.
	     */
	    if (TypeOf(*start_addr) == type_CodeHeader) {
		gc_assert(num_valid_stack_ra_locations <
			  MAX_STACK_RETURN_ADDRESSES);
		valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
		valid_stack_ra_code_objects[num_valid_stack_ra_locations++] =
		    (lispobj *) ((int) start_addr + type_OtherPointer);
	    } else {
		if (valid_dynamic_space_pointer((void *) thing, start_addr)) {
		    gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS);
		    valid_stack_locations[num_valid_stack_locations++] = sp;
		}
	    }

	}
    }

    if (pointer_filter_verbose) {
	fprintf(stderr, "Number of valid stack pointers = %d\n",
		num_valid_stack_locations);
	fprintf(stderr, "Number of stack return addresses = %d\n",
		num_valid_stack_ra_locations);
    }

}

static void
pscav_i386_stack(void)

{

    int i;

    for (i = 0; i < num_valid_stack_locations; i++)
	pscav(valid_stack_locations[i], 1, FALSE);

    for (i = 0; i < num_valid_stack_ra_locations; i++) {
	lispobj code_obj = (lispobj) (valid_stack_ra_code_objects[i]);

	pscav(&code_obj, 1, FALSE);
	if (pointer_filter_verbose)
	    fprintf(stderr,
		    "*C moved RA %lx to %x; for code object %p to %lx\n",
		    *valid_stack_ra_locations[i],
		    (int) (*valid_stack_ra_locations[i])
		    - ((int) valid_stack_ra_code_objects[i] - (int) code_obj),
		    valid_stack_ra_code_objects[i], code_obj);
	*valid_stack_ra_locations[i] =
	    (lispobj) ((int) (*valid_stack_ra_locations[i])
		       - ((int) valid_stack_ra_code_objects[i] -
			  (int) code_obj));
    }

}
#endif
#endif

static void
pscav_later(lispobj * where, int count)

{
    struct later *new;

    if (count > LATERMAXCOUNT) {

	while (count > LATERMAXCOUNT) {
	    pscav_later(where, LATERMAXCOUNT);
	    count -= LATERMAXCOUNT;
	    where += LATERMAXCOUNT;
	}
    } else {
	if (later_blocks == NULL || later_count == LATERBLOCKSIZE ||
	    (later_count == LATERBLOCKSIZE - 1 && count > 1)) {
	    new = (struct later *) malloc(sizeof(struct later));

	    new->next = later_blocks;
	    if (later_blocks && later_count < LATERBLOCKSIZE)
		later_blocks->u[later_count].ptr = NULL;
	    later_blocks = new;
	    later_count = 0;
	}

	if (count != 1)
	    later_blocks->u[later_count++].count = count;
	later_blocks->u[later_count++].ptr = where;

    }
}

static lispobj
ptrans_boxed(lispobj thing, lispobj header, boolean constant)

{
    int nwords;
    lispobj result, *new, *old;

    nwords = 1 + HeaderValue(header);

    /* Allocate it */

    old = (lispobj *) PTR(thing);

    if (constant) {

	new = read_only_free;
	read_only_free += CEILING(nwords, 2);
	assert_readonly_space_bounds(read_only_free);
    } else {
	new = static_free;
	static_free += CEILING(nwords, 2);
	assert_static_space_bounds(static_free);

    }

    /* Copy it. */

    memmove(new, old, nwords * sizeof(lispobj));

    /* Deposit forwarding pointer. */

    result = (lispobj) new | LowtagOf(thing);

    *old = result;

    /* Scavenge it. */
    pscav(new, nwords, constant);

    return result;
}

/* need to look at the layout to see if it is a pure structure class, and
   only then can we transport as constant.  If it is pure, we can
   ALWAYS transport as a constant */

static lispobj
ptrans_instance(lispobj thing, lispobj header, boolean constant)

{

    lispobj layout = ((struct instance *) PTR(thing))->slots[0];
    lispobj pure = ((struct instance *) PTR(layout))->slots[15];

    switch (pure) {

      case T:
	  return (ptrans_boxed(thing, header, 1));
      case NIL:
	  return (ptrans_boxed(thing, header, 0));
      case 0:{
	      /* Substructure: special case for the compact-info-envs, where
	         the instance may have a point to the dynamic space placed
	         into it (e.g. the cache-name slot), but the lists and arrays
	         at the time of a purify can be moved to the RO space. */
	      int nwords;
	      lispobj result, *new, *old;

	      nwords = 1 + HeaderValue(header);

	      /* Allocate it */
	      old = (lispobj *) PTR(thing);
	      new = static_free;
	      static_free += CEILING(nwords, 2);
	      assert_static_space_bounds(static_free);

	      /* Copy it. */
	      memmove(new, old, nwords * sizeof(lispobj));

	      /* Deposit forwarding pointer. */
	      result = (lispobj) new | LowtagOf(thing);
	      *old = result;

	      /* Scavenge it. */
	      pscav(new, nwords, 1);

	      return result;
	  }
      default:
	  gc_abort();
	  return 0;		/* squelch stupid warning */

    }

}

static lispobj
ptrans_fdefn(lispobj thing, lispobj header)

{
    int nwords;
    lispobj result, *new, *old, oldfn;
    struct fdefn *fdefn;

    nwords = 1 + HeaderValue(header);

    /* Allocate it */

    old = (lispobj *) PTR(thing);

    new = static_free;
    static_free += CEILING(nwords, 2);

    assert_static_space_bounds(static_free);

    /* Copy it. */

    memmove(new, old, nwords * sizeof(lispobj));

    /* Deposit forwarding pointer. */

    result = (lispobj) new | LowtagOf(thing);

    *old = result;

    /* Scavenge the function. */

    fdefn = (struct fdefn *) new;

    oldfn = fdefn->function;
    pscav(&fdefn->function, 1, FALSE);

    if ((char *) oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr)
	fdefn->raw_addr = (char *) fdefn->function + RAW_ADDR_OFFSET;

    return result;
}

static lispobj
ptrans_unboxed(lispobj thing, lispobj header)

{
    int nwords;
    lispobj result, *new, *old;

    nwords = 1 + HeaderValue(header);

    /* Allocate it */

    old = (lispobj *) PTR(thing);

    new = read_only_free;
    read_only_free += CEILING(nwords, 2);

    assert_readonly_space_bounds(read_only_free);

    /* Copy it. */

    memmove(new, old, nwords * sizeof(lispobj));

    /* Deposit forwarding pointer. */

    result = (lispobj) new | LowtagOf(thing);

    *old = result;

    return result;
}

static lispobj
ptrans_vector(lispobj thing, int bits, int extra,
	      boolean boxed, boolean constant)

{
    struct vector *vector;
    int nwords;
    lispobj result, *new;

    vector = (struct vector *) PTR(thing);
#ifdef __x86_64
    nwords =
	2 + (CEILING((fixnum_value(vector->length) + extra) * bits, 64) >> 6);

#else

    nwords =
	2 + (CEILING((fixnum_value(vector->length) + extra) * bits, 32) >> 5);

#endif

    if (boxed && !constant) {

	new = static_free;
	static_free += CEILING(nwords, 2);
	assert_static_space_bounds(static_free);
    } else {
	new = read_only_free;
	read_only_free += CEILING(nwords, 2);
	assert_readonly_space_bounds(read_only_free);

    }

    memmove(new, vector, nwords * sizeof(lispobj));

    result = (lispobj) new | LowtagOf(thing);

    vector->header = result;

    if (boxed)

	pscav(new, nwords, constant);

    return result;
}

#if (defined(i386) || defined(__x86_64))

static void
apply_code_fixups_during_purify(struct code *old_code, struct code *new_code)
{

    int nheader_words, ncode_words, nwords;
    void *code_start_addr;
    lispobj fixups = NIL;
    unsigned displacement = (unsigned) new_code - (unsigned) old_code;
    struct vector *fixups_vector;

    /* Byte compiled code has no fixups. The trace table offset will be
       a fixnum if it's x86 compiled code - check. */
    if (new_code->trace_table_offset & 0x3)
	return;

    /* Else it's x86 machine code. */
    ncode_words = fixnum_value(new_code->code_size);
    nheader_words = HeaderValue(*(lispobj *) new_code);
    nwords = ncode_words + nheader_words;

    code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj);

    /* The first constant should be a pointer to the fixups for this
       code objects. Check. */
    fixups = new_code->constants[0];

    /* It will be 0 or the unbound-marker if there are no fixups, and
       will be an other-pointer to a vector if it is valid. */
    if ((fixups == 0) || (fixups == type_UnboundMarker) || !Pointerp(fixups)) {

#if defined(GENCGC) && (defined(i386) || defined(__x86_64))

	/* Check for a possible errors. */
	sniff_code_object(new_code, displacement);
#endif
	return;
    }

    fixups_vector = (struct vector *) PTR(fixups);

    /* Could be pointing to a forwarding pointer. */
    if (Pointerp(fixups) && (dynamic_pointer_p(fixups))
	&& forwarding_pointer_p(*(lispobj *) fixups_vector)) {
	/* If so then follow it. */
	fixups_vector = (struct vector *) PTR(*(lispobj *) fixups_vector);
    }

    if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {
	/* Got the fixups for the code block.  Now work through the vector,
	   and apply a fixup at each address. */
	int length = fixnum_value(fixups_vector->length);

	/* offset_vector still has 32-bit elements on amd64.
	   Eventually we will make this consistent with internals.h */