/*
 * Stop and Copy GC based on Cheney's algorithm.
 *
 * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.1 1992/07/28 20:14:26 wlott Exp $
 * 
 * Written by Christopher Hoover.
 */

#include <stdio.h>
#include <sys/time.h>
#include <sys/resource.h>
#include <signal.h>
#include "lisp.h"
#include "internals.h"
#include "os.h"
#include "gc.h"
#include "globals.h"
#include "interrupt.h"
#include "validate.h"
#include "lispregs.h"
#include "interr.h"

static lispobj *from_space;
static lispobj *from_space_free_pointer;

static lispobj *new_space;
static lispobj *new_space_free_pointer;

static int (*scavtab[256])(lispobj *where, lispobj object);
static lispobj (*transother[256])(lispobj object);
static int (*sizetab[256])(lispobj *where);

static struct weak_pointer *weak_pointers;

static void scavenge(lispobj *start, long nwords);
static void scavenge_newspace(void);
static void scavenge_interrupt_contexts(void);
static void scan_weak_pointers(void);

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

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

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


/* Predicates */

#if defined(DEBUG_SPACE_PREDICATES)

boolean from_space_p(lispobj object)
{
	lispobj *ptr;

	gc_assert(Pointerp(object));

	ptr = (lispobj *) PTR(object);

	return ((from_space <= ptr) &&
		(ptr < from_space_free_pointer));
}	    

boolean new_space_p(lispobj object)
{
	lispobj *ptr;

	gc_assert(Pointerp(object));

	ptr = (lispobj *) PTR(object);
		
	return ((new_space <= ptr) &&
		(ptr < new_space_free_pointer));
}	    

#else

#define from_space_p(ptr) \
	((from_space <= ((lispobj *) ptr)) && \
	 (((lispobj *) ptr) < from_space_free_pointer))

#define new_space_p(ptr) \
	((new_space <= ((lispobj *) ptr)) && \
	 (((lispobj *) ptr) < new_space_free_pointer))

#endif


/* Copying Objects */

static lispobj
copy_object(lispobj object, int nwords)
{
	int tag;
	lispobj *new;
	lispobj *source, *dest;

	gc_assert(Pointerp(object));
	gc_assert(from_space_p(object));
	gc_assert((nwords & 0x01) == 0);

	/* get tag of object */
	tag = LowtagOf(object);

	/* allocate space */
	new = new_space_free_pointer;
	new_space_free_pointer += nwords;

	dest = new;
	source = (lispobj *) PTR(object);

	/* copy the object */
	while (nwords > 0) {
            dest[0] = source[0];
            dest[1] = source[1];
            dest += 2;
            source += 2;
            nwords -= 2;
	}

	/* return lisp pointer of new object */
	return ((lispobj) new) | tag;
}


/* Collect Garbage */

#ifdef PRINTNOISE
static double tv_diff(struct timeval *x, struct timeval *y)
{
    return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
	    ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
}
#endif

#define BYTES_ZERO_BEFORE_END (1<<12)

