diff --git a/Makefile b/Makefile index 05fbbc9c..edf7867a 100644 --- a/Makefile +++ b/Makefile @@ -24,7 +24,8 @@ SO = .dylib EXE = CLIBFLAGS = -dynamiclib STATICFLAGS = -static-libgcc -else ifeq ($(PLATFORM),mingw) +else +ifeq ($(PLATFORM),mingw) SO = .dll EXE = .exe CLIBFLAGS = -fPIC -shared @@ -34,6 +35,7 @@ EXE = CLIBFLAGS = -fPIC -shared STATICFLAGS = -static endif +endif ifdef USE_BOEHM GCLDFLAGS := -lgc @@ -90,6 +92,7 @@ test: chibi-scheme ./chibi-scheme tests/r5rs-tests.scm install: chibi-scheme + mkdir -p $(BINDIR) cp chibi-scheme $(BINDIR)/ mkdir -p $(MODDIR) cp init.scm $(MODDIR)/ diff --git a/debug.c b/debug.c index 8a03a8a8..d8a51689 100644 --- a/debug.c +++ b/debug.c @@ -28,9 +28,9 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { loop: opcode = *ip++; if (opcode*sizeof(char*) < sizeof(reverse_opcode_names)) { - sexp_printf(out, " %s ", reverse_opcode_names[opcode]); + sexp_printf(ctx, out, " %s ", reverse_opcode_names[opcode]); } else { - sexp_printf(out, " %d ", opcode); + sexp_printf(ctx, out, " %d ", opcode); } switch (opcode) { case OP_STACK_REF: @@ -44,7 +44,7 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { case OP_FCALL2: case OP_FCALL3: case OP_TYPEP: - sexp_printf(out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]); + sexp_printf(ctx, out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]); ip += sizeof(sexp); break; case OP_GLOBAL_REF: @@ -52,11 +52,11 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { case OP_TAIL_CALL: case OP_CALL: case OP_PUSH: - sexp_write(((sexp*)ip)[0], out); + sexp_write(ctx, ((sexp*)ip)[0], out); ip += sizeof(sexp); break; } - sexp_write_char('\n', out); + sexp_write_char(ctx, '\n', out); if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc)) goto loop; return SEXP_VOID; @@ -66,9 +66,9 @@ static sexp sexp_disasm (sexp ctx, sexp bc, sexp out) { static void sexp_print_stack (sexp *stack, int top, int fp, sexp out) { int i; for (i=0; i ", out); - sexp_flush(out); + sexp_flush(ctx, out); obj = sexp_read(ctx, in); if (obj == SEXP_EOF) break; @@ -65,7 +65,7 @@ void repl (sexp ctx) { sexp_context_top(ctx) = 0; res = sexp_eval(ctx, obj); #if USE_WARN_UNDEFS - sexp_warn_undefs(sexp_env_bindings(env), tmp, err); + sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, err); #endif if (res != SEXP_VOID) { sexp_write(ctx, res, out); @@ -89,7 +89,6 @@ void run_main (int argc, char **argv) { /* parse options */ for (i=1; i < argc && argv[i][0] == '-'; i++) { switch (argv[i][1]) { -#if USE_STRING_STREAMS case 'e': case 'p': if (! init_loaded++) @@ -106,7 +105,6 @@ void run_main (int argc, char **argv) { quit=1; i++; break; -#endif case 'l': if (! init_loaded++) sexp_load(ctx, str=find_module_file(ctx, sexp_init_file), env); diff --git a/opcodes.c b/opcodes.c index 33371854..52e75045 100644 --- a/opcodes.c +++ b/opcodes.c @@ -119,11 +119,9 @@ _FN1(0, "floor", 0, sexp_floor), _FN1(0, "ceiling", 0, sexp_ceiling), _FN2(0, 0, "expt", 0, sexp_expt), #endif -#if USE_STRING_STREAMS _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), -#endif #if USE_DEBUG _FN2(SEXP_PROCEDURE, SEXP_OPORT, "disasm", 0, sexp_disasm), #endif diff --git a/sexp.c b/sexp.c index 2279349a..ea0adbd9 100644 --- a/sexp.c +++ b/sexp.c @@ -594,9 +594,11 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) { sexp res; sexp_gc_var(ctx, cookie, s_cookie); sexp_gc_preserve(ctx, cookie, s_cookie); - cookie = sexp_vector(ctx, 4, ctx, str, - sexp_make_integer(sexp_string_length(str)), - sexp_make_integer(0)); + cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID); + sexp_stream_ctx(cookie) = ctx; + sexp_stream_buf(cookie) = str; + sexp_stream_size(cookie) = sexp_make_integer(sexp_string_length(str)); + sexp_stream_pos(cookie) = sexp_make_integer(0); in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL); res = sexp_make_input_port(ctx, in, SEXP_FALSE); sexp_port_cookie(res) = cookie; @@ -610,8 +612,11 @@ sexp sexp_make_output_string_port (sexp ctx) { sexp_gc_var(ctx, cookie, s_cookie); sexp_gc_preserve(ctx, cookie, s_cookie); size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE); - cookie = sexp_vector(ctx, 4, ctx, sexp_make_string(ctx, size, SEXP_VOID), - size, sexp_make_integer(0)); + cookie = sexp_make_vector(ctx, sexp_make_integer(4), SEXP_VOID); + sexp_stream_ctx(cookie) = ctx; + sexp_stream_buf(cookie) = sexp_make_string(ctx, size, SEXP_VOID); + sexp_stream_size(cookie) = size; + sexp_stream_pos(cookie) = sexp_make_integer(0); out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL); res = sexp_make_output_port(ctx, out, SEXP_FALSE); sexp_port_cookie(res) = cookie; @@ -672,7 +677,7 @@ int sexp_buffered_read_char (sexp ctx, sexp p) { sexp sexp_buffered_write_char (sexp ctx, int c, sexp p) { if (sexp_port_offset(p) >= sexp_port_size(p)) sexp_buffered_flush(ctx, p); - sexp_port_buf(p)[sexp_port_offset(p)++] = (c); + sexp_port_buf(p)[sexp_port_offset(p)++] = c; return SEXP_VOID; } @@ -685,29 +690,29 @@ sexp sexp_buffered_write_string_n (sexp ctx, char *str, sexp_uint_t len, sexp p) } sexp sexp_buffered_write_string (sexp ctx, char *str, sexp p) { - return sexp_buffered_write_string_n(str, strlen(str), p); + return sexp_buffered_write_string_n(ctx, str, strlen(str), p); } sexp sexp_buffered_flush (sexp ctx, sexp p) { sexp_gc_var(ctx, tmp, s_tmp); - sexp_gc_preserve(ctx, tmp, s_tmp); -/* if (! sexp_oportp(p)) */ -/* return sexp_type_exception(); */ -/* else if (! sexp_port_openp(p)) */ -/* return sexp_make_exception(); */ -/* else { */ - if (sexp_port_stream(p)) { - fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p)); - sexp_port_offset(p) = 0; - fflush(sexp_port_stream(p)); - } else if (sexp_port_offset(p) > 0) { - tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p)); - sexp_push(ctx, sexp_port_cookie(p), tmp); - sexp_port_offset(p) = 0; + if (! sexp_oportp(p)) + return sexp_type_exception(ctx, "not an output-port", p); + else if (! sexp_port_openp(p)) + return sexp_user_exception(ctx, SEXP_FALSE, "port is closed", p); + else { + if (sexp_port_stream(p)) { + fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p)); + sexp_port_offset(p) = 0; + fflush(sexp_port_stream(p)); + } else if (sexp_port_offset(p) > 0) { + sexp_gc_preserve(ctx, tmp, s_tmp); + tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p)); + sexp_push(ctx, sexp_port_cookie(p), tmp); + sexp_port_offset(p) = 0; + sexp_gc_release(ctx, tmp, s_tmp); + } + return SEXP_VOID; } - sexp_gc_release(ctx, tmp, s_tmp); - return SEXP_VOID; -/* } */ } sexp sexp_make_input_string_port (sexp ctx, sexp str) { @@ -751,17 +756,15 @@ sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name) { sexp_port_stream(p) = in; sexp_port_name(p) = name; sexp_port_line(p) = 0; + sexp_port_buf(p) = NULL; sexp_port_openp(p) = 1; + sexp_port_cookie(p) = SEXP_VOID; return p; } sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name) { - sexp p = sexp_alloc_type(ctx, port, SEXP_OPORT); - sexp_port_stream(p) = out; - sexp_port_name(p) = name; - sexp_port_line(p) = 0; - sexp_port_buf(p) = NULL; - sexp_port_openp(p) = 1; + sexp p = sexp_make_input_port(ctx, out, name); + sexp_pointer_tag(p) = SEXP_OPORT; return p; }