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