static void zero_stack(void)
{
    unsigned long *ptr = (unsigned long *)current_control_stack_pointer;

  search:
    do {
	if (*ptr)
	    goto fill;
	ptr++;
    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
    return;

  fill:
    do {
	*ptr++ = 0;
    } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
    goto search;
}

void collect_garbage(void)
{
#ifdef PRINTNOISE
	struct timeval start_tv, stop_tv;
	struct rusage start_rusage, stop_rusage;
	double real_time, system_time, user_time;
	double percent_retained, gc_rate;
	unsigned long size_discarded;
	unsigned long size_retained;
#endif
	lispobj *current_static_space_free_pointer;
	unsigned long static_space_size;
	unsigned long control_stack_size, binding_stack_size;
	int oldmask;
	
#ifdef PRINTNOISE
	printf("[Collecting garbage ... \n");

	getrusage(RUSAGE_SELF, &start_rusage);
	gettimeofday(&start_tv, (struct timezone *) 0);
#endif

	oldmask = sigblock(BLOCKABLE);

	current_static_space_free_pointer =
		(lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER);


	/* Set up from space and new space pointers. */

	from_space = current_dynamic_space;
#ifndef ibmrt
	from_space_free_pointer = current_dynamic_space_free_pointer;
#else
	from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER);
#endif

	if (current_dynamic_space == dynamic_0_space)
		new_space = dynamic_1_space;
	else if (current_dynamic_space == dynamic_1_space)
		new_space = dynamic_0_space;
	else
	    lose("GC lossage.  Current dynamic space is bogus!\n");

	new_space_free_pointer = new_space;


	/* Initialize the weak pointer list. */
	weak_pointers = (struct weak_pointer *) NULL;


	/* Scavenge all of the roots. */
#ifdef PRINTNOISE
	printf("Scavenging interrupt contexts ...\n");
#endif
	scavenge_interrupt_contexts();

#ifdef PRINTNOISE
	printf("Scavenging interrupt handlers (%d bytes) ...\n",
	       sizeof(interrupt_handlers));
#endif
	scavenge((lispobj *) interrupt_handlers,
		 sizeof(interrupt_handlers) / sizeof(lispobj));

	control_stack_size = current_control_stack_pointer - control_stack;
#ifdef PRINTNOISE
	printf("Scavenging the control stack (%d bytes) ...\n",
	       control_stack_size * sizeof(lispobj));
#endif
	scavenge(control_stack, control_stack_size);

#ifndef ibmrt
	binding_stack_size = current_binding_stack_pointer - binding_stack;
#else
	binding_stack_size =
	    (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack;
#endif
#ifdef PRINTNOISE
	printf("Scavenging the binding stack (%d bytes) ...\n",
	       binding_stack_size * sizeof(lispobj));
#endif
	scavenge(binding_stack, binding_stack_size);

	static_space_size = current_static_space_free_pointer - static_space;
#ifdef PRINTNOISE
	printf("Scavenging static space (%d bytes) ...\n",
	       static_space_size * sizeof(lispobj));
#endif
	scavenge(static_space, static_space_size);


	/* Scavenge newspace. */
#ifdef PRINTNOISE
	printf("Scavenging new space (%d bytes) ...\n",
	       (new_space_free_pointer - new_space) * sizeof(lispobj));
#endif
	scavenge_newspace();


#if defined(DEBUG_PRINT_GARBAGE)
	print_garbage(from_space, from_space_free_pointer);
#endif

	/* Scan the weak pointers. */
#ifdef PRINTNOISE
	printf("Scanning weak pointers ...\n");
#endif
	scan_weak_pointers();


	/* Flip spaces. */
#ifdef PRINTNOISE
	printf("Flipping spaces ...\n");
#endif

	os_zero((os_vm_address_t) current_dynamic_space,
		(os_vm_size_t) DYNAMIC_SPACE_SIZE);

	current_dynamic_space = new_space;
#ifndef ibmrt
	current_dynamic_space_free_pointer = new_space_free_pointer;
#else
	SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer);
#endif

#ifdef PRINTNOISE
	size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
	size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
#endif

	/* Zero stack. */
#ifdef PRINTNOISE
	printf("Zeroing empty part of control stack ...\n");
#endif
	zero_stack();

	(void) sigsetmask(oldmask);


#ifdef PRINTNOISE
	gettimeofday(&stop_tv, (struct timezone *) 0);
	getrusage(RUSAGE_SELF, &stop_rusage);

	printf("done.]\n");
	
	percent_retained = (((float) size_retained) /
			     ((float) size_discarded)) * 100.0;

	printf("Total of %d bytes out of %d bytes retained (%3.2f%%).\n",
	       size_retained, size_discarded, percent_retained);

	real_time = tv_diff(&stop_tv, &start_tv);
	user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
	system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);

#if 0
	printf("Statistics:\n");
	printf("%10.2f sec of real time\n", real_time);
	printf("%10.2f sec of user time,\n", user_time);
	printf("%10.2f sec of system time.\n", system_time);
#else
        printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
               real_time, user_time, system_time);
#endif        

	gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;

	printf("%10.2f M bytes/sec collected.\n", gc_rate);
#endif
}


/* Scavenging */

