/* Copyright 2009
 * Kaz Kylheku <kkylheku@gmail.com>
 * Vancouver, Canada
 * All rights reserved.
 *
 * BSD License:
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 *
 *   1. Redistributions of source code must retain the above copyright
 *      notice, this list of conditions and the following disclaimer.
 *   2. Redistributions in binary form must reproduce the above copyright
 *      notice, this list of conditions and the following disclaimer in
 *      the documentation and/or other materials provided with the
 *      distribution.
 *   3. The name of the author may not be used to endorse or promote
 *      products derived from this software without specific prior
 *      written permission.
 *
 * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
 * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
 */

#include <stdio.h>
#include <stdlib.h>
#include <stdarg.h>
#include <assert.h>
#include <setjmp.h>
#include <dirent.h>
#include "lib.h"
#include "gc.h"

#define PROT_STACK_SIZE         1024
#define HEAP_SIZE               16384
#define REACHABLE               0x100
#define FREE                    0x200

typedef struct heap {
  struct heap *next;
  obj_t block[HEAP_SIZE];
} heap_t;

int opt_gc_debug;
obj_t **gc_stack_top;

static obj_t **prot_stack[PROT_STACK_SIZE];
static obj_t ***prot_stack_limit = prot_stack + PROT_STACK_SIZE;
static obj_t ***top = prot_stack;

static obj_t *free_list, **free_tail = &free_list;
static heap_t *heap_list;

int gc_enabled = 1;

obj_t *prot1(obj_t **loc)
{
  assert (top < prot_stack_limit);
  *top++ = loc;
  return nil; /* for use in macros */
}

void rel1(obj_t **loc)
{
  /* protect and release calls must nest. */
  if (*--top != loc)
    abort();
}

void protect(obj_t **first, ...)
{
  obj_t **next = first;
  va_list vl;
  va_start (vl, first);

  while (next) {
    prot1(next);
    next = va_arg(vl, obj_t **);
  }

  va_end (vl);
}

void release(obj_t **last, ...)
{
  obj_t **next = last;
  va_list vl;
  va_start (vl, last);

  while (next) {
    rel1(next);
    next = va_arg(vl, obj_t **);
  }

  va_end (vl);
}

static void more()
{
  heap_t *heap = (heap_t *) chk_malloc(sizeof *heap);
  obj_t *block = heap->block, *end = heap->block + HEAP_SIZE;

  while (block < end) {
    block->t.next = free_list;
    block->t.type = FREE;
    free_list = block++;
  }

  free_tail = &block[-1].t.next;

  heap->next = heap_list;
  heap_list = heap;
}

obj_t *make_obj(void)
{
  int try;

  if (opt_gc_debug)
    gc();

  for (try = 0; try < 3; try++) {
    if (free_list) {
      obj_t *ret = free_list;
      free_list = free_list->t.next;
      return ret;
    }

    free_tail = &free_list;

    switch (try) {
    case 0: gc(); break;
    case 1: more(); break;
    }
  }

  return 0;
}

static void finalize(obj_t *obj)
{
  switch (obj->t.type) {
  case CONS:
    break;
  case STR:
    if (!opt_gc_debug) {
      free(obj->st.str);
      obj->st.str = 0;
    }
    break;
  case CHR:
  case NUM:
  case SYM:
  case FUN:
    break;
  case VEC:
    if (!opt_gc_debug) {
      free(obj->v.vec-2);
      obj->v.vec = 0;
    }
    break;
  case STREAM:
    stream_close(obj);
    break;
  case LCONS:
    break;
  case COBJ:
    obj->co.ops->destroy(obj);
    break;
  default:
    assert (0 && "corrupt type field");
  }
}

