rosella/rosella.c

#include <sys/time.h>

#include <inttypes.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>

#include "gc.h"
#include "builtin.h"
#include "interp.h"
#include "reader.h"

#ifdef HAVE_MOD_IO
#  include "mods/mod_io.h"
#endif

static void test_builtins(void);
static void test_weak_boxes_and_wills(void);
static void test_garbage_collection(bool keep_going);
static void test_reader(void);

static inline void comma(void) { fputs(", ", stdout); } 
static inline void nl(void) { putchar('\n'); } 

void out_of_memory(void)
{
  fprintf(stderr, "Out of memory!\n\n");
  print_gc_stats();
  abort();
}

int main(int argc, char **argv)
{
  srand((unsigned int)time(NULL));
#ifdef __linux__
  {
    FILE *f = fopen("/dev/urandom", "rb");
    if (f)
    {
      unsigned int seed;
      if (fread(&seed, sizeof(seed), 1, f)==1)
        srand(seed);
      fclose(f);
    }
  }
#endif

  gc_init(8*1024*1024, 16*1024*1024);
  builtin_init();
  interpreter_init();

#ifdef HAVE_MOD_IO
  mod_io_init();
#endif

  if (argc < 2 || (strcmp(argv[1], "-t") == 0) || (strcmp(argv[1], "--test") == 0))
  {
    test_builtins();
    test_weak_boxes_and_wills();
    test_garbage_collection(false);
  }
  else if ((strcmp(argv[1], "-b") == 0) || (strcmp(argv[1], "--burn-in") == 0))
  {
    test_garbage_collection(true);
  }
  else if ((strcmp(argv[1], "-r") == 0) || (strcmp(argv[1], "--reader") == 0))
  {
    test_reader();
  }
  else
  {
    gc_root_t argv_root;
    value_t program;
    value_t results;

    register_gc_root(&argv_root, NIL);

    /* Construct list backward, so that we don't have to reverse it. */
    for (int i = argc - 1; i >= 2; --i)
    {
      value_t temp = string_to_value(argv[i]);
      argv_root.value = cons(temp, argv_root.value);
    }
    
    program = read_value_from_path(argv[1]);

    unregister_gc_root(&argv_root);
    results = run_interpreter(program, argv_root.value);

    for (value_t result = results; !is_nil(result); result = _CDR(result))
    {
      print_value(CAR(result));
      nl();
    }

#if 0
    nl();
    fflush(stdout);

    fprint_gc_stats(stderr);
#endif
  }

  return 0;
}

static void test_builtins(void)
{
  print_value(lookup_builtin(BI_STRUCTURE)); nl(); nl();
  print_value(lookup_builtin(BI_TEMPLATE)); nl(); nl();
  print_value(lookup_builtin(BI_LAMBDA)); nl(); nl();
}

static void print_weak_box_results(value_t box)
{
  value_t v, f; 
  print_value(box); comma();
  get_next_finalizer(&v, &f);
  print_value(v); comma(); print_value(f); nl();
}

static void test_weak_boxes_and_wills(void)
{
  gc_root_t box_root, tmp_root;

  register_gc_root(&box_root, UNDEFINED);
  register_gc_root(&tmp_root, UNDEFINED);

  tmp_root.value = cons(fixnum_value(1), cons(fixnum_value(2), NIL));
  box_root.value = make_weak_box(tmp_root.value);

  register_finalizer(tmp_root.value, fixnum_value(10));
  print_weak_box_results(box_root.value);

  collect_garbage(0);
  print_weak_box_results(box_root.value);

  tmp_root.value = UNDEFINED;
  print_weak_box_results(box_root.value);

  collect_garbage(0);
  print_weak_box_results(box_root.value);

  collect_garbage(0);
  print_weak_box_results(box_root.value);
  nl();

  unregister_gc_root(&box_root);
  unregister_gc_root(&tmp_root);
}

static void test_garbage_collection(bool keep_going)
{
  gc_root_t root;
  gc_root_t root2;
  int count = 0;

  register_gc_root(&root, NIL);
  register_gc_root(&root2, NIL);

  /* Construct a large, static tree w/ many links. */
  for (int i = 0; i < 1000000; ++i)
  {
    root2.value = cons(root2.value, root2.value);
  }

  while (1)
  {
    int r = rand() & 0x1ffff;

    if (r == 0)
    {
      root.value = fixnum_value(rand());
    }
    else
    {
      switch (r & 15)
      {
      case 0:
        root.value = cons(fixnum_value(rand()), root.value);
        break;
      case 1:
        root.value = cons(root.value, make_byte_string(256, '\0'));
        break;
      case 2:
        root.value = make_box(root.value);
        break;
      case 3:
        root.value = cons(root.value, cons(fixnum_value(-1), NIL));
        _CDDR(root.value) = root.value;
        WRITE_BARRIER(_CDR(root.value));
        break;
      case 4:
        {
          value_t s = make_vector(4, FALSE_VALUE);
          _get_vector(s)->elements[r & 3] = root.value;
          root.value = s;
        }
        break;
      default:
        (void)cons(make_box(NIL), cons(NIL, cons(NIL, NIL)));
        break;
      }
    }

    if (++count >= 80000000)
    {
      print_gc_stats();
      nl();

      clear_gc_stats();
      count = 0;

      if (!keep_going)
        break;
    }
  }

  unregister_gc_root(&root);
  unregister_gc_root(&root2);
}

static void test_reader(void)
{
  value_t v;

  do {
    fputs("> ", stdout);
    fflush(stdout);

    v = read_value_from_file(stdin);

    print_value(v); nl();
    nl();
  } while (v != NIL);
}

/* vim:set sw=2 expandtab: */