add PIC_USE_CALLCC flag

lib/Makefile

@@ -45,9 +45,13 @@ mini-picrin: libpicrin.so ext/main.o
 libpicrin.so: $(LIBPICRIN_OBJS)
 	$(CC) $(CFLAGS) -shared -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
 
+libpicrin.so.minimal: $(LIBPICRIN_SRCS)
+	$(CC) -I./include -Os -DPIC_USE_LIBC=0 -DPIC_USE_CALLCC=0 -DPIC_USE_FILE=0 -DPIC_USE_READ=0 -DPIC_USE_WRITE=0 -DPIC_USE_EVAL=0 -nostdlib -ffreestanding -fno-stack-protector -shared -o $@ $(LIBPICRIN_SRCS) $(LDFLAGS)
+	strip $@
+
 $(LIBPICRIN_OBJS): $(LIBPICRIN_HEADERS)
 
 clean:
-	$(RM) $(LIBPICRIN_OBJS) libpicrin.so
+	$(RM) $(LIBPICRIN_OBJS) libpicrin.so libpicrin.so.minimal
 
 .PHONY: clean

lib/cont.c

@@ -6,6 +6,65 @@
 #include "object.h"
 #include "state.h"
 
+#if PIC_USE_CALLCC
+
+static pic_value
+cont_call(pic_state *pic)
+{
+  int argc;
+  pic_value *argv;
+  struct context *cxt, *c;
+  int i;
+
+  pic_get_args(pic, "*", &argc, &argv);
+
+  cxt = pic_data(pic, pic_closure_ref(pic, 0));
+
+  /* check if continuation is alive */
+  for (c = pic->cxt; c != NULL; c = c->prev) {
+    if (c == cxt) {
+      break;
+    }
+  }
+  if (c == NULL) {
+    pic_error(pic, "calling dead escape continuation", 0);
+  }
+
+#define MKCALLK(argc)                                                   \
+  (cxt->tmpcode[0] = OP_CALL, cxt->tmpcode[1] = (argc), cxt->tmpcode)
+
+  cxt->pc = MKCALLK(argc);
+  cxt->sp = pic_make_frame_unsafe(pic, argc + 2);
+  cxt->sp->regs[0] = pic_closure_ref(pic, 1); /* cont. */
+  for (i = 0; i < argc; ++i) {
+    cxt->sp->regs[i + 1] = argv[i];
+  }
+  pic->cxt = cxt;
+
+  PIC_LONGJMP(cxt->jmp, 1);
+  PIC_UNREACHABLE();
+}
+
+pic_value
+pic_make_cont(pic_state *pic, struct context *cxt, pic_value k)
+{
+  static const pic_data_type cxt_type = { "cxt", NULL };
+  return pic_lambda(pic, cont_call, 2, pic_data_value(pic, cxt, &cxt_type), k);
+}
+
+static pic_value
+pic_cont_callcc(pic_state *pic)
+{
+  pic_value f, args[1];
+
+  pic_get_args(pic, "l", &f);
+
+  args[0] = pic_make_cont(pic, pic->cxt, pic->cxt->fp->regs[1]);
+  return pic_applyk(pic, f, 1, args);
+}
+
+#endif  /* PIC_USE_CALCC */
+
 static pic_value
 applyk(pic_state *pic, pic_value proc, pic_value cont, int argc, pic_value *argv)
 {
@@ -62,61 +121,6 @@ pic_vvalues(pic_state *pic, int n, va_list ap)
   return valuesk(pic, n, retv);
 }
 
-static pic_value
-cont_call(pic_state *pic)
-{
-  int argc;
-  pic_value *argv;
-  struct context *cxt, *c;
-  int i;
-
-  pic_get_args(pic, "*", &argc, &argv);
-
-  cxt = pic_data(pic, pic_closure_ref(pic, 0));
-
-  /* check if continuation is alive */
-  for (c = pic->cxt; c != NULL; c = c->prev) {
-    if (c == cxt) {
-      break;
-    }
-  }
-  if (c == NULL) {
-    pic_error(pic, "calling dead escape continuation", 0);
-  }
-
-#define MKCALLK(argc)                                                   \
-  (cxt->tmpcode[0] = OP_CALL, cxt->tmpcode[1] = (argc), cxt->tmpcode)
-
-  cxt->pc = MKCALLK(argc);
-  cxt->sp = pic_make_frame_unsafe(pic, argc + 2);
-  cxt->sp->regs[0] = pic_closure_ref(pic, 1); /* cont. */
-  for (i = 0; i < argc; ++i) {
-    cxt->sp->regs[i + 1] = argv[i];
-  }
-  pic->cxt = cxt;
-
-  PIC_LONGJMP(pic, cxt->jmp, 1);
-  PIC_UNREACHABLE();
-}
-
-pic_value
-pic_make_cont(pic_state *pic, struct context *cxt, pic_value k)
-{
-  static const pic_data_type cxt_type = { "cxt", NULL };
-  return pic_lambda(pic, cont_call, 2, pic_data_value(pic, cxt, &cxt_type), k);
-}
-
-static pic_value
-pic_cont_callcc(pic_state *pic)
-{
-  pic_value f, args[1];
-
-  pic_get_args(pic, "l", &f);
-
-  args[0] = pic_make_cont(pic, pic->cxt, pic->cxt->fp->regs[1]);
-  return pic_applyk(pic, f, 1, args);
-}
-
 static pic_value
 pic_cont_values(pic_state *pic)
 {
@@ -158,8 +162,10 @@ pic_cont_call_with_values(pic_state *pic)
 void
 pic_init_cont(pic_state *pic)
 {
+#if PIC_USE_CALLCC
   pic_defun(pic, "call-with-current-continuation", pic_cont_callcc);
   pic_defun(pic, "call/cc", pic_cont_callcc);
+#endif
   pic_defun(pic, "values", pic_cont_values);
   pic_defun(pic, "call-with-values", pic_cont_call_with_values);
 }

lib/error.c

@@ -12,7 +12,9 @@ pic_panic(pic_state *pic, const char *msg)
   if (pic->panicf) {
     pic->panicf(pic, msg);
   }
-  PIC_ABORT(pic);
+#if PIC_USE_LIBC
+  abort();
+#endif
   PIC_UNREACHABLE();
 }
 