static void
scavenge(lispobj *start, long nwords)
{
	while (nwords > 0) {
		lispobj object;
		int type, words_scavenged;

		object = *start;
		type = TypeOf(object);

#if defined(DEBUG_SCAVENGE_VERBOSE)
		printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
		       (unsigned long) start, (unsigned long) object, type);
#endif

#if 0
		words_scavenged = (scavtab[type])(start, object);
#else
                if (Pointerp(object)) {
                    /* It be a pointer. */
                    if (from_space_p(object)) {
                        /* It currently points to old space.  Check for a */
                        /* forwarding pointer. */
                        lispobj first_word;

                        first_word = *((lispobj *)PTR(object));
                        if (Pointerp(first_word) && new_space_p(first_word)) {
                            /* Yep, there be a forwarding pointer. */
                            *start = first_word;
                            words_scavenged = 1;
                        }
                        else {
                            /* Scavenge that pointer. */
                            words_scavenged = (scavtab[type])(start, object);
                        }
                    }
                    else {
                        /* It points somewhere other than oldspace.  Leave */
                        /* it alone. */
                        words_scavenged = 1;
                    }
                }
                else if ((object & 3) == 0) {
                    /* It's a fixnum.  Real easy. */
                    words_scavenged = 1;
                }
                else {
                    /* It's some random header object. */
                    words_scavenged = (scavtab[type])(start, object);
                }
#endif

		start += words_scavenged;
		nwords -= words_scavenged;
	}
	gc_assert(nwords == 0);
}

static void scavenge_newspace(void)
{
    lispobj *here, *next;

    here = new_space;
    while (here < new_space_free_pointer) {
	next = new_space_free_pointer;
	scavenge(here, next - here);
	here = next;
    }
}


/* Scavenging Interrupt Contexts */

static int boxed_registers[] = BOXED_REGISTERS;

static void scavenge_interrupt_context(struct sigcontext *context)
{
	int i;
#ifdef reg_LIP
	unsigned long lip;
	unsigned long lip_offset;
	int lip_register_pair;
	unsigned long pc_code_offset;
#if defined(sparc) || defined(parisc)
	unsigned long npc_code_offset;
#endif defined(sparc) || defined(parisc)
#endif

	/* Find the LIP's register pair and calculate it's offset */
	/* before we scavenge the context. */
#ifdef reg_LIP
	lip = SC_REG(context, reg_LIP);
	lip_offset = 0x7FFFFFFF;
	lip_register_pair = -1;
	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
		unsigned long reg;
		long offset;
		int index;

		index = boxed_registers[i];
		reg = SC_REG(context, index);
		if (PTR(reg) <= lip) {
			offset = lip - reg;
			if (offset < lip_offset) {
				lip_offset = offset;
				lip_register_pair = index;
			}
		}
	}

	/* Compute the PC's offset from the start of the CODE */
	/* register. */
	pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE);
#ifdef sparc
	npc_code_offset = context->sc_npc - context->sc_regs[CODE];
#endif sparc
#ifdef parisc
	npc_code_offset = context->sc_pcoqt - SC_REG(context, reg_CODE);
#endif parisc
#endif reg_LIP
	       
	/* Scanvenge all boxed registers in the context. */
	for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
		int index;

		index = boxed_registers[i];
		scavenge((lispobj *) &(SC_REG(context, index)), 1);
	}

#ifdef reg_LIP
	/* Fix the LIP */
	SC_REG(context, reg_LIP) =
		SC_REG(context, lip_register_pair) + lip_offset;
	
	/* Fix the PC if it was in from space */
	if (from_space_p(SC_PC(context)))
		SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset;
#ifdef sparc
	if (from_space_p(context->sc_npc))
		context->sc_npc = context->sc_regs[CODE] + npc_code_offset;
#endif sparc
#ifdef parisc
	if (from_space_p(context->sc_pcoqt))
	    context->sc_pcoqt = SC_REG(context, reg_CODE) + npc_code_offset;
#endif parisc
#endif reg_LIP   
}

void scavenge_interrupt_contexts(void)
{
	int i, index;
	struct sigcontext *context;

	index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
#if defined(DEBUG_PRINT_CONTEXT_INDEX)
	printf("Number of active contexts: %d\n", index);
#endif

	for (i = 0; i < index; i++) {
		context = lisp_interrupt_contexts[i];
		scavenge_interrupt_context(context); 
	}
}


/* Debugging Code */

