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

add some FFI functions such as pic_defun and pic_get_args

This commit is contained in:
Yuichi Nishiwaki 2013-10-15 19:19:34 +09:00
parent 8a5ea7d7dc
commit 02d52723ac
2 changed files with 41 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
include/picrin.h
View File

@ -24,6 +24,8 @@ typedef struct {
int arena_idx; int arena_idx;
} pic_state; } pic_state;
typedef pic_value (*pic_func_t)(pic_state *);
void *pic_alloc(pic_state *, size_t); void *pic_alloc(pic_state *, size_t);
struct pic_object *pic_obj_alloc(pic_state *, size_t, enum pic_tt); struct pic_object *pic_obj_alloc(pic_state *, size_t, enum pic_tt);
void pic_free(pic_state *, void *); void pic_free(pic_state *, void *);
@ -35,6 +37,9 @@ void pic_gc_arena_restore(pic_state *, int);
pic_state *pic_open(); pic_state *pic_open();
void pic_close(pic_state *); void pic_close(pic_state *);
void pic_get_args(pic_state *, const char *, ...);
void pic_defun(pic_state *, const char *, pic_func_t);
pic_value pic_cons(pic_state *, pic_value, pic_value); pic_value pic_cons(pic_state *, pic_value, pic_value);
pic_value pic_car(pic_state *, pic_value); pic_value pic_car(pic_state *, pic_value);
pic_value pic_cdr(pic_state *, pic_value); pic_value pic_cdr(pic_state *, pic_value);

36
src/vm.c
View File

@ -1,5 +1,6 @@
#include <stdlib.h> #include <stdlib.h>
#include <stdio.h> #include <stdio.h>
#include <stdarg.h>
#include "picrin.h" #include "picrin.h"
#include "picrin/irep.h" #include "picrin/irep.h"
@ -53,6 +54,41 @@ pic_env_define(pic_state *pic, pic_value sym, struct pic_env *env)
return pic_pair_ptr(cell); return pic_pair_ptr(cell);
} }
void
pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
{
struct pic_proc *proc;
struct pic_pair *cell;
proc = (struct pic_proc *)pic_obj_alloc(pic, sizeof(struct pic_proc), PIC_TT_PROC);
proc->u.cfunc = cfunc;
cell = pic_env_define(pic, pic_intern_cstr(pic, name), pic->global_env);
cell->cdr = pic_obj_value(proc);
}
void
pic_get_args(pic_state *pic, const char *format, ...)
{
char c;
int i = 0;
va_list ap;
va_start(ap, format);
while ((c = *format++)) {
switch (c) {
case 'o':
{
pic_value *p;
p = va_arg(ap, pic_value*);
*p = *pic->sp--;
i++;
}
break;
}
}
}
static void static void
print_irep(pic_state *pic, struct pic_irep *irep) print_irep(pic_state *pic, struct pic_irep *irep)
{ {