remove pic_get_proc and add "&" format for pic_get_args

contrib/10.callcc/callcc.c

@@ -218,15 +218,14 @@ restore_cont(pic_state *pic, struct pic_fullcont *cont)
 PIC_NORETURN static pic_value
 cont_call(pic_state *pic)
 {
-  struct pic_proc *proc;
+  struct pic_proc *self;
   int argc;
   pic_value *argv;
   struct pic_fullcont *cont;
 
-  proc = pic_get_proc(pic);
-  pic_get_args(pic, "*", &argc, &argv);
+  pic_get_args(pic, "&*", &self, &argc, &argv);
 
-  cont = pic_data_ptr(pic_proc_env_ref(pic, proc, "cont"))->data;
+  cont = pic_data_ptr(pic_proc_env_ref(pic, self, "cont"))->data;
   cont->results = pic_list_by_array(pic, argc, argv);
 
   /* execute guard handlers */

extlib/benz/cont.c

@@ -85,13 +85,13 @@ pic_load_point(pic_state *pic, struct pic_cont *cont)
 static pic_value
 cont_call(pic_state *pic)
 {
-  struct pic_proc *self = pic_get_proc(pic);
+  struct pic_proc *self;
   int argc;
   pic_value *argv;
   int id;
   struct pic_cont *cc, *cont;
 
-  pic_get_args(pic, "*", &argc, &argv);
+  pic_get_args(pic, "&*", &self, &argc, &argv);
 
   id = pic_int(pic_proc_env_ref(pic, self, "id"));
 

extlib/benz/error.c

@@ -51,13 +51,13 @@ pic_value
 pic_native_exception_handler(pic_state *pic)
 {
   pic_value err;
-  struct pic_proc *cont;
+  struct pic_proc *self, *cont;
 
-  pic_get_args(pic, "o", &err);
+  pic_get_args(pic, "&o", &self, &err);
 
   pic->err = err;
 
-  cont = pic_proc_ptr(pic_proc_env_ref(pic, pic_get_proc(pic), "cont"));
+  cont = pic_proc_ptr(pic_proc_env_ref(pic, self, "cont"));
 
   pic_apply1(pic, cont, pic_false_value());
 

extlib/benz/include/picrin.h

@@ -155,7 +155,6 @@ void pic_set_argv(pic_state *, int argc, char *argv[], char **envp);
 
 void pic_add_feature(pic_state *, const char *);
 
-struct pic_proc *pic_get_proc(pic_state *);
 int pic_get_args(pic_state *, const char *, ...);
 
 bool pic_eq_p(pic_value, pic_value);

extlib/benz/proc.c

@@ -5,19 +5,10 @@
 #include "picrin.h"
 #include "picrin/opcode.h"
 
+#define MIN(x,y) ((x) < (y) ? (x) : (y))
+
 #define GET_OPERAND(pic,n) ((pic)->ci->fp[(n)])
 
-struct pic_proc *
-pic_get_proc(pic_state *pic)
-{
-  pic_value v = GET_OPERAND(pic,0);
-
-  if (! pic_proc_p(v)) {
-    pic_errorf(pic, "fatal error");
-  }
-  return pic_proc_ptr(v);
-}
-
 /**
  * char type                    desc.
  * ---- ----                    ----
@@ -45,61 +36,62 @@ int
 pic_get_args(pic_state *pic, const char *format, ...)
 {
   char c;
-  int paramc, optc, min;
+  int paramc = 0, optc = 0;
   int i, argc = pic->ci->argc - 1;
   va_list ap;
-  bool rest = false, opt = false;
+  bool proc = false, rest = false, opt = false;
 
-  /* paramc: required args count as scheme proc
-     optc:   optional args count as scheme proc
-     argc:   passed args count as scheme proc
-     vargc:  args count passed to this function
-  */
-
-  /* check nparams first */
-  for (paramc = 0, c = *format; c;  c = format[++paramc]) {
-    if (c == '|') {
-      opt = true;
-      break;
+  /* parse format */
+  if ((c = *format) != '\0') {
+    if (c == '&') {
+      proc = true;
+      format++;                 /* forget about '&' */
     }
-    else if (c == '*') {
-      rest = true;
-      break;
+    for (paramc = 0, c = *format; c;  c = format[++paramc]) {
+      if (c == '|') {
+        opt = true;
+        break;
+      } else if (c == '*') {
+        rest = true;
+        break;
+      }
     }
+    for (optc = 0; opt && c; c = format[paramc + opt + ++optc]) {
+      if (c == '*') {
+        rest = true;
+        break;
+      }
+    }
+    assert((opt ? 1 : 0) <= optc); /* at least 1 char after '|'? */
+    assert(format[paramc + opt + optc + rest] == '\0'); /* no extra chars? */
   }
 
-  for (optc = 0;  opt && c; c = format[paramc + opt + ++optc]) {
-     if (c == '*') {
-      rest = true;
-      break;
-    }
-  }
-
-  /* '|' should be followed by at least 1 char */
-  assert((opt ? 1 : 0) <= optc);
-  /* '*' should not be followed by any char */
-  assert(format[paramc + opt + optc + rest] == '\0');
-
-  /* check argc. */
   if (argc < paramc || (paramc + optc < argc && ! rest)) {
     pic_errorf(pic, "pic_get_args: wrong number of arguments (%d for %s%d)", argc, rest? "at least " : "", paramc);
   }
 
-  /* start dispatching */
   va_start(ap, format);
-  min = paramc + optc < argc ? paramc + optc : argc;
-  for (i = 1; i < min + 1; i++) {
+
+  /* dispatch */
+  if (proc) {
+    struct pic_proc **proc;
+
+    proc = va_arg(ap, struct pic_proc **);
+    *proc = pic_proc_ptr(GET_OPERAND(pic, 0));
+  }
+  for (i = 1; i <= MIN(paramc + optc, argc); ++i) {
 
     c = *format++;
-    /* skip '|' if exists. This is always safe because of assert and argc check */
-    c = c == '|' ? *format++ : c;
+    if (c == '|') {
+      c = *format++;
+    }
 
     switch (c) {
     case 'o': {
       pic_value *p;
 
       p = va_arg(ap, pic_value*);
-      *p = GET_OPERAND(pic,i);
+      *p = GET_OPERAND(pic, i);
       break;
     }
 
@@ -168,15 +160,17 @@ pic_get_args(pic_state *pic, const char *format, ...)
     }
   }
   if (rest) {
-      int *n;
-      pic_value **argv;
+    int *n;
+    pic_value **argv;
 
-      n = va_arg(ap, int *);
-      argv = va_arg(ap, pic_value **);
-      *n = argc - (i - 1);
-      *argv = &GET_OPERAND(pic, i);
+    n = va_arg(ap, int *);
+    argv = va_arg(ap, pic_value **);
+    *n = argc - (i - 1);
+    *argv = &GET_OPERAND(pic, i);
   }
+
   va_end(ap);
+
   return argc;
 }
 

extlib/benz/reg.c

@@ -104,12 +104,12 @@ reg_set(pic_state *pic, struct pic_reg *reg, void *key, pic_value val)
 static pic_value
 reg_call(pic_state *pic)
 {
-  struct pic_proc *self = pic_get_proc(pic);
+  struct pic_proc *self;
   struct pic_reg *reg;
   pic_value key, val;
   int n;
 
-  n = pic_get_args(pic, "o|o", &key, &val);
+  n = pic_get_args(pic, "&o|o", &self, &key, &val);
 
   if (! pic_obj_p(key)) {
     pic_errorf(pic, "attempted to set a non-object key '~s' in a register", key);

extlib/benz/var.c

@@ -43,11 +43,11 @@ var_set(pic_state *pic, struct pic_proc *var, pic_value val)
 static pic_value
 var_call(pic_state *pic)
 {
-  struct pic_proc *self = pic_get_proc(pic);
+  struct pic_proc *self;
   pic_value val;
   int n;
 
-  n = pic_get_args(pic, "|o", &val);
+  n = pic_get_args(pic, "&|o", &self, &val);
 
   if (n == 0) {
     return var_get(pic, self);