From 6fe11ffcd1e9e42fcb3be9f5abe3f37189cc5182 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Fri, 18 Dec 2009 15:58:23 +0900 Subject: [PATCH] Renaming all USE_ settings and all OP_, OPC_ and CORE_ enums to have an SEXP_ prefix. Now all values from the headers are prefixed with either sexp_ or SEXP_, important for ease of embedding. "make USE_BOEHM=1" still works as an alias for "make SEXP_USE_BOEHM=1". Sorry if this patch breaks your code, it had to be done sooner or later. --- Makefile | 49 +++-- eval.c | 398 +++++++++++++++++++++-------------------- gc.c | 14 +- include/chibi/config.h | 162 +++++++++-------- include/chibi/eval.h | 190 ++++++++++---------- include/chibi/sexp.h | 32 ++-- lib/chibi/posix.module | 4 +- lib/chibi/posix.stub | 6 +- lib/srfi/27/rand.c | 4 +- lib/srfi/33/bit.c | 26 +-- lib/srfi/69/hash.c | 2 +- main.c | 6 +- mkfile | 3 +- opcodes.c | 136 +++++++------- opt/debug.c | 52 +++--- opt/plan9.c | 20 +-- opt/simplify.c | 2 +- sexp.c | 80 ++++----- tools/genstubs.scm | 2 + 19 files changed, 607 insertions(+), 581 deletions(-) diff --git a/Makefile b/Makefile index e6c1d79a..87ed11d0 100644 --- a/Makefile +++ b/Makefile @@ -3,6 +3,8 @@ .PHONY: all libs doc dist clean cleaner test install uninstall .PRECIOUS: %.c +# install configuration + CC ?= cc PREFIX ?= /usr/local BINDIR ?= $(PREFIX)/bin @@ -16,6 +18,9 @@ DESTDIR ?= GENSTUBS ?= ./tools/genstubs.scm +# system configuration - if not using GNU make, set PLATFORM and the +# following flags as necessary. + ifndef PLATFORM ifeq ($(shell uname),Darwin) PLATFORM=macosx @@ -34,23 +39,45 @@ ifeq ($(PLATFORM),macosx) SO = .dylib EXE = CLIBFLAGS = -dynamiclib -STATICFLAGS = -static-libgcc -DUSE_DL=0 +STATICFLAGS = -static-libgcc -DSEXP_USE_DL=0 else ifeq ($(PLATFORM),mingw) SO = .dll EXE = .exe CC = gcc CLIBFLAGS = -shared -CPPFLAGS += -DUSE_STRING_STREAMS=0 -DBUILDING_DLL -DUSE_DEBUG=0 +CPPFLAGS += -DSEXP_USE_STRING_STREAMS=0 -DBUILDING_DLL -DSEXP_USE_DEBUG=0 LDFLAGS += -Wl,--out-implib,libchibi-scheme$(SO).a else SO = .so EXE = CLIBFLAGS = -fPIC -shared -STATICFLAGS = -static -DUSE_DL=0 +STATICFLAGS = -static -DSEXP_USE_DL=0 endif endif +ifeq ($(USE_BOEHM),1) +SEXP_USE_BOEHM = 1 +endif + +ifeq ($(SEXP_USE_BOEHM),1) +GCLDFLAGS := -lgc +XCPPFLAGS := $(CPPFLAGS) -Iinclude -DSEXP_USE_BOEHM=1 +else +GCLDFLAGS := +XCPPFLAGS := $(CPPFLAGS) -Iinclude +endif + +ifeq ($(SEXP_USE_DL),0) +XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm +XCFLAGS := -Wall -DSEXP_USE_DL=0 -g3 $(CFLAGS) +else +XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -ldl -lm +XCFLAGS := -Wall -g3 $(CFLAGS) +endif + +######################################################################## + all: chibi-scheme$(EXE) libs COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ @@ -60,22 +87,6 @@ COMPILED_LIBS := lib/srfi/27/rand$(SO) lib/srfi/33/bit$(SO) \ libs: $(COMPILED_LIBS) -ifeq ($(USE_BOEHM),1) -GCLDFLAGS := -lgc -XCPPFLAGS := $(CPPFLAGS) -Iinclude -DUSE_BOEHM=1 -else -GCLDFLAGS := -XCPPFLAGS := $(CPPFLAGS) -Iinclude -endif - -ifeq ($(USE_DL),0) -XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm -XCFLAGS := -Wall -DUSE_DL=0 -g3 $(CFLAGS) -else -XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -ldl -lm -XCFLAGS := -Wall -g3 $(CFLAGS) -endif - INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h include/chibi/install.h: Makefile diff --git a/eval.c b/eval.c index 8d5dc45a..883d7d6d 100644 --- a/eval.c +++ b/eval.c @@ -8,7 +8,7 @@ static int scheme_initialized_p = 0; -#if USE_DEBUG +#if SEXP_USE_DEBUG #include "opt/debug.c" #else #define print_stack(...) @@ -181,7 +181,7 @@ static void emit_word (sexp ctx, sexp_uint_t val) { } static void emit_push (sexp ctx, sexp obj) { - emit(ctx, OP_PUSH); + emit(ctx, SEXP_OP_PUSH); emit_word(ctx, (sexp_uint_t)obj); if (sexp_pointerp(obj) && ! sexp_symbolp(obj)) sexp_push(ctx, sexp_bytecode_literals(sexp_context_bc(ctx)), obj); @@ -189,7 +189,7 @@ static void emit_push (sexp ctx, sexp obj) { static sexp finalize_bytecode (sexp ctx) { sexp bc; - emit(ctx, OP_RET); + emit(ctx, SEXP_OP_RET); shrink_bcode(ctx, sexp_context_pos(ctx)); bc = sexp_context_bc(ctx); if (sexp_pairp(sexp_bytecode_literals(bc))) { /* compress literals */ @@ -281,10 +281,10 @@ void sexp_init_eval_context_globals (sexp ctx) { sexp_gc_var2(bc, vec); ctx = sexp_make_child_context(ctx, NULL); sexp_gc_preserve2(ctx, bc, vec); - emit(ctx, OP_RESUMECC); + emit(ctx, SEXP_OP_RESUMECC); sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx); ctx = sexp_make_child_context(ctx, NULL); - emit(ctx, OP_DONE); + emit(ctx, SEXP_OP_DONE); bc = finalize_bytecode(ctx); vec = sexp_make_vector(ctx, 0, SEXP_VOID); sexp_global(ctx, SEXP_G_FINAL_RESUMER) @@ -658,31 +658,31 @@ static sexp analyze (sexp ctx, sexp object) { op = sexp_cdr(cell); if (sexp_corep(op)) { switch (sexp_core_code(op)) { - case CORE_DEFINE: + case SEXP_CORE_DEFINE: res = analyze_define(ctx, x); break; - case CORE_SET: + case SEXP_CORE_SET: res = analyze_set(ctx, x); break; - case CORE_LAMBDA: + case SEXP_CORE_LAMBDA: res = analyze_lambda(ctx, x); break; - case CORE_IF: + case SEXP_CORE_IF: res = analyze_if(ctx, x); break; - case CORE_BEGIN: + case SEXP_CORE_BEGIN: res = analyze_seq(ctx, sexp_cdr(x)); break; - case CORE_QUOTE: - case CORE_SYNTAX_QUOTE: + case SEXP_CORE_QUOTE: + case SEXP_CORE_SYNTAX_QUOTE: if (! (sexp_pairp(sexp_cdr(x)) && sexp_nullp(sexp_cddr(x)))) res = sexp_compile_error(ctx, "bad quote form", x); else res = sexp_make_lit(ctx, - (sexp_core_code(op) == CORE_QUOTE) ? + (sexp_core_code(op) == SEXP_CORE_QUOTE) ? sexp_strip_synclos(ctx, sexp_cadr(x)) : sexp_cadr(x)); break; - case CORE_DEFINE_SYNTAX: + case SEXP_CORE_DEFINE_SYNTAX: res = analyze_define_syntax(ctx, x); break; - case CORE_LET_SYNTAX: + case SEXP_CORE_LET_SYNTAX: res = analyze_let_syntax(ctx, x); break; - case CORE_LETREC_SYNTAX: + case SEXP_CORE_LETREC_SYNTAX: res = analyze_letrec_syntax(ctx, x); break; default: res = sexp_compile_error(ctx, "unknown core form", op); break; @@ -767,7 +767,7 @@ static void generate_seq (sexp ctx, sexp app) { for ( ; sexp_pairp(tail); head=tail, tail=sexp_cdr(tail)) if (sexp_pointerp(sexp_car(head)) && (! sexp_litp(sexp_car(head)))) { generate(ctx, sexp_car(head)); - emit(ctx, OP_DROP); + emit(ctx, SEXP_OP_DROP); sexp_context_depth(ctx)--; } sexp_context_tailp(ctx) = tailp; @@ -779,11 +779,11 @@ static void generate_cnd (sexp ctx, sexp cnd) { sexp_context_tailp(ctx) = 0; generate(ctx, sexp_cnd_test(cnd)); sexp_context_tailp(ctx) = tailp; - emit(ctx, OP_JUMP_UNLESS); + emit(ctx, SEXP_OP_JUMP_UNLESS); sexp_context_depth(ctx)--; label1 = sexp_context_make_label(ctx); generate(ctx, sexp_cnd_pass(cnd)); - emit(ctx, OP_JUMP); + emit(ctx, SEXP_OP_JUMP); sexp_context_depth(ctx)--; label2 = sexp_context_make_label(ctx); sexp_context_patch_label(ctx, label1); @@ -797,7 +797,7 @@ 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, OP_LOCAL_REF); + emit(ctx, SEXP_OP_LOCAL_REF); emit_word(ctx, sexp_param_index(lambda, name)); } else { /* closure ref */ @@ -805,11 +805,11 @@ static void generate_non_global_ref (sexp ctx, sexp name, sexp cell, if ((name == sexp_ref_name(sexp_car(fv))) && (loc == sexp_ref_loc(sexp_car(fv)))) break; - emit(ctx, OP_CLOSURE_REF); + emit(ctx, SEXP_OP_CLOSURE_REF); emit_word(ctx, i); } if (unboxp && (sexp_memq(ctx, name, sexp_lambda_sv(loc)) != SEXP_FALSE)) - emit(ctx, OP_CDR); + emit(ctx, SEXP_OP_CDR); sexp_context_depth(ctx)++; } @@ -820,7 +820,7 @@ static void generate_ref (sexp ctx, sexp ref, int unboxp) { if (unboxp) { emit(ctx, (sexp_cdr(sexp_ref_cell(ref)) == SEXP_UNDEF) - ? OP_GLOBAL_REF : OP_GLOBAL_KNOWN_REF); + ? SEXP_OP_GLOBAL_REF : SEXP_OP_GLOBAL_KNOWN_REF); emit_word(ctx, (sexp_uint_t)sexp_ref_cell(ref)); } else emit_push(ctx, sexp_ref_cell(ref)); @@ -841,16 +841,16 @@ static void generate_set (sexp ctx, sexp set) { if (! sexp_lambdap(sexp_ref_loc(ref))) { /* global vars are set directly */ emit_push(ctx, sexp_ref_cell(ref)); - emit(ctx, OP_SET_CDR); + 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, OP_SET_CDR); + emit(ctx, SEXP_OP_SET_CDR); } else { /* internally defined variable */ - emit(ctx, OP_LOCAL_SET); + emit(ctx, SEXP_OP_LOCAL_SET); emit_word(ctx, sexp_param_index(lambda, sexp_ref_name(ref))); } } @@ -870,69 +870,69 @@ static void generate_opcode_app (sexp ctx, sexp app) { if ((num_args == sexp_opcode_num_args(op)) && sexp_opcode_variadic_p(op) && sexp_opcode_data(op) - && (sexp_opcode_class(op) != OPC_PARAMETER)) { + && (sexp_opcode_class(op) != SEXP_OPC_PARAMETER)) { emit_push(ctx, sexp_opcode_data(op)); if (sexp_opcode_opt_param_p(op)) - emit(ctx, OP_CDR); + emit(ctx, SEXP_OP_CDR); sexp_context_depth(ctx)++; num_args++; } /* push the arguments onto the stack in reverse order */ ls = ((sexp_opcode_inverse(op) - && (sexp_opcode_class(op) != OPC_ARITHMETIC_INV)) + && (sexp_opcode_class(op) != SEXP_OPC_ARITHMETIC_INV)) ? sexp_cdr(app) : sexp_reverse(ctx, sexp_cdr(app))); for ( ; sexp_pairp(ls); ls = sexp_cdr(ls)) generate(ctx, sexp_car(ls)); /* emit the actual operator call */ switch (sexp_opcode_class(op)) { - case OPC_ARITHMETIC: + case SEXP_OPC_ARITHMETIC: if (num_args > 1) emit(ctx, sexp_opcode_code(op)); break; - case OPC_ARITHMETIC_INV: + case SEXP_OPC_ARITHMETIC_INV: emit(ctx, (num_args==1) ? sexp_opcode_inverse(op) : sexp_opcode_code(op)); break; - case OPC_ARITHMETIC_CMP: + case SEXP_OPC_ARITHMETIC_CMP: if (num_args > 2) { - emit(ctx, OP_STACK_REF); + emit(ctx, SEXP_OP_STACK_REF); emit_word(ctx, 2); - emit(ctx, OP_STACK_REF); + emit(ctx, SEXP_OP_STACK_REF); emit_word(ctx, 2); emit(ctx, sexp_opcode_code(op)); - emit(ctx, OP_AND); + emit(ctx, SEXP_OP_AND); for (i=num_args-2; i>0; i--) { - emit(ctx, OP_STACK_REF); + emit(ctx, SEXP_OP_STACK_REF); emit_word(ctx, 3); - emit(ctx, OP_STACK_REF); + emit(ctx, SEXP_OP_STACK_REF); emit_word(ctx, 3); emit(ctx, sexp_opcode_code(op)); - emit(ctx, OP_AND); - emit(ctx, OP_AND); + emit(ctx, SEXP_OP_AND); + emit(ctx, SEXP_OP_AND); } } else emit(ctx, sexp_opcode_code(op)); break; - case OPC_FOREIGN: + case SEXP_OPC_FOREIGN: emit(ctx, sexp_opcode_code(op)); emit_word(ctx, (sexp_uint_t)op); break; - case OPC_TYPE_PREDICATE: - case OPC_ACCESSOR: - case OPC_CONSTRUCTOR: + case SEXP_OPC_TYPE_PREDICATE: + case SEXP_OPC_ACCESSOR: + case SEXP_OPC_CONSTRUCTOR: emit(ctx, sexp_opcode_code(op)); - if ((sexp_opcode_class(op) != OPC_CONSTRUCTOR) - || sexp_opcode_code(op) == OP_MAKE) { + 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))); if (sexp_opcode_data2(op)) emit_word(ctx, sexp_unbox_fixnum(sexp_opcode_data2(op))); } break; - case OPC_PARAMETER: + case SEXP_OPC_PARAMETER: emit_push(ctx, sexp_opcode_data(op)); - emit(ctx, ((num_args == 0) ? OP_CDR : OP_SET_CDR)); + emit(ctx, ((num_args == 0) ? SEXP_OP_CDR : SEXP_OP_SET_CDR)); break; default: emit(ctx, sexp_opcode_code(op)); @@ -940,8 +940,8 @@ static void generate_opcode_app (sexp ctx, sexp app) { /* emit optional folding of operator */ if ((num_args > 2) - && (sexp_opcode_class(op) == OPC_ARITHMETIC - || sexp_opcode_class(op) == OPC_ARITHMETIC_INV)) + && (sexp_opcode_class(op) == SEXP_OPC_ARITHMETIC + || sexp_opcode_class(op) == SEXP_OPC_ARITHMETIC_INV)) for (i=num_args-2; i>0; i--) emit(ctx, sexp_opcode_code(op)); @@ -964,7 +964,7 @@ static void generate_general_app (sexp ctx, sexp app) { generate(ctx, sexp_car(app)); /* maybe overwrite the current frame */ - emit(ctx, (tailp ? OP_TAIL_CALL : OP_CALL)); + emit(ctx, (tailp ? SEXP_OP_TAIL_CALL : SEXP_OP_CALL)); emit_word(ctx, (sexp_uint_t)sexp_make_fixnum(len)); sexp_context_tailp(ctx) = tailp; @@ -996,13 +996,13 @@ static void generate_lambda (sexp ctx, sexp lambda) { for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) { k = sexp_param_index(lambda, sexp_car(ls)); if (k >= 0) { - emit(ctx2, OP_LOCAL_REF); + emit(ctx2, SEXP_OP_LOCAL_REF); emit_word(ctx2, k); emit_push(ctx2, sexp_car(ls)); - emit(ctx2, OP_CONS); - emit(ctx2, OP_LOCAL_SET); + emit(ctx2, SEXP_OP_CONS); + emit(ctx2, SEXP_OP_LOCAL_SET); emit_word(ctx2, k); - emit(ctx2, OP_DROP); + emit(ctx2, SEXP_OP_DROP); } } sexp_context_tailp(ctx2) = 1; @@ -1022,24 +1022,24 @@ static void generate_lambda (sexp ctx, sexp lambda) { /* push the closed vars */ emit_push(ctx, SEXP_VOID); emit_push(ctx, sexp_length(ctx, fv)); - emit(ctx, OP_MAKE_VECTOR); + 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, OP_STACK_REF); + emit(ctx, SEXP_OP_STACK_REF); emit_word(ctx, 3); - emit(ctx, OP_VECTOR_SET); - emit(ctx, OP_DROP); + emit(ctx, SEXP_OP_VECTOR_SET); + emit(ctx, SEXP_OP_DROP); sexp_context_depth(ctx)--; } /* push the additional procedure info and make the closure */ emit_push(ctx, bc); emit_push(ctx, len); emit_push(ctx, flags); - emit(ctx, OP_MAKE_PROCEDURE); + emit(ctx, SEXP_OP_MAKE_PROCEDURE); } sexp_gc_release2(ctx); } @@ -1221,7 +1221,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { *stack = sexp_stack_data(sexp_context_stack(ctx)); unsigned char *ip = sexp_bytecode_data(bc); sexp_sint_t i, j, k, fp, top = sexp_stack_top(sexp_context_stack(ctx)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS sexp_lsint_t prod; #endif sexp_gc_var3(self, tmp1, tmp2); @@ -1230,17 +1230,17 @@ sexp sexp_vm (sexp ctx, sexp proc) { self = proc; loop: -#if USE_DEBUG_VM +#if SEXP_USE_DEBUG_VM if (sexp_context_tracep(ctx)) { sexp_print_stack(ctx, stack, top, fp, SEXP_FALSE); - fprintf(stderr, "%s\n", (*ip<=OP_NUM_OPCODES) ? + fprintf(stderr, "%s\n", (*ip<=SEXP_OP_NUM_OPCODES) ? reverse_opcode_names[*ip] : "UNKNOWN"); } #endif switch (*ip++) { - case OP_NOOP: + case SEXP_OP_NOOP: break; - case OP_RAISE: + case SEXP_OP_RAISE: call_error_handler: tmp1 = sexp_env_global_ref(env, sexp_global(ctx, SEXP_G_ERR_HANDLER_SYMBOL), SEXP_FALSE); if (! sexp_procedurep(tmp1)) goto end_loop; @@ -1255,7 +1255,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { cp = sexp_procedure_vars(self); fp = top-4; break; - case OP_RESUMECC: + case SEXP_OP_RESUMECC: tmp1 = stack[fp-1]; top = sexp_restore_stack(sexp_vector_ref(cp, 0), stack); fp = sexp_unbox_fixnum(_ARG1); @@ -1267,7 +1267,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { top -= 4; _ARG1 = tmp1; break; - case OP_CALLCC: + case SEXP_OP_CALLCC: stack[top] = SEXP_ONE; stack[top+1] = sexp_make_fixnum(ip-sexp_bytecode_data(bc)); stack[top+2] = self; @@ -1285,7 +1285,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { top++; ip -= sizeof(sexp); goto make_call; - case OP_APPLY1: + case SEXP_OP_APPLY1: tmp1 = _ARG1; tmp2 = _ARG2; i = sexp_unbox_fixnum(sexp_length(ctx, tmp2)); @@ -1295,7 +1295,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { top += i+1; ip -= sizeof(sexp); goto make_call; - case OP_TAIL_CALL: + case SEXP_OP_TAIL_CALL: i = sexp_unbox_fixnum(_WORD0); /* number of params */ tmp1 = _ARG1; /* procedure to call */ /* save frame info */ @@ -1312,8 +1312,8 @@ sexp sexp_vm (sexp ctx, sexp proc) { top = fp+i-j+1; fp = sexp_unbox_fixnum(tmp2); goto make_call; - case OP_CALL: -#if USE_CHECK_STACK + case SEXP_OP_CALL: +#if SEXP_USE_CHECK_STACK if (top+16 >= SEXP_INIT_STACK_SIZE) { _ARG1 = sexp_global(ctx, SEXP_G_OOS_ERROR); goto end_loop; @@ -1369,97 +1369,97 @@ sexp sexp_vm (sexp ctx, sexp proc) { cp = sexp_procedure_vars(self); fp = top-4; break; - case OP_FCALL0: + case SEXP_OP_FCALL0: sexp_context_top(ctx) = top; _PUSH(((sexp_proc1)sexp_opcode_func(_WORD0))(ctx)); ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL1: + case SEXP_OP_FCALL1: sexp_context_top(ctx) = top; _ARG1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx, _ARG1); ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL2: + case SEXP_OP_FCALL2: sexp_context_top(ctx) = top; _ARG2 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2); top--; ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL3: + case SEXP_OP_FCALL3: sexp_context_top(ctx) = top; _ARG3 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3); top -= 2; ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL4: + case SEXP_OP_FCALL4: sexp_context_top(ctx) = top; _ARG4 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4); top -= 3; ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL5: + case SEXP_OP_FCALL5: sexp_context_top(ctx) = top; _ARG5 = ((sexp_proc6)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5); top -= 4; ip += sizeof(sexp); sexp_check_exception(); break; - case OP_FCALL6: + case SEXP_OP_FCALL6: sexp_context_top(ctx) = top; _ARG6 = ((sexp_proc7)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6); top -= 5; ip += sizeof(sexp); sexp_check_exception(); break; - case OP_JUMP_UNLESS: + case SEXP_OP_JUMP_UNLESS: if (stack[--top] == SEXP_FALSE) ip += _SWORD0; else ip += sizeof(sexp_sint_t); break; - case OP_JUMP: + case SEXP_OP_JUMP: ip += _SWORD0; break; - case OP_PUSH: + case SEXP_OP_PUSH: _PUSH(_WORD0); ip += sizeof(sexp); break; - case OP_DROP: + case SEXP_OP_DROP: top--; break; - case OP_GLOBAL_REF: + case SEXP_OP_GLOBAL_REF: if (sexp_cdr(_WORD0) == SEXP_UNDEF) sexp_raise("undefined variable", sexp_list1(ctx, sexp_car(_WORD0))); /* ... FALLTHROUGH ... */ - case OP_GLOBAL_KNOWN_REF: + case SEXP_OP_GLOBAL_KNOWN_REF: _PUSH(sexp_cdr(_WORD0)); ip += sizeof(sexp); break; - case OP_STACK_REF: /* `pick' in forth */ + case SEXP_OP_STACK_REF: /* `pick' in forth */ stack[top] = stack[top - _SWORD0]; ip += sizeof(sexp); top++; break; - case OP_LOCAL_REF: + case SEXP_OP_LOCAL_REF: stack[top] = stack[fp - 1 - _SWORD0]; ip += sizeof(sexp); top++; break; - case OP_LOCAL_SET: + case SEXP_OP_LOCAL_SET: stack[fp - 1 - _SWORD0] = _ARG1; _ARG1 = SEXP_VOID; ip += sizeof(sexp); break; - case OP_CLOSURE_REF: + case SEXP_OP_CLOSURE_REF: _PUSH(sexp_vector_ref(cp, sexp_make_fixnum(_WORD0))); ip += sizeof(sexp); break; - case OP_VECTOR_REF: + case SEXP_OP_VECTOR_REF: if (! sexp_vectorp(_ARG1)) sexp_raise("vector-ref: not a vector", sexp_list1(ctx, _ARG1)); else if (! sexp_fixnump(_ARG2)) @@ -1470,7 +1470,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG2 = sexp_vector_ref(_ARG1, _ARG2); top--; break; - case OP_VECTOR_SET: + case SEXP_OP_VECTOR_SET: if (! sexp_vectorp(_ARG1)) sexp_raise("vector-set!: not a vector", sexp_list1(ctx, _ARG1)); else if (sexp_immutablep(_ARG1)) @@ -1484,12 +1484,12 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG3 = SEXP_VOID; top-=2; break; - case OP_VECTOR_LENGTH: + case SEXP_OP_VECTOR_LENGTH: if (! sexp_vectorp(_ARG1)) sexp_raise("vector-length: not a vector", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_fixnum(sexp_vector_length(_ARG1)); break; - case OP_STRING_REF: + case SEXP_OP_STRING_REF: if (! sexp_stringp(_ARG1)) sexp_raise("string-ref: not a string", sexp_list1(ctx, _ARG1)); else if (! sexp_fixnump(_ARG2)) @@ -1500,7 +1500,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG2 = sexp_string_ref(_ARG1, _ARG2); top--; break; - case OP_STRING_SET: + case SEXP_OP_STRING_SET: if (! sexp_stringp(_ARG1)) sexp_raise("string-set!: not a string", sexp_list1(ctx, _ARG1)); else if (sexp_immutablep(_ARG1)) @@ -1516,52 +1516,52 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG3 = SEXP_VOID; top-=2; break; - case OP_STRING_LENGTH: + case SEXP_OP_STRING_LENGTH: if (! sexp_stringp(_ARG1)) sexp_raise("string-length: not a string", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_fixnum(sexp_string_length(_ARG1)); break; - case OP_MAKE_PROCEDURE: + case SEXP_OP_MAKE_PROCEDURE: sexp_context_top(ctx) = top; _ARG4 = sexp_make_procedure(ctx, _ARG1, _ARG2, _ARG3, _ARG4); top-=3; break; - case OP_MAKE_VECTOR: + case SEXP_OP_MAKE_VECTOR: sexp_context_top(ctx) = top; if (! sexp_fixnump(_ARG1)) sexp_raise("make-vector: not an integer", sexp_list1(ctx, _ARG1)); _ARG2 = sexp_make_vector(ctx, _ARG1, _ARG2); top--; break; - case OP_AND: + case SEXP_OP_AND: _ARG2 = sexp_make_boolean((_ARG1 != SEXP_FALSE) && (_ARG2 != SEXP_FALSE)); top--; break; - case OP_EOFP: + case SEXP_OP_EOFP: _ARG1 = sexp_make_boolean(_ARG1 == SEXP_EOF); break; - case OP_NULLP: + case SEXP_OP_NULLP: _ARG1 = sexp_make_boolean(sexp_nullp(_ARG1)); break; - case OP_FIXNUMP: + case SEXP_OP_FIXNUMP: _ARG1 = sexp_make_boolean(sexp_fixnump(_ARG1)); break; - case OP_SYMBOLP: + case SEXP_OP_SYMBOLP: _ARG1 = sexp_make_boolean(sexp_symbolp(_ARG1)); break; - case OP_CHARP: + case SEXP_OP_CHARP: _ARG1 = sexp_make_boolean(sexp_charp(_ARG1)); break; - case OP_TYPEP: + case SEXP_OP_TYPEP: _ARG1 = sexp_make_boolean(sexp_check_tag(_ARG1, _UWORD0)); ip += sizeof(sexp); break; - case OP_MAKE: + case SEXP_OP_MAKE: _PUSH(sexp_alloc_tagged(ctx, _UWORD1, _UWORD0)); ip += sizeof(sexp)*2; break; - case OP_SLOT_REF: + case SEXP_OP_SLOT_REF: if (! sexp_check_tag(_ARG1, _UWORD0)) sexp_raise("slot-ref: bad type", sexp_list2(ctx, sexp_c_string(ctx, sexp_type_name_by_index(_UWORD0), -1), _ARG1)); _ARG1 = sexp_slot_ref(_ARG1, _UWORD1); ip += sizeof(sexp)*2; break; - case OP_SLOT_SET: + case SEXP_OP_SLOT_SET: if (! sexp_check_tag(_ARG1, _UWORD0)) sexp_raise("slot-set!: bad type", sexp_list2(ctx, sexp_c_string(ctx, sexp_type_name_by_index(_UWORD0), -1), _ARG1)); else if (sexp_immutablep(_ARG1)) @@ -1571,15 +1571,15 @@ sexp sexp_vm (sexp ctx, sexp proc) { ip += sizeof(sexp)*2; top--; break; - case OP_CAR: + case SEXP_OP_CAR: if (! sexp_pairp(_ARG1)) sexp_raise("car: not a pair", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_car(_ARG1); break; - case OP_CDR: + case SEXP_OP_CDR: if (! sexp_pairp(_ARG1)) sexp_raise("cdr: not a pair", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_cdr(_ARG1); break; - case OP_SET_CAR: + case SEXP_OP_SET_CAR: if (! sexp_pairp(_ARG1)) sexp_raise("set-car!: not a pair", sexp_list1(ctx, _ARG1)); else if (sexp_immutablep(_ARG1)) @@ -1588,7 +1588,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG2 = SEXP_VOID; top--; break; - case OP_SET_CDR: + case SEXP_OP_SET_CDR: if (! sexp_pairp(_ARG1)) sexp_raise("set-cdr!: not a pair", sexp_list1(ctx, _ARG1)); else if (sexp_immutablep(_ARG1)) @@ -1597,13 +1597,13 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG2 = SEXP_VOID; top--; break; - case OP_CONS: + case SEXP_OP_CONS: sexp_context_top(ctx) = top; _ARG2 = sexp_cons(ctx, _ARG1, _ARG2); top--; break; - case OP_ADD: -#if USE_BIGNUMS + case SEXP_OP_ADD: +#if SEXP_USE_BIGNUMS tmp1 = _ARG1, tmp2 = _ARG2; if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { j = sexp_unbox_fixnum(tmp1) + sexp_unbox_fixnum(tmp2); @@ -1617,7 +1617,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { #else if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) _ARG2 = sexp_fx_add(_ARG1, _ARG2); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_add(ctx, _ARG1, _ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1629,8 +1629,8 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_SUB: -#if USE_BIGNUMS + case SEXP_OP_SUB: +#if SEXP_USE_BIGNUMS tmp1 = _ARG1, tmp2 = _ARG2; if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { j = sexp_unbox_fixnum(tmp1) - sexp_unbox_fixnum(tmp2); @@ -1644,7 +1644,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { #else if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) _ARG2 = sexp_fx_sub(_ARG1, _ARG2); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_sub(ctx, _ARG1, _ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1656,8 +1656,8 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_MUL: -#if USE_BIGNUMS + case SEXP_OP_MUL: +#if SEXP_USE_BIGNUMS tmp1 = _ARG1, tmp2 = _ARG2; if (sexp_fixnump(tmp1) && sexp_fixnump(tmp2)) { prod = (sexp_lsint_t)sexp_unbox_fixnum(tmp1) * sexp_unbox_fixnum(tmp2); @@ -1671,7 +1671,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { #else if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) _ARG2 = sexp_fx_mul(_ARG1, _ARG2); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_mul(ctx, _ARG1, _ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1683,16 +1683,16 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_DIV: + case SEXP_OP_DIV: if (_ARG2 == SEXP_ZERO) { -#if USE_FLONUMS +#if SEXP_USE_FLONUMS if (sexp_flonump(_ARG1) && sexp_flonum_value(_ARG1) == 0.0) _ARG2 = sexp_make_flonum(ctx, 0.0/0.0); else #endif sexp_raise("divide by zero", SEXP_NULL); } else if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { -#if USE_FLONUMS +#if SEXP_USE_FLONUMS _ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1); _ARG2 = sexp_fixnum_to_flonum(ctx, _ARG2); _ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2); @@ -1702,11 +1702,11 @@ sexp sexp_vm (sexp ctx, sexp proc) { _ARG2 = sexp_fx_div(_ARG1, _ARG2); #endif } -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else _ARG2 = sexp_div(ctx, _ARG1, _ARG2); #else -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) _ARG2 = sexp_fp_div(ctx, _ARG1, _ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1718,14 +1718,14 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_QUOTIENT: + case SEXP_OP_QUOTIENT: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { if (_ARG2 == SEXP_ZERO) sexp_raise("divide by zero", SEXP_NULL); _ARG2 = sexp_fx_div(_ARG1, _ARG2); top--; } -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else { _ARG2 = sexp_quotient(ctx, _ARG1, _ARG2); top--; @@ -1734,7 +1734,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { else sexp_raise("quotient: not an integer", sexp_list2(ctx, _ARG1, _ARG2)); #endif break; - case OP_REMAINDER: + case SEXP_OP_REMAINDER: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { if (_ARG2 == SEXP_ZERO) sexp_raise("divide by zero", SEXP_NULL); @@ -1742,7 +1742,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { top--; _ARG1 = tmp1; } -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else { _ARG2 = sexp_remainder(ctx, _ARG1, _ARG2); top--; @@ -1751,34 +1751,34 @@ sexp sexp_vm (sexp ctx, sexp proc) { else sexp_raise("remainder: not an integer", sexp_list2(ctx, _ARG1, _ARG2)); #endif break; - case OP_NEGATIVE: + case SEXP_OP_NEGATIVE: if (sexp_fixnump(_ARG1)) _ARG1 = sexp_make_fixnum(-sexp_unbox_fixnum(_ARG1)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(_ARG1)) { _ARG1 = sexp_copy_bignum(ctx, NULL, _ARG1, 0); sexp_bignum_sign(_ARG1) = -sexp_bignum_sign(_ARG1); } #endif -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1)) _ARG1 = sexp_make_flonum(ctx, -sexp_flonum_value(_ARG1)); #endif else sexp_raise("-: not a number", sexp_list1(ctx, _ARG1)); break; - case OP_INVERSE: + case SEXP_OP_INVERSE: if (sexp_fixnump(_ARG1)) _ARG1 = sexp_make_flonum(ctx, 1/(double)sexp_unbox_fixnum(_ARG1)); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(_ARG1)) _ARG1 = sexp_make_flonum(ctx, 1/sexp_flonum_value(_ARG1)); #endif else sexp_raise("/: not a number", sexp_list1(ctx, _ARG1)); break; - case OP_LT: + case SEXP_OP_LT: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { i = (sexp_sint_t)_ARG1 < (sexp_sint_t)_ARG2; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS _ARG2 = sexp_make_boolean(i); } else { tmp1 = sexp_compare(ctx, _ARG1, _ARG2); @@ -1786,7 +1786,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) < 0) : tmp1; } #else -#if USE_FLONUMS +#if SEXP_USE_FLONUMS } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) i = sexp_flonum_value(_ARG1) < sexp_flonum_value(_ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1799,10 +1799,10 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_LE: + case SEXP_OP_LE: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { i = (sexp_sint_t)_ARG1 <= (sexp_sint_t)_ARG2; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS _ARG2 = sexp_make_boolean(i); } else { tmp1 = sexp_compare(ctx, _ARG1, _ARG2); @@ -1810,7 +1810,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) <= 0) : tmp1; } #else -#if USE_FLONUMS +#if SEXP_USE_FLONUMS } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) i = sexp_flonum_value(_ARG1) <= sexp_flonum_value(_ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1823,10 +1823,10 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_EQN: + case SEXP_OP_EQN: if (sexp_fixnump(_ARG1) && sexp_fixnump(_ARG2)) { i = _ARG1 == _ARG2; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS _ARG2 = sexp_make_boolean(i); } else { tmp1 = sexp_compare(ctx, _ARG1, _ARG2); @@ -1834,7 +1834,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { ? sexp_make_boolean(sexp_unbox_fixnum(tmp1) == 0) : tmp1; } #else -#if USE_FLONUMS +#if SEXP_USE_FLONUMS } else if (sexp_flonump(_ARG1) && sexp_flonump(_ARG2)) i = sexp_flonum_value(_ARG1) == sexp_flonum_value(_ARG2); else if (sexp_flonump(_ARG1) && sexp_fixnump(_ARG2)) @@ -1847,25 +1847,25 @@ sexp sexp_vm (sexp ctx, sexp proc) { #endif top--; break; - case OP_EQ: + case SEXP_OP_EQ: _ARG2 = sexp_make_boolean(_ARG1 == _ARG2); top--; break; - case OP_FIX2FLO: + case SEXP_OP_FIX2FLO: if (sexp_fixnump(_ARG1)) _ARG1 = sexp_fixnum_to_flonum(ctx, _ARG1); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(_ARG1)) _ARG1 = sexp_make_flonum(ctx, sexp_bignum_to_double(_ARG1)); #endif else if (! sexp_flonump(_ARG1)) sexp_raise("exact->inexact: not a number", sexp_list1(ctx, _ARG1)); break; - case OP_FLO2FIX: + case SEXP_OP_FLO2FIX: if (sexp_flonump(_ARG1)) { if (sexp_flonum_value(_ARG1) != trunc(sexp_flonum_value(_ARG1))) { sexp_raise("inexact->exact: not an integer", sexp_list1(ctx, _ARG1)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if ((sexp_flonum_value(_ARG1) > SEXP_MAX_FIXNUM) || sexp_flonum_value(_ARG1) < SEXP_MIN_FIXNUM) { _ARG1 = sexp_double_to_bignum(ctx, sexp_flonum_value(_ARG1)); @@ -1877,47 +1877,47 @@ sexp sexp_vm (sexp ctx, sexp proc) { sexp_raise("inexact->exact: not a number", sexp_list1(ctx, _ARG1)); } break; - case OP_CHAR2INT: + case SEXP_OP_CHAR2INT: if (! sexp_charp(_ARG1)) sexp_raise("char->integer: not a character", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_fixnum(sexp_unbox_character(_ARG1)); break; - case OP_INT2CHAR: + case SEXP_OP_INT2CHAR: if (! sexp_fixnump(_ARG1)) sexp_raise("integer->char: not an integer", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_character(sexp_unbox_fixnum(_ARG1)); break; - case OP_CHAR_UPCASE: + case SEXP_OP_CHAR_UPCASE: if (! sexp_charp(_ARG1)) sexp_raise("char-upcase: not a character", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_character(toupper(sexp_unbox_character(_ARG1))); break; - case OP_CHAR_DOWNCASE: + case SEXP_OP_CHAR_DOWNCASE: if (! sexp_charp(_ARG1)) sexp_raise("char-downcase: not a character", sexp_list1(ctx, _ARG1)); _ARG1 = sexp_make_character(tolower(sexp_unbox_character(_ARG1))); break; - case OP_WRITE_CHAR: + case SEXP_OP_WRITE_CHAR: if (! sexp_charp(_ARG1)) sexp_raise("write-char: not a character", sexp_list1(ctx, _ARG1)); sexp_write_char(ctx, sexp_unbox_character(_ARG1), _ARG2); _ARG2 = SEXP_VOID; top--; break; - case OP_NEWLINE: + case SEXP_OP_NEWLINE: sexp_newline(ctx, _ARG1); _ARG1 = SEXP_VOID; break; - case OP_READ_CHAR: + case SEXP_OP_READ_CHAR: i = sexp_read_char(ctx, _ARG1); _ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i); break; - case OP_PEEK_CHAR: + case SEXP_OP_PEEK_CHAR: i = sexp_read_char(ctx, _ARG1); sexp_push_char(ctx, i, _ARG1); _ARG1 = (i == EOF) ? SEXP_EOF : sexp_make_character(i); break; - case OP_RET: + case SEXP_OP_RET: i = sexp_unbox_fixnum(stack[fp]); stack[fp-i] = _ARG1; top = fp-i+1; @@ -1927,7 +1927,7 @@ sexp sexp_vm (sexp ctx, sexp proc) { cp = sexp_procedure_vars(self); fp = sexp_unbox_fixnum(stack[fp+3]); break; - case OP_DONE: + case SEXP_OP_DONE: goto end_loop; default: sexp_raise("unknown opcode", sexp_list1(ctx, sexp_make_fixnum(*(ip-1)))); @@ -1978,7 +1978,7 @@ static sexp sexp_close_port (sexp ctx, sexp port) { return sexp_user_exception(ctx, SEXP_FALSE, "port already closed", port); if (sexp_port_stream(port)) fclose(sexp_port_stream(port)); -#if ! USE_STRING_STREAMS +#if ! SEXP_USE_STRING_STREAMS if (sexp_port_buf(port) && sexp_oportp(port)) free(sexp_port_buf(port)); #endif @@ -2005,7 +2005,7 @@ void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) { } } -#if USE_DL +#if SEXP_USE_DL sexp sexp_load_dl (sexp ctx, sexp file, sexp env) { sexp_proc2 init; void *handle = dlopen(sexp_string_data(file), RTLD_LAZY); @@ -2021,7 +2021,7 @@ sexp sexp_load_dl (sexp ctx, sexp file, sexp env) { #endif sexp sexp_load (sexp ctx, sexp source, sexp env) { -#if USE_DL +#if SEXP_USE_DL char *suffix; #endif sexp tmp, out=SEXP_FALSE; @@ -2030,7 +2030,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) { return sexp_type_exception(ctx, "not a string", source); if (! sexp_envp(env)) return sexp_type_exception(ctx, "not an environment", env); -#if USE_DL +#if SEXP_USE_DL suffix = sexp_string_data(source) + sexp_string_length(source) - strlen(sexp_so_extension); if (strcmp(suffix, sexp_so_extension) == 0) { @@ -2062,19 +2062,19 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) { sexp_close_port(ctx, in); } sexp_gc_release4(ctx); -#if USE_DL +#if SEXP_USE_DL } #endif -#if USE_WARN_UNDEFS +#if SEXP_USE_WARN_UNDEFS if (sexp_oportp(out) && ! sexp_exceptionp(res)) sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, out); #endif return res; } -#if USE_MATH +#if SEXP_USE_MATH -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS #define maybe_convert_bignum(z) \ else if (sexp_bignump(z)) d = sexp_bignum_to_double(z); #else @@ -2113,7 +2113,7 @@ define_math_op(sexp_ceiling, ceil) static sexp sexp_expt (sexp ctx, sexp x, sexp e) { long double f, x1, e1; sexp res; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS if (sexp_bignump(e)) { /* bignum exponent needs special handling */ if ((x == SEXP_ZERO) || (x == SEXP_NEG_ONE)) res = sexp_make_flonum(ctx, pow(0, 0)); /* +nan.0 */ @@ -2129,7 +2129,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { #endif if (sexp_fixnump(x)) x1 = sexp_unbox_fixnum(x); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(x)) x1 = sexp_flonum_value(x); #endif @@ -2137,27 +2137,27 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) { return sexp_type_exception(ctx, "not a number", x); if (sexp_fixnump(e)) e1 = sexp_unbox_fixnum(e); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS else if (sexp_flonump(e)) e1 = sexp_flonum_value(e); #endif else return sexp_type_exception(ctx, "not a number", e); f = pow(x1, e1); -#if USE_FLONUMS +#if SEXP_USE_FLONUMS if ((f > SEXP_MAX_FIXNUM) || (! sexp_fixnump(x)) || (! sexp_fixnump(e))) { #endif -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS if (sexp_fixnump(x) && sexp_fixnump(e)) res = sexp_bignum_expt(ctx, sexp_fixnum_to_bignum(ctx, x), e); else #endif -#if USE_FLONUMS +#if SEXP_USE_FLONUMS res = sexp_make_flonum(ctx, f); } else #endif res = sexp_make_fixnum((sexp_sint_t)round(f)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } #endif return res; @@ -2200,23 +2200,23 @@ static sexp sexp_apply_optimization (sexp ctx, sexp proc, sexp ast) { return res; } -#if USE_SIMPLIFY +#if SEXP_USE_SIMPLIFY #include "opt/simplify.c" #endif /*********************** standard environment *************************/ static struct sexp_struct core_forms[] = { - {.tag=SEXP_CORE, .value={.core={CORE_DEFINE, "define"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_SET, "set!"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_LAMBDA, "lambda"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_IF, "if"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_BEGIN, "begin"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_QUOTE, "quote"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_SYNTAX_QUOTE, "syntax-quote"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_DEFINE_SYNTAX, "define-syntax"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_LET_SYNTAX, "let-syntax"}}}, - {.tag=SEXP_CORE, .value={.core={CORE_LETREC_SYNTAX, "letrec-syntax"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE, "define"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_SET, "set!"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_LAMBDA, "lambda"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_IF, "if"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_BEGIN, "begin"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_QUOTE, "quote"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_SYNTAX_QUOTE, "syntax-quote"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE_SYNTAX, "define-syntax"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_LET_SYNTAX, "let-syntax"}}}, + {.tag=SEXP_CORE, .value={.core={SEXP_CORE_LETREC_SYNTAX, "letrec-syntax"}}}, }; #include "opcodes.c" @@ -2241,10 +2241,10 @@ sexp sexp_make_opcode (sexp ctx, sexp name, sexp op_class, sexp code, if (! sexp_stringp(name)) res = sexp_type_exception(ctx, "make-opcode: not a string", name); else if ((! sexp_fixnump(op_class)) || (sexp_unbox_fixnum(op_class) <= 0) - || (sexp_unbox_fixnum(op_class) >= OPC_NUM_OP_CLASSES)) + || (sexp_unbox_fixnum(op_class) >= SEXP_OPC_NUM_OP_CLASSES)) res = sexp_type_exception(ctx, "make-opcode: bad opcode class", op_class); else if ((! sexp_fixnump(code)) || (sexp_unbox_fixnum(code) <= 0) - || (sexp_unbox_fixnum(code) >= OP_NUM_OPCODES)) + || (sexp_unbox_fixnum(code) >= SEXP_OP_NUM_OPCODES)) res = sexp_type_exception(ctx, "make-opcode: bad opcode", code); else if (! sexp_fixnump(num_args)) res = sexp_type_exception(ctx, "make-opcode: bad num_args", num_args); @@ -2275,8 +2275,8 @@ sexp sexp_make_foreign (sexp ctx, char *name, int num_args, sexp_make_fixnum(num_args)); } else { res = sexp_alloc_type(ctx, opcode, SEXP_OPCODE); - sexp_opcode_class(res) = OPC_FOREIGN; - sexp_opcode_code(res) = OP_FCALL1+num_args-1; + sexp_opcode_class(res) = SEXP_OPC_FOREIGN; + sexp_opcode_code(res) = SEXP_OP_FCALL1+num_args-1; if (flags & 1) num_args--; sexp_opcode_num_args(res) = num_args; sexp_opcode_flags(res) = flags; @@ -2301,13 +2301,13 @@ sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_args, return res; } -#if USE_TYPE_DEFS +#if SEXP_USE_TYPE_DEFS sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type) { if (! sexp_fixnump(type)) return sexp_type_exception(ctx, "make-type-predicate: bad type", type); - return sexp_make_opcode(ctx, name, sexp_make_fixnum(OPC_TYPE_PREDICATE), - sexp_make_fixnum(OP_TYPEP), SEXP_ONE, SEXP_ZERO, + return sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_TYPE_PREDICATE), + sexp_make_fixnum(SEXP_OP_TYPEP), SEXP_ONE, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, type, NULL, NULL); } @@ -2316,8 +2316,8 @@ sexp sexp_make_constructor (sexp ctx, sexp name, sexp type) { if (! sexp_fixnump(type)) return sexp_type_exception(ctx, "make-constructor: bad type", type); type_size = sexp_type_size_base(&(sexp_type_specs[sexp_unbox_fixnum(type)])); - return sexp_make_opcode(ctx, name, sexp_make_fixnum(OPC_CONSTRUCTOR), - sexp_make_fixnum(OP_MAKE), SEXP_ZERO, SEXP_ZERO, + return sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_CONSTRUCTOR), + sexp_make_fixnum(SEXP_OP_MAKE), SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, type, sexp_make_fixnum(type_size), NULL); } @@ -2328,16 +2328,16 @@ sexp sexp_make_accessor (sexp ctx, sexp name, sexp type, sexp index, sexp code) if ((! sexp_fixnump(index)) || (sexp_unbox_fixnum(index) < 0)) return sexp_type_exception(ctx, "make-accessor: bad index", index); return - sexp_make_opcode(ctx, name, sexp_make_fixnum(OPC_ACCESSOR), code, - sexp_make_fixnum(sexp_unbox_fixnum(code)==OP_SLOT_REF?1:2), + sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_ACCESSOR), code, + sexp_make_fixnum(sexp_unbox_fixnum(code)==SEXP_OP_SLOT_REF?1:2), SEXP_ZERO, type, SEXP_ZERO, SEXP_ZERO, type, index, NULL); } sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index) { - return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(OP_SLOT_REF)); + return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(SEXP_OP_SLOT_REF)); } sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index) { - return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(OP_SLOT_SET)); + return sexp_make_accessor(ctx, name, type, index, sexp_make_fixnum(SEXP_OP_SLOT_SET)); } #endif @@ -2384,13 +2384,15 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) { sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), e); sexp_env_define(ctx, e, sexp_intern(ctx, "*module-directory*"), sexp_c_string(ctx, sexp_module_dir, -1)); +#if SEXP_USE_DL sexp_env_define(ctx, e, sexp_intern(ctx, "*shared-object-extension*"), sexp_c_string(ctx, sexp_so_extension, -1)); +#endif tmp = sexp_list1(ctx, sym=sexp_intern(ctx, sexp_platform)); sexp_push(ctx, tmp, sym=sexp_intern(ctx, "chibi")); sexp_env_define(ctx, e, sexp_intern(ctx, "*features*"), tmp); sexp_global(ctx, SEXP_G_OPTIMIZATIONS) = SEXP_NULL; -#if USE_SIMPLIFY +#if SEXP_USE_SIMPLIFY op = sexp_make_foreign(ctx, "simplify", 1, 0, (sexp_proc1)sexp_simplify, SEXP_VOID); tmp = sexp_cons(ctx, sexp_make_fixnum(500), op); @@ -2417,7 +2419,7 @@ sexp sexp_env_copy (sexp ctx, sexp to, sexp from, sexp ls) { value = sexp_env_global_ref(from, oldname, SEXP_UNDEF); if (value != SEXP_UNDEF) { sexp_env_define(ctx, to, newname, value); -#if USE_WARN_UNDEFS +#if SEXP_USE_WARN_UNDEFS } else if (sexp_oportp(out=sexp_current_error_port(ctx))) { sexp_write_string(ctx, "WARNING: importing undefined variable: ", out); sexp_write(ctx, oldname, out); diff --git a/gc.c b/gc.c index 4f4d43df..e53b83af 100644 --- a/gc.c +++ b/gc.c @@ -31,11 +31,11 @@ #define sexp_heap_align(n) sexp_align(n, 4) #endif -#if USE_GLOBAL_HEAP +#if SEXP_USE_GLOBAL_HEAP static sexp_heap sexp_global_heap; #endif -#if USE_DEBUG_GC +#if SEXP_USE_DEBUG_GC static sexp* stack_base; #endif @@ -76,7 +76,7 @@ void sexp_mark (sexp x) { } } -#if USE_DEBUG_GC +#if SEXP_USE_DEBUG_GC int stack_references_pointer_p (sexp ctx, sexp x) { sexp *p; for (p=(&x)+1; pstring */ /* will not be available by default. */ -/* #define USE_STRING_STREAMS 0 */ +/* #define SEXP_USE_STRING_STREAMS 0 */ /* uncomment this to disable automatic closing of ports */ /* If enabled, the underlying FILE* for file ports will be */ /* automatically closed when they're garbage collected. Doesn't */ /* apply to stdin/stdout/stderr. */ -/* #define USE_AUTOCLOSE_PORTS 0 */ +/* #define SEXP_USE_AUTOCLOSE_PORTS 0 */ /* uncomment this to use the normal 1970 unix epoch */ /* By default chibi uses an datetime epoch starting at */ /* 2010/01/01 00:00:00 in order to be able to represent */ /* more common times as fixnums. */ -/* #define USE_2010_EPOCH 0 */ +/* #define SEXP_USE_2010_EPOCH 0 */ /* uncomment this to disable stack overflow checks */ /* By default stacks are fairly small, so it's good to leave */ /* this enabled. */ -/* #define USE_CHECK_STACK 0 */ +/* #define SEXP_USE_CHECK_STACK 0 */ /* uncomment this to disable debugging utilities */ /* By default there's a `disasm' procedure you can use to */ /* view the compiled VM instructions of a procedure. You can */ /* disable this if you don't need it. */ -/* #define USE_DEBUG 0 */ +/* #define SEXP_USE_DEBUG 0 */ -/* #define USE_DEBUG_VM 0 */ +/* #define SEXP_USE_DEBUG_VM 0 */ /* Experts only. */ /* For *very* verbose output on every VM operation. */ @@ -144,130 +150,131 @@ #define _GNU_SOURCE #endif -#ifndef USE_MODULES -#define USE_MODULES 1 +#ifndef SEXP_USE_MODULES +#define SEXP_USE_MODULES 1 #endif -#ifndef USE_TYPE_DEFS -#define USE_TYPE_DEFS 1 +#ifndef SEXP_USE_TYPE_DEFS +#define SEXP_USE_TYPE_DEFS 1 #endif #ifndef SEXP_MAXIMUM_TYPES #define SEXP_MAXIMUM_TYPES ((sexp_tag_t)-1) #endif -#ifndef USE_DL +#ifndef SEXP_USE_DL #ifdef PLAN9 -#define USE_DL 0 +#define SEXP_USE_DL 0 #else -#define USE_DL 1 +#define SEXP_USE_DL 1 #endif #endif -#ifndef USE_SIMPLIFY -#define USE_SIMPLIFY 1 +#ifndef SEXP_USE_SIMPLIFY +#define SEXP_USE_SIMPLIFY 1 #endif -#ifndef USE_BOEHM -#define USE_BOEHM 0 +#ifndef SEXP_USE_BOEHM +#define SEXP_USE_BOEHM 0 #endif -#ifndef USE_MALLOC -#define USE_MALLOC 0 +#ifndef SEXP_USE_MALLOC +#define SEXP_USE_MALLOC 0 #endif -#ifndef USE_DEBUG_GC -#define USE_DEBUG_GC 0 +#ifndef SEXP_USE_DEBUG_GC +#define SEXP_USE_DEBUG_GC 0 #endif -#ifndef USE_GLOBAL_HEAP -#if USE_BOEHM || USE_MALLOC -#define USE_GLOBAL_HEAP 1 +#ifndef SEXP_USE_GLOBAL_HEAP +#if SEXP_USE_BOEHM || SEXP_USE_MALLOC +#define SEXP_USE_GLOBAL_HEAP 1 #else -#define USE_GLOBAL_HEAP 0 +#define SEXP_USE_GLOBAL_HEAP 0 #endif #endif -#ifndef USE_GLOBAL_SYMBOLS -#if USE_BOEHM || USE_MALLOC -#define USE_GLOBAL_SYMBOLS 1 +#ifndef SEXP_USE_GLOBAL_SYMBOLS +#if SEXP_USE_BOEHM || SEXP_USE_MALLOC +#define SEXP_USE_GLOBAL_SYMBOLS 1 #else -#define USE_GLOBAL_SYMBOLS 0 +#define SEXP_USE_GLOBAL_SYMBOLS 0 #endif #endif -#ifndef USE_FLONUMS -#define USE_FLONUMS 1 +#ifndef SEXP_USE_FLONUMS +#define SEXP_USE_FLONUMS 1 #endif -#ifndef USE_INFINITIES -#if defined(PLAN9) || ! USE_FLONUMS -#define USE_INFINITIES 0 +#ifndef SEXP_USE_INFINITIES +#if defined(PLAN9) || ! SEXP_USE_FLONUMS +#define SEXP_USE_INFINITIES 0 #else -#define USE_INFINITIES 1 +#define SEXP_USE_INFINITIES 1 #endif #endif -#ifndef USE_IMMEDIATE_FLONUMS -#define USE_IMMEDIATE_FLONUMS 0 +#ifndef SEXP_USE_IMMEDIATE_FLONUMS +#define SEXP_USE_IMMEDIATE_FLONUMS 0 #endif -#ifndef USE_BIGNUMS -#define USE_BIGNUMS 1 +#ifndef SEXP_USE_BIGNUMS +#define SEXP_USE_BIGNUMS 1 #endif -#ifndef USE_MATH -#define USE_MATH USE_FLONUMS +#ifndef SEXP_USE_MATH +#define SEXP_USE_MATH SEXP_USE_FLONUMS #endif -#ifndef USE_WARN_UNDEFS -#define USE_WARN_UNDEFS 1 +#ifndef SEXP_USE_WARN_UNDEFS +#define SEXP_USE_WARN_UNDEFS 1 #endif -#ifndef USE_HUFF_SYMS -#define USE_HUFF_SYMS 1 +#ifndef SEXP_USE_HUFF_SYMS +#define SEXP_USE_HUFF_SYMS 1 #endif -#ifndef USE_HASH_SYMS -#define USE_HASH_SYMS 1 +#ifndef SEXP_USE_HASH_SYMS +#define SEXP_USE_HASH_SYMS 1 #endif -#ifndef USE_DEBUG -#define USE_DEBUG 1 +#ifndef SEXP_USE_DEBUG +#define SEXP_USE_DEBUG 1 #endif -#ifndef USE_DEBUG_VM -#define USE_DEBUG_VM 0 +#ifndef SEXP_USE_DEBUG_VM +#define SEXP_USE_DEBUG_VM 0 #endif -#ifndef USE_STRING_STREAMS -#define USE_STRING_STREAMS 1 +#ifndef SEXP_USE_STRING_STREAMS +#define SEXP_USE_STRING_STREAMS 1 #endif -#ifndef USE_AUTOCLOSE_PORTS -#define USE_AUTOCLOSE_PORTS 1 +#ifndef SEXP_USE_AUTOCLOSE_PORTS +#define SEXP_USE_AUTOCLOSE_PORTS 1 #endif -#ifndef USE_2010_EPOCH -#define USE_2010_EPOCH 1 +#ifndef SEXP_USE_2010_EPOCH +#define SEXP_USE_2010_EPOCH 1 #endif #ifndef SEXP_EPOCH_OFFSET -#if USE_2010_EPOCH +#if SEXP_USE_2010_EPOCH #define SEXP_EPOCH_OFFSET 1262271600 #else #define SEXP_EPOCH_OFFSET 0 #endif #endif -#ifndef USE_CHECK_STACK -#define USE_CHECK_STACK 1 +#ifndef SEXP_USE_CHECK_STACK +#define SEXP_USE_CHECK_STACK 1 #endif #ifdef PLAN9 #define errx(code, msg, ...) exits(msg) #define exit_normally() exits(NULL) +#define exit_failure() exits("ERROR") #define strcasecmp cistrcmp #define strncasecmp cistrncmp #define round(x) floor((x)+0.5) @@ -276,6 +283,7 @@ #else #define exit_normally() exit(0) +#define exit_failure() exit(EXIT_FAILURE) #if HAVE_ERR_H #include #else diff --git a/include/chibi/eval.h b/include/chibi/eval.h index 7009a29a..633771c3 100644 --- a/include/chibi/eval.h +++ b/include/chibi/eval.h @@ -16,106 +16,106 @@ #define sexp_config_file "config.scm" enum sexp_core_form_names { - CORE_DEFINE = 1, - CORE_SET, - CORE_LAMBDA, - CORE_IF, - CORE_BEGIN, - CORE_QUOTE, - CORE_SYNTAX_QUOTE, - CORE_DEFINE_SYNTAX, - CORE_LET_SYNTAX, - CORE_LETREC_SYNTAX + SEXP_CORE_DEFINE = 1, + SEXP_CORE_SET, + SEXP_CORE_LAMBDA, + SEXP_CORE_IF, + SEXP_CORE_BEGIN, + SEXP_CORE_QUOTE, + SEXP_CORE_SYNTAX_QUOTE, + SEXP_CORE_DEFINE_SYNTAX, + SEXP_CORE_LET_SYNTAX, + SEXP_CORE_LETREC_SYNTAX }; enum sexp_opcode_classes { - OPC_GENERIC = 1, - OPC_TYPE_PREDICATE, - OPC_PREDICATE, - OPC_ARITHMETIC, - OPC_ARITHMETIC_INV, - OPC_ARITHMETIC_CMP, - OPC_IO, - OPC_CONSTRUCTOR, - OPC_ACCESSOR, - OPC_PARAMETER, - OPC_FOREIGN, - OPC_NUM_OP_CLASSES + SEXP_OPC_GENERIC = 1, + SEXP_OPC_TYPE_PREDICATE, + SEXP_OPC_PREDICATE, + SEXP_OPC_ARITHMETIC, + SEXP_OPC_ARITHMETIC_INV, + SEXP_OPC_ARITHMETIC_CMP, + SEXP_OPC_IO, + SEXP_OPC_CONSTRUCTOR, + SEXP_OPC_ACCESSOR, + SEXP_OPC_PARAMETER, + SEXP_OPC_FOREIGN, + SEXP_OPC_NUM_OP_CLASSES }; enum sexp_opcode_names { - OP_NOOP, - OP_RAISE, - OP_RESUMECC, - OP_CALLCC, - OP_APPLY1, - OP_TAIL_CALL, - OP_CALL, - OP_FCALL0, - OP_FCALL1, - OP_FCALL2, - OP_FCALL3, - OP_FCALL4, - OP_FCALL5, - OP_FCALL6, - OP_JUMP_UNLESS, - OP_JUMP, - OP_PUSH, - OP_DROP, - OP_GLOBAL_REF, - OP_GLOBAL_KNOWN_REF, - OP_STACK_REF, - OP_LOCAL_REF, - OP_LOCAL_SET, - OP_CLOSURE_REF, - OP_VECTOR_REF, - OP_VECTOR_SET, - OP_VECTOR_LENGTH, - OP_STRING_REF, - OP_STRING_SET, - OP_STRING_LENGTH, - OP_MAKE_PROCEDURE, - OP_MAKE_VECTOR, - OP_AND, - OP_NULLP, - OP_FIXNUMP, - OP_SYMBOLP, - OP_CHARP, - OP_EOFP, - OP_TYPEP, - OP_MAKE, - OP_SLOT_REF, - OP_SLOT_SET, - OP_CAR, - OP_CDR, - OP_SET_CAR, - OP_SET_CDR, - OP_CONS, - OP_ADD, - OP_SUB, - OP_MUL, - OP_DIV, - OP_QUOTIENT, - OP_REMAINDER, - OP_NEGATIVE, - OP_INVERSE, - OP_LT, - OP_LE, - OP_EQN, - OP_EQ, - OP_FIX2FLO, - OP_FLO2FIX, - OP_CHAR2INT, - OP_INT2CHAR, - OP_CHAR_UPCASE, - OP_CHAR_DOWNCASE, - OP_WRITE_CHAR, - OP_NEWLINE, - OP_READ_CHAR, - OP_PEEK_CHAR, - OP_RET, - OP_DONE, - OP_NUM_OPCODES + SEXP_OP_NOOP, + SEXP_OP_RAISE, + SEXP_OP_RESUMECC, + SEXP_OP_CALLCC, + SEXP_OP_APPLY1, + SEXP_OP_TAIL_CALL, + SEXP_OP_CALL, + SEXP_OP_FCALL0, + SEXP_OP_FCALL1, + SEXP_OP_FCALL2, + SEXP_OP_FCALL3, + SEXP_OP_FCALL4, + SEXP_OP_FCALL5, + SEXP_OP_FCALL6, + SEXP_OP_JUMP_UNLESS, + SEXP_OP_JUMP, + SEXP_OP_PUSH, + SEXP_OP_DROP, + SEXP_OP_GLOBAL_REF, + SEXP_OP_GLOBAL_KNOWN_REF, + SEXP_OP_STACK_REF, + SEXP_OP_LOCAL_REF, + SEXP_OP_LOCAL_SET, + SEXP_OP_CLOSURE_REF, + SEXP_OP_VECTOR_REF, + SEXP_OP_VECTOR_SET, + SEXP_OP_VECTOR_LENGTH, + SEXP_OP_STRING_REF, + SEXP_OP_STRING_SET, + SEXP_OP_STRING_LENGTH, + SEXP_OP_MAKE_PROCEDURE, + SEXP_OP_MAKE_VECTOR, + SEXP_OP_AND, + SEXP_OP_NULLP, + SEXP_OP_FIXNUMP, + SEXP_OP_SYMBOLP, + SEXP_OP_CHARP, + SEXP_OP_EOFP, + SEXP_OP_TYPEP, + SEXP_OP_MAKE, + SEXP_OP_SLOT_REF, + SEXP_OP_SLOT_SET, + SEXP_OP_CAR, + SEXP_OP_CDR, + SEXP_OP_SET_CAR, + SEXP_OP_SET_CDR, + SEXP_OP_CONS, + SEXP_OP_ADD, + SEXP_OP_SUB, + SEXP_OP_MUL, + SEXP_OP_DIV, + SEXP_OP_QUOTIENT, + SEXP_OP_REMAINDER, + SEXP_OP_NEGATIVE, + SEXP_OP_INVERSE, + SEXP_OP_LT, + SEXP_OP_LE, + SEXP_OP_EQN, + SEXP_OP_EQ, + SEXP_OP_FIX2FLO, + SEXP_OP_FLO2FIX, + SEXP_OP_CHAR2INT, + SEXP_OP_INT2CHAR, + SEXP_OP_CHAR_UPCASE, + SEXP_OP_CHAR_DOWNCASE, + SEXP_OP_WRITE_CHAR, + SEXP_OP_NEWLINE, + SEXP_OP_READ_CHAR, + SEXP_OP_PEEK_CHAR, + SEXP_OP_RET, + SEXP_OP_DONE, + SEXP_OP_NUM_OPCODES }; /**************************** prototypes ******************************/ @@ -142,7 +142,7 @@ SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, char *name, int num_a #define sexp_define_foreign(c,e,s,n,f) sexp_define_foreign_aux(c,e,s,n,0,(sexp_proc1)f,NULL) #define sexp_define_foreign_opt(c,e,s,n,f,d) sexp_define_foreign_aux(c,e,s,n,1,(sexp_proc1)f,d) -#if USE_TYPE_DEFS +#if SEXP_USE_TYPE_DEFS SEXP_API sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type); SEXP_API sexp sexp_make_constructor (sexp ctx, sexp name, sexp type); SEXP_API sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index); diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index 9e58e0b9..ba8c0bf9 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -11,7 +11,7 @@ #include #include -#if USE_DL +#if SEXP_USE_DL #include #endif @@ -56,7 +56,7 @@ typedef unsigned long size_t; #define SEXP_CHAR_TAG 6 #define SEXP_EXTENDED_TAG 14 -#if USE_HASH_SYMS +#if SEXP_USE_HASH_SYMS #define SEXP_SYMBOL_TABLE_SIZE 389 #else #define SEXP_SYMBOL_TABLE_SIZE 1 @@ -278,7 +278,7 @@ struct sexp_struct { #define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */ #define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */ -#if USE_BOEHM +#if SEXP_USE_BOEHM #define sexp_gc_var(ctx, x, y) sexp x; #define sexp_gc_preserve(ctx, x, y) @@ -307,7 +307,7 @@ struct sexp_struct { #define sexp_gc_release(ctx, x, y) (sexp_context_saves(ctx) = y.next) -#if USE_MALLOC +#if SEXP_USE_MALLOC #define sexp_alloc(ctx, size) malloc(size) #define sexp_alloc_atomic(ctx, size) malloc(size) #define sexp_realloc(ctx, x, size) realloc(x, size) @@ -358,7 +358,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size); #define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag) -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS #include "chibi/bignum.h" #endif @@ -402,7 +402,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size); #define sexp_slot_ref(x,i) (((sexp*)&((x)->value))[i]) #define sexp_slot_set(x,i,v) (((sexp*)&((x)->value))[i] = (v)) -#if USE_IMMEDIATE_FLONUMS +#if SEXP_USE_IMMEDIATE_FLONUMS union sexp_flonum_conv { float flonum; sexp_uint_t bits; @@ -466,14 +466,14 @@ sexp sexp_make_flonum(sexp ctx, double f); #define sexp_fixnum_to_double(x) ((double)sexp_unbox_fixnum(x)) -#if USE_FLONUMS +#if SEXP_USE_FLONUMS #define sexp_fp_integerp(x) (sexp_flonum_value(x) == trunc(sexp_flonum_value(x))) #define _or_integer_flonump(x) || (sexp_flonump(x) && sexp_fp_integerp(x)) #else #define _or_integer_flonump(x) #endif -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x); #define sexp_exact_integerp(x) (sexp_fixnump(x) || sexp_bignump(x)) #else @@ -483,13 +483,13 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x); #define sexp_integerp(x) (sexp_exact_integerp(x) _or_integer_flonump(x)) -#if USE_FLONUMS +#if SEXP_USE_FLONUMS #define sexp_fixnum_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_fixnum(x))) #else #define sexp_fixnum_to_flonum(ctx, x) (x) #endif -#if USE_FLONUMS || USE_BIGNUMS +#if SEXP_USE_FLONUMS || SEXP_USE_BIGNUMS #define sexp_uint_value(x) ((sexp_uint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_data(x)[0])) #define sexp_sint_value(x) ((sexp_sint_t)(sexp_fixnump(x) ? sexp_unbox_fixnum(x) : sexp_bignum_sign(x)*sexp_bignum_data(x)[0])) #else @@ -627,13 +627,13 @@ 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 USE_GLOBAL_HEAP +#if SEXP_USE_GLOBAL_HEAP #define sexp_context_heap(ctx) sexp_global_heap #else #define sexp_context_heap(ctx) ((ctx)->value.context.heap) #endif -#if USE_GLOBAL_SYMBOLS +#if SEXP_USE_GLOBAL_SYMBOLS #define sexp_context_symbols(ctx) sexp_symbol_table #else #define sexp_context_symbols(ctx) sexp_vector_data(sexp_global(ctx, SEXP_G_SYMBOLS)) @@ -676,7 +676,7 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x); /****************************** utilities *****************************/ enum sexp_context_globals { -#if ! USE_GLOBAL_SYMBOLS +#if ! SEXP_USE_GLOBAL_SYMBOLS SEXP_G_SYMBOLS, #endif SEXP_G_OOM_ERROR, /* out of memory exception object */ @@ -724,7 +724,7 @@ enum sexp_context_globals { /***************************** general API ****************************/ -#if USE_STRING_STREAMS +#if SEXP_USE_STRING_STREAMS #define sexp_read_char(x, p) (getc(sexp_port_stream(p))) #define sexp_push_char(x, c, p) (ungetc(c, sexp_port_stream(p))) @@ -795,13 +795,13 @@ SEXP_API sexp sexp_range_exception(sexp ctx, sexp obj, sexp start, sexp end); SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out); SEXP_API void sexp_init(void); -#if USE_GLOBAL_HEAP +#if SEXP_USE_GLOBAL_HEAP #define sexp_destroy_context(ctx) #else SEXP_API void sexp_destroy_context(sexp ctx); #endif -#if USE_TYPE_DEFS +#if SEXP_USE_TYPE_DEFS SEXP_API sexp sexp_register_type (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2); SEXP_API sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots); SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name); diff --git a/lib/chibi/posix.module b/lib/chibi/posix.module index 95502c94..7a05181a 100644 --- a/lib/chibi/posix.module +++ b/lib/chibi/posix.module @@ -3,7 +3,9 @@ (export open-input-fd open-output-fd delete-file link-file symbolic-link rename-file directory-files create-directory delete-directory - current-seconds) + current-seconds + exit + ) (import (scheme)) (include-shared "posix") (include "posix.scm")) diff --git a/lib/chibi/posix.stub b/lib/chibi/posix.stub index a38eb0b1..b986952d 100644 --- a/lib/chibi/posix.stub +++ b/lib/chibi/posix.stub @@ -29,10 +29,10 @@ (define-c pid_t fork ()) ;; (define-c pid_t wait ((result pointer int))) -;; (define-c void exit (int)) -;; (define-c int (execute execvp) (string (array string null))) +(define-c void exit (int)) +;;(define-c int (execute execvp) (string (array string null))) -;;(define-c errno pipe ((result array int 2))) +;;(define-c errno pipe ((result (array int 2)))) (define-c time_t (current-seconds time) ((value NULL))) diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c index ece6eb53..d89227cc 100644 --- a/lib/srfi/27/rand.c +++ b/lib/srfi/27/rand.c @@ -42,7 +42,7 @@ static sexp sexp_rs_random_integer (sexp ctx, sexp rs, sexp bound) { if (sexp_fixnump(bound)) { sexp_call_random(rs, n); res = sexp_make_fixnum(n % sexp_unbox_fixnum(bound)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(bound)) { hi = sexp_bignum_hi(bound); len = hi * sizeof(sexp_uint_t) / sizeof(int32_t); @@ -100,7 +100,7 @@ static sexp sexp_random_source_state_set (sexp ctx, sexp rs, sexp state) { return sexp_type_exception(ctx, "not a random-source", rs); else if (sexp_fixnump(state)) *sexp_random_data(rs) = sexp_unbox_fixnum(state); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(state)) *sexp_random_data(rs) = sexp_bignum_data(state)[0]*sexp_bignum_sign(state); diff --git a/lib/srfi/33/bit.c b/lib/srfi/33/bit.c index 4af9118c..396dbc6f 100644 --- a/lib/srfi/33/bit.c +++ b/lib/srfi/33/bit.c @@ -2,7 +2,7 @@ #include #include -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS #include #endif @@ -12,13 +12,13 @@ static sexp sexp_bit_and (sexp ctx, sexp x, sexp y) { if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = (sexp) ((sexp_uint_t)x & (sexp_uint_t)y); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(y)) res = sexp_bit_and(ctx, y, x); #endif else res = sexp_type_exception(ctx, "bitwise-and: not an integer", y); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(x)) { if (sexp_fixnump(y)) { res = sexp_make_fixnum(sexp_unbox_fixnum(y) & sexp_bignum_data(x)[0]); @@ -46,13 +46,13 @@ static sexp sexp_bit_ior (sexp ctx, sexp x, sexp y) { if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = (sexp) ((sexp_uint_t)x | (sexp_uint_t)y); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(y)) res = sexp_bit_ior(ctx, y, x); #endif else res = sexp_type_exception(ctx, "bitwise-ior: not an integer", y); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(x)) { if (sexp_fixnump(y)) { res = sexp_copy_bignum(ctx, NULL, x, 0); @@ -84,13 +84,13 @@ static sexp sexp_bit_xor (sexp ctx, sexp x, sexp y) { if (sexp_fixnump(x)) { if (sexp_fixnump(y)) res = sexp_make_fixnum(sexp_unbox_fixnum(x) ^ sexp_unbox_fixnum(y)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS else if (sexp_bignump(y)) res = sexp_bit_xor(ctx, y, x); #endif else res = sexp_type_exception(ctx, "bitwise-xor: not an integer", y); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(x)) { if (sexp_fixnump(y)) { res = sexp_copy_bignum(ctx, NULL, x, 0); @@ -131,12 +131,12 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) { res = sexp_make_fixnum(sexp_unbox_fixnum(i) >> -c); } else { tmp = (sexp_uint_t)sexp_unbox_fixnum(i) << c; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS if (((tmp >> c) == sexp_unbox_fixnum(i)) && (tmp < SEXP_MAX_FIXNUM) && (tmp > SEXP_MIN_FIXNUM)) { #endif res = sexp_make_fixnum(tmp); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else { sexp_gc_preserve1(ctx, res); res = sexp_fixnum_to_bignum(ctx, i); @@ -145,7 +145,7 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp i, sexp count) { } #endif } -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(i)) { len = sexp_bignum_hi(i); if (c < 0) { @@ -198,7 +198,7 @@ static sexp sexp_bit_count (sexp ctx, sexp x) { if (sexp_fixnump(x)) { i = sexp_unbox_fixnum(x); res = sexp_make_fixnum(bit_count(i<0 ? ~i : i)); -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS } else if (sexp_bignump(x)) { for (i=count=0; i include/chibi/install.h + echo '#define sexp_platform "plan9"' >> include/chibi/install.h install:V: $BIN/$TARG test -d $MODDIR || mkdir -p $MODDIR diff --git a/opcodes.c b/opcodes.c index c18f7230..12949b3d 100644 --- a/opcodes.c +++ b/opcodes.c @@ -2,73 +2,73 @@ #define _OP(c,o,n,m,t,u,i,s,d,f) \ {.tag=SEXP_OPCODE, \ .value={.opcode={c, o, n, m, t, u, i, s, d, NULL, NULL, f}}} -#define _FN(o,n,m,t,u,s,d,f) _OP(OPC_FOREIGN, o, n, m, t, u, 0, s, d, (sexp_proc1)f) -#define _FN0(s, d, f) _FN(OP_FCALL0, 0, 0, 0, 0, s, d, f) -#define _FN1(t, s, d, f) _FN(OP_FCALL1, 1, 0, t, 0, s, d, f) -#define _FN1OPT(t, s, d, f) _FN(OP_FCALL1, 0, 1, t, u, s, d, f) -#define _FN1OPTP(t, s, d, f) _FN(OP_FCALL1, 0, 3, t, 0, s, d, f) -#define _FN2(t, u, s, d, f) _FN(OP_FCALL2, 2, 0, t, u, s, d, f) -#define _FN2OPT(t, u, s, d, f) _FN(OP_FCALL2, 1, 1, t, u, s, d, f) -#define _FN2OPTP(t, u, s, d, f) _FN(OP_FCALL2, 1, 3, t, u, s, d, f) -#define _FN3(t, u, s, d, f) _FN(OP_FCALL3, 3, 0, t, u, s, d, f) -#define _FN4(t, u, s, d, f) _FN(OP_FCALL4, 4, 0, t, u, s, d, f) -#define _FN5(t, u, s, d, f) _FN(OP_FCALL5, 5, 0, t, u, s, d, f) -#define _FN6(t, u, s, d, f) _FN(OP_FCALL6, 6, 0, t, u, s, d, f) -#define _PARAM(n, a, t) _OP(OPC_PARAMETER, OP_NOOP, 0, 3, t, 0, 0, n, a, 0) +#define _FN(o,n,m,t,u,s,d,f) _OP(SEXP_OPC_FOREIGN, o, n, m, t, u, 0, s, d, (sexp_proc1)f) +#define _FN0(s, d, f) _FN(SEXP_OP_FCALL0, 0, 0, 0, 0, s, d, f) +#define _FN1(t, s, d, f) _FN(SEXP_OP_FCALL1, 1, 0, t, 0, s, d, f) +#define _FN1OPT(t, s, d, f) _FN(SEXP_OP_FCALL1, 0, 1, t, u, s, d, f) +#define _FN1OPTP(t, s, d, f) _FN(SEXP_OP_FCALL1, 0, 3, t, 0, s, d, f) +#define _FN2(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 2, 0, t, u, s, d, f) +#define _FN2OPT(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 1, 1, t, u, s, d, f) +#define _FN2OPTP(t, u, s, d, f) _FN(SEXP_OP_FCALL2, 1, 3, t, u, s, d, f) +#define _FN3(t, u, s, d, f) _FN(SEXP_OP_FCALL3, 3, 0, t, u, s, d, f) +#define _FN4(t, u, s, d, f) _FN(SEXP_OP_FCALL4, 4, 0, t, u, s, d, f) +#define _FN5(t, u, s, d, f) _FN(SEXP_OP_FCALL5, 5, 0, t, u, s, d, f) +#define _FN6(t, u, s, d, f) _FN(SEXP_OP_FCALL6, 6, 0, t, u, s, d, f) +#define _PARAM(n, a, t) _OP(SEXP_OPC_PARAMETER, SEXP_OP_NOOP, 0, 3, t, 0, 0, n, a, 0) static struct sexp_struct opcodes[] = { -_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL), -_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL), -_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL), -_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL), -_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL), -_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL), -_OP(OPC_ACCESSOR, OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL), -_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL), -_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL), -_OP(OPC_ACCESSOR, OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL), -_OP(OPC_GENERIC, OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL), -_OP(OPC_GENERIC, OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL), -_OP(OPC_GENERIC, OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL), -_OP(OPC_GENERIC, OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL), -_OP(OPC_GENERIC, OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL), -_OP(OPC_GENERIC, OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL), -_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL), -_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL), -_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEGATIVE, "-", 0, NULL), -_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INVERSE, "/", 0, NULL), -_OP(OPC_ARITHMETIC, OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL), -_OP(OPC_ARITHMETIC, OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL), -_OP(OPC_ARITHMETIC_CMP, OP_LT, 2, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL), -_OP(OPC_ARITHMETIC_CMP, OP_LE, 2, 1, SEXP_FIXNUM, 0, 0, "<=", 0, NULL), -_OP(OPC_ARITHMETIC_CMP, OP_LT, 2, 1, SEXP_FIXNUM, 0, 1, ">", 0, NULL), -_OP(OPC_ARITHMETIC_CMP, OP_LE, 2, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL), -_OP(OPC_ARITHMETIC_CMP, OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL), -_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL), -_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL), -_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL), -_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL), -_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0), -_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0), -_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0), -_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0), -_OP(OPC_TYPE_PREDICATE, OP_FIXNUMP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "bignum?", sexp_make_fixnum(SEXP_BIGNUM), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0), -_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0), -_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL), -_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL), -_OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL), -_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL), -_OP(OPC_IO, OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL), -_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL), -_OP(OPC_IO, OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_VECTOR_LENGTH,1,0, SEXP_VECTOR, 0, 0,"vector-length", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", 0, NULL), +_OP(SEXP_OPC_ACCESSOR, SEXP_OP_STRING_LENGTH,1,0, SEXP_STRING, 0, 0,"string-length", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_FIX2FLO, 1, 0, 0, 0, 0, "exact->inexact", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_FLO2FIX, 1, 0, 0, 0, 0, "inexact->exact", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR2INT, 1, 0, SEXP_CHAR, 0, 0, "char->integer", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_INT2CHAR, 1, 0, SEXP_FIXNUM, 0, 0, "integer->char", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_UPCASE, 1, 0, SEXP_CHAR, 0, 0, "char-upcase", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_CHAR_DOWNCASE, 1, 0, SEXP_CHAR, 0, 0, "char-downcase", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", sexp_make_fixnum(0), NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", sexp_make_fixnum(1), NULL), +_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_SUB, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_NEGATIVE, "-", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_INV, SEXP_OP_DIV, 0, 1, SEXP_FIXNUM, 0, SEXP_OP_INVERSE, "/", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_QUOTIENT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC, SEXP_OP_REMAINDER, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "remainder", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 2, 1, SEXP_FIXNUM, 0, 0, "<", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LE, 2, 1, SEXP_FIXNUM, 0, 0, "<=", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LT, 2, 1, SEXP_FIXNUM, 0, 1, ">", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_LE, 2, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL), +_OP(SEXP_OPC_ARITHMETIC_CMP, SEXP_OP_EQN, 2, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL), +_OP(SEXP_OPC_PREDICATE, SEXP_OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL), +_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL), +_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL), +_OP(SEXP_OPC_CONSTRUCTOR, SEXP_OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_FIXNUMP, 1, 0, 0, 0, 0, "fixnum?", NULL, 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_fixnum(SEXP_PAIR), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "bignum?", sexp_make_fixnum(SEXP_BIGNUM), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "closure?", sexp_make_fixnum(SEXP_PROCEDURE), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "opcode?", sexp_make_fixnum(SEXP_OPCODE), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", sexp_make_fixnum(SEXP_IPORT), 0), +_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", sexp_make_fixnum(SEXP_OPORT), 0), +_OP(SEXP_OPC_GENERIC, SEXP_OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL), +_OP(SEXP_OPC_GENERIC, SEXP_OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL), +_OP(SEXP_OPC_IO, SEXP_OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL), +_OP(SEXP_OPC_IO, SEXP_OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL), +_OP(SEXP_OPC_IO, SEXP_OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL), +_OP(SEXP_OPC_IO, SEXP_OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL), _FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read), _FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write), _FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display), @@ -113,7 +113,7 @@ _PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV), _FN0("open-output-string", 0, sexp_make_output_string_port), _FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port), _FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string), -#if USE_MATH +#if SEXP_USE_MATH _FN1(0, "exp", 0, sexp_exp), _FN1(0, "log", 0, sexp_log), _FN1(0, "sin", 0, sexp_sin), @@ -129,14 +129,14 @@ _FN1(0, "floor", 0, sexp_floor), _FN1(0, "ceiling", 0, sexp_ceiling), _FN2(0, 0, "expt", 0, sexp_expt), #endif -#if USE_TYPE_DEFS +#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), _FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor), _FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter), _FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter), #endif -#if USE_DEBUG +#if SEXP_USE_DEBUG _FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sexp_disasm), #endif #if PLAN9 diff --git a/opt/debug.c b/opt/debug.c index 4d0631f2..16419d3a 100644 --- a/opt/debug.c +++ b/opt/debug.c @@ -57,45 +57,45 @@ static sexp disasm (sexp ctx, sexp bc, sexp out, int depth) { sexp_printf(ctx, out, " %d ", opcode); } switch (opcode) { - case OP_STACK_REF: - case OP_LOCAL_REF: - case OP_LOCAL_SET: - case OP_CLOSURE_REF: - case OP_JUMP: - case OP_JUMP_UNLESS: - case OP_TYPEP: - case OP_FCALL0: - case OP_FCALL1: - case OP_FCALL2: - case OP_FCALL3: - case OP_FCALL4: - case OP_FCALL5: - case OP_FCALL6: + case SEXP_OP_STACK_REF: + case SEXP_OP_LOCAL_REF: + case SEXP_OP_LOCAL_SET: + case SEXP_OP_CLOSURE_REF: + case SEXP_OP_JUMP: + case SEXP_OP_JUMP_UNLESS: + case SEXP_OP_TYPEP: + case SEXP_OP_FCALL0: + case SEXP_OP_FCALL1: + case SEXP_OP_FCALL2: + case SEXP_OP_FCALL3: + case SEXP_OP_FCALL4: + case SEXP_OP_FCALL5: + case SEXP_OP_FCALL6: sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]); ip += sizeof(sexp); break; - case OP_SLOT_REF: - case OP_SLOT_SET: - case OP_MAKE: + case SEXP_OP_SLOT_REF: + case SEXP_OP_SLOT_SET: + case SEXP_OP_MAKE: ip += sizeof(sexp)*2; break; - case OP_GLOBAL_REF: - case OP_GLOBAL_KNOWN_REF: - case OP_TAIL_CALL: - case OP_CALL: - case OP_PUSH: + case SEXP_OP_GLOBAL_REF: + case SEXP_OP_GLOBAL_KNOWN_REF: + case SEXP_OP_TAIL_CALL: + case SEXP_OP_CALL: + case SEXP_OP_PUSH: tmp = ((sexp*)ip)[0]; - if (((opcode == OP_GLOBAL_REF) || (opcode == OP_GLOBAL_KNOWN_REF)) + if (((opcode == SEXP_OP_GLOBAL_REF) || (opcode == SEXP_OP_GLOBAL_KNOWN_REF)) && sexp_pairp(tmp)) tmp = sexp_car(tmp); - else if ((opcode == OP_PUSH) && (sexp_pairp(tmp) || sexp_idp(tmp))) + else if ((opcode == SEXP_OP_PUSH) && (sexp_pairp(tmp) || sexp_idp(tmp))) sexp_write_char(ctx, '\'', out); sexp_write(ctx, tmp, out); ip += sizeof(sexp); break; } sexp_write_char(ctx, '\n', out); - if ((opcode == OP_PUSH) && (depth < SEXP_DISASM_MAX_DEPTH) + if ((opcode == SEXP_OP_PUSH) && (depth < SEXP_DISASM_MAX_DEPTH) && (sexp_bytecodep(tmp) || sexp_procedurep(tmp))) disasm(ctx, tmp, out, depth+1); if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc)) @@ -107,7 +107,7 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { return disasm(ctx, bc, out, 0); } -#if USE_DEBUG_VM +#if SEXP_USE_DEBUG_VM static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out) { int i; if (! sexp_oport(out)) out = sexp_current_error_port(ctx); diff --git a/opt/plan9.c b/opt/plan9.c index 68346ab8..b103912a 100644 --- a/opt/plan9.c +++ b/opt/plan9.c @@ -186,7 +186,7 @@ void sexp_run_9p_handler (Req *r, sexp handler) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, r); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, r, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); sexp_apply(ctx, handler, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -216,11 +216,11 @@ char* sexp_9p_walk1 (Fid *fid, char *name, Qid *qid) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, qid); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, qid, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); ptr = sexp_c_string(ctx, name, -1); args = sexp_cons(ctx, ptr, args); - ptr = sexp_make_cpointer(ctx, fid); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, fid, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, args); res = sexp_apply(ctx, s->walk1, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -234,9 +234,9 @@ char* sexp_9p_clone (Fid *oldfid, Fid *newfid) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, oldfid); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, oldfid, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); - ptr = sexp_make_cpointer(ctx, newfid); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, newfid, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, args); res = sexp_apply(ctx, s->clone, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -250,7 +250,7 @@ void sexp_9p_destroyfid (Fid *fid) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, fid); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, fid, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); sexp_apply(ctx, s->destroyfid, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -263,7 +263,7 @@ void sexp_9p_destroyreq (Req *r) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, r); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, r, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); sexp_apply(ctx, s->destroyreq, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -276,7 +276,7 @@ void sexp_9p_end (Srv *srv) { sexp_gc_var(ctx, args, s_args); sexp_gc_preserve(ctx, ptr, s_ptr); sexp_gc_preserve(ctx, args, s_args); - ptr = sexp_make_cpointer(ctx, srv); + ptr = sexp_make_cpointer(ctx, SEXP_CPOINTER, srv, SEXP_FALSE, 0); args = sexp_cons(ctx, ptr, SEXP_NULL); sexp_apply(ctx, s->end, args); sexp_gc_release(ctx, ptr, s_ptr); @@ -331,11 +331,11 @@ sexp sexp_9p_req_path (sexp ctx, sexp req) { #endif sexp sexp_9p_req_fid (sexp ctx, sexp req) { - return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->fid); + return sexp_make_cpointer(ctx, SEXP_CPOINTER, ((Req*)sexp_cpointer_value(req))->fid, SEXP_FALSE, 0); } sexp sexp_9p_req_newfid (sexp ctx, sexp req) { - return sexp_make_cpointer(ctx, ((Req*)sexp_cpointer_value(req))->newfid); + return sexp_make_cpointer(ctx, SEXP_CPOINTER, ((Req*)sexp_cpointer_value(req))->newfid, SEXP_FALSE, 0); } sexp sexp_9p_respond (sexp ctx, sexp req, sexp err) { diff --git a/opt/simplify.c b/opt/simplify.c index 4092f791..e01e4042 100644 --- a/opt/simplify.c +++ b/opt/simplify.c @@ -22,7 +22,7 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) { sexp_push(ctx, app, tmp=simplify(ctx, sexp_car(ls1), substs, lambda)); app = sexp_nreverse(ctx, app); if (sexp_opcodep(sexp_car(app))) { - if (sexp_opcode_class(sexp_car(app)) == OPC_ARITHMETIC) { + if (sexp_opcode_class(sexp_car(app)) == SEXP_OPC_ARITHMETIC) { for (check=1, ls1=sexp_cdr(app); sexp_pairp(ls1); ls1=sexp_cdr(ls1)) { if (sexp_pointerp(sexp_car(ls1)) && ! sexp_litp(sexp_car(ls1))) { check = 0; diff --git a/sexp.c b/sexp.c index f6d9d529..aad2b3b0 100644 --- a/sexp.c +++ b/sexp.c @@ -10,7 +10,7 @@ struct sexp_huff_entry { unsigned short bits; }; -#if USE_HUFF_SYMS +#if SEXP_USE_HUFF_SYMS #include "opt/sexp-hufftabs.c" static struct sexp_huff_entry huff_table[] = { #include "opt/sexp-huff.c" @@ -43,7 +43,7 @@ static int is_separator(int c) { return 0>3; while (c) { @@ -1270,7 +1270,7 @@ sexp sexp_read_number(sexp ctx, sexp in, int base) { if ((digit < 0) || (digit >= base)) break; tmp = res * base + digit; -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS if ((tmp < res) || (tmp > SEXP_MAX_FIXNUM)) { sexp_push_char(ctx, c, in); return sexp_read_bignum(ctx, in, res, (negativep ? -1 : 1), base); @@ -1514,16 +1514,16 @@ sexp sexp_read_raw (sexp ctx, sexp in) { sexp_push_char(ctx, c2, in); res = sexp_read_number(ctx, in, 10); if ((c1 == '-') && ! sexp_exceptionp(res)) { -#if USE_FLONUMS +#if SEXP_USE_FLONUMS if (sexp_flonump(res)) -#if USE_IMMEDIATE_FLONUMS +#if SEXP_USE_IMMEDIATE_FLONUMS res = sexp_make_flonum(ctx, -1 * sexp_flonum_value(res)); #else sexp_flonum_value(res) = -1 * sexp_flonum_value(res); #endif else #endif -#if USE_BIGNUMS +#if SEXP_USE_BIGNUMS if (sexp_bignump(res)) sexp_bignum_sign(res) = -sexp_bignum_sign(res); else @@ -1533,7 +1533,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) { } else { sexp_push_char(ctx, c2, in); res = sexp_read_symbol(ctx, in, c1, 1); -#if USE_INFINITIES +#if SEXP_USE_INFINITIES if (res == sexp_intern(ctx, "+inf.0")) res = sexp_make_flonum(ctx, 1.0/0.0); else if (res == sexp_intern(ctx, "-inf.0")) @@ -1591,21 +1591,21 @@ sexp sexp_write_to_string(sexp ctx, sexp obj) { } void sexp_init(void) { -#if USE_GLOBAL_SYMBOLS +#if SEXP_USE_GLOBAL_SYMBOLS int i; #endif if (! sexp_initialized_p) { sexp_initialized_p = 1; -#if USE_BOEHM +#if SEXP_USE_BOEHM GC_init(); -#if USE_GLOBAL_SYMBOLS +#if SEXP_USE_GLOBAL_SYMBOLS GC_add_roots((char*)&sexp_symbol_table, ((char*)&sexp_symbol_table)+sizeof(sexp_symbol_table)+1); #endif -#elif ! USE_MALLOC +#elif ! SEXP_USE_MALLOC sexp_gc_init(); #endif -#if USE_GLOBAL_SYMBOLS +#if SEXP_USE_GLOBAL_SYMBOLS for (i=0; i