magic/vm-src/gc.c

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <strings.h>

//#define TIME_GC

#ifdef TIME_GC
#include <sys/time.h>
#endif

#include "gc.h"
#include "globals.h"
#include "stack.h"
#include "bytecode.h"

typedef struct list {
  scm *data;
  struct list *next;
  struct list *prev;
} list;

struct list *gc_objects = NULL;

scm gc_timer = 0;
scm gc_fib = 1;
scm gc_timeout = 1;

void gc_list_push(scm *p) {
  struct list *link;

  link = malloc(sizeof(list));

  link->data = p;
  link->next = gc_objects;
  if(link->next) {
    link->next->prev = link;
  }
  link->prev = NULL;
  
  gc_objects = link;
}

#ifdef TIME_GC
FILE *fptr;
#endif

scm *heap_alloc(scm n) {
  scm *p;
  scm tmp;

  gc_timer++;
  if(gc_timer > gc_timeout) {
    gc_timer = 0;
    
    tmp = gc_timeout;
    gc_timeout += gc_fib;
    gc_fib = tmp;

#ifdef TIME_GC
    if(!fptr) {
	    fptr = fopen("gc-log.txt", "w");
    }
    struct timeval time;
    long microsec;
    gettimeofday(&time, NULL);
    microsec = ((unsigned long long)time.tv_sec * 1000000) + time.tv_usec;
    fprintf(fptr, "%ld 0\n", microsec);
#endif
    
    mark();
    sweep();

#ifdef TIME_GC
    gettimeofday(&time, NULL);
    microsec = ((unsigned long long)time.tv_sec * 1000000) + time.tv_usec;
    fprintf(fptr, "%ld 1\n", microsec);
#endif
  }

  p = calloc(n, sizeof(scm));

  gc_list_push(p);

  return p;
}

scm heap_alloc_closure(scm n, scm lbl) {
  scm *p;

  p = heap_alloc(1 + 1 + n);

  p[0] = make_header(color_white, 1, n);
  p[1] = lbl;

  return mk_clos(p);
}

scm heap_alloc_cons(scm car, scm cdr) {
  scm *p;

  p = heap_alloc(1 + 2);

  p[0] = make_header(color_white, 0, 2);
  p[1] = car;
  p[2] = cdr;

  return mk_cons(p);
}

scm heap_alloc_vect(scm n, scm val) {
  scm *p;
  int i;
  
  p = heap_alloc(1 + n);
  
  p[0] = make_header(color_white, 0, n);
  for(i = 0; i < n; i++) {
    p[1 + i] = val;
  }
  
  return mk_vect(p);
}

scm heap_alloc_strn(char *str, int i) {
  scm w;
  scm *p;
  unsigned char *s;
  
  w = (i + 8 + 1)/8;
  
  p = heap_alloc(2 + w);
  
  p[0] = make_header(color_white, 1 + w, 0);
  p[1] = i;
  s = (void*)(p+2);
  strncpy((char*)s, str, i);
  
  return mk_strn(p);
}

//#define DEBUG

void mark() {
  int i;

  scm gc_stack_ptr;
  scm gc_stack_base_ptr;

  scm tmp;

#ifdef DEBUG
  puts("MARK REG");
#endif
  
  mark_object(vm_reg_ret);
  mark_object(vm_reg_env);

#ifdef DEBUG
  puts("MARK GLO");
#endif
  
  for(i = 0; i < VM_GLOBALS_SIZE; i++) {
    mark_object(vm_globals[i]);
  }

#ifdef DEBUG
  puts("MARK STK");
#endif
  
  gc_stack_ptr = vm_stack_ptr;
  gc_stack_base_ptr = vm_stack_base_ptr;

  while(gc_stack_ptr > gc_stack_base_ptr) {
    mark_object(vm_stack[--gc_stack_ptr]);
  }
  
  while(gc_stack_ptr > 0) {
    tmp = vm_stack[--gc_stack_ptr];
    assert(tmp == 0xC0FFEEEEEEEEEEEE);
    --gc_stack_ptr;
    mark_object(vm_stack[--gc_stack_ptr]);
    gc_stack_base_ptr = vm_stack[--gc_stack_ptr];
    tmp = vm_stack[--gc_stack_ptr];
    assert(tmp == 0xC0DEDBADC0DEDBAD);

#ifdef DEBUG
    puts("     FRAME");
#endif

    while(gc_stack_ptr > gc_stack_base_ptr) {
      mark_object(vm_stack[--gc_stack_ptr]);
    }
  }
  
#ifdef DEBUG
  puts("MARK ARGS");
#endif

  for(i = 0; i < bytecode_args_num; i++) {
    mark_object(bytecode_args[i]);
  }
  
#ifdef DEBUG
  puts("MARK.");
#endif
}

void mark_object(scm obj) {
  scm *p;
  scm hdr;

  scm raw_size, scm_size;

  int i;
  //printf("MARK %ld\n", scm_get_tag(obj));
  switch(scm_get_tag(obj)) {
  case atom_tag_fals:
  case atom_tag_true:
  case atom_tag_null:
  case atom_tag_symb:
  case atom_tag_char:
  case tag_numb:
    break;

  case tag_cons:
  case tag_clos:
  case tag_vect:
  case tag_strn:
    p = (scm*)(obj & ~0b111);
    hdr = *p;

    if(header_color(hdr) == color_black)
      break;
    
    *p = color_header(hdr, color_black);
    
    raw_size = header_raw_size(hdr);
    scm_size = header_scm_size(hdr);
    
    for(i = 0; i < scm_size; i++) {
      mark_object(p[1 + raw_size + i]);
    }

    break;

  default:
    fprintf(stderr, "Unknown object type");
    exit(-1);
  }
}

void sweep() {
  struct list *link;
  struct list *tmp;
  scm hdr;

  link = gc_objects;
  while(link) {
    //printf("%p\n", link->data);
    hdr = *(link->data);

    if(header_color(hdr) == color_white) {
      bzero(link->data, (1 + header_raw_size(hdr) + header_scm_size(hdr)) * sizeof(scm));
      free(link->data);

      tmp = link;
      link = link->next;

      if(tmp->prev)
	tmp->prev->next = tmp->next;
      else {
	gc_objects = tmp->next;
	tmp->next->prev = NULL;
      }

      if(tmp->next)
	tmp->next->prev = tmp->prev;

      tmp->data = NULL;
      tmp->next = NULL;
      tmp->prev = NULL;
      free(tmp);
      
      /*
      bzero(link->data, (1 + header_raw_size(hdr) + header_scm_size(hdr)) * sizeof(scm));
      free(link->data);

      if(link->prev) {
	link->prev->next = link->next;
      }
      else {
	gc_objects = link;
      }
      
      if(link->next) {
	link->next->prev = link->prev;
      }
      
      tmp = link;
      link = link->next;

      tmp->data = NULL;
      tmp->next = NULL;
      tmp->prev = NULL;
      free(tmp);
      */
    }
    else {
      *(link->data) = color_header(hdr, color_white);
      
      link = link->next;
    }
  }
}