Exemplo n.º 1
0
Arquivo: weak.c Projeto: dmalves/benz
static pic_value
weak_call(pic_state *pic)
{
  pic_value key, val, weak;
  int n;

  n = pic_get_args(pic, "o|o", &key, &val);

  if (! pic_obj_p(pic, key)) {
    pic_error(pic, "attempted to set a non-object key", 1, key);
  }

  weak = pic_closure_ref(pic, 0);

  if (n == 1) {
    if (! pic_weak_has(pic, weak, key)) {
      return pic_false_value(pic);
    }
    return pic_cons(pic, key, pic_weak_ref(pic, weak, key));
  } else {
    if (pic_undef_p(pic, val)) {
      if (pic_weak_has(pic, weak, key)) {
        pic_weak_del(pic, weak, key);
      }
    } else {
      pic_weak_set(pic, weak, key, val);
    }
    return pic_undef_value(pic);
  }
}
Exemplo n.º 2
0
static void
gc_mark(pic_state *pic, pic_value v)
{
  if (! pic_obj_p(pic, v))
    return;

  gc_mark_object(pic, pic_ptr(pic, v));
}
Exemplo n.º 3
0
static bool
is_shared_object(pic_state *pic, pic_value obj, struct writer_control *p) {
  pic_value shared = p->shared;

  if (! pic_obj_p(pic, obj)) {
    return false;
  }
  if (! pic_weak_has(pic, shared, obj)) {
    return false;
  }
  return pic_int(pic, pic_weak_ref(pic, shared, obj)) > 0;
}
Exemplo n.º 4
0
pic_value
pic_protect(pic_state *pic, pic_value v)
{
  if (! pic_obj_p(pic, v))
    return v;

  if (pic->ai >= pic->arena_size) {
    pic->arena_size = pic->arena_size * 2 + 1;
    pic->arena = pic_realloc(pic, pic->arena, sizeof(struct object *) * pic->arena_size);
  }
  pic->arena[pic->ai++] = pic_ptr(pic, v);
  return v;
}
Exemplo n.º 5
0
struct pic_dict *
pic_attr(pic_state *pic, pic_value obj)
{
  struct pic_dict *dict;

  if (! pic_obj_p(obj)) {
    pic_errorf(pic, "attribute: expected heap object, but got immediate value ~s", obj);
  }

  if (! pic_reg_has(pic, pic->attrs, pic_ptr(obj))) {
    dict = pic_make_dict(pic);

    pic_reg_set(pic, pic->attrs, pic_ptr(obj), pic_obj_value(dict));

    return dict;
  }
  return pic_dict_ptr(pic_reg_ref(pic, pic->attrs, pic_ptr(obj)));
}
Exemplo n.º 6
0
static pic_value
reg_call(pic_state *pic)
{
  struct pic_proc *self = pic_get_proc(pic);
  struct pic_reg *reg;
  pic_value key, val;
  int n;

  n = pic_get_args(pic, "o|o", &key, &val);

  if (! pic_obj_p(key)) {
    pic_errorf(pic, "attempted to set a non-object key '~s' in a register", key);
  }

  reg = pic_reg_ptr(pic_proc_env_ref(pic, self, "reg"));

  if (n == 1) {
    return reg_get(pic, reg, pic_obj_ptr(key));
  } else {
    return reg_set(pic, reg, pic_obj_ptr(key), val);
  }
}
Exemplo n.º 7
0
void
pic_gc(pic_state *pic)
{
  struct context *cxt;
  size_t j;
  khash_t(oblist) *s = &pic->oblist;
  struct symbol *sym;
  int it;
  struct object *obj, *prev, *next;

  assert(pic->gc_attrs == NULL);

  if (! pic->gc_enable) {
    return;
  }

  /* scan objects */

  for (cxt = pic->cxt; cxt != NULL; cxt = cxt->prev) {
    if (cxt->fp) gc_mark_object(pic, (struct object *)cxt->fp);
    if (cxt->sp) gc_mark_object(pic, (struct object *)cxt->sp);
    if (cxt->irep) gc_mark_object(pic, (struct object *)cxt->irep);
    gc_mark(pic, cxt->conts);
  }

  for (j = 0; j < pic->ai; ++j) {
    gc_mark_object(pic, (struct object *)pic->arena[j]);
  }

  gc_mark(pic, pic->globals);
  gc_mark(pic, pic->halt);

  /* scan weak references */

  do {
    struct object *key;
    pic_value val;
    int it;
    khash_t(attr) *h;
    struct attr *attr;

    j = 0;
    attr = pic->gc_attrs;

    while (attr != NULL) {
      h = &attr->hash;
      for (it = kh_begin(h); it != kh_end(h); ++it) {
        if (! kh_exist(h, it))
          continue;
        key = kh_key(h, it);
        val = kh_val(h, it);
        if (is_alive(key)) {
          if (pic_obj_p(pic, val) && ! is_alive((struct object *) pic_ptr(pic, val))) {
            gc_mark(pic, val);
            ++j;
          }
        }
      }
      attr = attr->prev;
    }
  } while (j > 0);

  /* reclaim dead weak references */

  while (pic->gc_attrs != NULL) {
    khash_t(attr) *h = &pic->gc_attrs->hash;
    for (it = kh_begin(h); it != kh_end(h); ++it) {
      if (! kh_exist(h, it))
        continue;
      obj = kh_key(h, it);
      if (! is_alive(obj)) {
        kh_del(attr, h, it);
      }
    }
    pic->gc_attrs = pic->gc_attrs->prev;
  }

  for (it = kh_begin(s); it != kh_end(s); ++it) {
    if (! kh_exist(s, it))
      continue;
    sym = kh_val(s, it);
    if (sym && ! is_alive((struct object *)sym)) {
      kh_del(oblist, s, it);
    }
  }

  /* reclaim dead objects */

  for (prev = &pic->gc_head, obj = prev->next; obj != &pic->gc_head; prev = obj, obj = next) {
    next = obj->next;
    if (is_alive(obj)) {
      unmark(obj);
    } else {
      gc_finalize_object(pic, obj);
      pic_free(pic, obj);
      prev->next = next;
      obj = prev;
    }
  }
}
Exemplo n.º 8
0
static void
gc_mark_object(pic_state *pic, struct object *obj)
{
 loop:

  if (is_alive(obj))
    return;

  mark(obj);

#define LOOP(o) obj = (struct object *)(o); goto loop

  switch (obj_type(obj)) {
  case PIC_TYPE_PAIR: {
    struct pair *pair = (struct pair *) obj;
    gc_mark(pic, pair->car);
    if (pic_obj_p(pic, pair->cdr)) {
      LOOP(pic_ptr(pic, pair->cdr));
    }
    break;
  }
  case PIC_TYPE_FRAME: {
    struct frame *frame = (struct frame *) obj;
    int i;
    for (i = 0; i < frame->regc; ++i) {
      gc_mark(pic, frame->regs[i]);
    }
    if (frame->up) {
      LOOP(frame->up);
    }
    break;
  }
  case PIC_TYPE_PROC_FUNC: {
    struct proc *proc = (struct proc *) obj;
    if (proc->env) {
      LOOP(proc->env);
    }
    break;
  }
  case PIC_TYPE_PROC_IREP: {
    struct proc *proc = (struct proc *) obj;
    if (proc->env) {
      gc_mark_object(pic, (struct object *) proc->env);
    }
    LOOP(proc->u.irep);
    break;
  }
  case PIC_TYPE_IREP: {
    struct irep *irep = (struct irep *) obj;
    size_t i;
    for (i = 0; i < irep->objc; ++i) {
      gc_mark(pic, irep->obj[i]);
    }
    for (i = 0; i < irep->irepc; ++i) {
      gc_mark_object(pic, (struct object *) irep->irep[i]);
    }
    break;
  }
  case PIC_TYPE_VECTOR: {
    struct vector *vec = (struct vector *) obj;
    int i;
    for (i = 0; i < vec->len; ++i) {
      gc_mark(pic, vec->data[i]);
    }
    break;
  }
  case PIC_TYPE_DICT: {
    struct dict *dict = (struct dict *) obj;
    khash_t(dict) *h = &dict->hash;
    int it;
    for (it = 0; it != kh_end(h); ++it) {
      if (kh_exist(h, it)) {
        gc_mark_object(pic, (struct object *) kh_key(h, it));
        gc_mark(pic, kh_val(h, it));
      }
    }
    break;
  }
  case PIC_TYPE_RECORD: {
    struct record *rec = (struct record *) obj;
    gc_mark(pic, rec->datum);
    LOOP(rec->type);
    break;
  }
  case PIC_TYPE_SYMBOL: {
    struct symbol *sym = (struct symbol *) obj;
    LOOP(sym->str);
    break;
  }
  case PIC_TYPE_ATTR: {
    struct attr *attr = (struct attr *) obj;
    attr->prev = pic->gc_attrs;
    pic->gc_attrs = attr;
    break;
  }
  case PIC_TYPE_STRING: {
    struct string *str = (struct string *) obj;
    LOOP(str->rope);
    break;
  }
  case PIC_TYPE_ROPE_NODE: {
    struct rope_node *node = (struct rope_node *) obj;
    gc_mark_object(pic, (struct object *) node->s1);
    LOOP(node->s2);
    break;
  }

  case PIC_TYPE_ROPE_LEAF:
  case PIC_TYPE_BLOB:
  case PIC_TYPE_DATA:
    break;

  default:
    PIC_UNREACHABLE();
  }
}