void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
{
	lispobj *start;
	int total_words_not_copied;

	printf("Scanning from space ...\n");

	total_words_not_copied = 0;
	start = from_space;
	while (start < from_space_free_pointer) {
		lispobj object;
		int forwardp, type, nwords;
		lispobj header;

		object = *start;
		forwardp = Pointerp(object) && new_space_p(object);

		if (forwardp) {
			int tag;
			lispobj *pointer;

			tag = LowtagOf(object);

			switch (tag) {
			case type_ListPointer:
				nwords = 2;
				break;
			case type_StructurePointer:
				printf("Don't know about structures yet!\n");
				nwords = 1;
				break;
			case type_FunctionPointer:
				nwords = 1;
				break;
			case type_OtherPointer:
				pointer = (lispobj *) PTR(object);
				header = *pointer;
				type = TypeOf(header);
				nwords = (sizetab[type])(pointer);
			}
		} else {
			type = TypeOf(object);
			nwords = (sizetab[type])(start);
			total_words_not_copied += nwords;
			printf("%4d words not copied at 0x%08x; ",
			       nwords, (unsigned long) start);
			printf("Header word is 0x%08x\n", (unsigned long) object);
		}
		start += nwords;
	}
	printf("%d total words not copied.\n", total_words_not_copied);
}


/* Code and Code-Related Objects */

#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer)

static lispobj trans_function_header(lispobj object);
static lispobj trans_boxed(lispobj object);

static int
scav_function_pointer(lispobj *where, lispobj object)
{
	gc_assert(Pointerp(object));

	if (from_space_p(object)) {
		lispobj first, *first_pointer;

		/* object is a pointer into from space.  check to see */
		/* if it has been forwarded */
		first_pointer = (lispobj *) PTR(object);
		first = *first_pointer;
		
		if (!(Pointerp(first) && new_space_p(first))) {
			int type;
			lispobj copy;

			/* must transport object -- object may point */
			/* to either a function header, a closure */
			/* function header, or to a closure header. */
			
			type = TypeOf(first);
			switch (type) {
			  case type_FunctionHeader:
			  case type_ClosureFunctionHeader:
			    copy = trans_function_header(object);
			    break;
			  default:
			    copy = trans_boxed(object);
			    break;
			}

			first = *first_pointer = copy;
		}

		gc_assert(Pointerp(first));
		gc_assert(!from_space_p(first));

		*where = first;
	}
	return 1;
}

static struct code *
trans_code(struct code *code)
{
	struct code *new_code;
	lispobj first, l_code, l_new_code;
	int nheader_words, ncode_words, nwords;
	unsigned long displacement;
	lispobj fheaderl, *prev_pointer;

#if defined(DEBUG_CODE_GC)
	printf("\nTransporting code object located at 0x%08x.\n",
	       (unsigned long) code);
#endif

	/* if object has already been transported, just return pointer */
	first = code->header;
	if (Pointerp(first) && new_space_p(first))
		return (struct code *) PTR(first);
	
	gc_assert(TypeOf(first) == type_CodeHeader);

	/* prepare to transport the code vector */
	l_code = (lispobj) code | type_OtherPointer;

	ncode_words = fixnum_value(code->code_size);
	nheader_words = HeaderValue(code->header);
	nwords = ncode_words + nheader_words;
	nwords = CEILING(nwords, 2);

	l_new_code = copy_object(l_code, nwords);
	new_code = (struct code *) PTR(l_new_code);

	displacement = l_new_code - l_code;

#if defined(DEBUG_CODE_GC)
	printf("Old code object at 0x%08x, new code object at 0x%08x.\n",
	       (unsigned long) code, (unsigned long) new_code);
	printf("Code object is %d words long.\n", nwords);
#endif

	/* set forwarding pointer */
	code->header = l_new_code;
	
	/* set forwarding pointers for all the function headers in the */
	/* code object.  also fix all self pointers */

	fheaderl = code->entry_points;
	prev_pointer = &new_code->entry_points;

	while (fheaderl != NIL) {
		struct function_header *fheaderp, *nfheaderp;
		lispobj nfheaderl;
		
		fheaderp = (struct function_header *) PTR(fheaderl);
		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);

		/* calcuate the new function pointer and the new */
		/* function header */
		nfheaderl = fheaderl + displacement;
		nfheaderp = (struct function_header *) PTR(nfheaderl);

		/* set forwarding pointer */
		fheaderp->header = nfheaderl;
		
		/* fix self pointer */
		nfheaderp->self = nfheaderl;

		*prev_pointer = nfheaderl;

		fheaderl = fheaderp->next;
		prev_pointer = &nfheaderp->next;
	}

	return new_code;
}

