From 55b7e63985029ff9391e09e8d1ca9e4e3824a1f1 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 15 Apr 2017 01:33:18 +0900 Subject: [PATCH] add PIC_USE_CALLCC flag --- lib/Makefile | 6 +- lib/cont.c | 116 +++++++++++++++++++------------------ lib/error.c | 15 ++++- lib/include/picconf.h | 21 ++++--- lib/include/picrin.h | 2 +- lib/include/picrin/extra.h | 4 +- lib/include/picrin/setup.h | 24 ++++---- lib/proc.c | 2 +- 8 files changed, 111 insertions(+), 79 deletions(-) diff --git a/lib/Makefile b/lib/Makefile index eaa40e01..ff0a913a 100644 --- a/lib/Makefile +++ b/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 diff --git a/lib/cont.c b/lib/cont.c index d8ed6c59..8e672ec2 100644 --- a/lib/cont.c +++ b/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); } diff --git a/lib/error.c b/lib/error.c index 9ee1eefd..72f672b3 100644 --- a/lib/error.c +++ b/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) { diff --git a/lib/include/picconf.h b/lib/include/picconf.h index 130b7cda..48311f90 100644 --- a/lib/include/picconf.h +++ b/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 */ -/* #define PIC_SETJMP(pic, buf) setjmp(buf) */ -/* #define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) */ -/* #define PIC_ABORT(pic) abort() */ +/** + * I/O configuration + */ -/** I/O configuration */ /* #define PIC_BUFSIZ 1024 */ diff --git a/lib/include/picrin.h b/lib/include/picrin.h index b4bee49a..f3b13f77 100644 --- a/lib/include/picrin.h +++ b/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) \ diff --git a/lib/include/picrin/extra.h b/lib/include/picrin/extra.h index f2df3326..b63ce5e5 100644 --- a/lib/include/picrin/extra.h +++ b/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 diff --git a/lib/include/picrin/setup.h b/lib/include/picrin/setup.h index b490fe14..7eadae4b 100644 --- a/lib/include/picrin/setup.h +++ b/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 # define PIC_JMPBUF jmp_buf -#endif - -#ifndef PIC_SETJMP -# include -# define PIC_SETJMP(pic, buf) setjmp(buf) -#endif - -#ifndef PIC_LONGJMP -# include -# define PIC_LONGJMP(pic, buf, val) longjmp((buf), (val)) +# define PIC_SETJMP(buf) setjmp(buf) +# define PIC_LONGJMP(buf, val) longjmp((buf), (val)) +#else +# define PIC_JMPBUF char +# define PIC_SETJMP(buf) 0 #endif #ifndef PIC_ABORT diff --git a/lib/proc.c b/lib/proc.c index 413b5284..732c3617 100644 --- a/lib/proc.c +++ b/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 */ }