From 02d52723ac5c6e30db419daf3b773cf00aa7cf9f Mon Sep 17 00:00:00 2001
From: Yuichi Nishiwaki <yuichi.nishiwaki@gmail.com>
Date: Tue, 15 Oct 2013 19:19:34 +0900
Subject: [PATCH] add some FFI functions such as pic_defun and pic_get_args

---
 include/picrin.h |  5 +++++
 src/vm.c         | 36 ++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/include/picrin.h b/include/picrin.h
index 5632565f..df212005 100644
--- a/include/picrin.h
+++ b/include/picrin.h
@@ -24,6 +24,8 @@ typedef struct {
   int arena_idx;
 } pic_state;
 
+typedef pic_value (*pic_func_t)(pic_state *);
+
 void *pic_alloc(pic_state *, size_t);
 struct pic_object *pic_obj_alloc(pic_state *, size_t, enum pic_tt);
 void pic_free(pic_state *, void *);
@@ -35,6 +37,9 @@ void pic_gc_arena_restore(pic_state *, int);
 pic_state *pic_open();
 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_car(pic_state *, pic_value);
 pic_value pic_cdr(pic_state *, pic_value);
diff --git a/src/vm.c b/src/vm.c
index fd1abd11..2c47063b 100644
--- a/src/vm.c
+++ b/src/vm.c
@@ -1,5 +1,6 @@
 #include <stdlib.h>
 #include <stdio.h>
+#include <stdarg.h>
 
 #include "picrin.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);
 }
 
+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
 print_irep(pic_state *pic, struct pic_irep *irep)
 {