conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

heap symbol seems working (with GC stopped)

This commit is contained in:
Yuichi Nishiwaki 2015-01-19 10:59:35 +09:00
parent 4be979b1df
commit fc654dd280
8 changed files with 83 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extlib/benz/codegen.c
View File

@ -949,24 +949,24 @@ create_activation(codegen_context *cxt)
pic_sym *var;
size_t offset;
xh_init_int(&regs, sizeof(size_t));
xh_init_ptr(&regs, sizeof(size_t));
offset = 1;
for (i = 0; i < xv_size(&cxt->args); ++i) {
var = xv_get(&cxt->args, i);
n = i + offset;
xh_put_int(&regs, *var, &n);
xh_put_ptr(&regs, *var, &n);
}
offset += i;
for (i = 0; i < xv_size(&cxt->locals); ++i) {
var = xv_get(&cxt->locals, i);
n = i + offset;
xh_put_int(&regs, *var, &n);
xh_put_ptr(&regs, *var, &n);
}
for (i = 0; i < xv_size(&cxt->captures); ++i) {
var = xv_get(&cxt->captures, i);
if ((n = xh_val(xh_get_int(&regs, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) {
if ((n = xh_val(xh_get_ptr(&regs, *var), size_t)) <= xv_size(&cxt->args) || (cxt->varg && n == xv_size(&cxt->args) + 1)) {
/* copy arguments to capture variable area */
cxt->code[cxt->clen].insn = OP_LREF;
cxt->code[cxt->clen].u.i = (int)n;

12
extlib/benz/dict.c
View File

@ -14,7 +14,7 @@ pic_make_dict(pic_state *pic)
struct pic_dict *dict;
dict = (struct pic_dict *)pic_obj_alloc(pic, sizeof(struct pic_dict), PIC_TT_DICT);
xh_init_int(&dict->hash, sizeof(pic_value));
xh_init_ptr(&dict->hash, sizeof(pic_value));
return dict;
}
@ -24,7 +24,7 @@ pic_dict_ref(pic_state *pic, struct pic_dict *dict, pic_sym key)
{
xh_entry *e;
e = xh_get_int(&dict->hash, key);
e = xh_get_ptr(&dict->hash, key);
if (! e) {
pic_errorf(pic, "element not found for a key: ~s", pic_sym_value(key));
}
@ -36,7 +36,7 @@ pic_dict_set(pic_state *pic, struct pic_dict *dict, pic_sym key, pic_value val)
{
PIC_UNUSED(pic);
xh_put_int(&dict->hash, key, &val);
xh_put_ptr(&dict->hash, key, &val);
}
size_t
@ -52,17 +52,17 @@ pic_dict_has(pic_state *pic, struct pic_dict *dict, pic_sym key)
{
PIC_UNUSED(pic);
return xh_get_int(&dict->hash, key) != NULL;
return xh_get_ptr(&dict->hash, key) != NULL;
}
void
pic_dict_del(pic_state *pic, struct pic_dict *dict, pic_sym key)
{
if (xh_get_int(&dict->hash, key) == NULL) {
if (xh_get_ptr(&dict->hash, key) == NULL) {
pic_errorf(pic, "no slot named ~s found in dictionary", pic_sym_value(key));
}
xh_del_int(&dict->hash, key);
xh_del_ptr(&dict->hash, key);
}
static pic_value

14
extlib/benz/gc.c
View File

@ -19,6 +19,7 @@
#include "picrin/dict.h"
#include "picrin/record.h"
#include "picrin/read.h"
#include "picrin/symbol.h"
union header {
struct {
@ -471,11 +472,16 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
gc_mark_object(pic, (struct pic_object *)rec->data);
break;
}
case PIC_TT_SYMBOL: {
struct pic_symbol *sym = (struct pic_symbol *)obj;
gc_mark_object(pic, (struct pic_object *)sym->str);
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_CHAR:
case PIC_TT_EOF:
case PIC_TT_UNDEF:
@ -661,11 +667,13 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
case PIC_TT_RECORD: {
break;
}
case PIC_TT_SYMBOL: {
break;
}
case PIC_TT_NIL:
case PIC_TT_BOOL:
case PIC_TT_FLOAT:
case PIC_TT_INT:
case PIC_TT_SYMBOL:
case PIC_TT_CHAR:
case PIC_TT_EOF:
case PIC_TT_UNDEF:
@ -802,7 +810,7 @@ pic_obj_alloc_unsafe(pic_state *pic, size_t size, enum pic_tt tt)
obj = (struct pic_object *)gc_alloc(pic, size);
if (obj == NULL) {
pic_gc_run(pic);
/* pic_gc_run(pic); */
obj = (struct pic_object *)gc_alloc(pic, size);
if (obj == NULL) {
add_heap_page(pic);

9
extlib/benz/include/picrin.h
View File

@ -51,6 +51,11 @@ extern "C" {
#include "picrin/util.h"
#include "picrin/value.h"
#define pic_sym(v) pic_ptr(v)
#define pic_symbol_value(v) pic_sym_value(v)
#define pic_sym_value(v) pic_obj_value(v)
#define pic_sym_p(v) (pic_type(v) == PIC_TT_SYMBOL)
typedef struct pic_code pic_code;
struct pic_winder {
@ -112,10 +117,6 @@ typedef struct {
pic_value features;
xhash syms; /* name to symbol */
xhash sym_names; /* symbol to name */
int sym_cnt;
int uniq_sym_cnt;
struct pic_dict *globals;
struct pic_dict *macros;
pic_value libs;

21
extlib/benz/include/picrin/symbol.h Normal file
View File

@ -0,0 +1,21 @@
/**
* See Copyright Notice in picrin.h
*/
#ifndef PICRIN_SYMBOL_H
#define PICRIN_SYMBOL_H
#if defined(__cplusplus)
extern "C" {
#endif
struct pic_symbol {
PIC_OBJECT_HEADER
pic_str *str;
};
#if defined(__cplusplus)
}
#endif
#endif

55
extlib/benz/include/picrin/value.h
View File

@ -9,12 +9,6 @@
extern "C" {
#endif
/**
* pic_sym is just an alias of int.
*/
typedef int pic_sym;
/**
* `undef` values never seen from user-end: that is,
* it's used only for repsenting internal special state
@ -27,7 +21,6 @@ enum pic_vtype {
PIC_VTYPE_UNDEF,
PIC_VTYPE_FLOAT,
PIC_VTYPE_INT,
PIC_VTYPE_SYMBOL,
PIC_VTYPE_CHAR,
PIC_VTYPE_EOF,
PIC_VTYPE_HEAP
@ -40,7 +33,6 @@ enum pic_vtype {
* float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF
* ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP
* int : 1111111111110110 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII
* sym : 1111111111110111 0000000000000000 SSSSSSSSSSSSSSSS SSSSSSSSSSSSSSSS
* char : 1111111111111000 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC
*/
@ -71,14 +63,6 @@ pic_int(pic_value v)
return u.i;
}
static inline int
pic_sym(pic_value v)
{
union { int i; unsigned u; } u;
u.u = v & 0xfffffffful;
return u.i;
}
#define pic_char(v) ((v) & 0xfffffffful)
#else
@ -89,7 +73,6 @@ typedef struct {
void *data;
double f;
int i;
pic_sym sym;
char c;
} u;
} pic_value;
@ -100,7 +83,6 @@ typedef struct {
#define pic_float(v) ((v).u.f)
#define pic_int(v) ((v).u.i)
#define pic_sym(v) ((v).u.sym)
#define pic_char(v) ((v).u.c)
#endif
@ -111,11 +93,11 @@ enum pic_tt {
PIC_TT_BOOL,
PIC_TT_FLOAT,
PIC_TT_INT,
PIC_TT_SYMBOL,
PIC_TT_CHAR,
PIC_TT_EOF,
PIC_TT_UNDEF,
/* heap */
PIC_TT_SYMBOL,
PIC_TT_PAIR,
PIC_TT_STRING,
PIC_TT_VECTOR,
@ -139,6 +121,7 @@ struct pic_object {
PIC_OBJECT_HEADER
};
struct pic_symbol;
struct pic_pair;
struct pic_string;
struct pic_vector;
@ -150,6 +133,7 @@ struct pic_error;
/* set aliases to basic types */
typedef pic_value pic_list;
typedef struct pic_symbol *pic_sym;
typedef struct pic_pair pic_pair;
typedef struct pic_string pic_str;
typedef struct pic_vector pic_vec;
@ -164,7 +148,6 @@ typedef struct pic_blob pic_blob;
#define pic_undef_p(v) (pic_vtype(v) == PIC_VTYPE_UNDEF)
#define pic_float_p(v) (pic_vtype(v) == PIC_VTYPE_FLOAT)
#define pic_int_p(v) (pic_vtype(v) == PIC_VTYPE_INT)
#define pic_sym_p(v) (pic_vtype(v) == PIC_VTYPE_SYMBOL)
#define pic_char_p(v) (pic_vtype(v) == PIC_VTYPE_CHAR)
#define pic_eof_p(v) (pic_vtype(v) == PIC_VTYPE_EOF)
@ -189,12 +172,9 @@ static inline pic_value pic_obj_value(void *);
static inline pic_value pic_float_value(double);
static inline pic_value pic_int_value(int);
static inline pic_value pic_size_value(size_t);
static inline pic_value pic_sym_value(pic_sym);
static inline pic_value pic_char_value(char c);
static inline pic_value pic_none_value();
#define pic_symbol_value(sym) pic_sym_value(sym)
static inline bool pic_eq_p(pic_value, pic_value);
static inline bool pic_eqv_p(pic_value, pic_value);
@ -214,8 +194,6 @@ pic_type(pic_value v)
return PIC_TT_FLOAT;
case PIC_VTYPE_INT:
return PIC_TT_INT;
case PIC_VTYPE_SYMBOL:
return PIC_TT_SYMBOL;
case PIC_VTYPE_CHAR:
return PIC_TT_CHAR;
case PIC_VTYPE_EOF:
@ -370,19 +348,6 @@ pic_int_value(int i)
return v;
}
static inline pic_value
pic_symbol_value(pic_sym sym)
{
union { int i; unsigned u; } u;
pic_value v;
u.i = sym;
pic_init_value(v, PIC_VTYPE_SYMBOL);
v |= u.u;
return v;
}
static inline pic_value
pic_char_value(char c)
{
@ -425,16 +390,6 @@ pic_int_value(int i)
return v;
}
static inline pic_value
pic_symbol_value(pic_sym sym)
{
pic_value v;
pic_init_value(v, PIC_VTYPE_SYMBOL);
v.u.sym = sym;
return v;
}
static inline pic_value
pic_char_value(char c)
{
@ -493,8 +448,6 @@ pic_eq_p(pic_value x, pic_value y)
return true;
case PIC_TT_BOOL:
return pic_vtype(x) == pic_vtype(y);
case PIC_TT_SYMBOL:
return pic_sym(x) == pic_sym(y);
default:
return pic_ptr(x) == pic_ptr(y);
}
@ -511,8 +464,6 @@ pic_eqv_p(pic_value x, pic_value y)
return true;
case PIC_TT_BOOL:
return pic_vtype(x) == pic_vtype(y);
case PIC_TT_SYMBOL:
return pic_sym(x) == pic_sym(y);
case PIC_TT_FLOAT:
return pic_float(x) == pic_float(y);
case PIC_TT_INT:

14
extlib/benz/state.c
View File

@ -50,9 +50,6 @@ pic_open(int argc, char *argv[], char **envp)
/* symbol table */
xh_init_str(&pic->syms, sizeof(pic_sym));
xh_init_int(&pic->sym_names, sizeof(const char *));
pic->sym_cnt = 0;
pic->uniq_sym_cnt = 0;
/* global variables */
pic->globals = NULL;
@ -225,6 +222,11 @@ pic_close(pic_state *pic)
pic_trie_delete(pic, pic->reader->trie);
free(pic->reader);
/* free symbol names */
for (it = xh_begin(&pic->syms); it != NULL; it = xh_next(it)) {
free(xh_key(it, char *));
}
/* free global stacks */
xh_destroy(&pic->syms);
xh_destroy(&pic->attrs);
@ -232,11 +234,5 @@ pic_close(pic_state *pic)
/* free GC arena */
free(pic->arena);
/* free symbol names */
for (it = xh_begin(&pic->sym_names); it != NULL; it = xh_next(it)) {
free(xh_val(it, char *));
}
xh_destroy(&pic->sym_names);
free(pic);
}

70
extlib/benz/symbol.c
View File

@ -3,27 +3,37 @@
*/
#include "picrin.h"
#include "picrin/symbol.h"
#include "picrin/string.h"
pic_sym
pic_make_symbol(pic_state *pic, pic_str *str)
{
pic_sym sym;
sym = (pic_sym)pic_obj_alloc(pic, sizeof(struct pic_symbol), PIC_TT_SYMBOL);
sym->str = str;
return sym;
}
pic_sym
pic_intern(pic_state *pic, pic_str *str)
{
char *cstr;
xh_entry *e;
pic_sym id;
pic_sym sym;
char *cstr;
e = xh_get_str(&pic->syms, pic_str_cstr(str));
if (e) {
return xh_val(e, pic_sym);
}
cstr = (char *)pic_malloc(pic, pic_strlen(str) + 1);
cstr = pic_malloc(pic, pic_strlen(str) + 1);
strcpy(cstr, pic_str_cstr(str));
id = pic->sym_cnt++;
xh_put_str(&pic->syms, cstr, &id);
xh_put_int(&pic->sym_names, id, &cstr);
return id;
sym = pic_make_symbol(pic, str);
xh_put_str(&pic->syms, cstr, &sym);
return sym;
}
pic_sym
@ -35,37 +45,21 @@ pic_intern_cstr(pic_state *pic, const char *str)
pic_sym
pic_gensym(pic_state *pic, pic_sym base)
{
int uid = pic->uniq_sym_cnt++, len;
char *str, mark;
pic_sym uniq;
if (pic_interned_p(pic, base)) {
mark = '@';
} else {
mark = '.';
}
len = snprintf(NULL, 0, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
str = pic_alloc(pic, (size_t)len + 1);
sprintf(str, "%s%c%d", pic_symbol_name(pic, base), mark, uid);
/* don't put the symbol to pic->syms to keep it uninterned */
uniq = pic->sym_cnt++;
xh_put_int(&pic->sym_names, uniq, &str);
return uniq;
return pic_make_symbol(pic, base->str);
}
bool
pic_interned_p(pic_state *pic, pic_sym sym)
{
return sym == pic_intern_cstr(pic, pic_symbol_name(pic, sym));
return sym == pic_intern(pic, sym->str);
}
const char *
pic_symbol_name(pic_state *pic, pic_sym sym)
{
return xh_val(xh_get_int(&pic->sym_names, sym), const char *);
PIC_UNUSED(pic);
return pic_str_cstr(sym->str);
}
static pic_value
@ -100,29 +94,21 @@ pic_symbol_symbol_eq_p(pic_state *pic)
static pic_value
pic_symbol_symbol_to_string(pic_state *pic)
{
pic_value v;
pic_sym sym;
pic_get_args(pic, "o", &v);
pic_get_args(pic, "m", &sym);
if (! pic_sym_p(v)) {
pic_errorf(pic, "symbol->string: expected symbol");
}
return pic_obj_value(pic_make_str_cstr(pic, pic_symbol_name(pic, pic_sym(v))));
return pic_obj_value(sym->str);
}
static pic_value
pic_symbol_string_to_symbol(pic_state *pic)
{
pic_value v;
pic_str *str;
pic_get_args(pic, "o", &v);
pic_get_args(pic, "s", &str);
if (! pic_str_p(v)) {
pic_errorf(pic, "string->symbol: expected string");
}
return pic_symbol_value(pic_intern_cstr(pic, pic_str_cstr(pic_str_ptr(v))));
return pic_sym_value(pic_intern(pic, str));
}
void