% -*- mode: Noweb; noweb-code-mode: c-mode -*-
% $Id: gc.nw,v 1.18 2004-11-28 00:02:58 govereau Exp $
% ---------------------------------------------------------------------------
\section{Allocation and Garbage Collection}
\label{sec:gc}
% ---------------------------------------------------------------------------

% ---------------------------------------------------------------------------
\subsection{Memory Allocator}
% ---------------------------------------------------------------------------
The memory allocator is written in [[C--]], however {\em this
allocator is not called by compiled Tiger code.} The Tiger compiler
generate in-line allocations, which may call the [[call_gc]] function,
but not the [[alloc]] function. The [[alloc]] function is only
provided as an example, and as a convenience for library functions
that need to allocate memory.
<<alloc.c-->>=
target byteorder little;
import bits32 space_end;
import bits32 tig_gc;
export tig_alloc;
export tig_call_gc;
@
The [[call_gc]] function is a small [[C--]] proxy for the garbage
collector which is written in [[C]]. The [[call_gc]] function is called
with the [[gc]] callling convention. Be sure to recompile this code
whenever the [[gc]] convention changes. Otherwise compiled code and this
code will make different assumptions about the convention which will
result in hard-to-find bugs.

When the garbage collector is called, the allocation pointer will be
overwritten. However, the garbage collector returns a new allocation
pointer, so we do not need to save [[alloc_ptr]] before calling into
the [[C]] code.
<<alloc.c-->>=
bits32 alloc_ptr;
tig_call_gc() {
  alloc_ptr = foreign "C" tig_gc(k) also cuts to k;
  return;
continuation k():
  return;
}
@
This is an example allocator---it is {\em not called by compiled
code}. The Tiger compiler in-lines allocations which are roughly
equivalent to a call to this function, but they are more efficient.
When doing an allocation, we add an extra word at the beginning for
the garbage collector data, and then round up to the nearest machine
word.
<<alloc.c-->>=
tig_alloc(bits32 size) {
  bits32 p;
  p = 0;
  size = (size + 7) & 0xFFFFFFFC;
  if (alloc_ptr + size > bits32[space_end]) {
    tig_call_gc();
  }

  bits32[alloc_ptr] = size;
  p = alloc_ptr + 4;
  alloc_ptr = alloc_ptr + size;
  return(p);
}
@
% ---------------------------------------------------------------------------
\subsection{Garbage Collector Implementation}
% ---------------------------------------------------------------------------
The garbage collector exports two functions for initializing the
collector, and performing garbage collection. Both functions return
the value of the allocation pointer.
<<gc.h>>=
void* gc_init(int heap_size);
void* tig_gc(Cmm_Cont*);
@
The Tiger garbage collector is a very simple copying collector. Most
of the code is generic in that it is not specific to either Tiger or
[[C--]].
<<gc.c>>=
#include <stdio.h>
#include <stdlib.h>
#include <assert.h>
#include <string.h>
#include <qc--runtime.h>

/* global private state of GC */
static unsigned  heap_size  = 0;
static unsigned* heap       = NULL;
static unsigned* from_space = NULL;
static unsigned* to_space   = NULL;
static unsigned* alloc_ptr  = NULL;

/* This one is visible externally */
unsigned* space_end = NULL;

#define FORWARDED 0x80000000
#define SIZE_MASK 0x7FFFFFFF

#define gc_bits(x)         (*(unsigned*)(((unsigned)x) - sizeof(unsigned)))
#define forwarded(x)       (gc_bits(x) & FORWARDED)
#define forward_address(x) (*(unsigned*)(x))
#define size(x)            (gc_bits(x) & SIZE_MASK)

void set_forward_address(void* p, void* fp) {
  gc_bits(p) |= FORWARDED;
  *(unsigned*)p = (unsigned)fp;
}

/* flip also works for initialization */
void flip() {
  if (from_space == heap) {
    to_space = heap;
    from_space = (unsigned*)((unsigned)heap + heap_size);
  } else {
    from_space = heap;
    to_space = (unsigned*)((unsigned)heap + heap_size);
  }
  space_end = (unsigned*)((unsigned)from_space + heap_size);
}

