From b7f08e854fa7b693837c3c2c2d141954c973117d Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Sun, 2 May 2010 18:17:47 +0000 Subject: [PATCH] fully separating femtolisp into library core and main program --- femtolisp/Makefile | 19 ++++-- femtolisp/cvalues.c | 2 +- femtolisp/equalhash.c | 1 + femtolisp/flisp.c | 152 +++++++++++++++--------------------------- femtolisp/flisp.h | 35 +++++++++- femtolisp/flmain.c | 71 ++++++++++++++++++++ femtolisp/iostream.c | 1 + femtolisp/read.c | 2 +- femtolisp/table.c | 1 + 9 files changed, 180 insertions(+), 104 deletions(-) create mode 100644 femtolisp/flmain.c diff --git a/femtolisp/Makefile b/femtolisp/Makefile index 6c72984..9d56abd 100644 --- a/femtolisp/Makefile +++ b/femtolisp/Makefile @@ -5,6 +5,7 @@ SRCS = $(NAME).c builtins.c string.c equalhash.c table.c iostream.c OBJS = $(SRCS:%.c=%.o) DOBJS = $(SRCS:%.c=%.do) EXENAME = $(NAME) +LIBTARGET = lib$(NAME) LLTDIR = ../llt LLT = $(LLTDIR)/libllt.a @@ -27,16 +28,26 @@ test: flisp.o: flisp.c cvalues.c types.c flisp.h print.c read.c equal.c flisp.do: flisp.c cvalues.c types.c flisp.h print.c read.c equal.c +flmain.o: flmain.c flisp.h +flmain.do: flmain.c flisp.h $(LLT): cd $(LLTDIR) && make -debug: $(DOBJS) $(LIBFILES) - $(CC) $(DEBUGFLAGS) $(DOBJS) -o $(EXENAME) $(LIBS) +$(LIBTARGET).da: $(DOBJS) + rm -rf $@ + ar rs $@ $(DOBJS) + +$(LIBTARGET).a: $(OBJS) + rm -rf $@ + ar rs $@ $(OBJS) + +debug: $(DOBJS) $(LIBFILES) $(LIBTARGET).da flmain.do + $(CC) $(DEBUGFLAGS) $(DOBJS) flmain.do -o $(EXENAME) $(LIBS) $(LIBTARGET).da make test -release: $(OBJS) $(LIBFILES) - $(CC) $(SHIPFLAGS) $(OBJS) -o $(EXENAME) $(LIBS) +release: $(OBJS) $(LIBFILES) $(LIBTARGET).a flmain.o + $(CC) $(SHIPFLAGS) $(OBJS) flmain.o -o $(EXENAME) $(LIBS) $(LIBTARGET).a clean: rm -f *.o diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 597a38c..28747a7 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -762,7 +762,7 @@ static numerictype_t sym_to_numtype(value_t type) return T_FLOAT; else if (type == doublesym) return T_DOUBLE; - assert(false); + assert(0); return N_NUMTYPES; } diff --git a/femtolisp/equalhash.c b/femtolisp/equalhash.c index 4e3efdf..f51de7c 100644 --- a/femtolisp/equalhash.c +++ b/femtolisp/equalhash.c @@ -3,6 +3,7 @@ #include #include #include +#include #include "llt.h" #include "flisp.h" diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 7390dea..5d386fa 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -109,15 +109,9 @@ static value_t apply_cl(uint32_t nargs); static value_t *alloc_words(int n); static value_t relocate(value_t v); -typedef struct _readstate_t { - htable_t backrefs; - htable_t gensyms; - value_t source; - struct _readstate_t *prev; -} readstate_t; -static readstate_t *readstate = NULL; +static fl_readstate_t *readstate = NULL; -static void free_readstate(readstate_t *rs) +static void free_readstate(fl_readstate_t *rs) { htable_free(&rs->backrefs); htable_free(&rs->gensyms); @@ -133,45 +127,53 @@ static uint32_t *consflags; // error utilities ------------------------------------------------------------ // saved execution state for an unwind target -typedef struct _ectx_t { - jmp_buf buf; - uint32_t sp; - uint32_t frame; - uint32_t ngchnd; - readstate_t *rdst; - struct _ectx_t *prev; -} exception_context_t; - -static exception_context_t *ctx = NULL; -static value_t lasterror; -static uint32_t throwing_frame=0; // active frame when exception was thrown +fl_exception_context_t *fl_ctx = NULL; +uint32_t fl_throwing_frame=0; // active frame when exception was thrown +value_t fl_lasterror; #define FL_TRY \ - exception_context_t _ctx; int l__tr, l__ca; \ - _ctx.sp=SP; _ctx.frame=curr_frame; _ctx.rdst=readstate; _ctx.prev=ctx; \ - _ctx.ngchnd = N_GCHND; ctx = &_ctx; \ + fl_exception_context_t _ctx; int l__tr, l__ca; \ + _ctx.sp=SP; _ctx.frame=curr_frame; _ctx.rdst=readstate; _ctx.prev=fl_ctx; \ + _ctx.ngchnd = N_GCHND; fl_ctx = &_ctx; \ if (!setjmp(_ctx.buf)) \ - for (l__tr=1; l__tr; l__tr=0, (void)(ctx->prev && (ctx=ctx->prev))) + for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx->prev&&(fl_ctx=fl_ctx->prev))) #define FL_CATCH \ else \ - for (l__ca=1; l__ca; l__ca=0, \ - lasterror=NIL, throwing_frame=0, SP=_ctx.sp, curr_frame=_ctx.frame) + for(l__ca=1; l__ca; l__ca=0, \ + fl_lasterror=FL_NIL,fl_throwing_frame=0,SP=_ctx.sp,curr_frame=_ctx.frame) + +void fl_savestate(fl_exception_context_t *_ctx) +{ + _ctx->sp = SP; + _ctx->frame = curr_frame; + _ctx->rdst = readstate; + _ctx->prev = fl_ctx; + _ctx->ngchnd = N_GCHND; +} + +void fl_restorestate(fl_exception_context_t *_ctx) +{ + fl_lasterror = FL_NIL; + fl_throwing_frame = 0; + SP = _ctx->sp; + curr_frame = _ctx->frame; +} void fl_raise(value_t e) { - lasterror = e; + fl_lasterror = e; // unwind read state - while (readstate != ctx->rdst) { + while (readstate != fl_ctx->rdst) { free_readstate(readstate); readstate = readstate->prev; } - if (throwing_frame == 0) - throwing_frame = curr_frame; - N_GCHND = ctx->ngchnd; - exception_context_t *thisctx = ctx; - if (ctx->prev) // don't throw past toplevel - ctx = ctx->prev; + if (fl_throwing_frame == 0) + fl_throwing_frame = curr_frame; + N_GCHND = fl_ctx->ngchnd; + fl_exception_context_t *thisctx = fl_ctx; + if (fl_ctx->prev) // don't throw past toplevel + fl_ctx = fl_ctx->prev; longjmp(thisctx->buf, 1); } @@ -525,14 +527,14 @@ void gc(int mustgrow) static int grew = 0; void *temp; uint32_t i, f, top; - readstate_t *rs; + fl_readstate_t *rs; curheap = tospace; lim = curheap+heapsize-sizeof(cons_t); - if (throwing_frame > curr_frame) { - top = throwing_frame - 4; - f = Stack[throwing_frame-4]; + if (fl_throwing_frame > curr_frame) { + top = fl_throwing_frame - 4; + f = Stack[fl_throwing_frame-4]; } else { top = SP; @@ -558,7 +560,7 @@ void gc(int mustgrow) rs->source = relocate(rs->source); rs = rs->prev; } - lasterror = relocate(lasterror); + fl_lasterror = relocate(fl_lasterror); memory_exception_value = relocate(memory_exception_value); the_empty_vector = relocate(the_empty_vector); @@ -796,7 +798,7 @@ static value_t do_trycatch() FL_CATCH { v = Stack[saveSP-2]; PUSH(v); - PUSH(lasterror); + PUSH(fl_lasterror); v = apply_cl(1); } SP = saveSP; @@ -2119,7 +2121,7 @@ value_t fl_stacktrace(value_t *args, u_int32_t nargs) { (void)args; argcount("stacktrace", nargs, 0); - return _stacktrace(throwing_frame ? throwing_frame : curr_frame); + return _stacktrace(fl_throwing_frame ? fl_throwing_frame : curr_frame); } static builtinspec_t core_builtin_info[] = { @@ -2143,8 +2145,6 @@ static builtinspec_t core_builtin_info[] = { extern void builtins_init(); extern void comparehash_init(); -static char *EXEDIR = NULL; - static void lisp_init(void) { int i; @@ -2197,7 +2197,7 @@ static void lisp_init(void) set(printwidthsym=symbol("*print-width*"), fixnum(SCR_WIDTH)); set(printlengthsym=symbol("*print-length*"), FL_F); set(printlevelsym=symbol("*print-level*"), FL_F); - lasterror = NIL; + fl_lasterror = NIL; i = 0; for (i=OP_EQ; i <= OP_ASET; i++) { setc(symbol(builtin_names[i]), builtin(i)); @@ -2225,8 +2225,7 @@ static void lisp_init(void) char *exename = get_exename(buf, sizeof(buf)); if (exename != NULL) { path_to_dirname(exename); - EXEDIR = strdup(exename); - setc(symbol("*install-dir*"), cvalue_static_cstring(EXEDIR)); + setc(symbol("*install-dir*"), cvalue_static_cstring(strdup(exename))); } memory_exception_value = fl_list2(MemoryError, @@ -2237,49 +2236,27 @@ static void lisp_init(void) builtins_init(); } -// repl ----------------------------------------------------------------------- +// top level ------------------------------------------------------------------ value_t fl_toplevel_eval(value_t expr) { return fl_applyn(1, symbol_value(evalsym), expr); } -static value_t argv_list(int argc, char *argv[]) +void fl_init() { - int i; - PUSH(NIL); - for(i=argc-1; i >= 0; i--) { - PUSH(cvalue_static_cstring(argv[i])); - Stack[SP-2] = fl_cons(Stack[SP-1], Stack[SP-2]); - POPN(1); - } - return POP(); + lisp_init(); } -extern value_t fl_file(value_t *args, uint32_t nargs); - -int fl_startup() +int fl_load_system_image(value_t sys_image_iostream) { value_t e; int saveSP; symbol_t *sym; - char fname_buf[1024]; - lisp_init(); - - fname_buf[0] = '\0'; - if (EXEDIR != NULL) { - strcat(fname_buf, EXEDIR); - strcat(fname_buf, PATHSEPSTRING); - } - strcat(fname_buf, "flisp.boot"); - - FL_TRY { // toplevel exception handler - PUSH(cvalue_static_cstring(fname_buf)); - PUSH(symbol(":read")); - value_t f = fl_file(&Stack[SP-2], 2); - POPN(2); - PUSH(f); saveSP = SP; + PUSH(sys_image_iostream); + saveSP = SP; + FL_TRY { while (1) { e = fl_read_sexpr(Stack[SP-1]); if (ios_eof(value2c(ios_t*,Stack[SP-1]))) break; @@ -2301,33 +2278,14 @@ int fl_startup() break; } } - ios_close(value2c(ios_t*,Stack[SP-1])); - POPN(1); } FL_CATCH { ios_puts("fatal error during bootstrap:\n", ios_stderr); - fl_print(ios_stderr, lasterror); - ios_putc('\n', ios_stderr); - return 1; - } - return 0; -} - -int main(int argc, char *argv[]) -{ - if (fl_startup()) - return 1; - - FL_TRY { - PUSH(symbol_value(symbol("__start"))); - PUSH(argv_list(argc, argv)); - (void)_applyn(1); - } - FL_CATCH { - ios_puts("fatal error:\n", ios_stderr); - fl_print(ios_stderr, lasterror); + fl_print(ios_stderr, fl_lasterror); ios_putc('\n', ios_stderr); return 1; } + ios_close(value2c(ios_t*,Stack[SP-1])); + POPN(1); return 0; } diff --git a/femtolisp/flisp.h b/femtolisp/flisp.h index 0ee03a2..f5eac40 100644 --- a/femtolisp/flisp.h +++ b/femtolisp/flisp.h @@ -148,8 +148,40 @@ fixnum_t tofixnum(value_t v, char *fname); char *tostring(value_t v, char *fname); /* error handling */ +typedef struct _fl_readstate_t { + htable_t backrefs; + htable_t gensyms; + value_t source; + struct _fl_readstate_t *prev; +} fl_readstate_t; + +typedef struct _ectx_t { + jmp_buf buf; + uint32_t sp; + uint32_t frame; + uint32_t ngchnd; + fl_readstate_t *rdst; + struct _ectx_t *prev; +} fl_exception_context_t; + +extern fl_exception_context_t *fl_ctx; +extern uint32_t fl_throwing_frame; +extern value_t fl_lasterror; + +#define FL_TRY_EXTERN \ + fl_exception_context_t _ctx; int l__tr, l__ca; \ + fl_savestate(&_ctx); fl_ctx = &_ctx; \ + if (!setjmp(_ctx.buf)) \ + for (l__tr=1; l__tr; l__tr=0, (void)(fl_ctx->prev&&(fl_ctx=fl_ctx->prev))) + +#define FL_CATCH_EXTERN \ + else \ + for(l__ca=1; l__ca; l__ca=0, fl_restorestate(&_ctx)) + void lerrorf(value_t e, char *format, ...) __attribute__ ((__noreturn__)); void lerror(value_t e, const char *msg) __attribute__ ((__noreturn__)); +void fl_savestate(fl_exception_context_t *_ctx); +void fl_restorestate(fl_exception_context_t *_ctx); void fl_raise(value_t e) __attribute__ ((__noreturn__)); void type_error(char *fname, char *expected, value_t got) __attribute__ ((__noreturn__)); void bounds_error(char *fname, value_t arr, value_t ind) __attribute__ ((__noreturn__)); @@ -322,6 +354,7 @@ value_t fl_hash(value_t *args, u_int32_t nargs); value_t cvalue_byte(value_t *args, uint32_t nargs); value_t cvalue_wchar(value_t *args, uint32_t nargs); -int fl_startup(); +void fl_init(); +int fl_load_system_image(value_t ios); #endif diff --git a/femtolisp/flmain.c b/femtolisp/flmain.c new file mode 100644 index 0000000..4444774 --- /dev/null +++ b/femtolisp/flmain.c @@ -0,0 +1,71 @@ +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include "llt.h" +#include "flisp.h" +#include "opcodes.h" + +static value_t argv_list(int argc, char *argv[]) +{ + int i; + value_t lst, temp; + fl_gc_handle(&lst); + fl_gc_handle(&temp); + for(i=argc-1; i >= 0; i--) { + temp = cvalue_static_cstring(argv[i]); + lst = fl_cons(temp, lst); + } + fl_free_gc_handles(2); + return lst; +} + +extern value_t fl_file(value_t *args, uint32_t nargs); + +int main(int argc, char *argv[]) +{ + char fname_buf[1024]; + + fl_init(); + + fname_buf[0] = '\0'; + value_t str = symbol_value(symbol("*install-dir*")); + char *exedir = (str == UNBOUND ? NULL : cvalue_data(str)); + if (exedir != NULL) { + strcat(fname_buf, exedir); + strcat(fname_buf, PATHSEPSTRING); + } + strcat(fname_buf, "flisp.boot"); + + value_t args[2]; + fl_gc_handle(&args[0]); + fl_gc_handle(&args[1]); + FL_TRY_EXTERN { + args[0] = cvalue_static_cstring(fname_buf); + args[1] = symbol(":read"); + value_t f = fl_file(&args[0], 2); + fl_free_gc_handles(2); + + if (fl_load_system_image(f)) + return 1; + + (void)fl_applyn(1, symbol_value(symbol("__start")), + argv_list(argc, argv)); + } + FL_CATCH_EXTERN { + ios_puts("fatal error:\n", ios_stderr); + fl_print(ios_stderr, fl_lasterror); + ios_putc('\n', ios_stderr); + return 1; + } + return 0; +} diff --git a/femtolisp/iostream.c b/femtolisp/iostream.c index 369cca8..feac00f 100644 --- a/femtolisp/iostream.c +++ b/femtolisp/iostream.c @@ -4,6 +4,7 @@ #include #include #include +#include #include "llt.h" #include "flisp.h" diff --git a/femtolisp/read.c b/femtolisp/read.c index 88b1988..3fa4a63 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -659,7 +659,7 @@ static value_t do_read_sexpr(value_t label) value_t fl_read_sexpr(value_t f) { value_t v; - readstate_t state; + fl_readstate_t state; state.prev = readstate; htable_new(&state.backrefs, 8); htable_new(&state.gensyms, 8); diff --git a/femtolisp/table.c b/femtolisp/table.c index e3e7107..6a6e0c5 100644 --- a/femtolisp/table.c +++ b/femtolisp/table.c @@ -4,6 +4,7 @@ #include #include #include +#include #include "llt.h" #include "flisp.h" #include "equalhash.h"