static int
scav_code_header(lispobj *where, lispobj object)
{
	struct code *code;
	int nheader_words, ncode_words, nwords;
	lispobj fheaderl;
	struct function_header *fheaderp;

	code = (struct code *) where;
	ncode_words = fixnum_value(code->code_size);
	nheader_words = HeaderValue(object);
	nwords = ncode_words + nheader_words;
	nwords = CEILING(nwords, 2);

#if defined(DEBUG_CODE_GC)
	printf("\nScavening code object at 0x%08x.\n",
	       (unsigned long) where);
	printf("Code object is %d words long.\n", nwords);
	printf("Scavenging boxed section of code data block (%d words).\n",
	       nheader_words - 1);
#endif

	/* Scavenge the boxed section of the code data block */
	scavenge(where + 1, nheader_words - 1);

	/* Scavenge the boxed section of each function object in the */
	/* code data block */
	fheaderl = code->entry_points;
	while (fheaderl != NIL) {
		fheaderp = (struct function_header *) PTR(fheaderl);
		gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
		
#if defined(DEBUG_CODE_GC)
		printf("Scavenging boxed section of entry point located at 0x%08x.\n",
		       (unsigned long) PTR(fheaderl));
#endif
		scavenge(&fheaderp->name, 1);
		scavenge(&fheaderp->arglist, 1);
		scavenge(&fheaderp->type, 1);
		
		fheaderl = fheaderp->next;
	}
	
	return nwords;
}

static lispobj
trans_code_header(lispobj object)
{
	struct code *ncode;

	ncode = trans_code((struct code *) PTR(object));
	return (lispobj) ncode | type_OtherPointer;
}

static int
size_code_header(lispobj *where)
{
	struct code *code;
	int nheader_words, ncode_words, nwords;

	code = (struct code *) where;
	
	ncode_words = fixnum_value(code->code_size);
	nheader_words = HeaderValue(code->header);
	nwords = ncode_words + nheader_words;
	nwords = CEILING(nwords, 2);

	return nwords;
}


static int
scav_return_pc_header(lispobj *where, lispobj object)
{
    fprintf(stderr, "GC lossage.  Should not be scavenging a ");
    fprintf(stderr, "Return PC Header.\n");
    fprintf(stderr, "where = 0x%08x, object = 0x%08x",
	    (unsigned long) where, (unsigned long) object);
    lose(NULL);
    return 0;
}

static lispobj
trans_return_pc_header(lispobj object)
{
	struct function_header *return_pc;
	unsigned long offset;
	struct code *code, *ncode;
	
	return_pc = (struct function_header *) PTR(object);
	offset = HeaderValue(return_pc->header) * 4;

	/* Transport the whole code object */
	code = (struct code *) ((unsigned long) return_pc - offset);
	ncode = trans_code(code);

	return ((lispobj) ncode + offset) | type_OtherPointer;
}

/* On the 386, closures hold a pointer to the raw address instead of the
   function object, so we can use CALL [$FDEFN+const] to invoke the function
   without loading it into a register.  Given that code objects don't move,
   we don't need to update anything, but we do have to figure out that the
   function is still live. */
#ifdef i386
static
scav_closure_header(where, object)
lispobj *where, object;
{
	struct closure *closure;
	lispobj fun;

	closure = (struct closure *)where;
	fun = closure->function - RAW_ADDR_OFFSET;
	scavenge(&fun, 1);

	return 2;
}
#endif

static int
scav_function_header(lispobj *where, lispobj object)
{
    fprintf(stderr, "GC lossage.  Should not be scavenging a ");
    fprintf(stderr, "Function Header.\n");
    fprintf(stderr, "where = 0x%08x, object = 0x%08x",
	    (unsigned long) where, (unsigned long) object);
    lose(NULL);
    return 0;
}

