diff --git a/Makefile b/Makefile index 489beabb..0b6575ff 100644 --- a/Makefile +++ b/Makefile @@ -138,6 +138,9 @@ test-basic: chibi-scheme$(EXE) fi; \ done +test-build: + ./tests/build/build-tests.sh + test-numbers: all LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/numeric-tests.scm diff --git a/eval.c b/eval.c index e5cf340c..0eab33aa 100644 --- a/eval.c +++ b/eval.c @@ -22,8 +22,11 @@ static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) static sexp analyze (sexp ctx, sexp x); static void generate (sexp ctx, sexp x); + +#if SEXP_USE_MODULES static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env); static sexp sexp_find_module_file_op (sexp ctx, sexp file); +#endif static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) { sexp exn; @@ -2179,7 +2182,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { if ((x == SEXP_ZERO) || (x == SEXP_NEG_ONE)) res = sexp_make_flonum(ctx, pow(0, 0)); /* +nan.0 */ else if (x == SEXP_ONE) - res = sexp_make_flonum(ctx, 1); /* 1.0 */ + res = SEXP_ONE; /* 1.0 */ else if (sexp_flonump(x)) res = sexp_make_flonum(ctx, pow(sexp_flonum_value(x), sexp_bignum_to_double(e))); else @@ -2195,7 +2198,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { x1 = sexp_flonum_value(x); #endif else - return sexp_type_exception(ctx, "not a number", x); + return sexp_type_exception(ctx, "expt: not a number", x); if (sexp_fixnump(e)) e1 = sexp_unbox_fixnum(e); #if SEXP_USE_FLONUMS @@ -2203,11 +2206,13 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { e1 = sexp_flonum_value(e); #endif else - return sexp_type_exception(ctx, "not a number", e); + return sexp_type_exception(ctx, "expt: not a number", e); f = pow(x1, e1); + if ((f > SEXP_MAX_FIXNUM) || (f < SEXP_MIN_FIXNUM) #if SEXP_USE_FLONUMS - if ((f > SEXP_MAX_FIXNUM) || (! sexp_fixnump(x)) || (! sexp_fixnump(e))) { + || (! sexp_fixnump(x)) || (! sexp_fixnump(e)) #endif + ) { #if SEXP_USE_BIGNUMS if (sexp_fixnump(x) && sexp_fixnump(e)) res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e); @@ -2215,8 +2220,10 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { #endif #if SEXP_USE_FLONUMS res = sexp_make_flonum(ctx, f); - } else +#else + res = sexp_make_fixnum((sexp_sint_t)round(f)); #endif + } else res = sexp_make_fixnum((sexp_sint_t)round(f)); #if SEXP_USE_BIGNUMS } @@ -2472,13 +2479,6 @@ sexp sexp_find_module_file (sexp ctx, char *file) { return res; } -static sexp sexp_find_module_file_op (sexp ctx, sexp file) { - if (! sexp_stringp(file)) - return sexp_type_exception(ctx, "not a string", file); - else - return sexp_find_module_file(ctx, sexp_string_data(file)); -} - #define sexp_file_not_found "couldn't find file in module path" sexp sexp_load_module_file (sexp ctx, char *file, sexp env) { @@ -2496,6 +2496,13 @@ sexp sexp_load_module_file (sexp ctx, char *file, sexp env) { return res; } +#if SEXP_USE_MODULES +static sexp sexp_find_module_file_op (sexp ctx, sexp file) { + if (! sexp_stringp(file)) + return sexp_type_exception(ctx, "not a string", file); + else + return sexp_find_module_file(ctx, sexp_string_data(file)); +} sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) { if (! sexp_stringp(file)) return sexp_type_exception(ctx, "not a string", file); @@ -2503,6 +2510,7 @@ sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) { return sexp_type_exception(ctx, "not an environment", env); return sexp_load_module_file(ctx, sexp_string_data(file), env); } +#endif sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp) { sexp ls; diff --git a/gc.c b/gc.c index 79ff4b87..7a5b409c 100644 --- a/gc.c +++ b/gc.c @@ -32,7 +32,7 @@ #endif #if SEXP_USE_GLOBAL_HEAP -static sexp_heap sexp_global_heap; +sexp_heap sexp_global_heap; #endif #if SEXP_USE_DEBUG_GC diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index a73f3e98..918debbe 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -622,6 +622,9 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x); #define sexp_global(ctx,x) (sexp_vector_data(sexp_context_globals(ctx))[x]) #if SEXP_USE_GLOBAL_HEAP +#if ! SEXP_USE_BOEHM +SEXP_API sexp_heap sexp_global_heap; +#endif #define sexp_context_heap(ctx) sexp_global_heap #else #define sexp_context_heap(ctx) ((ctx)->value.context.heap) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index b21604eb..dd85692c 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -44,8 +44,6 @@ static sexp sexp_get_opcode_name (sexp ctx, sexp op) { } sexp sexp_init_library (sexp ctx, sexp env) { - sexp_gc_var2(name, op); - sexp_gc_preserve2(ctx, name, op); sexp_define_type_predicate(ctx, env, "syntactic-closure?", SEXP_SYNCLO); sexp_define_type_predicate(ctx, env, "lambda?", SEXP_LAMBDA); sexp_define_type_predicate(ctx, env, "cnd?", SEXP_CND); @@ -74,7 +72,6 @@ sexp sexp_init_library (sexp ctx, sexp env) { sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env); sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell); sexp_define_foreign(ctx, env, "opcode-name", 1, sexp_get_opcode_name); - sexp_gc_release2(ctx); return SEXP_VOID; } diff --git a/lib/chibi/heap-stats.c b/lib/chibi/heap-stats.c index fcea809b..583277a7 100644 --- a/lib/chibi/heap-stats.c +++ b/lib/chibi/heap-stats.c @@ -12,6 +12,9 @@ extern sexp sexp_gc (sexp ctx, size_t *sum_freed); extern sexp_uint_t sexp_allocated_bytes (sexp ctx, sexp x); +#if SEXP_USE_GLOBAL_HEAP +#endif + static void sexp_print_simple (sexp ctx, sexp x, sexp out, int depth) { int i; if ((!sexp_pointerp(x)) || sexp_symbolp(x) || sexp_stringp(x) diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c index d89227cc..bff675c1 100644 --- a/lib/srfi/27/rand.c +++ b/lib/srfi/27/rand.c @@ -36,7 +36,10 @@ static sexp default_random_source; static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) { sexp res; - int32_t n, hi, mod, len, i, *data; + int32_t n; +#if SEXP_USE_BIGNUMS + int32_t hi, mod, len, i, *data; +#endif if (! sexp_random_source_p(rs)) res = sexp_type_exception(ctx, "not a random-source", rs); if (sexp_fixnump(bound)) { diff --git a/lib/srfi/33/bit.c b/lib/srfi/33/bit.c index 396dbc6f..63cdc163 100644 --- a/lib/srfi/33/bit.c +++ b/lib/srfi/33/bit.c @@ -4,11 +4,15 @@ #if SEXP_USE_BIGNUMS #include +#else +#define sexp_bignum_normalize(x) x #endif static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) { sexp res; +#if SEXP_USE_BIGNUMS sexp_sint_t len, i; +#endif if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y); @@ -42,7 +46,9 @@ static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) { static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) { sexp res; +#if SEXP_USE_BIGNUMS sexp_sint_t len, i; +#endif if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y); @@ -80,7 +86,9 @@ static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) { static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) { sexp res; +#if SEXP_USE_BIGNUMS sexp_sint_t len, i; +#endif if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y)); @@ -119,9 +127,14 @@ static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) { /* should probably split into left and right shifts, that's a better */ /* interface anyway */ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) { - sexp_gc_var1(res); - sexp_sint_t c, len, offset, bit_shift, j; sexp_uint_t tmp; + sexp_sint_t c; +#if SEXP_USE_BIGNUMS + sexp_sint_t len, offset, bit_shift, j; + sexp_gc_var1(res); +#else + sexp res; +#endif if (! sexp_fixnump(count)) return sexp_type_exception(ctx, "arithmetic-shift: not an integer", count); c = sexp_unbox_fixnum(count); @@ -194,7 +207,10 @@ static sexp_uint_t bit_count (sexp_uint_t i) { static sexp sexp_bit_count (sexp ctx, sexp x) { sexp res; - sexp_sint_t count, i; + sexp_sint_t i; +#if SEXP_USE_BIGNUMS + sexp_uint_t count; +#endif if (sexp_fixnump(x)) { i = sexp_unbox_fixnum(x); res = sexp_make_fixnum(bit_count(i<0 ? ~i : i)); @@ -229,7 +245,10 @@ static sexp_uint_t integer_log2 (sexp_uint_t x) { } static sexp sexp_integer_length (sexp ctx, sexp x) { - sexp_sint_t hi, tmp; + sexp_sint_t tmp; +#if SEXP_USE_BIGNUMS + sexp_sint_t hi; +#endif if (sexp_fixnump(x)) { tmp = sexp_unbox_fixnum(x); return sexp_make_fixnum(integer_log2(tmp < 0 ? -tmp-1 : tmp)); @@ -245,7 +264,9 @@ static sexp sexp_integer_length (sexp ctx, sexp x) { } static sexp sexp_bit_set_p (sexp ctx, sexp i, sexp x) { +#if SEXP_USE_BIGNUMS sexp_uint_t pos; +#endif if (! sexp_fixnump(i)) return sexp_type_exception(ctx, "bit-set?: not an integer", i); if (sexp_fixnump(x)) { diff --git a/opcodes.c b/opcodes.c index c6f5445d..d3c77865 100644 --- a/opcodes.c +++ b/opcodes.c @@ -131,8 +131,8 @@ _FN1(0, "round", 0, sexp_round), _FN1(0, "truncate", 0, sexp_trunc), _FN1(0, "floor", 0, sexp_floor), _FN1(0, "ceiling", 0, sexp_ceiling), -_FN2(0, 0, "expt", 0, sexp_expt), #endif +_FN2(0, 0, "expt", 0, sexp_expt), #if SEXP_USE_TYPE_DEFS _FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type), _FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate), diff --git a/sexp.c b/sexp.c index b12900b3..bcdb619f 100644 --- a/sexp.c +++ b/sexp.c @@ -678,9 +678,13 @@ static sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) { #endif sexp sexp_intern(sexp ctx, char *str) { +#if SEXP_USE_HUFF_SYMS struct sexp_huff_entry he; - sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket; - char c, *p=str; + sexp_uint_t space=3, newbits; + char c; +#endif + sexp_uint_t len, res=FNV_OFFSET_BASIS, bucket; + char *p=str; sexp ls; sexp_gc_var1(sym); @@ -696,9 +700,9 @@ sexp sexp_intern(sexp ctx, char *str) { space += newbits; } return (sexp) (res + SEXP_ISYMBOL_TAG); -#endif normal_intern: +#endif #if SEXP_USE_HASH_SYMS bucket = (sexp_string_hash(p, res) % SEXP_SYMBOL_TABLE_SIZE); #else @@ -1013,7 +1017,10 @@ sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) { } sexp sexp_write (sexp ctx, sexp obj, sexp out) { - unsigned long len, c, res; +#if SEXP_USE_HUFF_SYMS + unsigned long res, c; +#endif + unsigned long len; long i=0; double f; sexp x, *elts; diff --git a/tests/build/build-opts.txt b/tests/build/build-opts.txt new file mode 100644 index 00000000..01d2a81d --- /dev/null +++ b/tests/build/build-opts.txt @@ -0,0 +1,20 @@ +CPPFLAGS=-DSEXP_USE_MODULES=0 +CPPFLAGS=-DSEXP_USE_DL=0 +CPPFLAGS=-DSEXP_USE_SIMPLIFY=0 +CPPFLAGS=-DSEXP_USE_TYPE_DEFS=0 +SEXP_USE_BOEHM=1 +CPPFLAGS=-DSEXP_USE_DEBUG_GC=1 +CPPFLAGS=-DSEXP_USE_GLOBAL_HEAP=1 +CPPFLAGS=-DSEXP_USE_GLOBAL_TYPES=1 +CPPFLAGS=-DSEXP_USE_GLOBAL_SYMBOLS=1 +CPPFLAGS=-DSEXP_USE_FLONUMS=0 +CPPFLAGS=-DSEXP_USE_IMMEDIATE_FLONUMS=1 +CPPFLAGS=-DSEXP_USE_BIGNUMS=0 +CPPFLAGS=-DSEXP_USE_MATH=0 +CPPFLAGS=-DSEXP_WARN_UNDEFS=0 +CPPFLAGS=-DSEXP_USE_HUFF_SYMS=0 +CPPFLAGS=-DSEXP_USE_HASH_SYMS=0 +CPPFLAGS=-DSEXP_USE_STRING_STREAMS=0 +CPPFLAGS=-DSEXP_USE_AUTOCLOSE_PORTS=0 +CPPFLAGS=-DSEXP_USE_2010_EPOCH=0 +CPPFLAGS=-DSEXP_USE_CHECK_STACK=0 diff --git a/tests/build/build-tests.sh b/tests/build/build-tests.sh new file mode 100755 index 00000000..b3bd46ec --- /dev/null +++ b/tests/build/build-tests.sh @@ -0,0 +1,37 @@ +#! /bin/bash + +# test basic build options + +# for bootstrapping reasons this is a shell script, instead of a +# scheme script using (chibi process) + +# we just check each build against r5rs-tests.scm - +# some of the libraries will fail to build (notably +# if modules or user-defined types are disabled). + +BUILDDIR=tests/build +FAILURES=0 +i=0 + +for opts in `cat ${BUILDDIR}/build-opts.txt`; do + make cleaner 2>&1 >/dev/null + if make $opts 2>&1 >${BUILDDIR}/build${i}-make.out; then + if make test 2>&1 | tee ${BUILDDIR}/build${i}-test.out | grep -q -E 'FAIL|ERROR'; then + echo "[FAIL] ${i}: tests failed with $opts" + FAILURES=$((FAILURES + 1)) + else + echo "[PASS] ${i}: tests passed with $opts" + fi + else + echo "[FAIL] ${i}: couldn't build with $opts" + FAILURES=$((FAILURES + 1)) + fi + i=$((i+1)) +done + +if (( FAILURES == 0 )); then + echo "build-tests: all tests passed" +else + echo "build-tests: ${FAILURES} tests failed" +fi + diff --git a/tests/r5rs-tests.scm b/tests/r5rs-tests.scm index 85b3a801..e91bd57e 100644 --- a/tests/r5rs-tests.scm +++ b/tests/r5rs-tests.scm @@ -120,8 +120,8 @@ (test '(a 3 4 5 6 b) `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b)) -(test '(10 5 2 4 3 8) - `(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8)) +(test '(10 5 4 16 9 8) + `(10 5 ,(expt 2 2) ,@(map (lambda (n) (expt n 2)) '(4 3)) 8)) (test '(a `(b ,(+ 1 2) ,(foo 4 d) e) f) `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)) @@ -216,21 +216,23 @@ (test 288 (lcm 32 -36)) -(test #t (= -5 (floor -4.3))) +;;;; these will fail when compiled either without flonums or trig funcs -(test #t (= -4 (ceiling -4.3))) +;; (test #t (= -5 (floor -4.3))) -(test #t (= -4 (truncate -4.3))) +;; (test #t (= -4 (ceiling -4.3))) -(test #t (= -4 (round -4.3))) +;; (test #t (= -4 (truncate -4.3))) -(test #t (= 3 (floor 3.5))) +;; (test #t (= -4 (round -4.3))) -(test #t (= 4 (ceiling 3.5))) +;; (test #t (= 3 (floor 3.5))) -(test #t (= 3 (truncate 3.5))) +;; (test #t (= 4 (ceiling 3.5))) -(test #t (= 4 (round 3.5))) +;; (test #t (= 3 (truncate 3.5))) + +;; (test #t (= 4 (round 3.5))) (test 100 (string->number "100"))