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

Merge branch 'box-global-variables'

This commit is contained in:
Yuichi Nishiwaki 2015-08-05 09:08:57 +09:00
parent 261580309e a12be32f19
commit 673198bbb6
7 changed files with 90 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
extlib/benz/codegen.c
View File

@ -436,7 +436,7 @@ define_var(pic_state *pic, analyze_scope *scope, pic_sym *sym)
int ret;
if (search_scope(scope, sym)) {
if (scope->depth > 0 || (pic_dict_has(pic, pic->globals, sym) && ! pic_invalid_p(pic_cdr(pic, pic_dict_ref(pic, pic->globals, sym))))) {
if (scope->depth > 0 || (pic_dict_has(pic, pic->globals, sym) && ! pic_invalid_p(pic_box_ptr(pic_dict_ref(pic, pic->globals, sym))->value))) {
pic_warnf(pic, "redefining variable: ~s", pic_obj_value(sym));
}
return;
@ -782,15 +782,15 @@ index_local(codegen_context *cxt, pic_sym *sym)
static int
index_global(pic_state *pic, codegen_context *cxt, pic_sym *name)
{
extern pic_value pic_vm_gref_slot(pic_state *, pic_sym *);
extern struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
int pidx;
pic_value slot;
struct pic_box *slot;
slot = pic_vm_gref_slot(pic, name);
check_pool_size(pic, cxt);
pidx = (int)cxt->plen++;
cxt->pool[pidx] = slot;
cxt->pool[pidx] = pic_obj_value(slot);
return pidx;
}

8
extlib/benz/gc.c
View File

@ -35,6 +35,7 @@ union object {
struct pic_port port;
struct pic_error err;
struct pic_lib lib;
struct pic_box box;
struct pic_checkpoint cp;
};
@ -405,6 +406,12 @@ gc_mark_object(pic_state *pic, union object *obj)
pic->heap->regs = reg;
break;
}
case PIC_TT_BOX: {
if (pic_obj_p(obj->box.value)) {
LOOP(pic_obj_ptr(obj->box.value));
}
break;
}
case PIC_TT_CP: {
if (obj->cp.prev) {
gc_mark_object(pic, (union object *)obj->cp.prev);
@ -597,6 +604,7 @@ gc_finalize_object(pic_state *pic, union object *obj)
case PIC_TT_LIB:
case PIC_TT_RECORD:
case PIC_TT_CP:
case PIC_TT_BOX:
break;
case PIC_TT_NIL:

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

@ -102,14 +102,15 @@ struct pic_state {
pic_sym *uDEFINE, *uLAMBDA, *uIF, *uBEGIN, *uQUOTE, *uSETBANG, *uDEFINE_MACRO;
pic_sym *uDEFINE_LIBRARY, *uIMPORT, *uEXPORT, *uCOND_EXPAND;
pic_sym *uCONS, *uCAR, *uCDR, *uNILP, *uSYMBOLP, *uPAIRP;
pic_sym *uADD, *uSUB, *uMUL, *uDIV, *uEQ, *uLT, *uLE, *uGT, *uGE, *uNOT;
pic_value pCONS, pCAR, pCDR, pNILP, pPAIRP, pSYMBOLP, pNOT;
pic_value pADD, pSUB, pMUL, pDIV, pEQ, pLT, pLE, pGT, pGE;
pic_value cCONS, cCAR, cCDR, cNILP, cPAIRP, cSYMBOLP, cNOT;
pic_value cADD, cSUB, cMUL, cDIV, cEQ, cLT, cLE, cGT, cGE;
struct pic_box *cCONS, *cCAR, *cCDR, *cNILP, *cPAIRP, *cSYMBOLP, *cNOT;
struct pic_box *cADD, *cSUB, *cMUL, *cDIV, *cEQ, *cLT, *cLE, *cGT, *cGE;
struct pic_lib *PICRIN_BASE;
struct pic_lib *PICRIN_USER;
@ -268,6 +269,7 @@ pic_value pic_fdisplay(pic_state *, pic_value, xFILE *);
#include "picrin/symbol.h"
#include "picrin/vector.h"
#include "picrin/reg.h"
#include "picrin/box.h"
#if defined(__cplusplus)
}

34
extlib/benz/include/picrin/box.h Normal file
View File

@ -0,0 +1,34 @@
/**
* See Copyright Notice in picrin.h
*/
#ifndef PICRIN_BOX_H
#define PICRIN_BOX_H
#if defined(__cplusplus)
extern "C" {
#endif
struct pic_box {
PIC_OBJECT_HEADER
pic_value value;
};
#define pic_box_p(v) (pic_type(v) == PIC_TT_BOX)
#define pic_box_ptr(v) ((struct pic_box *)pic_ptr(v))
PIC_INLINE struct pic_box *
pic_box(pic_state *pic, pic_value value)
{
struct pic_box *box;
box = (struct pic_box *)pic_obj_alloc(pic, sizeof(struct pic_box), PIC_TT_BOX);
box->value = value;
return box;
}
#if defined(__cplusplus)
}
#endif
#endif

3
extlib/benz/include/picrin/type.h
View File

@ -156,6 +156,7 @@ enum pic_tt {
PIC_TT_DICT,
PIC_TT_REG,
PIC_TT_RECORD,
PIC_TT_BOX,
PIC_TT_CXT,
PIC_TT_IREP,
PIC_TT_CP
@ -313,6 +314,8 @@ pic_type_repr(enum pic_tt tt)
return "dict";
case PIC_TT_REG:
return "reg";
case PIC_TT_BOX:
return "box";
case PIC_TT_RECORD:
return "record";
case PIC_TT_CP:

34
extlib/benz/state.c
View File

@ -127,7 +127,7 @@ static void
pic_init_core(pic_state *pic)
{
void pic_define_syntactic_keyword_(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
pic_value pic_vm_gref_slot(pic_state *, pic_sym *);
struct pic_box *pic_vm_gref_slot(pic_state *, pic_sym *);
pic_init_features(pic);
@ -434,22 +434,22 @@ pic_open(pic_allocf allocf, void *userdata)
/* turn on GC */
pic->gc_enable = true;
pic->cCONS = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cCAR = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cCDR = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cNILP = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cSYMBOLP = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cPAIRP = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cNOT = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cADD = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cSUB = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cMUL = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cDIV = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cEQ = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cLT = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cLE = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cGT = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cGE = pic_cons(pic, pic_false_value(), pic_invalid_value());
pic->cCONS = pic_box(pic, pic_invalid_value());
pic->cCAR = pic_box(pic, pic_invalid_value());
pic->cCDR = pic_box(pic, pic_invalid_value());
pic->cNILP = pic_box(pic, pic_invalid_value());
pic->cSYMBOLP = pic_box(pic, pic_invalid_value());
pic->cPAIRP = pic_box(pic, pic_invalid_value());
pic->cNOT = pic_box(pic, pic_invalid_value());
pic->cADD = pic_box(pic, pic_invalid_value());
pic->cSUB = pic_box(pic, pic_invalid_value());
pic->cMUL = pic_box(pic, pic_invalid_value());
pic->cDIV = pic_box(pic, pic_invalid_value());
pic->cEQ = pic_box(pic, pic_invalid_value());
pic->cLT = pic_box(pic, pic_invalid_value());
pic->cLE = pic_box(pic, pic_invalid_value());
pic->cGT = pic_box(pic, pic_invalid_value());
pic->cGE = pic_box(pic, pic_invalid_value());
pic_init_core(pic);

37
extlib/benz/vm.c
View File

@ -386,32 +386,35 @@ pic_get_args(pic_state *pic, const char *format, ...)
return argc;
}
pic_value
struct pic_box *
pic_vm_gref_slot(pic_state *pic, pic_sym *uid)
{
pic_value slot;
struct pic_box *box;
if (pic_dict_has(pic, pic->globals, uid)) {
return pic_dict_ref(pic, pic->globals, uid);
return pic_box_ptr(pic_dict_ref(pic, pic->globals, uid));
}
slot = pic_cons(pic, pic_obj_value(uid), pic_invalid_value());
pic_dict_set(pic, pic->globals, uid, slot);
return slot;
box = pic_box(pic, pic_invalid_value());
pic_dict_set(pic, pic->globals, uid, pic_obj_value(box));
return box;
}
static pic_value
vm_gref(pic_state *pic, pic_value slot)
vm_gref(pic_state *pic, struct pic_box *slot, pic_sym *uid)
{
if (pic_invalid_p(pic_cdr(pic, slot))) {
pic_errorf(pic, "uninitialized global variable: ~a", pic_car(pic, slot));
if (pic_invalid_p(slot->value)) {
if (uid == NULL) {
uid = pic_intern(pic, "unknown"); /* FIXME */
}
pic_errorf(pic, "uninitialized global variable: ~a", uid);
}
return pic_cdr(pic, slot);
return slot->value;
}
static void
vm_gset(pic_state *pic, pic_value slot, pic_value value)
vm_gset(struct pic_box *slot, pic_value value)
{
pic_set_cdr(pic, slot, value);
slot->value = value;
}
static void
@ -630,11 +633,11 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
NEXT;
}
CASE(OP_GREF) {
PUSH(vm_gref(pic, pic->ci->irep->pool[c.u.i]));
PUSH(vm_gref(pic, pic_box_ptr(pic->ci->irep->pool[c.u.i]), NULL)); /* FIXME */
NEXT;
}
CASE(OP_GSET) {
vm_gset(pic, pic->ci->irep->pool[c.u.i], POP());
vm_gset(pic_box_ptr(pic->ci->irep->pool[c.u.i]), POP());
PUSH(pic_undef_value());
NEXT;
}
@ -847,7 +850,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value args)
}
#define check_condition(name, n) do { \
if (! pic_eq_p(pic->p##name, pic_cdr(pic, pic->c##name))) \
if (! pic_eq_p(pic->p##name, pic->c##name->value)) \
goto L_CALL; \
if (c.u.i != n + 1) \
goto L_CALL; \
@ -1161,7 +1164,7 @@ pic_ref(pic_state *pic, struct pic_lib *lib, const char *name)
pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
}
return vm_gref(pic, pic_vm_gref_slot(pic, uid));
return vm_gref(pic, pic_vm_gref_slot(pic, uid), uid);
}
void
@ -1175,7 +1178,7 @@ pic_set(pic_state *pic, struct pic_lib *lib, const char *name, pic_value val)
pic_errorf(pic, "symbol \"%s\" not defined in library ~s", name, lib->name);
}
vm_gset(pic, pic_vm_gref_slot(pic, uid), val);
vm_gset(pic_vm_gref_slot(pic, uid), val);
}
pic_value