Compare commits
10 Commits
3aaa5f29b3
...
685c541bbf
Author | SHA1 | Date |
---|---|---|
Masanori Ogino | 685c541bbf | |
Masanori Ogino | 05a21b650c | |
Masanori Ogino | 2af16bc88f | |
Yuichi Nishiwaki | 1a19e8f582 | |
Yuichi Nishiwaki | 86e4eac543 | |
Yuichi Nishiwaki | f69bc42187 | |
Yuichi Nishiwaki | e8f4bd250a | |
Yuichi Nishiwaki | f6f3064b40 | |
Yuichi Nishiwaki | 247987f09d | |
Yuichi Nishiwaki | 716629f761 |
|
@ -1,6 +1,10 @@
|
|||
*.o
|
||||
src/load_piclib.c
|
||||
bin/
|
||||
lib/libpicrin.a
|
||||
lib/mini-picrin
|
||||
src/init_contrib.c
|
||||
src/init_lib.c
|
||||
src/load_piclib.c
|
||||
docs/contrib.rst
|
||||
.dir-locals.el
|
||||
GPATH
|
||||
|
|
|
@ -1,5 +1,7 @@
|
|||
<img width="500" src="https://raw.githubusercontent.com/picrin-scheme/picrin/master/etc/picrin-logo-fin01-02.png"></img>
|
||||
|
||||
# The project is in hiatus and being archived soon...
|
||||
|
||||
[![Build Status](https://travis-ci.org/picrin-scheme/picrin.png?branch=master)](https://travis-ci.org/picrin-scheme/picrin)
|
||||
[![Docs Status](https://readthedocs.org/projects/picrin/badge/?version=latest)](https://picrin.readthedocs.org/)
|
||||
|
||||
|
|
|
@ -26,11 +26,6 @@ Documentation
|
|||
|
||||
See http://picrin.readthedocs.org/
|
||||
|
||||
IRC
|
||||
---
|
||||
|
||||
There is a chat room on chat.freenode.org, channel #picrin. IRC logs here: https://botbot.me/freenode/picrin/
|
||||
|
||||
LICENSE
|
||||
-------
|
||||
|
||||
|
|
35
lib/dict.c
35
lib/dict.c
|
@ -242,39 +242,6 @@ pic_dict_alist_to_dictionary(pic_state *pic)
|
|||
return dict;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_dict_dictionary_to_plist(pic_state *pic)
|
||||
{
|
||||
pic_value dict, key, val, plist = pic_nil_value(pic);
|
||||
int it = 0;
|
||||
|
||||
pic_get_args(pic, "d", &dict);
|
||||
|
||||
while (pic_dict_next(pic, dict, &it, &key, &val)) {
|
||||
pic_push(pic, val, plist);
|
||||
pic_push(pic, key, plist);
|
||||
}
|
||||
|
||||
return plist;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
pic_dict_plist_to_dictionary(pic_state *pic)
|
||||
{
|
||||
pic_value dict, plist, e;
|
||||
|
||||
pic_get_args(pic, "o", &plist);
|
||||
|
||||
dict = pic_make_dict(pic);
|
||||
|
||||
for (e = pic_reverse(pic, plist); ! pic_nil_p(pic, e); e = pic_cddr(pic, e)) {
|
||||
TYPE_CHECK(pic, pic_cadr(pic, e), sym);
|
||||
pic_dict_set(pic, dict, pic_cadr(pic, e), pic_car(pic, e));
|
||||
}
|
||||
|
||||
return dict;
|
||||
}
|
||||
|
||||
void
|
||||
pic_init_dict(pic_state *pic)
|
||||
{
|
||||
|
@ -290,6 +257,4 @@ pic_init_dict(pic_state *pic)
|
|||
pic_defun(pic, "dictionary-for-each", pic_dict_dictionary_for_each);
|
||||
pic_defun(pic, "dictionary->alist", pic_dict_dictionary_to_alist);
|
||||
pic_defun(pic, "alist->dictionary", pic_dict_alist_to_dictionary);
|
||||
pic_defun(pic, "dictionary->plist", pic_dict_dictionary_to_plist);
|
||||
pic_defun(pic, "plist->dictionary", pic_dict_plist_to_dictionary);
|
||||
}
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
static pic_value
|
||||
pic_cont_reset(pic_state *pic)
|
||||
{
|
||||
pic_value thunk;
|
||||
pic_value thunk, prev = pic_ref(pic, "__picrin_dynenv__");
|
||||
struct context cxt;
|
||||
|
||||
pic_get_args(pic, "l", &thunk);
|
||||
|
@ -25,21 +25,23 @@ pic_cont_reset(pic_state *pic)
|
|||
CONTEXT_INITK(pic, &cxt, thunk, pic->halt, 0, (pic_value *) NULL);
|
||||
cxt.reset = 1;
|
||||
pic_vm(pic, &cxt);
|
||||
pic_set(pic, "__picrin_dynenv__", prev);
|
||||
return pic_protect(pic, cxt.fp->regs[1]);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
shift_call(pic_state *pic)
|
||||
{
|
||||
pic_value x;
|
||||
pic_value x, prev = pic_ref(pic, "__picrin_dynenv__");
|
||||
struct context cxt;
|
||||
|
||||
pic_get_args(pic, "o", &x);
|
||||
|
||||
CONTEXT_INIT(pic, &cxt, pic_closure_ref(pic, 0), 1, &x);
|
||||
cxt.reset = 1;
|
||||
pic->dyn_env = pic_closure_ref(pic, 1);
|
||||
pic_set(pic, "__picrin_dynenv__", pic_closure_ref(pic, 1));
|
||||
pic_vm(pic, &cxt);
|
||||
pic_set(pic, "__picrin_dynenv__", prev);
|
||||
return pic_protect(pic, cxt.fp->regs[1]);
|
||||
}
|
||||
|
||||
|
@ -54,7 +56,7 @@ pic_cont_shift(pic_state *pic)
|
|||
pic_error(pic, "c function call interleaved in delimited continuation", 0);
|
||||
}
|
||||
|
||||
k = pic_lambda(pic, shift_call, 2, pic->cxt->fp->regs[1], pic->dyn_env);
|
||||
k = pic_lambda(pic, shift_call, 2, pic->cxt->fp->regs[1], pic_ref(pic, "__picrin_dynenv__"));
|
||||
CONTEXT_INITK(pic, pic->cxt, f, pic->halt, 1, &k);
|
||||
return pic_invalid_value(pic);
|
||||
}
|
||||
|
@ -85,7 +87,7 @@ cont_call(pic_state *pic)
|
|||
}
|
||||
pic->cxt = pic->cxt->prev;
|
||||
}
|
||||
pic->dyn_env = dyn_env;
|
||||
pic_set(pic, "__picrin_dynenv__", dyn_env);
|
||||
|
||||
longjmp(cxt->jmp, 1);
|
||||
PIC_UNREACHABLE();
|
||||
|
@ -96,7 +98,7 @@ pic_make_cont(pic_state *pic, pic_value k)
|
|||
{
|
||||
static const pic_data_type cxt_type = { "cxt", NULL };
|
||||
pic_value c;
|
||||
c = pic_lambda(pic, cont_call, 4, pic_true_value(pic), pic_data_value(pic, pic->cxt, &cxt_type), k, pic->dyn_env);
|
||||
c = pic_lambda(pic, cont_call, 4, pic_true_value(pic), pic_data_value(pic, pic->cxt, &cxt_type), k, pic_ref(pic, "__picrin_dynenv__"));
|
||||
pic->cxt->conts = pic_cons(pic, c, pic->cxt->conts);
|
||||
return c;
|
||||
}
|
||||
|
|
|
@ -52,7 +52,7 @@ pic_enter_try(pic_state *pic)
|
|||
var = pic_exc(pic);
|
||||
env = pic_make_attr(pic);
|
||||
pic_attr_set(pic, env, var, pic_cons(pic, handler, pic_call(pic, var, 0)));
|
||||
pic->dyn_env = pic_cons(pic, env, pic->dyn_env);
|
||||
pic_set(pic, "__picrin_dynenv__", pic_cons(pic, env, pic_ref(pic, "__picrin_dynenv__")));
|
||||
|
||||
pic_leave(pic, pic->cxt->ai);
|
||||
}
|
||||
|
@ -62,7 +62,7 @@ pic_exit_try(pic_state *pic)
|
|||
{
|
||||
struct context *cxt = pic->cxt;
|
||||
pic_value c, it;
|
||||
pic->dyn_env = pic_cdr(pic, pic->dyn_env);
|
||||
pic_set(pic, "__picrin_dynenv__", pic_cdr(pic, pic_ref(pic, "__picrin_dynenv__")));
|
||||
pic_for_each (c, cxt->conts, it) {
|
||||
proc_ptr(pic, c)->env->regs[0] = pic_false_value(pic);
|
||||
}
|
||||
|
|
650
lib/gc.c
650
lib/gc.c
|
@ -7,85 +7,6 @@
|
|||
#include "object.h"
|
||||
#include "state.h"
|
||||
|
||||
#define PAGE_UNITS ((PIC_HEAP_PAGE_SIZE - offsetof(struct heap_page, u)) / sizeof(union header))
|
||||
|
||||
#define alignof(type) offsetof(struct { char c; type m; }, m)
|
||||
#define roundup(n,unit) (((n) + (unit) - 1) / (unit) * (unit))
|
||||
|
||||
struct object {
|
||||
union {
|
||||
struct basic basic;
|
||||
struct symbol sym;
|
||||
struct string str;
|
||||
struct blob blob;
|
||||
struct pair pair;
|
||||
struct vector vec;
|
||||
struct dict dict;
|
||||
struct attr attr;
|
||||
struct data data;
|
||||
struct record rec;
|
||||
struct proc proc;
|
||||
struct frame frame;
|
||||
struct irep irep;
|
||||
} u;
|
||||
};
|
||||
|
||||
struct free_region {
|
||||
union header *ptr;
|
||||
size_t size;
|
||||
};
|
||||
|
||||
union header {
|
||||
struct free_region s;
|
||||
char alignment[roundup(sizeof(struct free_region), alignof(struct object))];
|
||||
};
|
||||
|
||||
struct heap_page {
|
||||
struct heap_page *next;
|
||||
union {
|
||||
union header basep[1];
|
||||
struct object alignment;
|
||||
} u;
|
||||
};
|
||||
|
||||
struct heap {
|
||||
union header base, *freep;
|
||||
struct heap_page *pages;
|
||||
struct attr *attrs; /* weak map chain */
|
||||
};
|
||||
|
||||
#define unitsof(type) ((type2size(type) + sizeof(union header) - 1) / sizeof(union header))
|
||||
|
||||
struct heap *
|
||||
pic_heap_open(pic_state *pic)
|
||||
{
|
||||
struct heap *heap;
|
||||
|
||||
heap = pic_malloc(pic, sizeof(struct heap));
|
||||
|
||||
heap->base.s.ptr = &heap->base;
|
||||
heap->base.s.size = 0; /* not 1, since it must never be used for allocation */
|
||||
heap->freep = &heap->base;
|
||||
|
||||
heap->pages = NULL;
|
||||
heap->attrs = NULL;
|
||||
|
||||
return heap;
|
||||
}
|
||||
|
||||
void
|
||||
pic_heap_close(pic_state *pic, struct heap *heap)
|
||||
{
|
||||
struct heap_page *page;
|
||||
|
||||
while (heap->pages) {
|
||||
page = heap->pages;
|
||||
heap->pages = heap->pages->next;
|
||||
pic_free(pic, page);
|
||||
}
|
||||
pic_free(pic, heap);
|
||||
}
|
||||
|
||||
#if PIC_USE_LIBC
|
||||
void *
|
||||
pic_default_allocf(void *PIC_UNUSED(userdata), void *ptr, size_t size)
|
||||
|
@ -99,44 +20,30 @@ pic_default_allocf(void *PIC_UNUSED(userdata), void *ptr, size_t size)
|
|||
#endif
|
||||
|
||||
void *
|
||||
pic_malloc(pic_state *pic, size_t size)
|
||||
pic_realloc(pic_state *pic, void *ptr, size_t size)
|
||||
{
|
||||
void *ptr;
|
||||
void *p;
|
||||
|
||||
retry:
|
||||
ptr = pic->allocf(pic->userdata, NULL, size);
|
||||
if (ptr == NULL && size > 0) {
|
||||
p = pic->allocf(pic->userdata, ptr, size);
|
||||
if (p == NULL && size > 0) {
|
||||
pic->panicf(pic, "out of memory", 0, NULL);
|
||||
goto retry;
|
||||
}
|
||||
return ptr;
|
||||
return p;
|
||||
}
|
||||
|
||||
void *
|
||||
pic_realloc(pic_state *pic, void *ptr, size_t size)
|
||||
pic_malloc(pic_state *pic, size_t size)
|
||||
{
|
||||
retry:
|
||||
ptr = pic->allocf(pic->userdata, ptr, size);
|
||||
if (ptr == NULL && size > 0) {
|
||||
pic->panicf(pic, "out of memory", 0, NULL);
|
||||
goto retry;
|
||||
}
|
||||
return ptr;
|
||||
return pic_realloc(pic, NULL, size);
|
||||
}
|
||||
|
||||
void *
|
||||
pic_calloc(pic_state *pic, size_t count, size_t size)
|
||||
{
|
||||
void *ptr;
|
||||
|
||||
size *= count;
|
||||
retry:
|
||||
ptr = pic->allocf(pic->userdata, NULL, size);
|
||||
if (ptr == NULL && size > 0) {
|
||||
pic->panicf(pic, "out of memory", 0, NULL);
|
||||
goto retry;
|
||||
}
|
||||
memset(ptr, 0, size);
|
||||
void *ptr = pic_malloc(pic, count * size);
|
||||
memset(ptr, 0, count * size);
|
||||
return ptr;
|
||||
}
|
||||
|
||||
|
@ -146,14 +53,16 @@ pic_free(pic_state *pic, void *ptr)
|
|||
pic->allocf(pic->userdata, ptr, 0);
|
||||
}
|
||||
|
||||
static void
|
||||
gc_protect(pic_state *pic, struct object *obj)
|
||||
size_t
|
||||
pic_enter(pic_state *pic)
|
||||
{
|
||||
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++] = obj;
|
||||
return pic->ai;
|
||||
}
|
||||
|
||||
void
|
||||
pic_leave(pic_state *pic, size_t ai)
|
||||
{
|
||||
pic->ai = ai;
|
||||
}
|
||||
|
||||
pic_value
|
||||
|
@ -162,23 +71,14 @@ pic_protect(pic_state *pic, pic_value v)
|
|||
if (! pic_obj_p(pic, v))
|
||||
return v;
|
||||
|
||||
gc_protect(pic, pic_ptr(pic, 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;
|
||||
}
|
||||
|
||||
size_t
|
||||
pic_enter(pic_state *pic)
|
||||
{
|
||||
return pic->ai;
|
||||
}
|
||||
|
||||
void
|
||||
pic_leave(pic_state *pic, size_t state)
|
||||
{
|
||||
pic->ai = state;
|
||||
}
|
||||
|
||||
void *
|
||||
pic_alloca(pic_state *pic, size_t n)
|
||||
{
|
||||
|
@ -187,19 +87,12 @@ pic_alloca(pic_state *pic, size_t n)
|
|||
return pic_data(pic, pic_data_value(pic, pic_malloc(pic, n), &t));
|
||||
}
|
||||
|
||||
/* MARK */
|
||||
/* GC */
|
||||
|
||||
PIC_STATIC_INLINE bool
|
||||
is_alive(struct object *obj)
|
||||
{
|
||||
return obj->u.basic.tt & GC_MARK;
|
||||
}
|
||||
#define is_alive(obj) ((obj)->tt & GC_MARK)
|
||||
#define mark(obj) ((obj)->tt |= GC_MARK)
|
||||
#define unmark(obj) ((obj)->tt &= ~GC_MARK)
|
||||
|
||||
PIC_STATIC_INLINE void
|
||||
mark(struct object *obj)
|
||||
{
|
||||
obj->u.basic.tt |= GC_MARK;
|
||||
}
|
||||
static void gc_mark_object(pic_state *, struct object *);
|
||||
|
||||
static void
|
||||
|
@ -225,179 +118,133 @@ gc_mark_object(pic_state *pic, struct object *obj)
|
|||
|
||||
switch (obj_type(obj)) {
|
||||
case PIC_TYPE_PAIR: {
|
||||
gc_mark(pic, obj->u.pair.car);
|
||||
if (pic_obj_p(pic, obj->u.pair.cdr)) {
|
||||
LOOP(pic_ptr(pic, obj->u.pair.cdr));
|
||||
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 < obj->u.frame.regc; ++i) {
|
||||
gc_mark(pic, obj->u.frame.regs[i]);
|
||||
for (i = 0; i < frame->regc; ++i) {
|
||||
gc_mark(pic, frame->regs[i]);
|
||||
}
|
||||
if (obj->u.frame.up) {
|
||||
LOOP(obj->u.frame.up);
|
||||
if (frame->up) {
|
||||
LOOP(frame->up);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_PROC_FUNC: {
|
||||
if (obj->u.proc.env) {
|
||||
LOOP(obj->u.proc.env);
|
||||
struct proc *proc = (struct proc *) obj;
|
||||
if (proc->env) {
|
||||
LOOP(proc->env);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_PROC_IREP: {
|
||||
if (obj->u.proc.env) {
|
||||
gc_mark_object(pic, (struct object *)obj->u.proc.env);
|
||||
struct proc *proc = (struct proc *) obj;
|
||||
if (proc->env) {
|
||||
gc_mark_object(pic, (struct object *) proc->env);
|
||||
}
|
||||
LOOP(obj->u.proc.u.irep);
|
||||
LOOP(proc->u.irep);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_IREP: {
|
||||
struct irep *irep = (struct irep *) obj;
|
||||
size_t i;
|
||||
for (i = 0; i < obj->u.irep.objc; ++i) {
|
||||
gc_mark(pic, obj->u.irep.obj[i]);
|
||||
for (i = 0; i < irep->objc; ++i) {
|
||||
gc_mark(pic, irep->obj[i]);
|
||||
}
|
||||
for (i = 0; i < obj->u.irep.irepc; ++i) {
|
||||
gc_mark_object(pic, (struct object *)obj->u.irep.irep[i]);
|
||||
for (i = 0; i < irep->irepc; ++i) {
|
||||
gc_mark_object(pic, (struct object *) irep->irep[i]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_STRING: {
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_VECTOR: {
|
||||
struct vector *vec = (struct vector *) obj;
|
||||
int i;
|
||||
for (i = 0; i < obj->u.vec.len; ++i) {
|
||||
gc_mark(pic, obj->u.vec.data[i]);
|
||||
for (i = 0; i < vec->len; ++i) {
|
||||
gc_mark(pic, vec->data[i]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_BLOB: {
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_DATA: {
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_DICT: {
|
||||
pic_value key, val;
|
||||
int it = 0;
|
||||
|
||||
while (pic_dict_next(pic, obj_value(pic, &obj->u.dict), &it, &key, &val)) {
|
||||
gc_mark(pic, key);
|
||||
gc_mark(pic, val);
|
||||
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: {
|
||||
gc_mark(pic, obj->u.rec.datum);
|
||||
LOOP(obj->u.rec.type);
|
||||
struct record *rec = (struct record *) obj;
|
||||
gc_mark(pic, rec->datum);
|
||||
LOOP(rec->type);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_SYMBOL: {
|
||||
LOOP(obj->u.sym.str);
|
||||
struct symbol *sym = (struct symbol *) obj;
|
||||
LOOP(sym->str);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_ATTR: {
|
||||
struct attr *attr = (struct attr *)obj;
|
||||
|
||||
attr->prev = pic->heap->attrs;
|
||||
pic->heap->attrs = 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();
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
gc_mark_phase(pic_state *pic)
|
||||
{
|
||||
struct context *cxt;
|
||||
size_t j;
|
||||
|
||||
assert(pic->heap->attrs == NULL);
|
||||
|
||||
/* context */
|
||||
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);
|
||||
}
|
||||
|
||||
/* arena */
|
||||
for (j = 0; j < pic->ai; ++j) {
|
||||
gc_mark_object(pic, (struct object *)pic->arena[j]);
|
||||
}
|
||||
|
||||
/* global variables */
|
||||
gc_mark(pic, pic->globals);
|
||||
|
||||
/* dynamic environment */
|
||||
gc_mark(pic, pic->dyn_env);
|
||||
|
||||
/* top continuation */
|
||||
gc_mark(pic, pic->halt);
|
||||
|
||||
/* weak maps */
|
||||
do {
|
||||
struct object *key;
|
||||
pic_value val;
|
||||
int it;
|
||||
khash_t(attr) *h;
|
||||
struct attr *attr;
|
||||
|
||||
j = 0;
|
||||
attr = pic->heap->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(pic_ptr(pic, val))) {
|
||||
gc_mark(pic, val);
|
||||
++j;
|
||||
}
|
||||
}
|
||||
}
|
||||
attr = attr->prev;
|
||||
}
|
||||
} while (j > 0);
|
||||
}
|
||||
|
||||
/* SWEEP */
|
||||
|
||||
static void
|
||||
gc_finalize_object(pic_state *pic, struct object *obj)
|
||||
{
|
||||
switch (obj_type(obj)) {
|
||||
case PIC_TYPE_VECTOR: {
|
||||
pic_free(pic, obj->u.vec.data);
|
||||
struct vector *vec = (struct vector *) obj;
|
||||
pic_free(pic, vec->data);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_BLOB: {
|
||||
pic_free(pic, obj->u.blob.data);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_STRING: {
|
||||
pic_rope_decref(pic, obj->u.str.rope);
|
||||
struct blob *blob = (struct blob *) obj;
|
||||
pic_free(pic, blob->data);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_DATA: {
|
||||
if (obj->u.data.type->dtor) {
|
||||
obj->u.data.type->dtor(pic, obj->u.data.data);
|
||||
struct data *data = (struct data *) obj;
|
||||
if (data->type->dtor) {
|
||||
data->type->dtor(pic, data->data);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_DICT: {
|
||||
kh_destroy(dict, &obj->u.dict.hash);
|
||||
struct dict *dict = (struct dict *) obj;
|
||||
kh_destroy(dict, &dict->hash);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_SYMBOL: {
|
||||
|
@ -405,11 +252,12 @@ gc_finalize_object(pic_state *pic, struct object *obj)
|
|||
break;
|
||||
}
|
||||
case PIC_TYPE_ATTR: {
|
||||
kh_destroy(attr, &obj->u.attr.hash);
|
||||
struct attr *attr = (struct attr *) obj;
|
||||
kh_destroy(attr, &attr->hash);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_IREP: {
|
||||
struct irep *irep = &obj->u.irep;
|
||||
struct irep *irep = (struct irep *) obj;
|
||||
if ((irep->flags & IREP_CODE_STATIC) == 0) {
|
||||
pic_free(pic, (code_t *) irep->code);
|
||||
}
|
||||
|
@ -418,10 +266,18 @@ gc_finalize_object(pic_state *pic, struct object *obj)
|
|||
break;
|
||||
}
|
||||
case PIC_TYPE_FRAME: {
|
||||
pic_free(pic, obj->u.frame.regs);
|
||||
struct frame *frame = (struct frame *) obj;
|
||||
pic_free(pic, frame->regs);
|
||||
break;
|
||||
}
|
||||
case PIC_TYPE_ROPE_LEAF: {
|
||||
struct rope_leaf *leaf = (struct rope_leaf *) obj;
|
||||
pic_free(pic, (char *) leaf->str);
|
||||
break;
|
||||
}
|
||||
|
||||
case PIC_TYPE_STRING:
|
||||
case PIC_TYPE_ROPE_NODE:
|
||||
case PIC_TYPE_PAIR:
|
||||
case PIC_TYPE_RECORD:
|
||||
case PIC_TYPE_PROC_FUNC:
|
||||
|
@ -433,168 +289,72 @@ gc_finalize_object(pic_state *pic, struct object *obj)
|
|||
}
|
||||
}
|
||||
|
||||
static size_t
|
||||
type2size(int type)
|
||||
void
|
||||
pic_gc(pic_state *pic)
|
||||
{
|
||||
switch (type) {
|
||||
case PIC_TYPE_VECTOR: return sizeof(struct vector);
|
||||
case PIC_TYPE_BLOB: return sizeof(struct blob);
|
||||
case PIC_TYPE_STRING: return sizeof(struct string);
|
||||
case PIC_TYPE_DATA: return sizeof(struct data);
|
||||
case PIC_TYPE_DICT: return sizeof(struct dict);
|
||||
case PIC_TYPE_SYMBOL: return sizeof(struct symbol);
|
||||
case PIC_TYPE_ATTR: return sizeof(struct attr);
|
||||
case PIC_TYPE_IREP: return sizeof(struct irep);
|
||||
case PIC_TYPE_PAIR: return sizeof(struct pair);
|
||||
case PIC_TYPE_FRAME: return sizeof(struct frame);
|
||||
case PIC_TYPE_RECORD: return sizeof(struct record);
|
||||
case PIC_TYPE_PROC_FUNC: return sizeof(struct proc);
|
||||
case PIC_TYPE_PROC_IREP: return sizeof(struct proc);
|
||||
default: PIC_UNREACHABLE();
|
||||
}
|
||||
}
|
||||
|
||||
static struct object *
|
||||
obj_alloc(pic_state *pic, int type)
|
||||
{
|
||||
union header *p, *prevp;
|
||||
struct object *obj;
|
||||
size_t nunits;
|
||||
|
||||
nunits = unitsof(type);
|
||||
|
||||
prevp = pic->heap->freep;
|
||||
for (p = prevp->s.ptr; ; prevp = p, p = p->s.ptr) {
|
||||
if (p->s.size >= nunits)
|
||||
break;
|
||||
if (p == pic->heap->freep) {
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
|
||||
if (p->s.size == nunits) {
|
||||
prevp->s.ptr = p->s.ptr;
|
||||
}
|
||||
else {
|
||||
p->s.size -= nunits;
|
||||
p += p->s.size;
|
||||
p->s.size = nunits;
|
||||
}
|
||||
pic->heap->freep = prevp;
|
||||
|
||||
obj = (struct object *) p;
|
||||
obj->u.basic.tt = type;
|
||||
return obj;
|
||||
}
|
||||
|
||||
static void
|
||||
free_chunk(pic_state *pic, union header *bp)
|
||||
{
|
||||
union header *p;
|
||||
|
||||
assert(bp != NULL);
|
||||
|
||||
for (p = pic->heap->freep; ! (bp > p && bp < p->s.ptr); p = p->s.ptr) {
|
||||
if (p >= p->s.ptr && (bp > p || bp < p->s.ptr)) {
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (bp + bp->s.size == p->s.ptr && p->s.ptr->s.size > 0) { /* don't melt base header */
|
||||
bp->s.size += p->s.ptr->s.size;
|
||||
bp->s.ptr = p->s.ptr->s.ptr;
|
||||
} else {
|
||||
bp->s.ptr = p->s.ptr;
|
||||
}
|
||||
if (p + p->s.size == bp && bp->s.size > 0) { /* don't melt base header */
|
||||
p->s.size += bp->s.size;
|
||||
p->s.ptr = bp->s.ptr;
|
||||
} else {
|
||||
p->s.ptr = bp;
|
||||
}
|
||||
pic->heap->freep = p;
|
||||
}
|
||||
|
||||
static void
|
||||
heap_morecore(pic_state *pic)
|
||||
{
|
||||
union header *bp, *np;
|
||||
struct heap_page *page;
|
||||
|
||||
assert(PAGE_UNITS >= 2);
|
||||
|
||||
page = pic_malloc(pic, PIC_HEAP_PAGE_SIZE);
|
||||
page->next = pic->heap->pages;
|
||||
|
||||
bp = page->u.basep;
|
||||
bp->s.size = 0; /* bp is never used for allocation */
|
||||
free_chunk(pic, bp);
|
||||
|
||||
np = page->u.basep + 1;
|
||||
np->s.size = PAGE_UNITS - 1;
|
||||
free_chunk(pic, np);
|
||||
|
||||
pic->heap->pages = page;
|
||||
}
|
||||
|
||||
static size_t
|
||||
gc_sweep_page(pic_state *pic, struct heap_page *page)
|
||||
{
|
||||
union header *bp, *p, *head = NULL, *tail = NULL;
|
||||
struct object *obj;
|
||||
size_t alive = 0, nunits;
|
||||
|
||||
for (bp = page->u.basep; ; bp = bp->s.ptr) {
|
||||
p = bp + (bp->s.size ? bp->s.size : 1); /* first bp's size is 0, so force advnce */
|
||||
while (p != bp->s.ptr) {
|
||||
if (p < page->u.basep || page->u.basep + PAGE_UNITS <= p) {
|
||||
goto escape;
|
||||
}
|
||||
obj = (struct object *) p;
|
||||
nunits = unitsof(obj_type(obj));
|
||||
if (obj->u.basic.tt & GC_MARK) {
|
||||
obj->u.basic.tt &= ~GC_MARK;
|
||||
alive += nunits;
|
||||
} else {
|
||||
gc_finalize_object(pic, obj);
|
||||
if (head == NULL) {
|
||||
head = p;
|
||||
}
|
||||
if (tail != NULL) {
|
||||
tail->s.ptr = p;
|
||||
}
|
||||
tail = p;
|
||||
tail->s.size = nunits;
|
||||
tail->s.ptr = NULL; /* We can safely reuse ptr field of dead object */
|
||||
}
|
||||
p += nunits;
|
||||
}
|
||||
}
|
||||
escape:
|
||||
|
||||
/* free! */
|
||||
while (head != NULL) {
|
||||
p = head;
|
||||
head = head->s.ptr;
|
||||
free_chunk(pic, p);
|
||||
}
|
||||
|
||||
return alive;
|
||||
}
|
||||
|
||||
static void
|
||||
gc_sweep_phase(pic_state *pic)
|
||||
{
|
||||
struct heap_page *page;
|
||||
int it;
|
||||
khash_t(attr) *h;
|
||||
struct context *cxt;
|
||||
size_t j;
|
||||
khash_t(oblist) *s = &pic->oblist;
|
||||
struct symbol *sym;
|
||||
struct object *obj;
|
||||
size_t total = 0, inuse = 0;
|
||||
int it;
|
||||
struct object *obj, *prev, *next;
|
||||
|
||||
/* weak maps */
|
||||
while (pic->heap->attrs != NULL) {
|
||||
h = &pic->heap->attrs->hash;
|
||||
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;
|
||||
|
@ -603,10 +363,9 @@ gc_sweep_phase(pic_state *pic)
|
|||
kh_del(attr, h, it);
|
||||
}
|
||||
}
|
||||
pic->heap->attrs = pic->heap->attrs->prev;
|
||||
pic->gc_attrs = pic->gc_attrs->prev;
|
||||
}
|
||||
|
||||
/* symbol table */
|
||||
for (it = kh_begin(s); it != kh_end(s); ++it) {
|
||||
if (! kh_exist(s, it))
|
||||
continue;
|
||||
|
@ -616,53 +375,62 @@ gc_sweep_phase(pic_state *pic)
|
|||
}
|
||||
}
|
||||
|
||||
page = pic->heap->pages;
|
||||
while (page) {
|
||||
inuse += gc_sweep_page(pic, page);
|
||||
total += PAGE_UNITS;
|
||||
page = page->next;
|
||||
}
|
||||
/* reclaim dead objects */
|
||||
|
||||
if (PIC_PAGE_REQUEST_THRESHOLD(total) <= inuse) {
|
||||
heap_morecore(pic);
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
pic_gc(pic_state *pic)
|
||||
static size_t
|
||||
type2size(int type)
|
||||
{
|
||||
if (! pic->gc_enable) {
|
||||
return;
|
||||
switch (type) {
|
||||
case PIC_TYPE_VECTOR: return sizeof(struct vector);
|
||||
case PIC_TYPE_BLOB: return sizeof(struct blob);
|
||||
case PIC_TYPE_STRING: return sizeof(struct string);
|
||||
case PIC_TYPE_DATA: return sizeof(struct data);
|
||||
case PIC_TYPE_DICT: return sizeof(struct dict);
|
||||
case PIC_TYPE_SYMBOL: return sizeof(struct symbol);
|
||||
case PIC_TYPE_ATTR: return sizeof(struct attr);
|
||||
case PIC_TYPE_IREP: return sizeof(struct irep);
|
||||
case PIC_TYPE_PAIR: return sizeof(struct pair);
|
||||
case PIC_TYPE_FRAME: return sizeof(struct frame);
|
||||
case PIC_TYPE_RECORD: return sizeof(struct record);
|
||||
case PIC_TYPE_PROC_FUNC: return sizeof(struct proc);
|
||||
case PIC_TYPE_PROC_IREP: return sizeof(struct proc);
|
||||
case PIC_TYPE_ROPE_LEAF: return sizeof(struct rope_leaf);
|
||||
case PIC_TYPE_ROPE_NODE: return sizeof(struct rope_node);
|
||||
default: PIC_UNREACHABLE();
|
||||
}
|
||||
|
||||
gc_mark_phase(pic);
|
||||
gc_sweep_phase(pic);
|
||||
}
|
||||
|
||||
struct object *
|
||||
pic_obj_alloc_unsafe(pic_state *pic, int type)
|
||||
{
|
||||
struct object *obj;
|
||||
size_t size = type2size(type);
|
||||
|
||||
if (pic->heap->pages == NULL) {
|
||||
heap_morecore(pic);
|
||||
}
|
||||
|
||||
#if GC_STRESS
|
||||
pic_gc(pic);
|
||||
#endif
|
||||
|
||||
obj = obj_alloc(pic, type);
|
||||
if (obj == NULL) {
|
||||
if (pic->gc_count > PIC_GC_PERIOD) {
|
||||
pic_gc(pic);
|
||||
retry:
|
||||
obj = obj_alloc(pic, type);
|
||||
if (obj == NULL) {
|
||||
pic->panicf(pic, "out of memory", 0, NULL);
|
||||
goto retry;
|
||||
}
|
||||
pic->gc_count -= PIC_GC_PERIOD;
|
||||
}
|
||||
|
||||
obj = pic_malloc(pic, size);
|
||||
obj->tt = type;
|
||||
obj->next = pic->gc_head.next;
|
||||
pic->gc_head.next = obj;
|
||||
|
||||
pic->gc_count += size;
|
||||
|
||||
return obj;
|
||||
}
|
||||
|
||||
|
@ -673,6 +441,6 @@ pic_obj_alloc(pic_state *pic, int type)
|
|||
|
||||
obj = pic_obj_alloc_unsafe(pic, type);
|
||||
|
||||
gc_protect(pic, obj);
|
||||
pic_protect(pic, obj_value(pic, obj));
|
||||
return obj;
|
||||
}
|
||||
|
|
|
@ -41,7 +41,7 @@ typedef struct value {
|
|||
uint64_t v;
|
||||
#else
|
||||
union {
|
||||
void *data;
|
||||
void *p;
|
||||
double f;
|
||||
int i;
|
||||
char c;
|
||||
|
@ -135,7 +135,7 @@ pic_value pic_deserialize(pic_state *pic, pic_value blob);
|
|||
bool pic_str_p(pic_state *, pic_value);
|
||||
pic_value pic_str_value(pic_state *, const char *str, int len);
|
||||
pic_value pic_cstr_value(pic_state *, const char *str);
|
||||
#define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, -((int)sizeof lit - 1))
|
||||
#define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, sizeof lit - 1)
|
||||
pic_value pic_strf_value(pic_state *, const char *fmt, ...);
|
||||
pic_value pic_vstrf_value(pic_state *, const char *fmt, va_list ap);
|
||||
const char *pic_str(pic_state *, pic_value str, int *len);
|
||||
|
|
|
@ -72,12 +72,8 @@
|
|||
# define PIC_ARENA_SIZE (8 * 1024)
|
||||
#endif
|
||||
|
||||
#ifndef PIC_HEAP_PAGE_SIZE
|
||||
# define PIC_HEAP_PAGE_SIZE (4 * 1024 * 1024)
|
||||
#endif
|
||||
|
||||
#ifndef PIC_PAGE_REQUEST_THRESHOLD
|
||||
# define PIC_PAGE_REQUEST_THRESHOLD(total) ((total) * 77 / 100)
|
||||
#ifndef PIC_GC_PERIOD
|
||||
# define PIC_GC_PERIOD (8 * 1024 * 1024)
|
||||
#endif
|
||||
|
||||
/* check compatibility */
|
||||
|
|
30
lib/object.h
30
lib/object.h
|
@ -12,14 +12,13 @@ extern "C" {
|
|||
#include "khash.h"
|
||||
|
||||
#define OBJECT_HEADER \
|
||||
struct object *next; \
|
||||
unsigned char tt;
|
||||
|
||||
#define TYPE_MASK 0x7f
|
||||
#define GC_MARK 0x80
|
||||
|
||||
struct object; /* defined in gc.c */
|
||||
|
||||
struct basic {
|
||||
struct object {
|
||||
OBJECT_HEADER
|
||||
};
|
||||
|
||||
|
@ -29,6 +28,25 @@ struct blob {
|
|||
int len;
|
||||
};
|
||||
|
||||
#define ROPE_HEADER \
|
||||
OBJECT_HEADER \
|
||||
int len;
|
||||
|
||||
struct rope {
|
||||
ROPE_HEADER
|
||||
};
|
||||
|
||||
struct rope_leaf {
|
||||
ROPE_HEADER
|
||||
const char *str;
|
||||
};
|
||||
|
||||
struct rope_node {
|
||||
ROPE_HEADER
|
||||
struct rope *s1;
|
||||
struct rope *s2;
|
||||
};
|
||||
|
||||
struct string {
|
||||
OBJECT_HEADER
|
||||
struct rope *rope;
|
||||
|
@ -157,7 +175,7 @@ struct proc {
|
|||
PIC_STATIC_INLINE int
|
||||
obj_type(void *ptr)
|
||||
{
|
||||
return ((struct basic *) ptr)->tt & TYPE_MASK;
|
||||
return ((struct object *) ptr)->tt & TYPE_MASK;
|
||||
}
|
||||
|
||||
PIC_STATIC_INLINE pic_value
|
||||
|
@ -199,10 +217,6 @@ pic_value pic_make_cont(pic_state *pic, pic_value k);
|
|||
int pic_str_hash(pic_state *pic, pic_value str);
|
||||
int pic_str_cmp(pic_state *pic, pic_value str1, pic_value str2);
|
||||
|
||||
struct rope *pic_rope_incref(struct rope *);
|
||||
void pic_rope_decref(pic_state *, struct rope *);
|
||||
|
||||
|
||||
void pic_warnf(pic_state *pic, const char *fmt, ...); /* deprecated */
|
||||
|
||||
#if defined(__cplusplus)
|
||||
|
|
40
lib/state.c
40
lib/state.c
|
@ -13,12 +13,9 @@ static pic_value pic_state_features(pic_state *);
|
|||
void
|
||||
pic_add_feature(pic_state *pic, const char *feature)
|
||||
{
|
||||
pic_value f = pic_ref(pic, "features");
|
||||
pic_value f = pic_ref(pic, "__picrin_features__");
|
||||
|
||||
if (! (pic_proc_func_p(pic, f) && proc_ptr(pic, f)->u.func == pic_state_features)) {
|
||||
pic_error(pic, "the features procedure is overwritten", 0);
|
||||
}
|
||||
pic_push(pic, pic_intern_cstr(pic, feature), proc_ptr(pic, f)->env->regs[0]);
|
||||
pic_set(pic, "__picrin_features__", pic_cons(pic, pic_intern_cstr(pic, feature), f));
|
||||
}
|
||||
|
||||
void pic_init_bool(pic_state *);
|
||||
|
@ -50,9 +47,11 @@ pic_init_core(pic_state *pic)
|
|||
{
|
||||
size_t ai = pic_enter(pic);
|
||||
|
||||
pic_define(pic, "__picrin_features__", pic_nil_value(pic));
|
||||
pic_define(pic, "__picrin_dynenv__", pic_list(pic, 1, pic_make_attr(pic)));
|
||||
|
||||
pic_init_bool(pic); DONE;
|
||||
pic_init_pair(pic); DONE;
|
||||
pic_init_port(pic); DONE;
|
||||
pic_init_number(pic); DONE;
|
||||
pic_init_proc(pic); DONE;
|
||||
pic_init_symbol(pic); DONE;
|
||||
|
@ -69,6 +68,9 @@ pic_init_core(pic_state *pic)
|
|||
#if PIC_USE_CONT
|
||||
pic_init_cont(pic); DONE;
|
||||
#endif
|
||||
#if PIC_USE_PORT
|
||||
pic_init_port(pic); DONE;
|
||||
#endif
|
||||
#if PIC_USE_READ
|
||||
pic_init_read(pic); DONE;
|
||||
#endif
|
||||
|
@ -128,8 +130,10 @@ pic_open(pic_allocf allocf, void *userdata, pic_panicf panicf)
|
|||
/* turn off GC */
|
||||
pic->gc_enable = false;
|
||||
|
||||
/* memory heap */
|
||||
pic->heap = pic_heap_open(pic);
|
||||
/* gc */
|
||||
pic->gc_head.next = (struct object *) &pic->gc_head;
|
||||
pic->gc_attrs = NULL;
|
||||
pic->gc_count = 0;
|
||||
|
||||
/* symbol table */
|
||||
kh_init(oblist, &pic->oblist);
|
||||
|
@ -137,9 +141,6 @@ pic_open(pic_allocf allocf, void *userdata, pic_panicf panicf)
|
|||
/* global variables */
|
||||
pic->globals = pic_make_dict(pic);
|
||||
|
||||
/* dynamic environment */
|
||||
pic->dyn_env = pic_list(pic, 1, pic_make_attr(pic));
|
||||
|
||||
/* top continuation */
|
||||
{
|
||||
static const code_t halt_code[] = { 0x00 };
|
||||
|
@ -161,9 +162,6 @@ pic_open(pic_allocf allocf, void *userdata, pic_panicf panicf)
|
|||
pic->halt = obj_value(pic, proc);
|
||||
}
|
||||
|
||||
/* panic handler */
|
||||
pic->panicf = NULL;
|
||||
|
||||
/* turn on GC */
|
||||
pic->gc_enable = true;
|
||||
|
||||
|
@ -189,7 +187,6 @@ pic_close(pic_state *pic)
|
|||
pic->ai = 0;
|
||||
pic->halt = pic_invalid_value(pic);
|
||||
pic->globals = pic_invalid_value(pic);
|
||||
pic->dyn_env = pic_invalid_value(pic);
|
||||
|
||||
assert(pic->cxt->ai == 0);
|
||||
assert(pic->cxt->pc == NULL);
|
||||
|
@ -201,8 +198,7 @@ pic_close(pic_state *pic)
|
|||
/* free all heap objects */
|
||||
pic_gc(pic);
|
||||
|
||||
/* free heaps */
|
||||
pic_heap_close(pic, pic->heap);
|
||||
assert(pic->gc_head.next == (struct object *) &pic->gc_head);
|
||||
|
||||
/* free global stacks */
|
||||
kh_destroy(oblist, &pic->oblist);
|
||||
|
@ -342,7 +338,7 @@ pic_state_features(pic_state *pic)
|
|||
{
|
||||
pic_get_args(pic, "");
|
||||
|
||||
return pic_closure_ref(pic, 0);
|
||||
return pic_ref(pic, "__picrin_features__");
|
||||
}
|
||||
|
||||
static pic_value
|
||||
|
@ -369,10 +365,6 @@ pic_state_error(pic_state *pic)
|
|||
void
|
||||
pic_init_state(pic_state *pic)
|
||||
{
|
||||
pic_define(pic, "features", pic_lambda(pic, pic_state_features, 1, pic_nil_value(pic)));
|
||||
pic_defun(pic, "global-objects", pic_state_global_objects);
|
||||
pic_defun(pic, "error", pic_state_error);
|
||||
|
||||
pic_add_feature(pic, "picrin");
|
||||
|
||||
#if __STDC_IEC_559__
|
||||
|
@ -426,4 +418,8 @@ pic_init_state(pic_state *pic)
|
|||
pic_add_feature(pic, "big-endian");
|
||||
# endif
|
||||
#endif
|
||||
|
||||
pic_defun(pic, "features", pic_state_features);
|
||||
pic_defun(pic, "global-objects", pic_state_global_objects);
|
||||
pic_defun(pic, "error", pic_state_error);
|
||||
}
|
||||
|
|
12
lib/state.h
12
lib/state.h
|
@ -36,26 +36,24 @@ struct pic_state {
|
|||
void *userdata;
|
||||
|
||||
struct context *cxt, default_cxt;
|
||||
|
||||
size_t ai;
|
||||
pic_value dyn_env;
|
||||
|
||||
khash_t(oblist) oblist; /* string to symbol */
|
||||
pic_value globals; /* dict */
|
||||
|
||||
bool gc_enable;
|
||||
struct heap *heap;
|
||||
struct object **arena;
|
||||
size_t arena_size;
|
||||
|
||||
bool gc_enable;
|
||||
struct object gc_head;
|
||||
struct attr *gc_attrs;
|
||||
size_t gc_count;
|
||||
|
||||
pic_value halt; /* top continuation */
|
||||
|
||||
pic_panicf panicf;
|
||||
};
|
||||
|
||||
struct heap *pic_heap_open(pic_state *);
|
||||
void pic_heap_close(pic_state *, struct heap *);
|
||||
|
||||
pic_value pic_global_ref(pic_state *pic, pic_value uid);
|
||||
void pic_global_set(pic_state *pic, pic_value uid, pic_value value);
|
||||
|
||||
|
|
321
lib/string.c
321
lib/string.c
|
@ -6,212 +6,26 @@
|
|||
#include "value.h"
|
||||
#include "object.h"
|
||||
|
||||
struct rope {
|
||||
int refcnt;
|
||||
int weight;
|
||||
bool isleaf;
|
||||
union {
|
||||
struct {
|
||||
struct rope *owner;
|
||||
const char *str; /* always points to zero-term'd buf */
|
||||
} leaf;
|
||||
struct {
|
||||
struct rope *left, *right;
|
||||
} node;
|
||||
} u;
|
||||
char buf[1];
|
||||
};
|
||||
|
||||
struct rope *
|
||||
pic_rope_incref(struct rope *rope) {
|
||||
rope->refcnt++;
|
||||
return rope;
|
||||
}
|
||||
|
||||
void
|
||||
pic_rope_decref(pic_state *pic, struct rope *rope) {
|
||||
if (! --rope->refcnt) {
|
||||
if (rope->isleaf) {
|
||||
if (rope->u.leaf.owner) {
|
||||
pic_rope_decref(pic, rope->u.leaf.owner);
|
||||
}
|
||||
} else {
|
||||
pic_rope_decref(pic, rope->u.node.left);
|
||||
pic_rope_decref(pic, rope->u.node.right);
|
||||
}
|
||||
pic_free(pic, rope);
|
||||
}
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
make_rope_leaf(pic_state *pic, const char *str, int len)
|
||||
{
|
||||
struct rope *rope;
|
||||
|
||||
rope = pic_malloc(pic, offsetof(struct rope, buf) + len + 1);
|
||||
rope->refcnt = 1;
|
||||
rope->weight = len;
|
||||
rope->isleaf = true;
|
||||
rope->u.leaf.owner = NULL;
|
||||
rope->u.leaf.str = rope->buf;
|
||||
rope->buf[len] = 0;
|
||||
if (str) {
|
||||
memcpy(rope->buf, str, len);
|
||||
}
|
||||
|
||||
return rope;
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
make_rope_lit(pic_state *pic, const char *str, int len)
|
||||
{
|
||||
struct rope *rope;
|
||||
|
||||
rope = pic_malloc(pic, offsetof(struct rope, buf));
|
||||
rope->refcnt = 1;
|
||||
rope->weight = len;
|
||||
rope->isleaf = true;
|
||||
rope->u.leaf.owner = NULL;
|
||||
rope->u.leaf.str = str;
|
||||
|
||||
return rope;
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
make_rope_slice(pic_state *pic, struct rope *owner, int i, int j)
|
||||
{
|
||||
struct rope *rope, *real_owner;
|
||||
|
||||
assert(owner->isleaf);
|
||||
|
||||
real_owner = owner->u.leaf.owner == NULL ? owner : owner->u.leaf.owner;
|
||||
|
||||
rope = pic_malloc(pic, offsetof(struct rope, buf));
|
||||
rope->refcnt = 1;
|
||||
rope->weight = j - i;
|
||||
rope->isleaf = true;
|
||||
rope->u.leaf.owner = real_owner;
|
||||
rope->u.leaf.str = owner->u.leaf.str + i;
|
||||
|
||||
pic_rope_incref(real_owner);
|
||||
|
||||
return rope;
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
make_rope_node(pic_state *pic, struct rope *left, struct rope *right)
|
||||
{
|
||||
struct rope *rope;
|
||||
|
||||
rope = pic_malloc(pic, sizeof(struct rope));
|
||||
rope->refcnt = 1;
|
||||
rope->weight = left->weight + right->weight;
|
||||
rope->isleaf = false;
|
||||
rope->u.node.left = pic_rope_incref(left);
|
||||
rope->u.node.right = pic_rope_incref(right);
|
||||
|
||||
return rope;
|
||||
}
|
||||
|
||||
static pic_value
|
||||
make_str(pic_state *pic, struct rope *rope)
|
||||
{
|
||||
struct string *str;
|
||||
|
||||
str = (struct string *)pic_obj_alloc(pic, PIC_TYPE_STRING);
|
||||
str->rope = rope; /* delegate ownership */
|
||||
|
||||
return obj_value(pic, str);
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
merge(pic_state *pic, struct rope *left, struct rope *right)
|
||||
{
|
||||
if (left == 0)
|
||||
return pic_rope_incref(right);
|
||||
if (right == 0)
|
||||
return pic_rope_incref(left);
|
||||
|
||||
return make_rope_node(pic, left, right);
|
||||
}
|
||||
|
||||
static struct rope *
|
||||
slice(pic_state *pic, struct rope *rope, int i, int j)
|
||||
{
|
||||
int lweight;
|
||||
|
||||
if (i == 0 && rope->weight == j) {
|
||||
return pic_rope_incref(rope);
|
||||
}
|
||||
|
||||
if (rope->isleaf) {
|
||||
return make_rope_slice(pic, rope, i, j);
|
||||
}
|
||||
|
||||
lweight = rope->u.node.left->weight;
|
||||
|
||||
if (j <= lweight) {
|
||||
return slice(pic, rope->u.node.left, i, j);
|
||||
} else if (lweight <= i) {
|
||||
return slice(pic, rope->u.node.right, i - lweight, j - lweight);
|
||||
} else {
|
||||
struct rope *r, *l;
|
||||
|
||||
l = slice(pic, rope->u.node.left, i, lweight);
|
||||
r = slice(pic, rope->u.node.right, 0, j - lweight);
|
||||
rope = merge(pic, l, r);
|
||||
|
||||
pic_rope_decref(pic, l);
|
||||
pic_rope_decref(pic, r);
|
||||
|
||||
return rope;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
flatten(pic_state *pic, struct rope *rope, struct rope *owner, char *buf)
|
||||
{
|
||||
if (rope->isleaf) {
|
||||
memcpy(buf, rope->u.leaf.str, rope->weight);
|
||||
} else {
|
||||
flatten(pic, rope->u.node.left, owner, buf);
|
||||
flatten(pic, rope->u.node.right, owner, buf + rope->u.node.left->weight);
|
||||
}
|
||||
|
||||
/* path compression */
|
||||
|
||||
if (! rope->isleaf) {
|
||||
pic_rope_incref(owner);
|
||||
pic_rope_decref(pic, rope->u.node.left);
|
||||
pic_rope_decref(pic, rope->u.node.right);
|
||||
rope->isleaf = true;
|
||||
rope->u.leaf.owner = owner;
|
||||
rope->u.leaf.str = buf;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
str_update(pic_state *pic, pic_value dst, pic_value src)
|
||||
{
|
||||
pic_rope_incref(str_ptr(pic, src)->rope);
|
||||
pic_rope_decref(pic, str_ptr(pic, dst)->rope);
|
||||
str_ptr(pic, dst)->rope = str_ptr(pic, src)->rope;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_str_value(pic_state *pic, const char *str, int len)
|
||||
{
|
||||
struct rope *r;
|
||||
char *buf;
|
||||
struct rope_leaf *leaf;
|
||||
struct string *s;
|
||||
|
||||
if (len > 0) {
|
||||
r = make_rope_leaf(pic, str, len);
|
||||
} else {
|
||||
if (len == 0) {
|
||||
str = "";
|
||||
}
|
||||
r = make_rope_lit(pic, str, -len);
|
||||
}
|
||||
return make_str(pic, r);
|
||||
assert(str != NULL);
|
||||
|
||||
buf = pic_malloc(pic, len + 1);
|
||||
buf[len] = 0;
|
||||
memcpy(buf, str, len);
|
||||
|
||||
leaf = (struct rope_leaf *) pic_obj_alloc(pic, PIC_TYPE_ROPE_LEAF);
|
||||
leaf->len = len;
|
||||
leaf->str = buf;
|
||||
|
||||
s = (struct string *) pic_obj_alloc(pic, PIC_TYPE_STRING);
|
||||
s->rope = (struct rope *) leaf;
|
||||
return obj_value(pic, s);
|
||||
}
|
||||
|
||||
pic_value
|
||||
|
@ -273,12 +87,12 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
|
|||
}
|
||||
case 'p': {
|
||||
static const char digits[] = "0123456789abcdef";
|
||||
static const size_t bufsiz = sizeof(long) * CHAR_BIT / 4;
|
||||
#define MAXLEN (sizeof(long) * CHAR_BIT / 4)
|
||||
unsigned long vp = (unsigned long) va_arg(ap, void*);
|
||||
char buf[2 + bufsiz + 1] = "0x", *p = buf + 2;
|
||||
char buf[2 + MAXLEN + 1] = "0x", *p = buf + 2;
|
||||
size_t i;
|
||||
for (i = 0; i < bufsiz; ++i) {
|
||||
p[bufsiz - i - 2] = digits[vp % 16];
|
||||
for (i = 0; i < MAXLEN; ++i) {
|
||||
p[MAXLEN - i - 2] = digits[vp % 16];
|
||||
vp /= 16;
|
||||
}
|
||||
p[i] = '\0';
|
||||
|
@ -295,19 +109,58 @@ pic_vstrf_value(pic_state *pic, const char *fmt, va_list ap)
|
|||
int
|
||||
pic_str_len(pic_state *pic, pic_value str)
|
||||
{
|
||||
return str_ptr(pic, str)->rope->weight;
|
||||
return str_ptr(pic, str)->rope->len;
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_str_cat(pic_state *pic, pic_value a, pic_value b)
|
||||
{
|
||||
return make_str(pic, merge(pic, str_ptr(pic, a)->rope, str_ptr(pic, b)->rope));
|
||||
struct rope *s1 = str_ptr(pic, a)->rope, *s2 = str_ptr(pic, b)->rope;
|
||||
struct rope_node *node;
|
||||
struct string *s;
|
||||
|
||||
node = (struct rope_node *) pic_obj_alloc(pic, PIC_TYPE_ROPE_NODE);
|
||||
node->len = s1->len + s2->len;
|
||||
node->s1 = s1;
|
||||
node->s2 = s2;
|
||||
|
||||
s = (struct string *) pic_obj_alloc(pic, PIC_TYPE_STRING);
|
||||
s->rope = (struct rope *) node;
|
||||
return obj_value(pic, s);
|
||||
}
|
||||
|
||||
static pic_value
|
||||
str_sub(pic_state *pic, struct rope *rope, int i, int j)
|
||||
{
|
||||
int lweight;
|
||||
pic_value s1, s2;
|
||||
|
||||
if (i == 0 && rope->len == j) {
|
||||
return obj_value(pic, rope);
|
||||
}
|
||||
|
||||
if (obj_type(rope) == PIC_TYPE_ROPE_LEAF) {
|
||||
return pic_str_value(pic, ((struct rope_leaf *) rope)->str + i, j - i);
|
||||
}
|
||||
|
||||
lweight = ((struct rope_node *) rope)->s1->len;
|
||||
|
||||
if (j <= lweight) {
|
||||
return str_sub(pic, ((struct rope_node *) rope)->s1, i, j);
|
||||
}
|
||||
if (lweight <= i) {
|
||||
return str_sub(pic, ((struct rope_node *) rope)->s2, i - lweight, j - lweight);
|
||||
}
|
||||
|
||||
s1 = str_sub(pic, ((struct rope_node *) rope)->s1, i, lweight);
|
||||
s2 = str_sub(pic, ((struct rope_node *) rope)->s2, 0, j - lweight);
|
||||
return pic_str_cat(pic, s1, s2);
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_str_sub(pic_state *pic, pic_value str, int s, int e)
|
||||
{
|
||||
return make_str(pic, slice(pic, str_ptr(pic, str)->rope, s, e));
|
||||
return str_sub(pic, str_ptr(pic, str)->rope, s, e);
|
||||
}
|
||||
|
||||
int
|
||||
|
@ -342,24 +195,45 @@ pic_str_cmp(pic_state *pic, pic_value str1, pic_value str2)
|
|||
return len1 - len2;
|
||||
}
|
||||
|
||||
static void
|
||||
str_cstr(pic_state *pic, struct rope *rope, char *buf)
|
||||
{
|
||||
if (obj_type(rope) == PIC_TYPE_ROPE_LEAF) {
|
||||
memcpy(buf, ((struct rope_leaf *) rope)->str, rope->len);
|
||||
} else {
|
||||
struct rope_node *r = (struct rope_node *) rope;
|
||||
str_cstr(pic, r->s1, buf);
|
||||
str_cstr(pic, r->s2, buf + r->s1->len);
|
||||
}
|
||||
}
|
||||
|
||||
const char *
|
||||
pic_str(pic_state *pic, pic_value str, int *len)
|
||||
{
|
||||
struct rope *rope = str_ptr(pic, str)->rope, *r;
|
||||
struct rope *rope = str_ptr(pic, str)->rope;
|
||||
char *buf;
|
||||
struct rope_leaf *leaf;
|
||||
|
||||
if (len) {
|
||||
*len = rope->weight;
|
||||
*len = rope->len;
|
||||
}
|
||||
|
||||
if (rope->isleaf && rope->u.leaf.str[rope->weight] == '\0') {
|
||||
return rope->u.leaf.str;
|
||||
if (obj_type(rope) == PIC_TYPE_ROPE_LEAF) {
|
||||
return ((struct rope_leaf *) rope)->str;
|
||||
}
|
||||
|
||||
r = make_rope_leaf(pic, 0, rope->weight);
|
||||
buf = pic_malloc(pic, rope->len + 1);
|
||||
buf[rope->len] = 0;
|
||||
str_cstr(pic, rope, buf);
|
||||
|
||||
flatten(pic, rope, r, r->buf);
|
||||
leaf = (struct rope_leaf *) pic_obj_alloc(pic, PIC_TYPE_ROPE_LEAF);
|
||||
leaf->len = rope->len;
|
||||
leaf->str = buf;
|
||||
|
||||
return r->u.leaf.str;
|
||||
/* cache the result */
|
||||
str_ptr(pic, str)->rope = (struct rope *) leaf;
|
||||
|
||||
return buf;
|
||||
}
|
||||
|
||||
const char *
|
||||
|
@ -453,7 +327,7 @@ pic_str_string_ref(pic_state *pic)
|
|||
static pic_value
|
||||
pic_str_string_set(pic_state *pic)
|
||||
{
|
||||
pic_value str, x, y, z;
|
||||
pic_value str, x, y, z, w;
|
||||
char c;
|
||||
int k, len;
|
||||
|
||||
|
@ -466,8 +340,9 @@ pic_str_string_set(pic_state *pic)
|
|||
x = pic_str_sub(pic, str, 0, k);
|
||||
y = pic_str_value(pic, &c, 1);
|
||||
z = pic_str_sub(pic, str, k + 1, len);
|
||||
w = pic_str_cat(pic, x, pic_str_cat(pic, y, z));
|
||||
|
||||
str_update(pic, str, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
|
||||
str_ptr(pic, str)->rope = str_ptr(pic, w)->rope;
|
||||
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
@ -527,7 +402,7 @@ pic_str_string_copy(pic_state *pic)
|
|||
static pic_value
|
||||
pic_str_string_copy_ip(pic_state *pic)
|
||||
{
|
||||
pic_value to, from, x, y, z;
|
||||
pic_value to, from, x, y, z, w;
|
||||
int n, at, start, end, tolen, fromlen;
|
||||
|
||||
n = pic_get_args(pic, "sis|ii", &to, &at, &from, &start, &end);
|
||||
|
@ -547,8 +422,9 @@ pic_str_string_copy_ip(pic_state *pic)
|
|||
x = pic_str_sub(pic, to, 0, at);
|
||||
y = pic_str_sub(pic, from, start, end);
|
||||
z = pic_str_sub(pic, to, at + end - start, tolen);
|
||||
w = pic_str_cat(pic, x, pic_str_cat(pic, y, z));
|
||||
|
||||
str_update(pic, to, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
|
||||
str_ptr(pic, to)->rope = str_ptr(pic, w)->rope;
|
||||
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
@ -556,7 +432,7 @@ pic_str_string_copy_ip(pic_state *pic)
|
|||
static pic_value
|
||||
pic_str_string_fill_ip(pic_state *pic)
|
||||
{
|
||||
pic_value str, x, y, z;
|
||||
pic_value str, x, y, z, w;
|
||||
char c, *buf;
|
||||
int n, start, end, len;
|
||||
|
||||
|
@ -579,8 +455,9 @@ pic_str_string_fill_ip(pic_state *pic)
|
|||
x = pic_str_sub(pic, str, 0, start);
|
||||
y = pic_str_value(pic, buf, end - start);
|
||||
z = pic_str_sub(pic, str, end, len);
|
||||
w = pic_str_cat(pic, x, pic_str_cat(pic, y, z));
|
||||
|
||||
str_update(pic, str, pic_str_cat(pic, x, pic_str_cat(pic, y, z)));
|
||||
str_ptr(pic, str)->rope = str_ptr(pic, w)->rope;
|
||||
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
|
14
lib/value.h
14
lib/value.h
|
@ -30,10 +30,12 @@ enum {
|
|||
PIC_TYPE_DICT = 22,
|
||||
PIC_TYPE_RECORD = 23,
|
||||
PIC_TYPE_ATTR = 24,
|
||||
PIC_TYPE_IREP = 27,
|
||||
PIC_TYPE_FRAME = 28,
|
||||
PIC_TYPE_PROC_FUNC = 29,
|
||||
PIC_TYPE_PROC_IREP = 30,
|
||||
PIC_TYPE_IREP = 25,
|
||||
PIC_TYPE_FRAME = 26,
|
||||
PIC_TYPE_PROC_FUNC = 27,
|
||||
PIC_TYPE_PROC_IREP = 28,
|
||||
PIC_TYPE_ROPE_LEAF = 29,
|
||||
PIC_TYPE_ROPE_NODE = 30,
|
||||
PIC_TYPE_MAX = 63
|
||||
};
|
||||
|
||||
|
@ -42,7 +44,7 @@ enum {
|
|||
PIC_STATIC_INLINE void
|
||||
make_value(struct value *v, int type)
|
||||
{
|
||||
static const struct value zero = { 0 };
|
||||
static const struct value zero = { {0}, 0 };
|
||||
*v = zero;
|
||||
v->type = type;
|
||||
}
|
||||
|
@ -61,7 +63,7 @@ make_float_value(struct value *v, double f)
|
|||
v->u.f = f;
|
||||
}
|
||||
|
||||
PIC_STATIC_INLINE struct value
|
||||
PIC_STATIC_INLINE void
|
||||
make_char_value(struct value *v, char c)
|
||||
{
|
||||
make_value(v, PIC_TYPE_CHAR);
|
||||
|
|
10
lib/var.c
10
lib/var.c
|
@ -20,7 +20,7 @@ var_call(pic_state *pic)
|
|||
if (n == 0) {
|
||||
pic_value env, it;
|
||||
|
||||
pic_for_each(env, pic->dyn_env, it) {
|
||||
pic_for_each(env, pic_ref(pic, "__picrin_dynenv__"), it) {
|
||||
if (pic_attr_has(pic, env, self)) {
|
||||
return pic_attr_ref(pic, env, self);
|
||||
}
|
||||
|
@ -33,7 +33,7 @@ var_call(pic_state *pic)
|
|||
if (! pic_false_p(pic, conv)) {
|
||||
val = pic_call(pic, conv, 1, val);
|
||||
}
|
||||
pic_attr_set(pic, pic_car(pic, pic->dyn_env), self, val);
|
||||
pic_attr_set(pic, pic_car(pic, pic_ref(pic, "__picrin_dynenv__")), self, val);
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
}
|
||||
|
@ -41,7 +41,7 @@ var_call(pic_state *pic)
|
|||
pic_value
|
||||
pic_make_var(pic_state *pic, pic_value init, pic_value conv)
|
||||
{
|
||||
pic_value var, env = pic->dyn_env;
|
||||
pic_value var, env = pic_ref(pic, "__picrin_dynenv__");
|
||||
|
||||
var = pic_lambda(pic, var_call, 1, conv);
|
||||
while (1) {
|
||||
|
@ -76,9 +76,9 @@ pic_var_current_dynamic_environment(pic_state *pic)
|
|||
n = pic_get_args(pic, "|o", &dyn_env);
|
||||
|
||||
if (n == 0) {
|
||||
return pic->dyn_env;
|
||||
return pic_ref(pic, "__picrin_dynenv__");
|
||||
} else {
|
||||
pic->dyn_env = dyn_env;
|
||||
pic_set(pic, "__picrin_dynenv__", dyn_env);
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue