/*
 * Stop and Copy GC based on Cheney's algorithm.
 *

 * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.23 2005/09/15 18:26:51 rtoy 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 DEBUG

#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;

    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)

{

#ifndef alpha

    unsigned long *ptr = (unsigned long *) current_control_stack_pointer;

#else

    u32 *ptr = (u32 *) current_control_stack_pointer;

#endif

  search:
    do {
	if (*ptr)
	    goto fill;
	ptr++;

#ifndef alpha

    } while (((unsigned long) ptr) & (BYTES_ZERO_BEFORE_END - 1));

#else

    } while (((u32) ptr) & (BYTES_ZERO_BEFORE_END - 1));

#endif

    return;

  fill:
    do {
	*ptr++ = 0;

#ifndef alpha

    } while (((unsigned long) ptr) & (BYTES_ZERO_BEFORE_END - 1));

#else

    } while (((u32) ptr) & (BYTES_ZERO_BEFORE_END - 1));

#endif

    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;

#ifdef POSIX_SIGS

    sigset_t tmp, old;

#else

    int oldmask;

#endif

    SAVE_CONTEXT();

#ifdef PRINTNOISE

    printf("[Collecting garbage ... \n");

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

#endif

#ifdef POSIX_SIGS

    sigemptyset(&tmp);
    FILLBLOCKSET(&tmp);
    sigprocmask(SIG_BLOCK, &tmp, &old);

#else

    oldmask = sigblock(BLOCKABLE);

#endif

    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();

#ifdef POSIX_SIGS

    sigprocmask(SIG_SETMASK, &old, 0);

#else

    (void) sigsetmask(oldmask);

#endif

#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 */

#define DIRECT_SCAV 0

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 DIRECT_SCAV

	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(os_context_t * context)

{

    int i;

#ifdef reg_LIP

    unsigned long lip;
    unsigned long lip_offset;
    int lip_register_pair;

#endif

    unsigned long pc_code_offset;

#ifdef SC_NPC

    unsigned long npc_code_offset;

#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 (Pointerp(reg) && PTR(reg) <= lip) {
	    offset = lip - reg;
	    if (offset < lip_offset) {
		lip_offset = offset;
		lip_register_pair = index;
	    }

	}

    }

#endif /* reg_LIP */

    /* Compute the PC's offset from the start of the CODE */
    /* register. */
    pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE);

#ifdef SC_NPC

    npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);

#endif /* SC_NPC */

    /* Scanvenge all boxed registers in the context. */
    for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
	int index;
	lispobj foo;

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

	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;

#endif /* reg_LIP */

    /* 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 SC_NPC

    if (from_space_p(SC_NPC(context)))
	SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;

#endif /* SC_NPC */

}

void
scavenge_interrupt_contexts(void)

{

    int i, index;
    os_context_t *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_InstancePointer:
		  printf("Don't know about instances 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);

#if DIRECT_SCAV

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;

}

#else
static int

scav_function_pointer(lispobj * where, lispobj object)
{
    lispobj *first_pointer;
    lispobj copy;
    lispobj first;
    int type;

    gc_assert(Pointerp(object));

    /* object is a pointer into from space. Not a FP */
    first_pointer = (lispobj *) PTR(object);
    first = *first_pointer;

    /* 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;

}
#endif

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);