void* gc_init(int size) {
  heap_size = size;
  heap = malloc(heap_size * 2);
  if (heap == NULL) {
    perror("could not create heap");
    exit(1);
  }
  bzero(heap, heap_size * 2);
  flip();
  alloc_ptr = from_space;
  return alloc_ptr;
}

void* internal_alloc(int size) {
  void *p = alloc_ptr + 1;
  assert(size > 0);
  size = (size + 7) & 0xFFFFFFFC;
  assert(size % 4 == 0);
  (*(unsigned*)alloc_ptr) = size & SIZE_MASK;
  alloc_ptr = (unsigned*)((unsigned)alloc_ptr + size);
  return p;
}

int is_pointer(unsigned p) {
  if (p < (unsigned)from_space || 
      p > (unsigned)from_space + heap_size) {
    return 0;
  }
  return 1;
}

unsigned* gc_forward(unsigned *p, int ptr) {
  void* addr;
  if (ptr == 0 || !is_pointer((unsigned)p)) return p;
  if (forwarded(p)) return (void*)forward_address(p);

  addr = internal_alloc(size(p) - 4);
  memcpy(addr, p, size(p) - 4);
  set_forward_address(p, addr);
  return addr;
}

void gc_copy(void) {
  unsigned* scan;
  for (scan = to_space; scan < alloc_ptr; scan++)
    *scan = (unsigned)gc_forward((unsigned*)*scan, -1);
}
@ 
% ---------------------------------------------------------------------------
\subsection{Garbage Collector Main Loop}
% ---------------------------------------------------------------------------
The Tiger compiler outputs GC data for each procedure in the form of
user spans. The span data indicates the type of each variable in the
procedure; pointer or not-pointer. There is a list of types for stack
parameters, followed by a list for temporaries. The first parameter of
a function is always the parent frame pointer, and we can safely
ignore it. We also know that the GC is only called from [[call_gc]],
and we can safely ignore the first activation record.
<<gc.c>>=
void* tig_gc(Cmm_Cont* k) {
  Cmm_Activation a;
  alloc_ptr = to_space;
  space_end = (unsigned*)((unsigned)to_space + heap_size);

  a = Cmm_YoungestActivation(k);   // ignore call_gc activation
  while (Cmm_ChangeActivation(&a))
  {
    int i;
    unsigned  var_count = Cmm_LocalVarCount(&a);
    unsigned* gc_data   = Cmm_GetDescriptor(&a, 1);

    assert(!gc_data || gc_data[gc_data[0]+1] == var_count);

    /* If we have gc_data and stack vars, then we are in a proper
       tiger function. The first stack var will be the pfp and we can
       safely skip it. The assertion checks that the first stack var is a
       pointer -- it should be the parent frame pointer.
     */
    if (gc_data && gc_data[0] > 0) {
      unsigned* tig_fp          = Cmm_FindStackLabel(&a, 0);
      unsigned  stack_var_count = gc_data[0];

      assert(tig_fp);
      assert(gc_data[1] == 1);
      for (i = 1; i < stack_var_count; ++i)
        tig_fp[i] = (unsigned)gc_forward((void*)tig_fp[i], gc_data[i+1]);
    }

    /* The first local will be the pfp in a tiger procedure, but the
       forward function will ignore it. For stdlib functions we may
       need to collect the first argument.
     */
    for (i = 0; i < var_count; ++i) {
      int ptr_flg;
      unsigned** rootp = (unsigned **) Cmm_FindLocalVar(&a, i);
      if (rootp != NULL) {
        if (gc_data) ptr_flg = gc_data[gc_data[0] + 2 + i];
        else         ptr_flg = -1;
        *rootp = gc_forward(*rootp, ptr_flg);
      }
    }
  }
  gc_copy();
  bzero(from_space, heap_size);
  flip();
  return alloc_ptr;
}
@