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

add pic_func struct to hold native function name

This commit is contained in:
Yuichi Nishiwaki 2014-02-26 00:39:16 +09:00
parent bb93a8be14
commit 06a7b0f5f6
5 changed files with 28 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
include/picrin/proc.h
View File

@ -9,6 +9,12 @@
extern "C" {
#endif
/* native C function */
struct pic_func {
pic_func_t f;
pic_sym name;
};
struct pic_env {
PIC_OBJECT_HEADER
pic_value *values;
@ -18,22 +24,26 @@ struct pic_env {
struct pic_proc {
PIC_OBJECT_HEADER
bool cfunc_p;
char kind;
union {
pic_func_t cfunc;
struct pic_func func;
struct pic_irep *irep;
} u;
struct pic_env *env;
};
#define PIC_PROC_KIND_FUNC 1
#define PIC_PROC_KIND_IREP 2
#define pic_proc_func_p(proc) ((proc)->kind == PIC_PROC_KIND_FUNC)
#define pic_proc_irep_p(proc) ((proc)->kind == PIC_PROC_KIND_IREP)
#define pic_proc_p(o) (pic_type(o) == PIC_TT_PROC)
#define pic_env_p(o) (pic_type(o) == PIC_TT_ENV)
#define pic_proc_ptr(o) ((struct pic_proc *)pic_ptr(o))
#define pic_env_ptr(o) ((struct pic_env *)pic_ptr(o))
#define pic_proc_cfunc_p(o) (pic_proc_ptr(o)->cfunc_p)
struct pic_proc *pic_proc_new(pic_state *, pic_func_t);
struct pic_proc *pic_proc_new_irep(pic_state *, struct pic_irep *, struct pic_env *);

2
src/gc.c
View File

@ -356,7 +356,7 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
if (proc->env) {
gc_mark_object(pic, (struct pic_object *)proc->env);
}
if (! proc->cfunc_p) {
if (pic_proc_irep_p(proc)) {
gc_mark_object(pic, (struct pic_object *)proc->u.irep);
}
break;

9
src/proc.c
View File

@ -8,13 +8,14 @@
#include "picrin/irep.h"
struct pic_proc *
pic_proc_new(pic_state *pic, pic_func_t cfunc)
pic_proc_new(pic_state *pic, pic_func_t func)
{
struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->cfunc_p = true;
proc->u.cfunc = cfunc;
proc->kind = PIC_PROC_KIND_FUNC;
proc->u.func.f = func;
proc->u.func.name = pic_intern_cstr(pic, "(no name)");
proc->env = NULL;
return proc;
}
@ -25,7 +26,7 @@ pic_proc_new_irep(pic_state *pic, struct pic_irep *irep, struct pic_env *env)
struct pic_proc *proc;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->cfunc_p = false;
proc->kind = PIC_PROC_KIND_IREP;
proc->u.irep = irep;
proc->env = env;
return proc;

5
src/var.c
View File

@ -50,7 +50,10 @@ get_var_from_proc(pic_state *pic, struct pic_proc *proc)
{
pic_value v;
if (! proc->cfunc_p) {
if (! pic_proc_p(v)) {
goto typeerror;
}
if (! pic_proc_func_p(pic_proc_ptr(v))) {
goto typeerror;
}
if (pic_proc_cv_size(pic, proc) != 1) {

8
src/vm.c
View File

@ -480,7 +480,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
pic_error(pic, "logic flaw");
}
irep = pic_proc_ptr(self)->u.irep;
if (pic_proc_cfunc_p(self)) {
if (! pic_proc_irep_p(pic_proc_ptr(self))) {
pic_error(pic, "logic flaw");
}
PUSH(irep->pool[c.u.i]);
@ -590,10 +590,10 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
ci->ip = pic->ip;
ci->fp = pic->sp - c.u.i;
ci->env = NULL;
if (pic_proc_cfunc_p(x)) {
if (pic_proc_func_p(pic_proc_ptr(x))) {
/* invoke! */
pic->sp[0] = proc->u.cfunc(pic);
pic->sp[0] = proc->u.func.f(pic);
pic->sp += ci->retc;
pic_gc_arena_restore(pic, ai);
@ -702,7 +702,7 @@ pic_apply(pic_state *pic, struct pic_proc *proc, pic_value argv)
pic_error(pic, "logic flaw");
}
irep = pic_proc_ptr(self)->u.irep;
if (pic_proc_cfunc_p(self)) {
if (! pic_proc_irep_p(pic_proc_ptr(self))) {
pic_error(pic, "logic flaw");
}
proc = pic_proc_new_irep(pic, irep->irep[c.u.i], pic->ci->env);