
// A stop-and-copy garbage collector.
// see wikipedia article: "Tracing garbage collection"

int gc_copy_list(int x) {
  int ret;
  int processing;
  int this_list;
  int new_cell;
  int tempcar;
  int typeplusproc; // procs are also lists

  typeplusproc = TYPEPLUSPROC(x);

  if (MIsMarkedCell(x))
    return typeplusproc | MmarkedCellValue(x);
  else {
    processing = 1;
    ret = 0;
    this_list = curr_cell;
    while (processing) {
      if (MlistProcp(x)) {
        tempcar = Mcar(x);
        Msetcar(x, curr_cell);
        MmarkCell(x);
        new_cell = curr_cell;
        curr_cell = curr_cell + 2;
        Msetcar(new_cell, gc_copy(tempcar));
        if (MlistProcp(Mcdr(x))) {
          if (MIsMarkedCell(Mcdr(x))) {
            Msetcdr(new_cell, MmarkedCellValue(Mcdr(x)));
            ret = typeplusproc | this_list;
	    processing = 0;
          }
          else {
            Msetcdr(new_cell, TYPEOF(Mcdr(x)) | curr_cell);
            x = Mcdr(x);
	  }
        }
        else {
          Msetcdr(new_cell, gc_copy(Mcdr(x)));
          ret = typeplusproc | this_list;
	  processing = 0;
        }
      }
      else
        processing = 0;
    }
    if (ret)
      return ret;
    else
      return typeplusproc | this_list;
  }
}

int gc_copy_vector(int x) {
  int this_vector;
  int new_vector;
  int i;
  int size;
  int sizeAndSubtype;
  int subtype;

  if (MIsMarkedCell(x))
    return VECTORTYPE | MmarkedCellValue(x);
  else {
    size = VECTORSIZEMASK(Mvecref(x, 0));
    sizeAndSubtype = Mvecref(x, 0);
    subtype = VECTORSUBTYPEOF(sizeAndSubtype);
    if (subtype == SYMBOLSUBTYPE)
      size = SYMBOLSIZEMASK(sizeAndSubtype);
    this_vector = curr_cell;
    Msetcar(x, curr_cell);
    MmarkCell(x);
    new_vector = curr_cell;
    curr_cell = curr_cell + size + 1;
    Mvecset(this_vector, 0, sizeAndSubtype);
    if (subtype == VECTORSUBTYPE)
      for (i = 1; i <= size; i++)
        Mvecset(new_vector, i, gc_copy(Mvecref(x, i)));
    else // other vector subtypes are non-recursive
      for (i = 1; i <= size; i++)
        Mvecset(new_vector, i, Mvecref(x, i));
    return VECTORTYPE | this_vector;
  }
}

int gc_copy(int x) {
  if (MlistProcp(x))
    x = gc_copy_list(x);
  else
  if (Mvectorp(x))
    x = gc_copy_vector(x);
  // else x is cell value
  return x;
}

int gc(int x, int y, int size) {
  int freecount;

  if (curr_cell < n_cells) {
    curr_cell = n_cells + 2;
    cell_max = n_cells * 2 - 1;
  }
  else {
    curr_cell = 2;
    cell_max = n_cells - 1;
  }

  // initialize new copy to zeros

//for (i = curr_cell; i <= cell_max; i++)
//  cells[i] = 0;
  memset32(cells, curr_cell, 0, cell_max - curr_cell + 1);

  stack = gc_copy(stack);
  stack_arg1 = gc_copy(stack_arg1);
  stack_arg2 = gc_copy(stack_arg2);
  stack_arg3 = gc_copy(stack_arg3);
  label_instructions = gc_copy(label_instructions);
  atomlist = gc_copy(atomlist);
  code = gc_copy(code);
  globals = gc_copy(globals);
  env = gc_copy(env);
  instruction = gc_copy(instruction);
  instructions = gc_copy(instructions);
  token_list = gc_copy(token_list);
  token_new = gc_copy(token_new);
  token_tail = gc_copy(token_tail);
  opcode = gc_copy(opcode);
  operands = gc_copy(operands);
  binding = gc_copy(binding);
  closure = gc_copy(closure);
  returnval = gc_copy(returnval);
  arglist = gc_copy(arglist);
  call_cc_code = gc_copy(call_cc_code);
  gc_car = gc_copy(x);
  gc_cdr = gc_copy(y);

  gccopykeywords();

  freecount = 
    n_cells + n_cells * ((curr_cell - 1) / n_cells) - curr_cell - 3;
    // 3 is 2 + 1 where 2 is 2 empty cells 0 and 1

  if (size >= freecount) {
    printf("not enough heap cells left. ");
    write_int(size);
    printf(" requested ");
    write_int(freecount);
    printf(" available");
    writeln();
    my_exit(0);
  }
  if (debug) {
    printf("garbage collected: ");
    write_int(freecount);
    printf(" cells reclaimed");
    writeln();
    printf("stack size = ");
    write_int(list_length(stack));
    writeln();
  }

  return freecount;
}