static void mark_obj(obj_t *obj)
{
  type_t t;

  if (obj == nil)
    return;

  t = obj->t.type;

  if ((t & REACHABLE) != 0)
    return;

  if ((t & FREE) != 0)
    abort();

  obj->t.type |= REACHABLE;

  switch (t) {
  case CONS:
    mark_obj(obj->c.car);
    mark_obj(obj->c.cdr);
    break;
  case STR:
    mark_obj(obj->st.len);
    break;
  case CHR:
  case NUM:
    break;
  case SYM:
    mark_obj(obj->s.name);
    mark_obj(obj->s.val);
    break;
  case FUN:
    mark_obj(obj->f.env);
    if (obj->f.functype == FINTERP)
      mark_obj(obj->f.f.interp_fun);
    break;
  case VEC:
    {
      obj_t *alloc_size = obj->v.vec[-2];
      obj_t *fill_ptr = obj->v.vec[-1];
      long i, fp = c_num(fill_ptr);

      mark_obj(alloc_size);
      mark_obj(fill_ptr);

      for (i = 0; i < fp; i++)
        mark_obj(obj->v.vec[i]);
    }
    break;
  case STREAM:
    mark_obj(obj->sm.label_pushback);
    break;
  case LCONS:
    mark_obj(obj->lc.car);
    mark_obj(obj->lc.cdr);
    mark_obj(obj->lc.func);
    break;
  case COBJ:
    mark_obj(obj->co.cls);
    break;
  default:
    assert (0 && "corrupt type field");
  }
}

static int in_heap(obj_t *ptr)
{
  heap_t *heap;

  for (heap = heap_list; heap != 0; heap = heap->next) {
    if (ptr >= heap->block && ptr < heap->block + HEAP_SIZE)
      if (((char *) ptr - (char *) heap->block) % sizeof (obj_t) == 0)
        return 1;
  }

  return 0;
}

static void mark_mem_region(obj_t **bottom, obj_t **top)
{
  if (bottom > top) {
    obj_t **tmp = top;
    top = bottom;
    bottom = tmp;
  }

  while (bottom < top) {
    obj_t *maybe_obj = *bottom;
    if (in_heap(maybe_obj)) {
      type_t t = maybe_obj->t.type;
      if ((t & FREE) == 0)
        mark_obj(maybe_obj);
    }
    bottom++;
  }
}

static void mark(void)
{
  obj_t *gc_stack_bottom;
  obj_t ***rootloc;

  /*
   * First, scan the officially registered locations.
   */

  for (rootloc = prot_stack; rootloc != top; rootloc++) {
    if (*rootloc) /* stack may have nulls */
      mark_obj(**rootloc);
  }

  mark_mem_region(&gc_stack_bottom, gc_stack_top);
}

static void sweep(void)
{
  heap_t *heap;
  int dbg = opt_gc_debug;
  long freed = 0;

  for (heap = heap_list; heap != 0; heap = heap->next) {
    obj_t *block, *end;
    for (block = heap->block, end = heap->block + HEAP_SIZE;
         block < end;
         block++)
    {
      if (block->t.type & REACHABLE) {
        block->t.type &= ~REACHABLE;
        continue;
      }

      if (block->t.type & FREE)
        continue;

      if (0 && dbg) {
        fprintf(stderr, "%s: finalizing: ", progname);
        obj_print(block, stderr);
        putc('\n', stderr);
      }
      finalize(block);
      block->t.type |= FREE;
      if (dbg) {
        *free_tail = block;
        block->t.next = nil;
        free_tail = &block->t.next;
      } else {
        block->t.next = free_list;
        free_list = block;
      }
      freed++;
    }
  }

  if (dbg)
    fprintf(stderr, "%s: gc freed %ld blocks\n", progname, freed);
}

void gc(void)
{
  if (gc_enabled) {
    jmp_buf jmp;
    setjmp(jmp);
    mark();
    sweep();
  }
}

int gc_state(int enabled)
{
  int old = gc_enabled;
  gc_enabled = enabled;
  return old;
}

/*
 * Useful functions for gdb'ing.
 */
void unmark(void)
{
  heap_t *heap;

  for (heap = heap_list; heap != 0; heap = heap->next) {
    obj_t *block, *end;
    for (block = heap->block, end = heap->block + HEAP_SIZE;
         block < end;
         block++)
    {
      block->t.type &= ~(FREE | REACHABLE);
    }
  }
}