From a18deb68ccf4096a9ef185b7832d94b5f8285c5f Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 21 Jun 2012 23:04:07 -0700 Subject: [PATCH] Optional code refactoring. Chibi uses a lot of #if conditioned code so that configuration management can be done entirely with the C preprocessor. Originally this also involved conditional includes of .c files from other source files. The alterative, which this change switches to, is to compile and link all files, and for uneeded files conditionally eliminate their entire bodies so they compile to empty object files. Pros for conditionally including all code into one large file: * Don't need to declare most functions (keeps .h files small). * Can keep most functions static/inlined (keeps objects small). * Don't need to even distribute uneeded files with the default Makefile (e.g. can prune opt/* from dist for minimal builds). Pros for linking multiple possibly empty files: * Extensions and third-party libs probably want the exported declarations anyway. * Static analysis tools work better (e.g. flymake on what previously was an included file). * Can build each file in parallel (i.e. make -j for faster builds). * Can build and link in just the changed files, instead of having to recompile the whole thing. For Chibi these are all minor points - it will be small regardless, and will build fast regardless - but the arguments for splitting seem stronger. Note the new shared lib is about 1k larger, but that can be trimmed down later. --- Makefile | 21 ++-- eval.c | 118 +++++-------------- gc.c | 6 +- include/chibi/bignum.h | 92 +++++++-------- include/chibi/eval.h | 79 +++++++++++-- include/chibi/sexp.h | 37 +++++- opcodes.c | 5 + opt/bignum.c | 16 ++- opt/simplify.c | 12 +- sexp.c | 77 +++++++------ vm.c | 254 +++++++++++++++++++++-------------------- 11 files changed, 395 insertions(+), 322 deletions(-) diff --git a/Makefile b/Makefile index 39c2f74f..44133a39 100644 --- a/Makefile +++ b/Makefile @@ -77,31 +77,32 @@ include/chibi/install.h: Makefile echo '#define sexp_version "'`cat VERSION`'"' >> $@ echo '#define sexp_release_name "'`cat RELEASE`'"' >> $@ -sexp.o: sexp.c gc.c opt/bignum.c $(BASE_INCLUDES) Makefile +%.o: %.c $(BASE_INCLUDES) $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $< -sexp-ulimit.o: sexp.c gc.c opt/bignum.c $(BASE_INCLUDES) Makefile +sexp-ulimit.o: sexp.c $(BASE_INCLUDES) $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -DSEXP_USE_LIMITED_MALLOC -o $@ $< -eval.o: eval.c opcodes.c vm.c opt/simplify.c $(INCLUDES) Makefile - $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $< - -main.o: main.c $(INCLUDES) Makefile +main.o: main.c $(INCLUDES) $(CC) -c $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -libchibi-sexp$(SO): sexp.o +SEXP_OBJS = gc.o sexp.o opt/bignum.o +SEXP_ULIMIT_OBJS = gc.o sexp-ulimit.o opt/bignum.o +EVAL_OBJS = opcodes.o vm.o eval.o opt/simplify.o + +libchibi-sexp$(SO): $(SEXP_OBJS) $(CC) $(CLIBFLAGS) -o $@ $^ $(XLDFLAGS) -libchibi-scheme$(SO): eval.o sexp.o +libchibi-scheme$(SO): $(SEXP_OBJS) $(EVAL_OBJS) $(CC) $(CLIBFLAGS) -o $@ $^ $(XLDFLAGS) chibi-scheme$(EXE): main.o libchibi-scheme$(SO) $(CC) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -L. -lchibi-scheme -chibi-scheme-static$(EXE): main.o eval.o sexp.o +chibi-scheme-static$(EXE): main.o $(SEXP_OBJS) $(EVAL_OBJS) $(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS) -lm -chibi-scheme-ulimit$(EXE): main.o eval.o sexp-ulimit.o +chibi-scheme-ulimit$(EXE): main.o $(SEXP_ULIMIT_OBJS) $(EVAL_OBJS) $(CC) $(XCFLAGS) $(STATICFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS) -lm clibs.c: $(GENSTATIC) chibi-scheme$(EXE) diff --git a/eval.c b/eval.c index 0c64499e..cb5d27a1 100644 --- a/eval.c +++ b/eval.c @@ -13,7 +13,6 @@ static int scheme_initialized_p = 0; static sexp analyze (sexp ctx, sexp x); -static void generate (sexp ctx, sexp name, sexp loc, sexp lam, sexp x); #if SEXP_USE_MODULES sexp sexp_load_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file, sexp env); @@ -241,7 +240,7 @@ int sexp_param_index (sexp lambda, sexp name) { /************************* bytecode utilities ***************************/ -static void shrink_bcode (sexp ctx, sexp_uint_t i) { +void sexp_shrink_bcode (sexp ctx, sexp_uint_t i) { sexp tmp; if (sexp_bytecode_length(sexp_context_bc(ctx)) != i) { tmp = sexp_alloc_bytecode(ctx, i); @@ -256,7 +255,7 @@ static void shrink_bcode (sexp ctx, sexp_uint_t i) { } } -static void expand_bcode (sexp ctx, sexp_uint_t size) { +void sexp_expand_bcode (sexp ctx, sexp_uint_t size) { sexp tmp; if (sexp_bytecode_length(sexp_context_bc(ctx)) < (sexp_context_pos(ctx))+size) { @@ -273,14 +272,15 @@ static void expand_bcode (sexp ctx, sexp_uint_t size) { } } -static void emit_enter (sexp ctx); -static void emit_return (sexp ctx); -static void bless_bytecode (sexp ctx, sexp bc); +void sexp_emit (sexp ctx, unsigned char c) { + sexp_expand_bcode(ctx, 1); + sexp_bytecode_data(sexp_context_bc(ctx))[sexp_context_pos(ctx)++] = c; +} -static sexp finalize_bytecode (sexp ctx) { +sexp sexp_complete_bytecode (sexp ctx) { sexp bc; - emit_return(ctx); - shrink_bcode(ctx, sexp_context_pos(ctx)); + sexp_emit_return(ctx); + sexp_shrink_bcode(ctx, sexp_context_pos(ctx)); bc = sexp_context_bc(ctx); if (sexp_pairp(sexp_bytecode_literals(bc))) { /* compress literals */ if (sexp_nullp(sexp_cdr(sexp_bytecode_literals(bc)))) @@ -290,15 +290,10 @@ static sexp finalize_bytecode (sexp ctx) { else sexp_bytecode_literals(bc) = sexp_list_to_vector(ctx, sexp_bytecode_literals(bc)); } - bless_bytecode(ctx, bc); + sexp_bless_bytecode(ctx, bc); return bc; } -static void emit (sexp ctx, unsigned char c) { - expand_bcode(ctx, 1); - sexp_bytecode_data(sexp_context_bc(ctx))[sexp_context_pos(ctx)++] = c; -} - sexp sexp_make_procedure_op (sexp ctx, sexp self, sexp_sint_t n, sexp flags, sexp num_args, sexp bc, sexp vars) { sexp proc = sexp_alloc_type(ctx, procedure, SEXP_PROCEDURE); @@ -329,7 +324,7 @@ sexp sexp_make_synclo_op (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp fv, /* internal AST */ -static sexp sexp_make_lambda (sexp ctx, sexp params) { +sexp sexp_make_lambda (sexp ctx, sexp params) { sexp res = sexp_alloc_type(ctx, lambda, SEXP_LAMBDA); sexp_lambda_name(res) = SEXP_FALSE; sexp_lambda_params(res) = params; @@ -342,6 +337,13 @@ static sexp sexp_make_lambda (sexp ctx, sexp params) { return res; } +sexp sexp_make_ref (sexp ctx, sexp name, sexp cell) { + sexp res = sexp_alloc_type(ctx, ref, SEXP_REF); + sexp_ref_name(res) = name; + sexp_ref_cell(res) = cell; + return res; +} + static sexp sexp_make_set (sexp ctx, sexp var, sexp value) { sexp res = sexp_alloc_type(ctx, set, SEXP_SET); sexp_set_var(res) = var; @@ -349,13 +351,6 @@ static sexp sexp_make_set (sexp ctx, sexp var, sexp value) { return res; } -static sexp sexp_make_ref (sexp ctx, sexp name, sexp cell) { - sexp res = sexp_alloc_type(ctx, ref, SEXP_REF); - sexp_ref_name(res) = name; - sexp_ref_cell(res) = cell; - return res; -} - static sexp sexp_make_cnd (sexp ctx, sexp test, sexp pass, sexp fail) { sexp res = sexp_alloc_type(ctx, cnd, SEXP_CND); sexp_cnd_test(res) = test; @@ -392,11 +387,11 @@ static void sexp_add_path (sexp ctx, const char *str) { static void sexp_init_eval_context_bytecodes (sexp ctx) { sexp_gc_var3(tmp, vec, ctx2); sexp_gc_preserve3(ctx, tmp, vec, ctx2); - emit(ctx, SEXP_OP_RESUMECC); - sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx); + sexp_emit(ctx, SEXP_OP_RESUMECC); + sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = sexp_complete_bytecode(ctx); ctx2 = sexp_make_child_context(ctx, NULL); - emit(ctx2, SEXP_OP_DONE); - tmp = finalize_bytecode(ctx2); + sexp_emit(ctx2, SEXP_OP_DONE); + tmp = sexp_complete_bytecode(ctx2); vec = sexp_make_vector(ctx, 0, SEXP_VOID); sexp_global(ctx, SEXP_G_FINAL_RESUMER) = sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, tmp, vec); @@ -1449,47 +1444,6 @@ sexp sexp_string_cmp_op (sexp ctx, sexp self, sexp_sint_t n, sexp str1, sexp str #if SEXP_USE_UTF8_STRINGS -int sexp_utf8_initial_byte_count (int c) { - if (c < 0xC0) return 1; - if (c < 0xE0) return 2; - return ((c>>4)&1)+3; -} - -int sexp_utf8_char_byte_count (int c) { - if (c < 0x80) return 1; - if (c < 0x800) return 2; - if (c < 0x10000) return 3; - return 4; -} - -int sexp_string_utf8_length (unsigned char *p, int len) { - unsigned char *q = p+len; - int i; - for (i=0; p>6 == 2) - ; - return (char*)p; -} - -sexp sexp_string_utf8_ref (sexp ctx, sexp str, sexp i) { - unsigned char *p=(unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(i); - if (*p < 0x80) - return sexp_make_character(*p); - else if ((*p < 0xC0) || (*p > 0xF7)) - return sexp_user_exception(ctx, NULL, "string-ref: invalid utf8 byte", i); - else if (*p < 0xE0) - return sexp_make_character(((p[0]&0x3F)<<6) + (p[1]&0x3F)); - else if (*p < 0xF0) - return sexp_make_character(((p[0]&0x1F)<<12) + ((p[1]&0x3F)<<6) + (p[2]&0x3F)); - else - return sexp_make_character(((p[0]&0x0F)<<16) + ((p[1]&0x3F)<<6) + ((p[2]&0x3F)<<6) + (p[2]&0x3F)); -} - sexp sexp_string_utf8_index_ref (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp i) { sexp off; sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str); @@ -1573,14 +1527,6 @@ sexp sexp_make_promise (sexp ctx, sexp self, sexp_sint_t n, sexp done, sexp val) #include "opt/plan9.c" #endif -/************************** optimizations *****************************/ - -#if SEXP_USE_SIMPLIFY -#include "opt/simplify.c" -#else -#define sexp_rest_unused_p(lambda) 0 -#endif - /***************************** opcodes ********************************/ #if SEXP_USE_TYPE_DEFS @@ -1658,8 +1604,6 @@ static sexp sexp_reset_vm_profile (sexp ctx, sexp self, sexp_sint_t n); static sexp sexp_print_vm_profile (sexp ctx, sexp self, sexp_sint_t n); #endif -#include "opcodes.c" - static sexp sexp_copy_core (sexp ctx, struct sexp_core_form_struct *core) { sexp res = sexp_alloc_type(ctx, core, SEXP_CORE); memcpy(&(res->value), core, sizeof(core[0])); @@ -1803,8 +1747,8 @@ sexp sexp_make_primitive_env (sexp ctx, sexp version) { sexp_gc_var4(e, op, sym, name); sexp_gc_preserve4(ctx, e, op, sym, name); e = sexp_make_null_env(ctx, version); - for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) { - op = sexp_copy_opcode(ctx, &opcodes[i]); + for (i=0; sexp_primitive_opcodes[i].op_class; i++) { + op = sexp_copy_opcode(ctx, &sexp_primitive_opcodes[i]); name = sexp_intern(ctx, (char*)sexp_opcode_name(op), -1); sexp_opcode_name(op) = sexp_c_string(ctx, (char*)sexp_opcode_name(op), -1); if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) { @@ -2133,14 +2077,6 @@ sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from, return SEXP_VOID; } -/************************* backend ***************************/ - -#if SEXP_USE_NATIVE_X86 -#include "opt/x86.c" -#else -#include "vm.c" -#endif - /************************** eval interface ****************************/ sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) { @@ -2160,9 +2096,9 @@ sexp sexp_compile_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp env) { for ( ; sexp_pairp(res); res=sexp_cdr(res)) ast = sexp_apply1(ctx2, sexp_cdar(res), ast); sexp_free_vars(ctx2, ast, SEXP_NULL); /* should return SEXP_NULL */ - emit_enter(ctx2); - generate(ctx2, 0, 0, 0, ast); - res = finalize_bytecode(ctx2); + sexp_emit_enter(ctx2); + sexp_generate(ctx2, 0, 0, 0, ast); + res = sexp_complete_bytecode(ctx2); vec = sexp_make_vector(ctx2, 0, SEXP_VOID); res = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, vec); } diff --git a/gc.c b/gc.c index ae32e0f0..7b80086c 100644 --- a/gc.c +++ b/gc.c @@ -1,7 +1,9 @@ /* gc.c -- simple mark&sweep garbage collector */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ +#if ! SEXP_USE_BOEHM && ! SEXP_USE_MALLOC + #include "chibi/sexp.h" #if SEXP_USE_MMAP_GC @@ -720,3 +722,5 @@ void sexp_gc_init (void) { stack_base = ((sexp*)&size) + 32; #endif } + +#endif diff --git a/include/chibi/bignum.h b/include/chibi/bignum.h index 2c44f503..d23262ee 100644 --- a/include/chibi/bignum.h +++ b/include/chibi/bignum.h @@ -1,10 +1,12 @@ /* bignum.h -- header for bignum utilities */ -/* Copyright (c) 2009-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ #ifndef SEXP_BIGNUM_H #define SEXP_BIGNUM_H +#include "chibi/eval.h" + #if (SEXP_64_BIT) && defined(__GNUC__) typedef unsigned int uint128_t __attribute__((mode(TI))); typedef int sint128_t __attribute__((mode(TI))); @@ -15,53 +17,53 @@ typedef unsigned long long sexp_luint_t; typedef long long sexp_lsint_t; #endif -sexp_sint_t sexp_bignum_compare (sexp a, sexp b); -sexp sexp_compare (sexp ctx, sexp a, sexp b); -sexp sexp_make_bignum (sexp ctx, sexp_uint_t len); -sexp sexp_copy_bignum (sexp ctx, sexp dst, sexp a, sexp_uint_t len); -sexp sexp_bignum_normalize (sexp a); -sexp_uint_t sexp_bignum_hi (sexp a); -sexp sexp_fixnum_to_bignum (sexp ctx, sexp a); -double sexp_bignum_to_double (sexp a); -sexp sexp_double_to_bignum (sexp ctx, double f); -sexp sexp_bignum_fxadd (sexp ctx, sexp a, sexp_uint_t b); -sexp sexp_bignum_fxmul (sexp ctx, sexp d, sexp a, sexp_uint_t b, int offset); -sexp_uint_t sexp_bignum_fxdiv (sexp ctx, sexp a, sexp_uint_t b, int offset); -sexp sexp_bignum_add (sexp ctx, sexp dst, sexp a, sexp b); -sexp sexp_bignum_sub (sexp ctx, sexp dst, sexp a, sexp b); -sexp sexp_bignum_mul (sexp ctx, sexp dst, sexp a, sexp b); -sexp sexp_bignum_div (sexp ctx, sexp dst, sexp a, sexp b); -sexp sexp_bignum_expt (sexp ctx, sexp n, sexp e); -sexp sexp_add (sexp ctx, sexp a, sexp b); -sexp sexp_sub (sexp ctx, sexp a, sexp b); -sexp sexp_mul (sexp ctx, sexp a, sexp b); -sexp sexp_div (sexp ctx, sexp a, sexp b); -sexp sexp_quotient (sexp ctx, sexp a, sexp b); -sexp sexp_remainder (sexp ctx, sexp a, sexp b); +SEXP_API sexp_sint_t sexp_bignum_compare (sexp a, sexp b); +SEXP_API sexp sexp_compare (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_make_bignum (sexp ctx, sexp_uint_t len); +SEXP_API sexp sexp_copy_bignum (sexp ctx, sexp dst, sexp a, sexp_uint_t len); +SEXP_API sexp sexp_bignum_normalize (sexp a); +SEXP_API sexp_uint_t sexp_bignum_hi (sexp a); +SEXP_API sexp sexp_fixnum_to_bignum (sexp ctx, sexp a); +SEXP_API double sexp_bignum_to_double (sexp a); +SEXP_API sexp sexp_double_to_bignum (sexp ctx, double f); +SEXP_API sexp sexp_bignum_fxadd (sexp ctx, sexp a, sexp_uint_t b); +SEXP_API sexp sexp_bignum_fxmul (sexp ctx, sexp d, sexp a, sexp_uint_t b, int offset); +SEXP_API sexp_uint_t sexp_bignum_fxdiv (sexp ctx, sexp a, sexp_uint_t b, int offset); +SEXP_API sexp sexp_bignum_add (sexp ctx, sexp dst, sexp a, sexp b); +SEXP_API sexp sexp_bignum_sub (sexp ctx, sexp dst, sexp a, sexp b); +SEXP_API sexp sexp_bignum_mul (sexp ctx, sexp dst, sexp a, sexp b); +SEXP_API sexp sexp_bignum_div (sexp ctx, sexp dst, sexp a, sexp b); +SEXP_API sexp sexp_bignum_expt (sexp ctx, sexp n, sexp e); +SEXP_API sexp sexp_add (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_sub (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_mul (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_div (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_quotient (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_remainder (sexp ctx, sexp a, sexp b); #if SEXP_USE_RATIOS -sexp sexp_double_to_ratio (sexp ctx, double f); -double sexp_ratio_to_double (sexp rat); -sexp sexp_make_ratio (sexp ctx, sexp num, sexp den); -sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in); -sexp sexp_ratio_round (sexp ctx, sexp a); -sexp sexp_ratio_trunc (sexp ctx, sexp a); -sexp sexp_ratio_floor (sexp ctx, sexp a); -sexp sexp_ratio_ceiling (sexp ctx, sexp a); +SEXP_API sexp sexp_double_to_ratio (sexp ctx, double f); +SEXP_API double sexp_ratio_to_double (sexp rat); +SEXP_API sexp sexp_make_ratio (sexp ctx, sexp num, sexp den); +SEXP_API sexp sexp_ratio_normalize (sexp ctx, sexp rat, sexp in); +SEXP_API sexp sexp_ratio_round (sexp ctx, sexp a); +SEXP_API sexp sexp_ratio_trunc (sexp ctx, sexp a); +SEXP_API sexp sexp_ratio_floor (sexp ctx, sexp a); +SEXP_API sexp sexp_ratio_ceiling (sexp ctx, sexp a); #endif #if SEXP_USE_COMPLEX -sexp sexp_make_complex (sexp ctx, sexp real, sexp image); -sexp sexp_complex_normalize (sexp real); -sexp sexp_complex_math_error (sexp ctx, sexp z); -sexp sexp_complex_sqrt (sexp ctx, sexp z); -sexp sexp_complex_exp (sexp ctx, sexp z); -sexp sexp_complex_expt (sexp ctx, sexp a, sexp b); -sexp sexp_complex_log (sexp ctx, sexp z); -sexp sexp_complex_sin (sexp ctx, sexp z); -sexp sexp_complex_cos (sexp ctx, sexp z); -sexp sexp_complex_tan (sexp ctx, sexp z); -sexp sexp_complex_asin (sexp ctx, sexp z); -sexp sexp_complex_acos (sexp ctx, sexp z); -sexp sexp_complex_atan (sexp ctx, sexp z); +SEXP_API sexp sexp_make_complex (sexp ctx, sexp real, sexp image); +SEXP_API sexp sexp_complex_normalize (sexp real); +SEXP_API sexp sexp_complex_math_error (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_sqrt (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_exp (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_expt (sexp ctx, sexp a, sexp b); +SEXP_API sexp sexp_complex_log (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_sin (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_cos (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_tan (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_asin (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_acos (sexp ctx, sexp z); +SEXP_API sexp sexp_complex_atan (sexp ctx, sexp z); #endif #endif /* ! SEXP_BIGNUM_H */ diff --git a/include/chibi/eval.h b/include/chibi/eval.h index c643a1cf..e1d6dc6e 100644 --- a/include/chibi/eval.h +++ b/include/chibi/eval.h @@ -46,6 +46,8 @@ enum sexp_opcode_classes { SEXP_OPC_NUM_OP_CLASSES }; +SEXP_API struct sexp_opcode_struct* sexp_primitive_opcodes; + /**************************** prototypes ******************************/ SEXP_API void sexp_scheme_init (void); @@ -53,6 +55,22 @@ SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env, sexp_u SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda); SEXP_API sexp sexp_compile_error (sexp ctx, const char *message, sexp obj); SEXP_API sexp sexp_analyze (sexp context, sexp x); +SEXP_API sexp sexp_simplify (sexp ctx, sexp self, sexp_sint_t n, sexp ast); +SEXP_API sexp sexp_make_lambda (sexp ctx, sexp params); +SEXP_API sexp sexp_make_ref (sexp ctx, sexp name, sexp cell); +SEXP_API void sexp_generate (sexp ctx, sexp name, sexp loc, sexp lam, sexp x); +SEXP_API void sexp_emit (sexp ctx, unsigned char c); +SEXP_API void sexp_emit_return (sexp ctx); +#if SEXP_USE_NATIVE_X86 +SEXP_API void sexp_emit_enter (sexp ctx); +SEXP_API void sexp_bless_bytecode (sexp ctx, sexp bc); +#else +#define sexp_emit_enter(ctx) +#define sexp_bless_bytecode(ctx, bc) +#endif +SEXP_API sexp sexp_complete_bytecode (sexp ctx); +SEXP_API void sexp_shrink_bcode (sexp ctx, sexp_uint_t i); +SEXP_API void sexp_expand_bcode (sexp ctx, sexp_uint_t size); SEXP_API void sexp_stack_trace (sexp ctx, sexp out); SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv); SEXP_API int sexp_param_index (sexp lambda, sexp name); @@ -60,6 +78,7 @@ SEXP_API sexp sexp_compile_op (sexp context, sexp self, sexp_sint_t n, sexp obj, SEXP_API sexp sexp_eval_op (sexp context, sexp self, sexp_sint_t n, sexp obj, sexp env); SEXP_API sexp sexp_eval_string (sexp context, const char *str, sexp_sint_t len, sexp env); SEXP_API sexp sexp_load_op (sexp context, sexp self, sexp_sint_t n, sexp expr, sexp env); +SEXP_API sexp sexp_exception_type_op (sexp ctx, sexp self, sexp_sint_t n, sexp exn); SEXP_API sexp sexp_make_env_op (sexp context, sexp self, sexp_sint_t n); SEXP_API sexp sexp_make_null_env_op (sexp context, sexp self, sexp_sint_t n, sexp version); SEXP_API sexp sexp_make_primitive_env (sexp context, sexp version); @@ -69,15 +88,23 @@ SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version); SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file); SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env); +SEXP_API sexp sexp_find_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file); +SEXP_API sexp sexp_load_module_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp file, sexp env); SEXP_API sexp sexp_add_module_directory_op (sexp ctx, sexp self, sexp_sint_t n, sexp dir, sexp appendp); +SEXP_API sexp sexp_current_environment (sexp ctx, sexp self, sexp_sint_t n); SEXP_API sexp sexp_meta_environment (sexp ctx, sexp self, sexp_sint_t n); SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value); SEXP_API sexp sexp_env_import_op (sexp ctx, sexp self, sexp_sint_t n, sexp to, sexp from, sexp ls, sexp immutp); -SEXP_API sexp sexp_identifier_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); -SEXP_API sexp sexp_syntactic_closure_expr(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_env_exports_op (sexp ctx, sexp self, sexp_sint_t n, sexp env); +SEXP_API sexp sexp_identifierp_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_identifier_eq_op(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp c, sexp d); +SEXP_API sexp sexp_make_synclo_op(sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp fv, sexp expr); +SEXP_API sexp sexp_strip_synclos(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_syntactic_closure_expr_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_open_input_file_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_open_output_file_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_open_binary_input_file(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_open_binary_output_file(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_close_port_op(sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val); SEXP_API sexp sexp_env_cell (sexp env, sexp sym, int localp); @@ -88,18 +115,44 @@ SEXP_API sexp sexp_make_lit (sexp ctx, sexp value); SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1); SEXP_API sexp sexp_make_procedure_op (sexp ctx, sexp self, sexp_sint_t n, sexp flags, sexp num_args, sexp bc, sexp vars); SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, const char *name, int num_args, int flags, sexp_proc1 f, sexp data); +SEXP_API sexp sexp_register_optimization(sexp ctx, sexp self, sexp_sint_t n, sexp f, sexp i); +#if SEXP_USE_UTF8_STRINGS +SEXP_API sexp sexp_read_utf8_char (sexp ctx, sexp port, int i); +SEXP_API void sexp_string_utf8_set (sexp ctx, sexp str, sexp index, sexp ch); +SEXP_API sexp sexp_string_utf8_index_ref (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp i); +SEXP_API sexp sexp_string_utf8_index_set (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp i, sexp ch); +#endif #if SEXP_USE_GREEN_THREADS SEXP_API sexp sexp_dk (sexp ctx, sexp self, sexp_sint_t n, sexp val); SEXP_API sexp sexp_thread_parameters (sexp ctx, sexp self, sexp_sint_t n); SEXP_API sexp sexp_thread_parameters_set (sexp ctx, sexp self, sexp_sint_t n, sexp val); #endif -#if SEXP_USE_UTF8_STRINGS -SEXP_API int sexp_utf8_initial_byte_count (int c); -SEXP_API int sexp_utf8_char_byte_count (int c); -SEXP_API int sexp_string_utf8_length (unsigned char *p, int len); -SEXP_API char* sexp_string_utf8_prev (unsigned char *p); -SEXP_API sexp sexp_string_utf8_ref (sexp ctx, sexp str, sexp i); +SEXP_API sexp sexp_string_cmp_op (sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp ci); +#if SEXP_USE_RATIOS +SEXP_API sexp sexp_ratio_numerator_op (sexp ctx, sexp self, sexp_sint_t n, sexp rat); +SEXP_API sexp sexp_ratio_denominator_op (sexp ctx, sexp self, sexp_sint_t n, sexp rat); #endif +#if SEXP_USE_COMPLEX +SEXP_API sexp sexp_complex_real_op (sexp ctx, sexp self, sexp_sint_t n, sexp rat); +SEXP_API sexp sexp_complex_imag_op (sexp ctx, sexp self, sexp_sint_t n, sexp rat); +#endif + +#if SEXP_USE_MATH +SEXP_API sexp sexp_exp(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_log(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_sin(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_cos(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_tan(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_asin(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_acos(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_atan(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_sqrt(sexp ctx, sexp self, sexp_sint_t n, sexp z); +SEXP_API sexp sexp_round(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_trunc(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_floor(sexp ctx, sexp self, sexp_sint_t n, sexp x); +SEXP_API sexp sexp_ceiling(sexp ctx, sexp self, sexp_sint_t n, sexp x); +#endif +SEXP_API sexp sexp_expt_op(sexp ctx, sexp self, sexp_sint_t n, sexp z1, sexp z2); #if SEXP_USE_NATIVE_X86 SEXP_API sexp sexp_write_char_op(sexp ctx, sexp self, sexp_sint_t n, sexp ch, sexp out); @@ -128,6 +181,13 @@ SEXP_API sexp sexp_make_type_predicate_op (sexp ctx, sexp self, sexp_sint_t n, s SEXP_API sexp sexp_make_constructor_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp type); SEXP_API sexp sexp_make_getter_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp type, sexp index); SEXP_API sexp sexp_make_setter_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp type, sexp index); +SEXP_API sexp sexp_type_slot_offset_op (sexp ctx, sexp self, sexp_sint_t n, sexp type, sexp index); +#endif + +#if SEXP_USE_SIMPLIFY +SEXP_API int sexp_rest_unused_p (sexp lambda); +#else +#define sexp_rest_unused_p(lambda) 0 #endif /* simplify primitive API interface */ @@ -141,12 +201,13 @@ SEXP_API sexp sexp_make_setter_op (sexp ctx, sexp self, sexp_sint_t n, sexp name #define sexp_load(ctx, f, e) sexp_load_op(ctx, NULL, 2, f, e) #define sexp_env_import(ctx, a, b, c, d) sexp_env_import_op(ctx, NULL, 4, a, b, c, d) #define sexp_identifierp(ctx, x) sexp_identifierp_op(ctx, NULL, 1, x) -#define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx, NULL, 1, x) +#define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr_op(ctx, NULL, 1, x) #define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx, NULL, 4, a, b, c, d) #define sexp_open_input_file(ctx, x) sexp_open_input_file_op(ctx, NULL, 1, x) #define sexp_open_output_file(ctx, x) sexp_open_output_file_op(ctx, NULL, 1, x) #define sexp_close_port(ctx, x) sexp_close_port_op(ctx, NULL, 1, x) #define sexp_warn_undefs(ctx, from, to, res) sexp_warn_undefs_op(ctx, NULL, 3, from, to, res) +#define sexp_string_cmp(ctx, a, b, c) sexp_string_cmp_op(ctx, NULL, 3, a, b, c) #ifdef __cplusplus } /* extern "C" */ diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 04aef12e..82a615cd 100755 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -1256,6 +1256,21 @@ SEXP_API int sexp_buffered_flush (sexp ctx, sexp p); #define sexp_at_eofp(p) (feof(sexp_port_stream(p))) #define sexp_port_fileno(p) (sexp_port_stream(p) ? fileno(sexp_port_stream(p)) : sexp_filenop(sexp_port_fd(p)) ? sexp_fileno_fd(sexp_port_fd(p)) : -1) +#if SEXP_USE_AUTOCLOSE_PORTS +#define SEXP_FINALIZE_PORT sexp_finalize_port +#define SEXP_FINALIZE_FILENO sexp_finalize_fileno +#else +#define SEXP_FINALIZE_PORT NULL +#define SEXP_FINALIZE_FILENO NULL +#endif + +#if SEXP_USE_DL +sexp sexp_finalize_dl (sexp ctx, sexp self, sexp_sint_t n, sexp dl); +#define SEXP_FINALIZE_DL sexp_finalize_dl +#else +#define SEXP_FINALIZE_DL NULL +#endif + #if SEXP_USE_TRACK_ALLOC_SOURCE #define sexp_current_source_param , const char* source #else @@ -1290,18 +1305,26 @@ SEXP_API sexp sexp_flonump_op (sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_make_vector_op (sexp ctx, sexp self, sexp_sint_t n, sexp len, sexp dflt); SEXP_API sexp sexp_list_to_vector_op (sexp ctx, sexp self, sexp_sint_t n, sexp ls); SEXP_API sexp sexp_make_cpointer (sexp ctx, sexp_uint_t type_id, void* value, sexp parent, int freep); +SEXP_API int sexp_is_separator(int c); SEXP_API sexp sexp_write_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp out); SEXP_API sexp sexp_display_op (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp out); SEXP_API sexp sexp_flush_output_op (sexp ctx, sexp self, sexp_sint_t n, sexp out); SEXP_API sexp sexp_read_string (sexp ctx, sexp in, int sentinel); SEXP_API sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp); SEXP_API sexp sexp_read_number (sexp ctx, sexp in, int base); +#if SEXP_USE_BIGNUMS +SEXP_API sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init, + signed char sign, sexp_uint_t base); +SEXP_API sexp sexp_write_bignum (sexp ctx, sexp a, sexp out, sexp_uint_t base); +#endif +SEXP_API sexp sexp_read_float_tail(sexp ctx, sexp in, double whole, int negp); #if SEXP_USE_COMPLEX SEXP_API sexp sexp_read_complex_tail(sexp ctx, sexp in, sexp res); #endif SEXP_API sexp sexp_read_raw (sexp ctx, sexp in); SEXP_API sexp sexp_read_op (sexp ctx, sexp self, sexp_sint_t n, sexp in); SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len); +SEXP_API sexp sexp_read_error (sexp ctx, const char *msg, sexp ir, sexp port); SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj); SEXP_API sexp sexp_write_simple_object (sexp ctx, sexp self, sexp_sint_t n, sexp obj, sexp writer, sexp out); SEXP_API sexp sexp_finalize_port (sexp ctx, sexp self, sexp_sint_t n, sexp port); @@ -1340,6 +1363,11 @@ SEXP_API sexp sexp_make_foreign (sexp ctx, const char *name, int num_args, int f SEXP_API void sexp_init(void); #if SEXP_USE_UTF8_STRINGS +SEXP_API int sexp_utf8_initial_byte_count (int c); +SEXP_API int sexp_utf8_char_byte_count (int c); +SEXP_API int sexp_string_utf8_length (unsigned char *p, int len); +SEXP_API char* sexp_string_utf8_prev (unsigned char *p); +SEXP_API sexp sexp_string_utf8_ref (sexp ctx, sexp str, sexp i); SEXP_API sexp sexp_string_index_to_offset (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp index); SEXP_API sexp sexp_utf8_substring_op (sexp ctx, sexp self, sexp_sint_t n, sexp str, sexp start, sexp end); SEXP_API void sexp_utf8_encode_char (unsigned char* p, int len, int c); @@ -1366,6 +1394,14 @@ SEXP_API void sexp_maybe_unblock_port (sexp ctx, sexp in); #define SEXP_COPY_FREEP SEXP_ONE #define SEXP_COPY_LOADP SEXP_TWO +#if ! SEXP_USE_BOEHM && ! SEXP_USE_MALLOC +SEXP_API void sexp_gc_init (void); +SEXP_API sexp_heap sexp_make_heap (size_t size, size_t max_size); +SEXP_API void sexp_mark (sexp ctx, sexp x); +SEXP_API sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr); +SEXP_API sexp sexp_finalize (sexp ctx); +#endif + #if SEXP_USE_GLOBAL_HEAP #define sexp_free_heap(heap) #define sexp_destroy_context(ctx) @@ -1426,7 +1462,6 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp self, sexp_sint_t n, sexp obj #define sexp_symbol_to_string(ctx, s) sexp_symbol_to_string_op(ctx, NULL, 1, s) #define sexp_make_bytes(ctx, l, i) sexp_make_bytes_op(ctx, NULL, 2, l, i) #define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx, NULL, 2, l, c) -#define sexp_string_cmp(ctx, a, b, c) sexp_string_cmp_op(ctx, NULL, 3, a, b, c) #define sexp_substring(ctx, a, b, c) sexp_substring_op(ctx, NULL, 3, a, b, c) #define sexp_subbytes(ctx, a, b, c) sexp_subbytes_op(ctx, NULL, 3, a, b, c) #define sexp_string_concatenate(ctx, ls, s) sexp_string_concatenate_op(ctx, NULL, 2, ls, s) diff --git a/opcodes.c b/opcodes.c index e7d012c5..85236e7e 100644 --- a/opcodes.c +++ b/opcodes.c @@ -1,4 +1,6 @@ +#include "chibi/eval.h" + #define _I(n) sexp_make_fixnum(n) #define _OP(c,o,n,m,rt,a1,a2,a3,i,s,d,f) {c, o, n, m, i, (sexp)s, d, NULL, NULL, rt, a1, a2, a3, NULL, NULL, SEXP_FALSE, f} #if SEXP_USE_IMAGE_LOADING @@ -244,8 +246,11 @@ _FN0(SEXP_VOID, "print-vm-profile", 0, sexp_print_vm_profile), _OP(SEXP_OPC_GENERIC, SEXP_OP_FORCE, 1, 0, _I(SEXP_OBJECT), _I(SEXP_OBJECT), SEXP_FALSE, SEXP_FALSE, 0, "force", 0, NULL), _FN2(_I(SEXP_PROMISE), _I(SEXP_BOOLEAN), _I(SEXP_OBJECT), "promise", 0, sexp_make_promise), #endif +_OP(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), }; +struct sexp_opcode_struct* sexp_primitive_opcodes = opcodes; + #undef _I #undef _OP #undef _FN diff --git a/opt/bignum.c b/opt/bignum.c index b0bb0682..e4c08123 100644 --- a/opt/bignum.c +++ b/opt/bignum.c @@ -2,8 +2,20 @@ /* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ +#include "chibi/sexp.h" + +#if SEXP_USE_BIGNUMS + #define SEXP_INIT_BIGNUM_SIZE 2 +static int digit_value (int c) { + return (((c)<='9') ? ((c) - '0') : ((sexp_toupper(c) - 'A') + 10)); +} + +static int hex_digit (int n) { + return ((n<=9) ? ('0' + n) : ('A' + n - 10)); +} + sexp sexp_make_bignum (sexp ctx, sexp_uint_t len) { sexp_uint_t size = sexp_sizeof(bignum) + len*sizeof(sexp_uint_t); sexp res = sexp_alloc_tagged(ctx, size, SEXP_BIGNUM); @@ -236,7 +248,7 @@ sexp sexp_read_bignum (sexp ctx, sexp in, sexp_uint_t init, res = sexp_bignum_normalize(res); res = sexp_read_complex_tail(ctx, in, res); #endif - } else if ((c!=EOF) && ! is_separator(c)) { + } else if ((c!=EOF) && ! sexp_is_separator(c)) { res = sexp_read_error(ctx, "invalid numeric syntax", sexp_make_character(c), in); } else { @@ -1544,3 +1556,5 @@ sexp sexp_compare (sexp ctx, sexp a, sexp b) { sexp_gc_release1(ctx); return r; } + +#endif diff --git a/opt/simplify.c b/opt/simplify.c index 9fd88ab8..6cfd3151 100644 --- a/opt/simplify.c +++ b/opt/simplify.c @@ -1,7 +1,11 @@ /* simplify.c -- basic simplification pass */ -/* Copyright (c) 2010-2011 Alex Shinn. All rights reserved. */ +/* Copyright (c) 2010-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ +#include "chibi/eval.h" + +#if SEXP_USE_SIMPLIFY + #define simplify_it(it) ((it) = simplify(ctx, it, substs, lambda)) static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) { @@ -37,8 +41,8 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) { } if (check) { ctx2 = sexp_make_eval_context(ctx, NULL, sexp_context_env(ctx), 0, 0); - generate(ctx2, 0, 0, 0, app); - res = finalize_bytecode(ctx2); + sexp_generate(ctx2, 0, 0, 0, app); + res = sexp_complete_bytecode(ctx2); if (! sexp_exceptionp(res)) { tmp = sexp_make_vector(ctx2, 0, SEXP_VOID); tmp = sexp_make_procedure(ctx2, SEXP_ZERO, SEXP_ZERO, res, tmp); @@ -178,3 +182,5 @@ int sexp_rest_unused_p (sexp lambda) { if (sexp_nullp(var)) return 0; return !usedp(lambda, var, sexp_lambda_body(lambda)); } + +#endif diff --git a/sexp.c b/sexp.c index 2fbdd11e..a67d9a26 100644 --- a/sexp.c +++ b/sexp.c @@ -19,8 +19,6 @@ static struct sexp_huff_entry huff_table[] = { static int sexp_initialized_p = 0; -sexp sexp_read_float_tail(sexp ctx, sexp in, double whole, int negp); - static const char sexp_separators[] = { /* 1 2 3 4 5 6 7 8 9 a b c d e f */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, /* x0_ */ @@ -41,7 +39,7 @@ static int hex_digit (int n) { return ((n<=9) ? ('0' + n) : ('A' + n - 10)); } -static int is_separator(int c) { +int sexp_is_separator(int c) { return 0>4)&1)+3; } -static int sexp_utf8_char_byte_count (int c) { +int sexp_utf8_char_byte_count (int c) { if (c < 0x80) return 1; if (c < 0x800) return 2; if (c < 0x10000) return 3; return 4; } +int sexp_string_utf8_length (unsigned char *p, int len) { + unsigned char *q = p+len; + int i; + for (i=0; p>6 == 2) + ; + return (char*)p; +} + +sexp sexp_string_utf8_ref (sexp ctx, sexp str, sexp i) { + unsigned char *p=(unsigned char*)sexp_string_data(str) + sexp_unbox_fixnum(i); + if (*p < 0x80) + return sexp_make_character(*p); + else if ((*p < 0xC0) || (*p > 0xF7)) + return sexp_user_exception(ctx, NULL, "string-ref: invalid utf8 byte", i); + else if (*p < 0xE0) + return sexp_make_character(((p[0]&0x3F)<<6) + (p[1]&0x3F)); + else if (*p < 0xF0) + return sexp_make_character(((p[0]&0x1F)<<12) + ((p[1]&0x3F)<<6) + (p[2]&0x3F)); + else + return sexp_make_character(((p[0]&0x0F)<<16) + ((p[1]&0x3F)<<6) + ((p[2]&0x3F)<<6) + (p[2]&0x3F)); +} + void sexp_utf8_encode_char (unsigned char* p, int len, int c) { switch (len) { case 4: *p++ = (0xF0 + ((c)>>18)); *p++ = (0x80 + ((c>>12)&0x3F)); @@ -1176,10 +1183,6 @@ sexp sexp_make_cpointer (sexp ctx, sexp_uint_t type_id, void *value, /************************ reading and writing *************************/ -#if SEXP_USE_BIGNUMS -#include "opt/bignum.c" -#endif - #if SEXP_USE_STRING_STREAMS #define SEXP_INIT_STRING_PORT_SIZE 128 @@ -1835,7 +1838,7 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) { str = sexp_lsymbol_data(obj); c = sexp_lsymbol_length(obj) > 0 ? EOF : '|'; for (i=sexp_lsymbol_length(obj)-1; i>=0; i--) - if (str[i] <= ' ' || str[i] == '\\' || is_separator(str[i])) c = '|'; + if (str[i] <= ' ' || str[i] == '\\' || sexp_is_separator(str[i])) c = '|'; if (c!=EOF) sexp_write_char(ctx, c, out); for (i=sexp_lsymbol_length(obj); i>0; str++, i--) { if (str[0] == '\\') sexp_write_char(ctx, '\\', out); @@ -2114,7 +2117,7 @@ sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp) { if (foldp) c = sexp_tolower(c); #endif if (c == '\\') c = sexp_read_char(ctx, in); - if (c == EOF || is_separator(c)) { + if (c == EOF || sexp_is_separator(c)) { sexp_push_char(ctx, c, in); break; } @@ -2164,7 +2167,7 @@ sexp sexp_read_complex_tail (sexp ctx, sexp in, sexp real) { if (c=='i' || c=='I') { /* trailing i, no sign */ trailing_i: c = sexp_read_char(ctx, in); - if ((c!=EOF) && ! is_separator(c)) + if ((c!=EOF) && ! sexp_is_separator(c)) res = sexp_read_error(ctx, "invalid complex numeric syntax", sexp_make_character(c), in); else sexp_push_char(ctx, c, in); @@ -2235,7 +2238,7 @@ sexp sexp_read_float_tail (sexp ctx, sexp in, double whole, int negp) { res = sexp_read_complex_tail(ctx, in, res); } else #endif - if ((c!=EOF) && ! is_separator(c)) + if ((c!=EOF) && ! sexp_is_separator(c)) res = sexp_read_error(ctx, "invalid numeric syntax", sexp_make_character(c), in); else @@ -2330,7 +2333,7 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) { if (c=='e' || c=='E') { sexp_push_char(ctx, c, in); return sexp_read_float_tail(ctx, in, whole, negativep); - } else if ((c!=EOF) && !is_separator(c)) { + } else if ((c!=EOF) && !sexp_is_separator(c)) { return sexp_read_error(ctx, "invalid numeric syntax after placeholders", sexp_make_character(c), in); } @@ -2384,7 +2387,7 @@ sexp sexp_read_number (sexp ctx, sexp in, int base) { return sexp_read_complex_tail(ctx, in, sexp_make_fixnum(negativep ? -val : val)); #endif } else { - if ((c!=EOF) && ! is_separator(c)) + if ((c!=EOF) && ! sexp_is_separator(c)) return sexp_read_error(ctx, "invalid numeric syntax", sexp_make_character(c), in); else if (tmp < 0) @@ -2589,7 +2592,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) { case 'f': case 'F': case 't': case 'T': c2 = sexp_read_char(ctx, in); - if (c2 == EOF || is_separator(c2)) { + if (c2 == EOF || sexp_is_separator(c2)) { res = (sexp_tolower(c1) == 't' ? SEXP_TRUE : SEXP_FALSE); sexp_push_char(ctx, c2, in); } else { @@ -2747,7 +2750,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) { case '.': c1 = sexp_read_char(ctx, in); sexp_push_char(ctx, c1, in); - if (c1 == EOF || is_separator(c1)) { + if (c1 == EOF || sexp_is_separator(c1)) { res = SEXP_RAWDOT; } else if (sexp_isdigit(c1)) { res = sexp_read_float_tail(ctx, in, 0, 0); diff --git a/vm.c b/vm.c index 7e9906ce..e474688e 100644 --- a/vm.c +++ b/vm.c @@ -2,6 +2,13 @@ /* Copyright (c) 2009-2012 Alex Shinn. All rights reserved. */ /* BSD-style license: http://synthcode.com/license.txt */ +#if SEXP_USE_NATIVE_X86 +#include "opt/x86.c" +#else +/* ... the rest of this file ... */ + +#include "chibi/eval.h" + #if SEXP_USE_DEBUG_VM > 1 static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) { int i; @@ -62,26 +69,23 @@ static void bytecode_preserve (sexp ctx, sexp obj) { sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), obj); } -static void emit_word (sexp ctx, sexp_uint_t val) { +static void sexp_emit_word (sexp ctx, sexp_uint_t val) { unsigned char *data; - expand_bcode(ctx, sizeof(sexp)); + sexp_expand_bcode(ctx, sizeof(sexp)); data = sexp_bytecode_data(sexp_context_bc(ctx)); sexp_context_align_pos(ctx); *((sexp_uint_t*)(&(data[sexp_context_pos(ctx)]))) = val; sexp_context_pos(ctx) += sizeof(sexp); } -static void emit_push (sexp ctx, sexp obj) { - emit(ctx, SEXP_OP_PUSH); - emit_word(ctx, (sexp_uint_t)obj); +static void sexp_emit_push (sexp ctx, sexp obj) { + sexp_emit(ctx, SEXP_OP_PUSH); + sexp_emit_word(ctx, (sexp_uint_t)obj); bytecode_preserve(ctx, obj); } -static void emit_enter (sexp ctx) {return;} -static void bless_bytecode (sexp ctx, sexp bc) {return;} - -static void emit_return (sexp ctx) { - emit(ctx, SEXP_OP_RET); +void sexp_emit_return (sexp ctx) { + sexp_emit(ctx, SEXP_OP_RET); } static sexp_sint_t sexp_context_make_label (sexp ctx) { @@ -99,7 +103,7 @@ static void sexp_context_patch_label (sexp ctx, sexp_sint_t label) { } static void generate_lit (sexp ctx, sexp value) { - emit_push(ctx, value); + sexp_emit_push(ctx, value); } static void generate_drop_prev (sexp ctx, sexp prev) { @@ -110,7 +114,7 @@ static void generate_drop_prev (sexp ctx, sexp prev) { || sexp_setp(prev) || sexp_litp(prev) || prev == SEXP_VOID) sexp_context_pos(ctx) -= 1 + sizeof(sexp); else - emit(ctx, SEXP_OP_DROP); + sexp_emit(ctx, SEXP_OP_DROP); } static void generate_seq (sexp ctx, sexp name, sexp loc, sexp lam, sexp app) { @@ -119,29 +123,29 @@ static void generate_seq (sexp ctx, sexp name, sexp loc, sexp lam, sexp app) { sexp_context_tailp(ctx) = 0; for ( ; sexp_pairp(tail); head=tail, tail=sexp_cdr(tail)) if (sexp_pointerp(sexp_car(head)) && (! sexp_litp(sexp_car(head)))) { - generate(ctx, name, loc, lam, sexp_car(head)); + sexp_generate(ctx, name, loc, lam, sexp_car(head)); generate_drop_prev(ctx, sexp_car(head)); sexp_context_depth(ctx)--; } sexp_context_tailp(ctx) = tailp; - generate(ctx, name, loc, lam, sexp_car(head)); + sexp_generate(ctx, name, loc, lam, sexp_car(head)); } static void generate_cnd (sexp ctx, sexp name, sexp loc, sexp lam, sexp cnd) { sexp_sint_t label1, label2, tailp=sexp_context_tailp(ctx); sexp_context_tailp(ctx) = 0; - generate(ctx, name, loc, lam, sexp_cnd_test(cnd)); + sexp_generate(ctx, name, loc, lam, sexp_cnd_test(cnd)); sexp_context_tailp(ctx) = tailp; - emit(ctx, SEXP_OP_JUMP_UNLESS); + sexp_emit(ctx, SEXP_OP_JUMP_UNLESS); sexp_context_depth(ctx)--; label1 = sexp_context_make_label(ctx); - generate(ctx, name, loc, lam, sexp_cnd_pass(cnd)); + sexp_generate(ctx, name, loc, lam, sexp_cnd_pass(cnd)); sexp_context_tailp(ctx) = tailp; - emit(ctx, SEXP_OP_JUMP); + sexp_emit(ctx, SEXP_OP_JUMP); sexp_context_depth(ctx)--; label2 = sexp_context_make_label(ctx); sexp_context_patch_label(ctx, label1); - generate(ctx, name, loc, lam, sexp_cnd_fail(cnd)); + sexp_generate(ctx, name, loc, lam, sexp_cnd_fail(cnd)); sexp_context_patch_label(ctx, label2); } @@ -151,19 +155,19 @@ static void generate_non_global_ref (sexp ctx, sexp name, sexp cell, sexp loc = sexp_cdr(cell); if (loc == lambda && sexp_lambdap(lambda)) { /* local ref */ - emit(ctx, SEXP_OP_LOCAL_REF); - emit_word(ctx, sexp_param_index(lambda, name)); + sexp_emit(ctx, SEXP_OP_LOCAL_REF); + sexp_emit_word(ctx, sexp_param_index(lambda, name)); } else { /* closure ref */ for (i=0; sexp_pairp(fv); fv=sexp_cdr(fv), i++) if ((name == sexp_ref_name(sexp_car(fv))) && (loc == sexp_ref_loc(sexp_car(fv)))) break; - emit(ctx, SEXP_OP_CLOSURE_REF); - emit_word(ctx, i); + sexp_emit(ctx, SEXP_OP_CLOSURE_REF); + sexp_emit_word(ctx, i); } if (unboxp && (sexp_truep(sexp_memq(ctx, name, sexp_lambda_sv(loc))))) - emit(ctx, SEXP_OP_CDR); + sexp_emit(ctx, SEXP_OP_CDR); sexp_context_depth(ctx)++; } @@ -172,12 +176,12 @@ static void generate_ref (sexp ctx, sexp ref, int unboxp) { if (! sexp_lambdap(sexp_ref_loc(ref))) { /* global ref */ if (unboxp) { - emit(ctx, (sexp_cdr(sexp_ref_cell(ref)) == SEXP_UNDEF) - ? SEXP_OP_GLOBAL_REF : SEXP_OP_GLOBAL_KNOWN_REF); - emit_word(ctx, (sexp_uint_t)sexp_ref_cell(ref)); + sexp_emit(ctx, (sexp_cdr(sexp_ref_cell(ref)) == SEXP_UNDEF) + ? SEXP_OP_GLOBAL_REF : SEXP_OP_GLOBAL_KNOWN_REF); + sexp_emit_word(ctx, (sexp_uint_t)sexp_ref_cell(ref)); bytecode_preserve(ctx, sexp_ref_cell(ref)); } else - emit_push(ctx, sexp_ref_cell(ref)); + sexp_emit_push(ctx, sexp_ref_cell(ref)); } else { lam = sexp_context_lambda(ctx); generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref), @@ -191,32 +195,32 @@ static void generate_set (sexp ctx, sexp set) { sexp_context_tailp(ctx) = 0; if (sexp_lambdap(sexp_set_value(set))) { sexp_lambda_name(sexp_set_value(set)) = sexp_ref_name(ref); - generate(ctx, sexp_ref_name(ref), sexp_ref_loc(ref), sexp_set_value(set), sexp_set_value(set)); + sexp_generate(ctx, sexp_ref_name(ref), sexp_ref_loc(ref), sexp_set_value(set), sexp_set_value(set)); } else { - generate(ctx, 0, 0, 0, sexp_set_value(set)); + sexp_generate(ctx, 0, 0, 0, sexp_set_value(set)); } if (! sexp_lambdap(sexp_ref_loc(ref))) { /* global vars are set directly */ if (sexp_cdr(sexp_ref_cell(ref)) == SEXP_UNDEF) { /* force an undefined variable error if still undef at runtime */ generate_ref(ctx, ref, 1); - emit(ctx, SEXP_OP_DROP); + sexp_emit(ctx, SEXP_OP_DROP); } - emit_push(ctx, sexp_ref_cell(ref)); - emit(ctx, SEXP_OP_SET_CDR); + sexp_emit_push(ctx, sexp_ref_cell(ref)); + sexp_emit(ctx, SEXP_OP_SET_CDR); } else { lambda = sexp_ref_loc(ref); if (sexp_truep(sexp_memq(ctx, sexp_ref_name(ref), sexp_lambda_sv(lambda)))) { /* stack or closure mutable vars are boxed */ generate_ref(ctx, ref, 0); - emit(ctx, SEXP_OP_SET_CDR); + sexp_emit(ctx, SEXP_OP_SET_CDR); } else { /* internally defined variable */ - emit(ctx, SEXP_OP_LOCAL_SET); - emit_word(ctx, sexp_param_index(lambda, sexp_ref_name(ref))); + sexp_emit(ctx, SEXP_OP_LOCAL_SET); + sexp_emit_word(ctx, sexp_param_index(lambda, sexp_ref_name(ref))); } } - emit_push(ctx, SEXP_VOID); + sexp_emit_push(ctx, SEXP_VOID); sexp_context_depth(ctx)--; } @@ -239,15 +243,15 @@ static void generate_opcode_app (sexp ctx, sexp app) { } else { if (sexp_opcode_opt_param_p(op) && sexp_opcodep(sexp_opcode_data(op))) { #if SEXP_USE_GREEN_THREADS - emit(ctx, SEXP_OP_PARAMETER_REF); - emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op)); + sexp_emit(ctx, SEXP_OP_PARAMETER_REF); + sexp_emit_word(ctx, (sexp_uint_t)sexp_opcode_data(op)); bytecode_preserve(ctx, sexp_opcode_data(op)); #else - emit_push(ctx, sexp_opcode_data(sexp_opcode_data(op))); + sexp_emit_push(ctx, sexp_opcode_data(sexp_opcode_data(op))); #endif - emit(ctx, SEXP_OP_CDR); + sexp_emit(ctx, SEXP_OP_CDR); } else { - emit_push(ctx, sexp_opcode_data(op)); + sexp_emit_push(ctx, sexp_opcode_data(op)); } sexp_context_depth(ctx)++; num_args++; @@ -260,11 +264,11 @@ static void generate_opcode_app (sexp ctx, sexp app) { && (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC)) ? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app))); for ( ; sexp_pairp(ls); ls = sexp_cdr(ls)) { - generate(ctx, 0, 0, 0, sexp_car(ls)); + sexp_generate(ctx, 0, 0, 0, sexp_car(ls)); #if SEXP_USE_AUTO_FORCE if ((sexp_opcode_class(op) != SEXP_OPC_CONSTRUCTOR) || sexp_opcode_code(op) == SEXP_OP_MAKE_VECTOR) - emit(ctx, SEXP_OP_FORCE); + sexp_emit(ctx, SEXP_OP_FORCE); #endif } } @@ -273,8 +277,8 @@ static void generate_opcode_app (sexp ctx, sexp app) { /* push the default for inverse opcodes */ if (inv_default) { - emit_push(ctx, sexp_opcode_data(op)); - if (sexp_opcode_opt_param_p(op)) emit(ctx, SEXP_OP_CDR); + sexp_emit_push(ctx, sexp_opcode_data(op)); + if (sexp_opcode_opt_param_p(op)) sexp_emit(ctx, SEXP_OP_CDR); sexp_context_depth(ctx)++; num_args++; } @@ -284,44 +288,44 @@ static void generate_opcode_app (sexp ctx, sexp app) { case SEXP_OPC_ARITHMETIC: /* fold variadic arithmetic operators */ for (i=num_args-1; i>0; i--) - emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, sexp_opcode_code(op)); break; case SEXP_OPC_ARITHMETIC_CMP: if (num_args > 2) { - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 2); - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 2); - emit(ctx, sexp_opcode_code(op)); - emit(ctx, SEXP_OP_AND); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 2); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 2); + sexp_emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, SEXP_OP_AND); for (i=num_args-2; i>0; i--) { - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 3); - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 3); - emit(ctx, sexp_opcode_code(op)); - emit(ctx, SEXP_OP_AND); - emit(ctx, SEXP_OP_AND); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 3); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 3); + sexp_emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, SEXP_OP_AND); + sexp_emit(ctx, SEXP_OP_AND); } } else - emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, sexp_opcode_code(op)); break; case SEXP_OPC_FOREIGN: - emit(ctx, sexp_opcode_code(op)); - emit_word(ctx, (sexp_uint_t)op); + sexp_emit(ctx, sexp_opcode_code(op)); + sexp_emit_word(ctx, (sexp_uint_t)op); bytecode_preserve(ctx, op); break; case SEXP_OPC_TYPE_PREDICATE: case SEXP_OPC_GETTER: case SEXP_OPC_SETTER: case SEXP_OPC_CONSTRUCTOR: - emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, sexp_opcode_code(op)); if ((sexp_opcode_class(op) != SEXP_OPC_CONSTRUCTOR) || sexp_opcode_code(op) == SEXP_OP_MAKE) { if (sexp_opcode_data(op)) - emit_word(ctx, sexp_unbox_fixnum(sexp_opcode_data(op))); + sexp_emit_word(ctx, sexp_unbox_fixnum(sexp_opcode_data(op))); if (sexp_opcode_data2(op)) - emit_word(ctx, sexp_unbox_fixnum(sexp_opcode_data2(op))); + sexp_emit_word(ctx, sexp_unbox_fixnum(sexp_opcode_data2(op))); if (sexp_opcode_data(op) || sexp_opcode_data2(op)) bytecode_preserve(ctx, op); } @@ -331,34 +335,34 @@ static void generate_opcode_app (sexp ctx, sexp app) { if (num_args > 0) { if (sexp_opcode_data2(op) && sexp_applicablep(sexp_opcode_data2(op))) { ls = sexp_list2(ctx, sexp_opcode_data2(op), sexp_cadr(app)); - generate(ctx, 0, 0, 0, ls); + sexp_generate(ctx, 0, 0, 0, ls); } else { - generate(ctx, 0, 0, 0, sexp_cadr(app)); + sexp_generate(ctx, 0, 0, 0, sexp_cadr(app)); } } - emit(ctx, SEXP_OP_PARAMETER_REF); - emit_word(ctx, (sexp_uint_t)op); + sexp_emit(ctx, SEXP_OP_PARAMETER_REF); + sexp_emit_word(ctx, (sexp_uint_t)op); bytecode_preserve(ctx, op); #else - if (num_args > 0) generate(ctx, 0, 0, 0, sexp_cadr(app)); - emit_push(ctx, sexp_opcode_data(op)); + if (num_args > 0) sexp_generate(ctx, 0, 0, 0, sexp_cadr(app)); + sexp_emit_push(ctx, sexp_opcode_data(op)); #endif - emit(ctx, ((num_args == 0) ? SEXP_OP_CDR : SEXP_OP_SET_CDR)); - if (num_args > 0) emit_push(ctx, SEXP_VOID); + sexp_emit(ctx, ((num_args == 0) ? SEXP_OP_CDR : SEXP_OP_SET_CDR)); + if (num_args > 0) sexp_emit_push(ctx, SEXP_VOID); break; default: - emit(ctx, sexp_opcode_code(op)); + sexp_emit(ctx, sexp_opcode_code(op)); } if (sexp_opcode_static_param_p(op)) for (ls=sexp_cdr(app); sexp_pairp(ls); ls=sexp_cdr(ls)) - emit_word(ctx, sexp_unbox_fixnum(sexp_litp(sexp_car(ls)) ? - sexp_lit_value(sexp_car(ls)) : - sexp_car(ls))); + sexp_emit_word(ctx, sexp_unbox_fixnum(sexp_litp(sexp_car(ls)) ? + sexp_lit_value(sexp_car(ls)) : + sexp_car(ls))); if (sexp_opcode_return_type(op) == SEXP_VOID && sexp_opcode_class(op) != SEXP_OPC_FOREIGN) - emit_push(ctx, SEXP_VOID); + sexp_emit_push(ctx, SEXP_VOID); sexp_context_depth(ctx) -= (num_args-1); sexp_gc_release1(ctx); @@ -373,14 +377,14 @@ static void generate_general_app (sexp ctx, sexp app) { /* push the arguments onto the stack */ sexp_context_tailp(ctx) = 0; for (ls=sexp_reverse(ctx, sexp_cdr(app)); sexp_pairp(ls); ls=sexp_cdr(ls)) - generate(ctx, 0, 0, 0, sexp_car(ls)); + sexp_generate(ctx, 0, 0, 0, sexp_car(ls)); /* push the operator onto the stack */ - generate(ctx, 0, 0, 0, sexp_car(app)); + sexp_generate(ctx, 0, 0, 0, sexp_car(app)); /* maybe overwrite the current frame */ - emit(ctx, (tailp ? SEXP_OP_TAIL_CALL : SEXP_OP_CALL)); - emit_word(ctx, (sexp_uint_t)sexp_make_fixnum(len)); + sexp_emit(ctx, (tailp ? SEXP_OP_TAIL_CALL : SEXP_OP_CALL)); + sexp_emit_word(ctx, (sexp_uint_t)sexp_make_fixnum(len)); sexp_context_tailp(ctx) = tailp; sexp_context_depth(ctx) -= len; @@ -400,20 +404,20 @@ static void generate_tail_jump (sexp ctx, sexp name, sexp loc, sexp lam, sexp ap && sexp_ref_name(sexp_car(ls1)) == sexp_car(ls2) && sexp_ref_loc(sexp_car(ls1)) == lam && sexp_not(sexp_memq(ctx, sexp_car(ls2), sexp_lambda_sv(lam))))) { - generate(ctx, 0, 0, 0, sexp_car(ls1)); + sexp_generate(ctx, 0, 0, 0, sexp_car(ls1)); ls3 = sexp_cons(ctx, sexp_car(ls2), ls3); } } for (ls1=ls3; sexp_pairp(ls1); ls1=sexp_cdr(ls1)) { - emit(ctx, SEXP_OP_LOCAL_SET); - emit_word(ctx, sexp_param_index(lam, sexp_car(ls1))); + sexp_emit(ctx, SEXP_OP_LOCAL_SET); + sexp_emit_word(ctx, sexp_param_index(lam, sexp_car(ls1))); } /* drop the current result and jump */ - emit(ctx, SEXP_OP_JUMP); - emit_word(ctx, (sexp_uint_t) (-sexp_context_pos(ctx) + - (sexp_pairp(sexp_lambda_locals(lam)) - ? 1 + sizeof(sexp) : 0))); + sexp_emit(ctx, SEXP_OP_JUMP); + sexp_emit_word(ctx, (sexp_uint_t) (-sexp_context_pos(ctx) + + (sexp_pairp(sexp_lambda_locals(lam)) + ? 1 + sizeof(sexp) : 0))); sexp_context_tailp(ctx) = 1; sexp_gc_release3(ctx); @@ -457,7 +461,7 @@ static int generate_lambda_locals (sexp ctx, sexp name, sexp loc, sexp lam, sexp return 0; return 1; } else if (sexp_setp(x) && sexp_internal_definep(ctx, sexp_set_var(x))) { - generate(ctx, name, loc, lam, x); + sexp_generate(ctx, name, loc, lam, x); sexp_context_pos(ctx) -= 1 + sizeof(sexp); return 1; } @@ -477,11 +481,11 @@ static int generate_lambda_body (sexp ctx, sexp name, sexp loc, sexp lam, sexp x generate_drop_prev(ctx, sexp_car(ls)); for (ls=sexp_cdr(ls); sexp_pairp(ls) && sexp_pairp(sexp_cdr(ls)); ls=sexp_cdr(ls)) { - generate(ctx, name, loc, lam, sexp_car(ls)); + sexp_generate(ctx, name, loc, lam, sexp_car(ls)); generate_drop_prev(ctx, sexp_car(ls)); } sexp_context_tailp(ctx) = tailp; - generate(ctx, name, loc, lam, sexp_car(ls)); + sexp_generate(ctx, name, loc, lam, sexp_car(ls)); } return 0; } @@ -501,22 +505,22 @@ static int generate_lambda_body (sexp ctx, sexp name, sexp loc, sexp lam, sexp x generate_non_global_ref(ctx, sexp_ref_name(sexp_set_var(x)), sexp_ref_cell(sexp_set_var(x)), lam, sexp_lambda_fv(lam), 1); - emit(ctx, SEXP_OP_CLOSURE_VARS); + sexp_emit(ctx, SEXP_OP_CLOSURE_VARS); } generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref), lam, sexp_lambda_fv(lam), 1); - emit_push(ctx, sexp_make_fixnum(k)); - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 3); - emit(ctx, SEXP_OP_VECTOR_SET); + sexp_emit_push(ctx, sexp_make_fixnum(k)); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 3); + sexp_emit(ctx, SEXP_OP_VECTOR_SET); sexp_context_depth(ctx)--; } } } - if (updatep) emit(ctx, SEXP_OP_DROP); + if (updatep) sexp_emit(ctx, SEXP_OP_DROP); return 1; } - generate(ctx, name, loc, lam, x); + sexp_generate(ctx, name, loc, lam, x); return 0; } #endif @@ -535,21 +539,21 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd k = sexp_unbox_fixnum(sexp_length(ctx, sexp_lambda_locals(lambda))); if (k > 0) { #if SEXP_USE_RESERVE_OPCODE - emit(ctx2, SEXP_OP_RESERVE); - emit_word(ctx2, k); + sexp_emit(ctx2, SEXP_OP_RESERVE); + sexp_emit_word(ctx2, k); #else - while (k--) emit_push(ctx2, SEXP_UNDEF); + while (k--) sexp_emit_push(ctx2, SEXP_UNDEF); #endif } /* box mutable vars */ for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) { k = sexp_param_index(lambda, sexp_car(ls)); - emit(ctx2, SEXP_OP_LOCAL_REF); - emit_word(ctx2, k); - emit_push(ctx2, sexp_car(ls)); - emit(ctx2, SEXP_OP_CONS); - emit(ctx2, SEXP_OP_LOCAL_SET); - emit_word(ctx2, k); + sexp_emit(ctx2, SEXP_OP_LOCAL_REF); + sexp_emit_word(ctx2, k); + sexp_emit_push(ctx2, sexp_car(ls)); + sexp_emit(ctx2, SEXP_OP_CONS); + sexp_emit(ctx2, SEXP_OP_LOCAL_SET); + sexp_emit_word(ctx2, k); } if (lam != lambda) loc = 0; #if SEXP_USE_UNBOXED_LOCALS @@ -559,14 +563,14 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd generate_lambda_body(ctx2, name, loc, lambda, sexp_lambda_body(lambda), prev_lambda); #else sexp_context_tailp(ctx2) = 1; - generate(ctx2, name, loc, lam, sexp_lambda_body(lambda)); + sexp_generate(ctx2, name, loc, lam, sexp_lambda_body(lambda)); #endif flags = sexp_make_fixnum(sexp_not(sexp_listp(ctx, sexp_lambda_params(lambda))) ? (SEXP_PROC_VARIADIC + (sexp_rest_unused_p(lambda) ? SEXP_PROC_UNUSED_REST: 0)) : SEXP_PROC_NONE); len = sexp_length(ctx2, sexp_lambda_params(lambda)); - bc = finalize_bytecode(ctx2); + bc = sexp_complete_bytecode(ctx2); sexp_bytecode_name(bc) = sexp_lambda_name(lambda); sexp_bytecode_source(bc) = sexp_lambda_source(lambda); if (sexp_nullp(fv)) { @@ -577,31 +581,31 @@ static void generate_lambda (sexp ctx, sexp name, sexp loc, sexp lam, sexp lambd generate_lit(ctx, tmp); } else { /* push the closed vars */ - emit_push(ctx, SEXP_VOID); - emit_push(ctx, sexp_length(ctx, fv)); - emit(ctx, SEXP_OP_MAKE_VECTOR); + sexp_emit_push(ctx, SEXP_VOID); + sexp_emit_push(ctx, sexp_length(ctx, fv)); + sexp_emit(ctx, SEXP_OP_MAKE_VECTOR); sexp_context_depth(ctx)--; for (k=0; sexp_pairp(fv); fv=sexp_cdr(fv), k++) { ref = sexp_car(fv); generate_non_global_ref(ctx, sexp_ref_name(ref), sexp_ref_cell(ref), prev_lambda, prev_fv, 0); - emit_push(ctx, sexp_make_fixnum(k)); - emit(ctx, SEXP_OP_STACK_REF); - emit_word(ctx, 3); - emit(ctx, SEXP_OP_VECTOR_SET); + sexp_emit_push(ctx, sexp_make_fixnum(k)); + sexp_emit(ctx, SEXP_OP_STACK_REF); + sexp_emit_word(ctx, 3); + sexp_emit(ctx, SEXP_OP_VECTOR_SET); sexp_context_depth(ctx)--; } /* push the additional procedure info and make the closure */ - emit(ctx, SEXP_OP_MAKE_PROCEDURE); - emit_word(ctx, (sexp_uint_t)flags); - emit_word(ctx, (sexp_uint_t)len); - emit_word(ctx, (sexp_uint_t)bc); + sexp_emit(ctx, SEXP_OP_MAKE_PROCEDURE); + sexp_emit_word(ctx, (sexp_uint_t)flags); + sexp_emit_word(ctx, (sexp_uint_t)len); + sexp_emit_word(ctx, (sexp_uint_t)bc); bytecode_preserve(ctx, bc); } sexp_gc_release2(ctx); } -static void generate (sexp ctx, sexp name, sexp loc, sexp lam, sexp x) { +void sexp_generate (sexp ctx, sexp name, sexp loc, sexp lam, sexp x) { if (sexp_pointerp(x)) { switch (sexp_pointer_tag(x)) { case SEXP_PAIR: generate_app(ctx, name, loc, lam, x); break; @@ -651,7 +655,7 @@ static sexp make_opcode_procedure (sexp ctx, sexp op, sexp_uint_t i) { refs = sexp_reverse(ctx2, refs); refs = sexp_cons(ctx2, op, refs); generate_opcode_app(ctx2, refs); - bc = finalize_bytecode(ctx2); + bc = sexp_complete_bytecode(ctx2); sexp_bytecode_name(bc) = sexp_opcode_name(op); res=sexp_make_procedure(ctx2, SEXP_ZERO, sexp_make_fixnum(i), bc, SEXP_VOID); if (i == sexp_opcode_num_args(op)) @@ -1973,3 +1977,5 @@ sexp sexp_apply1 (sexp ctx, sexp f, sexp x) { } return res; } + +#endif