@@ -30,6 +32,8 @@ pic_warnf(pic_state *pic, const char *fmt, ...)
 
 #define pic_exc(pic) pic_ref(pic, "current-exception-handlers")
 
+#if PIC_USE_CALLCC
+
 PIC_JMPBUF *
 pic_prepare_try(pic_state *pic)
 {
@@ -91,6 +95,15 @@ pic_abort_try(pic_state *pic)
   return err;
 }
 
+#else
+
+PIC_JMPBUF *pic_prepare_try(pic_state *PIC_UNUSED(pic)) { return NULL; }
+void pic_enter_try(pic_state *PIC_UNUSED(pic)) { }
+void pic_exit_try(pic_state *PIC_UNUSED(pic)) { }
+pic_value pic_abort_try(pic_state *PIC_UNUSED(pic)) { PIC_UNREACHABLE(); }
+
+#endif
+
 pic_value
 pic_make_error(pic_state *pic, const char *type, const char *msg, pic_value irrs)
 {

lib/include/picconf.h

@@ -2,20 +2,25 @@
  * See Copyright Notice in picrin.h
  */
 
-/** enable libc */
+/**
+ * enable libc
+ */
+
+/* When PIC_USE_LIBC=0, users must supply panicf which never returns. */
 /* #define PIC_USE_LIBC 1 */
 
-/** enable specific features */
+/**
+ * enable specific features
+ */
+
+/* #define PIC_USE_CALLCC 1 */
 /* #define PIC_USE_READ 1 */
 /* #define PIC_USE_WRITE 1 */
 /* #define PIC_USE_EVAL 1 */
 /* #define PIC_USE_FILE 1 */
 
-/** essential external functions */
+/**
-/* #define PIC_JMPBUF jmp_buf */
+ * I/O configuration
-/* #define PIC_SETJMP(pic, buf) setjmp(buf) */
+ */
-/* #define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) */
-/* #define PIC_ABORT(pic) abort() */
 
-/** I/O configuration */
 /* #define PIC_BUFSIZ 1024 */

lib/include/picrin.h

@@ -306,7 +306,7 @@ pic_value pic_make_error(pic_state *, const char *type, const char *msg, pic_val
     extern void pic_exit_try(pic_state *);                              \
     extern pic_value pic_abort_try(pic_state *);                        \
     PIC_JMPBUF *jmp = pic_prepare_try(pic);                             \
-    if (PIC_SETJMP(pic, *jmp) == 0) {                                   \
+    if (PIC_SETJMP(*jmp) == 0) {                                        \
       pic_enter_try(pic);
 #define pic_catch(e) pic_catch_(e, PIC_GENSYM(label))
 #define pic_catch_(e, label)                              \

lib/include/picrin/extra.h

@@ -9,9 +9,11 @@
 extern "C" {
 #endif
 
-
 #if PIC_USE_LIBC
 void *pic_default_allocf(void *, void *, size_t);
+#endif
+
+#if PIC_USE_FILE
 pic_value pic_fopen(pic_state *, FILE *, const char *mode);
 #endif
 

lib/include/picrin/setup.h

@@ -8,6 +8,10 @@
 # define PIC_USE_LIBC 1
 #endif
 
+#ifndef PIC_USE_CALLCC
+# define PIC_USE_CALLCC 1
+#endif
+
 #ifndef PIC_USE_READ
 # define PIC_USE_READ 1
 #endif
@@ -30,20 +34,18 @@
 #if !PIC_USE_LIBC && PIC_USE_FILE
 # error PIC_USE_FILE requires PIC_USE_LIBC
 #endif
+#if !PIC_USE_LIBC && PIC_USE_CALLCC
+# error PIC_USE_CALLCC requires PIC_USE_LIBC
+#endif
 
-#ifndef PIC_JMPBUF
+#if PIC_USE_CALLCC
 # include <setjmp.h>
 # define PIC_JMPBUF jmp_buf
-#endif
+# define PIC_SETJMP(buf) setjmp(buf)
-
+# define PIC_LONGJMP(buf, val) longjmp((buf), (val))
-#ifndef PIC_SETJMP
+#else
-# include <setjmp.h>
+# define PIC_JMPBUF char
-# define PIC_SETJMP(pic, buf) setjmp(buf)
+# define PIC_SETJMP(buf) 0
-#endif
-
-#ifndef PIC_LONGJMP
-# include <setjmp.h>
-# define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val))
 #endif
 
 #ifndef PIC_ABORT

lib/proc.c

@@ -380,7 +380,7 @@ pic_apply(pic_state *pic, pic_value proc, int argc, pic_value *argv)
   cxt.prev = pic->cxt;
   pic->cxt = &cxt;
 
-  if (PIC_SETJMP(pic, cxt.jmp) != 0) {
+  if (PIC_SETJMP(cxt.jmp) != 0) {
     /* pass */
   }