static lispobj
trans_function_header(lispobj object)
{
	struct function_header *fheader;
	unsigned long offset;
	struct code *code, *ncode;
	
	fheader = (struct function_header *) PTR(object);
	offset = HeaderValue(fheader->header) * 4;

	/* Transport the whole code object */
	code = (struct code *) ((unsigned long) fheader - offset);
	ncode = trans_code(code);

	return ((lispobj) ncode + offset) | type_FunctionPointer;
}



/* Structures */

static int
scav_structure_pointer(lispobj *where, lispobj object)
{
    if (from_space_p(object)) {
	lispobj first, *first_pointer;

	/* object is a pointer into from space.  check to see */
	/* if it has been forwarded */
	first_pointer = (lispobj *) PTR(object);
	first = *first_pointer;
		
	if (!(Pointerp(first) && new_space_p(first)))
	    first = *first_pointer = trans_boxed(object);
	*where = first;
    }
    return 1;
}


/* Lists and Conses */

static lispobj trans_list(lispobj object);

static int
scav_list_pointer(lispobj *where, lispobj object)
{
	gc_assert(Pointerp(object));

	if (from_space_p(object)) {
		lispobj first, *first_pointer;

		/* object is a pointer into from space.  check to see */
		/* if it has been forwarded */
		first_pointer = (lispobj *) PTR(object);
		first = *first_pointer;
		
		if (!(Pointerp(first) && new_space_p(first)))
			first = *first_pointer = trans_list(object);

		gc_assert(Pointerp(first));
		gc_assert(!from_space_p(first));
	
		*where = first;
	}
	return 1;
}

static lispobj
trans_list(lispobj object)
{
	lispobj new_list_pointer;
	struct cons *cons, *new_cons;
	
	cons = (struct cons *) PTR(object);

	/* ### Don't use copy_object here. */
	new_list_pointer = copy_object(object, 2);
	new_cons = (struct cons *) PTR(new_list_pointer);

	/* Set forwarding pointer. */
	cons->car = new_list_pointer;
	
	/* Try to linearize the list in the cdr direction to help reduce */
	/* paging. */

	while (1) {
		lispobj cdr, new_cdr, first;
		struct cons *cdr_cons, *new_cdr_cons;

		cdr = cons->cdr;

                if (LowtagOf(cdr) != type_ListPointer ||
                    !from_space_p(cdr) ||
                    (Pointerp(first = *(lispobj *)PTR(cdr)) &&
                     new_space_p(first)))
                	break;

		cdr_cons = (struct cons *) PTR(cdr);

		/* ### Don't use copy_object here */
		new_cdr = copy_object(cdr, 2);
		new_cdr_cons = (struct cons *) PTR(new_cdr);

		/* Set forwarding pointer */
		cdr_cons->car = new_cdr;

		/* Update the cdr of the last cons copied into new */
		/* space to keep the newspace scavenge from having to */
		/* do it. */
		new_cons->cdr = new_cdr;
		
		cons = cdr_cons;
		new_cons = new_cdr_cons;
	}

	return new_list_pointer;
}


/* Scavenging and Transporting Other Pointers */

static int
scav_other_pointer(lispobj *where, lispobj object)
{
	gc_assert(Pointerp(object));

	if (from_space_p(object)) {
		lispobj first, *first_pointer;

		/* object is a pointer into from space.  check to see */
		/* if it has been forwarded */
		first_pointer = (lispobj *) PTR(object);
		first = *first_pointer;
		
		if (!(Pointerp(first) && new_space_p(first)))
			first = *first_pointer = 
				(transother[TypeOf(first)])(object);

		gc_assert(Pointerp(first));
		gc_assert(!from_space_p(first));

		*where = first;
	}
	return 1;
}


/* Immediate, Boxed, and Unboxed Objects */

static int
size_pointer(lispobj *where)
{
    return 1;
}

static int
scav_immediate(lispobj *where, lispobj object)
{
    return 1;
}

static lispobj
trans_immediate(lispobj object)
{
    fprintf(stderr, "GC lossage.  Trying to transport an immediate!?\n");
    lose(NULL);
    return NIL;
}

static int
size_immediate(lispobj *where)
{
    return 1;
}


static int
scav_boxed(lispobj *where, lispobj object)
{
    return 1;
}

static lispobj
trans_boxed(lispobj object)