mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-08 21:47:33 +02:00
switching to linking as a library
This commit is contained in:
parent
56dcf497de
commit
24d9bfc950
8 changed files with 170 additions and 115 deletions
62
Makefile
62
Makefile
|
@ -1,29 +1,65 @@
|
||||||
|
# -*- makefile-gmake -*-
|
||||||
|
|
||||||
.PHONY: all doc dist clean cleaner test install uninstall
|
.PHONY: all doc dist clean cleaner test install uninstall
|
||||||
|
|
||||||
all: chibi-scheme
|
all: chibi-scheme
|
||||||
|
|
||||||
PREFIX=/usr/local
|
CC ?= cc
|
||||||
|
PREFIX ?= /usr/local
|
||||||
BINDIR=$(PREFIX)/bin
|
BINDIR=$(PREFIX)/bin
|
||||||
LIBDIR=$(PREFIX)/lib
|
LIBDIR=$(PREFIX)/lib
|
||||||
INCDIR=$(PREFIX)/include/chibi-scheme
|
INCDIR=$(PREFIX)/include/chibi
|
||||||
MODDIR=$(PREFIX)/share/chibi-scheme
|
MODDIR=$(PREFIX)/share/chibi
|
||||||
|
|
||||||
LDFLAGS=-lm #-lgc -L/opt/local/lib
|
ifndef PLATFORM
|
||||||
|
ifeq ($(shell uname),Darwin)
|
||||||
|
PLATFORM=macosx
|
||||||
|
else
|
||||||
|
PLATFORM=unix
|
||||||
|
endif
|
||||||
|
endif
|
||||||
|
|
||||||
CFLAGS=-Wall -O2 -g #-I/opt/local/include #-save-temps
|
ifeq ($(PLATFORM),macosx)
|
||||||
|
SO = .dylib
|
||||||
|
EXE =
|
||||||
|
CLIBFLAGS = -dynamiclib
|
||||||
|
else ifeq ($(PLATFORM),mingw)
|
||||||
|
SO = .dll
|
||||||
|
EXE = .exe
|
||||||
|
CLIBFLAGS = -fPIC shared
|
||||||
|
else
|
||||||
|
SO = .so
|
||||||
|
EXE =
|
||||||
|
CLIBFLAGS = -fPIC -shared
|
||||||
|
endif
|
||||||
|
|
||||||
sexp.o: sexp.c gc.c sexp.h config.h Makefile
|
ifdef USE_BOEHM
|
||||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
GCLDFLAGS := -lgc
|
||||||
|
else
|
||||||
|
GCLDFLAGS :=
|
||||||
|
endif
|
||||||
|
|
||||||
eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h Makefile
|
LDFLAGS := $(LDFLAGS) -lm
|
||||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
CPPFLAGS := $(CPPFLAGS) -Iinclude
|
||||||
|
CFLAGS := $(CFLAGS) -Wall -O2 -g
|
||||||
|
|
||||||
main.o: main.c eval.c debug.c opcodes.c eval.h sexp.h config.h Makefile
|
sexp.o: sexp.c gc.c include/chibi/sexp.h include/chibi/config.h Makefile
|
||||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||||
|
|
||||||
chibi-scheme: main.o sexp.o
|
eval.o: eval.c debug.c opcodes.c include/chibi/eval.h include/chibi/sexp.h include/chibi/config.h Makefile
|
||||||
gcc $(CFLAGS) $(LDFLAGS) -o $@ $^
|
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||||
|
|
||||||
|
main.o: main.c eval.c debug.c opcodes.c include/chibi/eval.h include/chibi/sexp.h include/chibi/config.h Makefile
|
||||||
|
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||||
|
|
||||||
|
libchibi-scheme$(SO): eval.o sexp.o
|
||||||
|
$(CC) -dynamiclib -o $@ $^
|
||||||
|
|
||||||
|
chibi-scheme$(EXE): main.o libchibi-scheme$(SO)
|
||||||
|
$(CC) $(CPPFLAGS) $(CFLAGS) -o $@ $< $(LDFLAGS) $(GCLDFLAGS) -L. -lchibi-scheme
|
||||||
|
|
||||||
|
chibi-scheme-static$(EXE): main.o eval.o sexp.o
|
||||||
|
$(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS)
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
rm -f *.o *.i *.s
|
rm -f *.o *.i *.s
|
||||||
|
|
75
eval.c
75
eval.c
|
@ -2,7 +2,7 @@
|
||||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||||
/* BSD-style license: http://synthcode.com/license.txt */
|
/* BSD-style license: http://synthcode.com/license.txt */
|
||||||
|
|
||||||
#include "eval.h"
|
#include "chibi/eval.h"
|
||||||
|
|
||||||
/************************************************************************/
|
/************************************************************************/
|
||||||
|
|
||||||
|
@ -248,7 +248,7 @@ static sexp sexp_make_lit(sexp ctx, sexp value) {
|
||||||
|
|
||||||
#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*INIT_STACK_SIZE)
|
#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*INIT_STACK_SIZE)
|
||||||
|
|
||||||
static sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
||||||
sexp_gc_var(ctx, res, save_res);
|
sexp_gc_var(ctx, res, save_res);
|
||||||
if (ctx) sexp_gc_preserve(ctx, res, save_res);
|
if (ctx) sexp_gc_preserve(ctx, res, save_res);
|
||||||
res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
|
res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
|
||||||
|
@ -279,7 +279,7 @@ static sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
static sexp sexp_make_child_context(sexp context, sexp lambda) {
|
sexp sexp_make_child_context(sexp context, sexp lambda) {
|
||||||
sexp ctx = sexp_make_context(context,
|
sexp ctx = sexp_make_context(context,
|
||||||
sexp_context_stack(context),
|
sexp_context_stack(context),
|
||||||
sexp_context_env(context));
|
sexp_context_env(context));
|
||||||
|
@ -582,7 +582,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
|
||||||
&& sexp_nullp(sexp_cddar(ls)))) {
|
&& sexp_nullp(sexp_cddar(ls)))) {
|
||||||
res = sexp_compile_error(eval_ctx, "bad syntax binding", sexp_car(ls));
|
res = sexp_compile_error(eval_ctx, "bad syntax binding", sexp_car(ls));
|
||||||
} else {
|
} else {
|
||||||
proc = eval_in_context(eval_ctx, sexp_cadar(ls));
|
proc = sexp_eval(eval_ctx, sexp_cadar(ls));
|
||||||
if (sexp_exceptionp(proc)) {
|
if (sexp_exceptionp(proc)) {
|
||||||
res = proc;
|
res = proc;
|
||||||
break;
|
break;
|
||||||
|
@ -697,7 +697,7 @@ static sexp analyze (sexp ctx, sexp object) {
|
||||||
tmp = sexp_cons(ctx, sexp_macro_env(op), SEXP_NULL);
|
tmp = sexp_cons(ctx, sexp_macro_env(op), SEXP_NULL);
|
||||||
tmp = sexp_cons(ctx, sexp_context_env(ctx), tmp);
|
tmp = sexp_cons(ctx, sexp_context_env(ctx), tmp);
|
||||||
tmp = sexp_cons(ctx, x, tmp);
|
tmp = sexp_cons(ctx, x, tmp);
|
||||||
x = apply(sexp_make_child_context(ctx, sexp_context_lambda(ctx)),
|
x = sexp_apply(sexp_make_child_context(ctx, sexp_context_lambda(ctx)),
|
||||||
sexp_macro_proc(op),
|
sexp_macro_proc(op),
|
||||||
tmp);
|
tmp);
|
||||||
/* if (in_repl_p) sexp_debug(" => ", x, ctx); */
|
/* if (in_repl_p) sexp_debug(" => ", x, ctx); */
|
||||||
|
@ -1216,7 +1216,7 @@ static sexp_uint_t sexp_restore_stack(sexp saved, sexp *current) {
|
||||||
goto call_error_handler;} \
|
goto call_error_handler;} \
|
||||||
while (0)
|
while (0)
|
||||||
|
|
||||||
sexp vm (sexp ctx, sexp proc) {
|
sexp sexp_vm (sexp ctx, sexp proc) {
|
||||||
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);
|
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);
|
||||||
sexp env = sexp_context_env(ctx),
|
sexp env = sexp_context_env(ctx),
|
||||||
*stack = sexp_stack_data(sexp_context_stack(ctx));
|
*stack = sexp_stack_data(sexp_context_stack(ctx));
|
||||||
|
@ -1414,7 +1414,7 @@ sexp vm (sexp ctx, sexp proc) {
|
||||||
break;
|
break;
|
||||||
case OP_EVAL:
|
case OP_EVAL:
|
||||||
sexp_context_top(ctx) = top;
|
sexp_context_top(ctx) = top;
|
||||||
_ARG1 = eval_in_context(ctx, _ARG1);
|
_ARG1 = sexp_eval(ctx, _ARG1);
|
||||||
sexp_check_exception();
|
sexp_check_exception();
|
||||||
break;
|
break;
|
||||||
case OP_JUMP_UNLESS:
|
case OP_JUMP_UNLESS:
|
||||||
|
@ -1830,7 +1830,7 @@ static sexp sexp_close_port (sexp ctx, sexp port) {
|
||||||
return SEXP_VOID;
|
return SEXP_VOID;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void sexp_warn_undefs (sexp from, sexp to, sexp out) {
|
void sexp_warn_undefs (sexp from, sexp to, sexp out) {
|
||||||
sexp x;
|
sexp x;
|
||||||
for (x=from; sexp_pairp(x) && x!=to; x=sexp_cdr(x))
|
for (x=from; sexp_pairp(x) && x!=to; x=sexp_cdr(x))
|
||||||
if (sexp_cdar(x) == SEXP_UNDEF) {
|
if (sexp_cdar(x) == SEXP_UNDEF) {
|
||||||
|
@ -1862,7 +1862,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
|
||||||
res = in;
|
res = in;
|
||||||
} else {
|
} else {
|
||||||
while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) {
|
while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) {
|
||||||
res = eval_in_context(ctx2, x);
|
res = sexp_eval(ctx2, x);
|
||||||
if (sexp_exceptionp(res))
|
if (sexp_exceptionp(res))
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
@ -2013,23 +2013,26 @@ static sexp sexp_make_null_env (sexp ctx, sexp version) {
|
||||||
|
|
||||||
static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||||
sexp_uint_t i;
|
sexp_uint_t i;
|
||||||
sexp cell, sym;
|
sexp ctx2, cell, sym, perr_cell, err_cell;
|
||||||
sexp_gc_var(ctx, e, s_e);
|
sexp_gc_var(ctx, e, s_e);
|
||||||
sexp_gc_var(ctx, op, s_op);
|
sexp_gc_var(ctx, op, s_op);
|
||||||
|
sexp_gc_var(ctx, tmp, s_tmp);
|
||||||
|
sexp_gc_var(ctx, err_handler, s_err);
|
||||||
sexp_gc_preserve(ctx, e, s_e);
|
sexp_gc_preserve(ctx, e, s_e);
|
||||||
sexp_gc_preserve(ctx, op, s_op);
|
sexp_gc_preserve(ctx, op, s_op);
|
||||||
|
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||||
|
sexp_gc_preserve(ctx, err_handler, s_err);
|
||||||
e = sexp_make_null_env(ctx, version);
|
e = sexp_make_null_env(ctx, version);
|
||||||
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
||||||
/* op = &opcodes[i]; */
|
|
||||||
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
||||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) {
|
if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) {
|
||||||
/* op = sexp_copy_opcode(ctx, op); */
|
|
||||||
sym = sexp_intern(ctx, (char*)sexp_opcode_default(op));
|
sym = sexp_intern(ctx, (char*)sexp_opcode_default(op));
|
||||||
cell = env_cell_create(ctx, e, sym, SEXP_VOID);
|
cell = env_cell_create(ctx, e, sym, SEXP_VOID);
|
||||||
sexp_opcode_default(op) = cell;
|
sexp_opcode_default(op) = cell;
|
||||||
}
|
}
|
||||||
env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
|
env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
|
||||||
}
|
}
|
||||||
|
/* add io port and interaction env parameters */
|
||||||
env_define(ctx, e, the_cur_in_symbol,
|
env_define(ctx, e, the_cur_in_symbol,
|
||||||
sexp_make_input_port(ctx, stdin, SEXP_FALSE));
|
sexp_make_input_port(ctx, stdin, SEXP_FALSE));
|
||||||
env_define(ctx, e, the_cur_out_symbol,
|
env_define(ctx, e, the_cur_out_symbol,
|
||||||
|
@ -2037,13 +2040,35 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||||
env_define(ctx, e, the_cur_err_symbol,
|
env_define(ctx, e, the_cur_err_symbol,
|
||||||
sexp_make_output_port(ctx, stderr, SEXP_FALSE));
|
sexp_make_output_port(ctx, stderr, SEXP_FALSE));
|
||||||
env_define(ctx, e, the_interaction_env_symbol, e);
|
env_define(ctx, e, the_interaction_env_symbol, e);
|
||||||
|
/* add default exception handler */
|
||||||
|
err_cell = env_cell(e, the_cur_err_symbol);
|
||||||
|
perr_cell = env_cell(e, sexp_intern(ctx, "print-exception"));
|
||||||
|
ctx2 = sexp_make_context(ctx, sexp_context_stack(ctx), e);
|
||||||
|
sexp_context_tailp(ctx2) = 0;
|
||||||
|
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
|
||||||
|
emit(ctx2, OP_GLOBAL_KNOWN_REF);
|
||||||
|
emit_word(ctx2, (sexp_uint_t)err_cell);
|
||||||
|
emit(ctx2, OP_LOCAL_REF);
|
||||||
|
emit_word(ctx2, 0);
|
||||||
|
emit(ctx2, OP_FCALL2);
|
||||||
|
emit_word(ctx2, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell)));
|
||||||
|
}
|
||||||
|
emit_push(ctx2, SEXP_VOID);
|
||||||
|
emit(ctx2, OP_DONE);
|
||||||
|
tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
|
||||||
|
err_handler = sexp_make_procedure(ctx2,
|
||||||
|
sexp_make_integer(0),
|
||||||
|
sexp_make_integer(0),
|
||||||
|
finalize_bytecode(ctx2),
|
||||||
|
tmp);
|
||||||
|
env_define(ctx2, e, the_err_handler_symbol, err_handler);
|
||||||
sexp_gc_release(ctx, e, s_e);
|
sexp_gc_release(ctx, e, s_e);
|
||||||
return e;
|
return e;
|
||||||
}
|
}
|
||||||
|
|
||||||
/************************** eval interface ****************************/
|
/************************** eval interface ****************************/
|
||||||
|
|
||||||
sexp apply (sexp ctx, sexp proc, sexp args) {
|
sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
||||||
sexp ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
|
sexp ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
|
||||||
sexp_sint_t top = sexp_context_top(ctx), offset;
|
sexp_sint_t top = sexp_context_top(ctx), offset;
|
||||||
offset = top + sexp_unbox_integer(sexp_length(ctx, args));
|
offset = top + sexp_unbox_integer(sexp_length(ctx, args));
|
||||||
|
@ -2055,10 +2080,10 @@ sexp apply (sexp ctx, sexp proc, sexp args) {
|
||||||
stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer));
|
stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer));
|
||||||
stack[top++] = sexp_make_vector(ctx, 0, SEXP_VOID);
|
stack[top++] = sexp_make_vector(ctx, 0, SEXP_VOID);
|
||||||
stack[top++] = sexp_make_integer(0);
|
stack[top++] = sexp_make_integer(0);
|
||||||
return vm(ctx, proc);
|
return sexp_vm(ctx, proc);
|
||||||
}
|
}
|
||||||
|
|
||||||
sexp compile (sexp ctx, sexp x) {
|
sexp sexp_compile (sexp ctx, sexp x) {
|
||||||
sexp_gc_var(ctx, ast, s_ast);
|
sexp_gc_var(ctx, ast, s_ast);
|
||||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||||
sexp_gc_var(ctx, vec, s_vec);
|
sexp_gc_var(ctx, vec, s_vec);
|
||||||
|
@ -2084,11 +2109,11 @@ sexp compile (sexp ctx, sexp x) {
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
sexp eval_in_context (sexp ctx, sexp obj) {
|
sexp sexp_eval (sexp ctx, sexp obj) {
|
||||||
sexp res;
|
sexp res;
|
||||||
sexp_gc_var(ctx, thunk, s_thunk);
|
sexp_gc_var(ctx, thunk, s_thunk);
|
||||||
sexp_gc_preserve(ctx, thunk, s_thunk);
|
sexp_gc_preserve(ctx, thunk, s_thunk);
|
||||||
thunk = compile(ctx, obj);
|
thunk = sexp_compile(ctx, obj);
|
||||||
if (sexp_exceptionp(thunk)) {
|
if (sexp_exceptionp(thunk)) {
|
||||||
sexp_print_exception(ctx, thunk,
|
sexp_print_exception(ctx, thunk,
|
||||||
env_global_ref(sexp_context_env(ctx),
|
env_global_ref(sexp_context_env(ctx),
|
||||||
|
@ -2096,19 +2121,23 @@ sexp eval_in_context (sexp ctx, sexp obj) {
|
||||||
SEXP_FALSE));
|
SEXP_FALSE));
|
||||||
res = thunk;
|
res = thunk;
|
||||||
} else {
|
} else {
|
||||||
res = apply(ctx, thunk, SEXP_NULL);
|
res = sexp_apply(ctx, thunk, SEXP_NULL);
|
||||||
}
|
}
|
||||||
sexp_gc_release(ctx, thunk, s_thunk);
|
sexp_gc_release(ctx, thunk, s_thunk);
|
||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
sexp eval (sexp obj, sexp env) {
|
sexp sexp_eval_string (sexp ctx, char *str) {
|
||||||
sexp ctx = sexp_make_context(NULL, NULL, NULL);
|
sexp res;
|
||||||
sexp_context_env(ctx) = env;
|
sexp_gc_var(ctx, obj, s_obj);
|
||||||
return eval_in_context(ctx, obj);
|
sexp_gc_preserve(ctx, obj, s_obj);
|
||||||
|
obj = sexp_read_from_string(ctx, str);
|
||||||
|
res = sexp_eval(ctx, obj);
|
||||||
|
sexp_gc_release(ctx, obj, s_obj);
|
||||||
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
void scheme_init () {
|
void sexp_scheme_init () {
|
||||||
sexp ctx;
|
sexp ctx;
|
||||||
if (! scheme_initialized_p) {
|
if (! scheme_initialized_p) {
|
||||||
scheme_initialized_p = 1;
|
scheme_initialized_p = 1;
|
||||||
|
|
2
gc.c
2
gc.c
|
@ -2,7 +2,7 @@
|
||||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||||
/* BSD-style license: http://synthcode.com/license.txt */
|
/* BSD-style license: http://synthcode.com/license.txt */
|
||||||
|
|
||||||
#include "sexp.h"
|
#include "chibi/sexp.h"
|
||||||
|
|
||||||
#define SEXP_INITIAL_HEAP_SIZE (2*1024*1024)
|
#define SEXP_INITIAL_HEAP_SIZE (2*1024*1024)
|
||||||
#define SEXP_MAXIMUM_HEAP_SIZE 0
|
#define SEXP_MAXIMUM_HEAP_SIZE 0
|
||||||
|
|
|
@ -14,7 +14,7 @@
|
||||||
/* uncomment this if you only want fixnum support */
|
/* uncomment this if you only want fixnum support */
|
||||||
/* #define USE_FLONUMS 0 */
|
/* #define USE_FLONUMS 0 */
|
||||||
|
|
||||||
/* uncomment this if you want immediate flonums (experimental) */
|
/* uncomment this if you want immediate flonums */
|
||||||
/* #define USE_IMMEDIATE_FLONUMS 1 */
|
/* #define USE_IMMEDIATE_FLONUMS 1 */
|
||||||
|
|
||||||
/* uncomment this if you don't need extended math operations */
|
/* uncomment this if you don't need extended math operations */
|
||||||
|
@ -32,8 +32,8 @@
|
||||||
/* uncomment this to disable string ports */
|
/* uncomment this to disable string ports */
|
||||||
/* #define USE_STRING_STREAMS 0 */
|
/* #define USE_STRING_STREAMS 0 */
|
||||||
|
|
||||||
/* uncomment this to disable stack checks */
|
/* uncomment this to enable stack overflow checks */
|
||||||
/* #define USE_CHECK_STACK 0 */
|
/* #define USE_CHECK_STACK 1 */
|
||||||
|
|
||||||
/* uncomment this to enable debugging utilities */
|
/* uncomment this to enable debugging utilities */
|
||||||
/* #define USE_DEBUG 1 */
|
/* #define USE_DEBUG 1 */
|
||||||
|
@ -101,6 +101,6 @@
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifndef USE_CHECK_STACK
|
#ifndef USE_CHECK_STACK
|
||||||
#define USE_CHECK_STACK 1
|
#define USE_CHECK_STACK 0
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -14,8 +14,6 @@
|
||||||
|
|
||||||
#define sexp_init_file "init.scm"
|
#define sexp_init_file "init.scm"
|
||||||
|
|
||||||
#define sexp_debug(msg, obj, ctx) (sexp_write_string(msg,env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)), sexp_write(obj, env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)), sexp_write_char('\n',env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)))
|
|
||||||
|
|
||||||
/* procedure types */
|
/* procedure types */
|
||||||
typedef sexp (*sexp_proc0) ();
|
typedef sexp (*sexp_proc0) ();
|
||||||
typedef sexp (*sexp_proc1) (sexp);
|
typedef sexp (*sexp_proc1) (sexp);
|
||||||
|
@ -130,9 +128,13 @@ enum opcode_names {
|
||||||
|
|
||||||
/**************************** prototypes ******************************/
|
/**************************** prototypes ******************************/
|
||||||
|
|
||||||
sexp apply(sexp proc, sexp args, sexp context);
|
SEXP_API void sexp_scheme_init();
|
||||||
sexp eval_in_context(sexp expr, sexp context);
|
SEXP_API sexp sexp_apply(sexp context, sexp proc, sexp args);
|
||||||
sexp eval(sexp expr, sexp env);
|
SEXP_API sexp sexp_eval(sexp context, sexp obj);
|
||||||
|
SEXP_API sexp sexp_eval_string(sexp context, char *str);
|
||||||
|
SEXP_API sexp sexp_load(sexp context, sexp expr, sexp env);
|
||||||
|
SEXP_API sexp sexp_make_context(sexp context, sexp stack, sexp env);
|
||||||
|
SEXP_API void sexp_warn_undefs (sexp from, sexp to, sexp out);
|
||||||
|
|
||||||
#endif /* ! SEXP_EVAL_H */
|
#endif /* ! SEXP_EVAL_H */
|
||||||
|
|
|
@ -16,6 +16,10 @@
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
|
#ifndef SEXP_API
|
||||||
|
#define SEXP_API extern
|
||||||
|
#endif
|
||||||
|
|
||||||
/* tagging system
|
/* tagging system
|
||||||
* bits end in 00: pointer
|
* bits end in 00: pointer
|
||||||
* 01: fixnum
|
* 01: fixnum
|
||||||
|
@ -511,43 +515,43 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
||||||
#define sexp_scanf(p, ...) (fscanf(sexp_port_stream(p), __VA_ARGS__))
|
#define sexp_scanf(p, ...) (fscanf(sexp_port_stream(p), __VA_ARGS__))
|
||||||
#define sexp_flush(p) (fflush(sexp_port_stream(p)))
|
#define sexp_flush(p) (fflush(sexp_port_stream(p)))
|
||||||
|
|
||||||
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
|
SEXP_API sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
|
||||||
sexp sexp_cons(sexp ctx, sexp head, sexp tail);
|
SEXP_API sexp sexp_cons(sexp ctx, sexp head, sexp tail);
|
||||||
sexp sexp_list2(sexp ctx, sexp a, sexp b);
|
SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);
|
||||||
sexp sexp_equalp (sexp ctx, sexp a, sexp b);
|
SEXP_API sexp sexp_equalp (sexp ctx, sexp a, sexp b);
|
||||||
sexp sexp_listp(sexp ctx, sexp obj);
|
SEXP_API sexp sexp_listp(sexp ctx, sexp obj);
|
||||||
sexp sexp_reverse(sexp ctx, sexp ls);
|
SEXP_API sexp sexp_reverse(sexp ctx, sexp ls);
|
||||||
sexp sexp_nreverse(sexp ctx, sexp ls);
|
SEXP_API sexp sexp_nreverse(sexp ctx, sexp ls);
|
||||||
sexp sexp_append2(sexp ctx, sexp a, sexp b);
|
SEXP_API sexp sexp_append2(sexp ctx, sexp a, sexp b);
|
||||||
sexp sexp_memq(sexp ctx, sexp x, sexp ls);
|
SEXP_API sexp sexp_memq(sexp ctx, sexp x, sexp ls);
|
||||||
sexp sexp_assq(sexp ctx, sexp x, sexp ls);
|
SEXP_API sexp sexp_assq(sexp ctx, sexp x, sexp ls);
|
||||||
sexp sexp_length(sexp ctx, sexp ls);
|
SEXP_API sexp sexp_length(sexp ctx, sexp ls);
|
||||||
sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen);
|
SEXP_API sexp sexp_c_string(sexp ctx, char *str, sexp_sint_t slen);
|
||||||
sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
|
SEXP_API sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
|
||||||
sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
|
SEXP_API sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
|
||||||
sexp sexp_intern(sexp ctx, char *str);
|
SEXP_API sexp sexp_intern(sexp ctx, char *str);
|
||||||
sexp sexp_string_to_symbol(sexp ctx, sexp str);
|
SEXP_API sexp sexp_string_to_symbol(sexp ctx, sexp str);
|
||||||
sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
|
SEXP_API sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
|
||||||
sexp sexp_list_to_vector(sexp ctx, sexp ls);
|
SEXP_API sexp sexp_list_to_vector(sexp ctx, sexp ls);
|
||||||
sexp sexp_vector(sexp ctx, int count, ...);
|
SEXP_API sexp sexp_vector(sexp ctx, int count, ...);
|
||||||
void sexp_write(sexp obj, sexp out);
|
SEXP_API void sexp_write(sexp obj, sexp out);
|
||||||
sexp sexp_read_string(sexp ctx, sexp in);
|
SEXP_API sexp sexp_read_string(sexp ctx, sexp in);
|
||||||
sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp);
|
SEXP_API sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp);
|
||||||
sexp sexp_read_number(sexp ctx, sexp in, int base);
|
SEXP_API sexp sexp_read_number(sexp ctx, sexp in, int base);
|
||||||
sexp sexp_read_raw(sexp ctx, sexp in);
|
SEXP_API sexp sexp_read_raw(sexp ctx, sexp in);
|
||||||
sexp sexp_read(sexp ctx, sexp in);
|
SEXP_API sexp sexp_read(sexp ctx, sexp in);
|
||||||
sexp sexp_read_from_string(sexp ctx, char *str);
|
SEXP_API sexp sexp_read_from_string(sexp ctx, char *str);
|
||||||
sexp sexp_make_input_port(sexp ctx, FILE* in, sexp name);
|
SEXP_API sexp sexp_make_input_port(sexp ctx, FILE* in, sexp name);
|
||||||
sexp sexp_make_output_port(sexp ctx, FILE* out, sexp name);
|
SEXP_API sexp sexp_make_output_port(sexp ctx, FILE* out, sexp name);
|
||||||
sexp sexp_make_input_string_port(sexp ctx, sexp str);
|
SEXP_API sexp sexp_make_input_string_port(sexp ctx, sexp str);
|
||||||
sexp sexp_make_output_string_port(sexp ctx);
|
SEXP_API sexp sexp_make_output_string_port(sexp ctx);
|
||||||
sexp sexp_get_output_string(sexp ctx, sexp port);
|
SEXP_API sexp sexp_get_output_string(sexp ctx, sexp port);
|
||||||
sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
|
SEXP_API sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
|
||||||
sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj);
|
SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj);
|
||||||
sexp sexp_type_exception (sexp ctx, char *message, sexp obj);
|
SEXP_API sexp sexp_type_exception (sexp ctx, char *message, sexp obj);
|
||||||
sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
|
SEXP_API sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
|
||||||
sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
|
SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
|
||||||
void sexp_init();
|
SEXP_API void sexp_init();
|
||||||
|
|
||||||
#endif /* ! SEXP_H */
|
#endif /* ! SEXP_H */
|
||||||
|
|
41
main.c
41
main.c
|
@ -1,5 +1,8 @@
|
||||||
|
/* main.c -- chibi-scheme command-line app using */
|
||||||
|
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||||
|
/* BSD-style license: http://synthcode.com/license.txt */
|
||||||
|
|
||||||
#include "eval.c"
|
#include "chibi/eval.h"
|
||||||
|
|
||||||
void repl (sexp ctx) {
|
void repl (sexp ctx) {
|
||||||
sexp tmp, res, env, in, out, err;
|
sexp tmp, res, env, in, out, err;
|
||||||
|
@ -7,9 +10,9 @@ void repl (sexp ctx) {
|
||||||
sexp_gc_preserve(ctx, obj, s_obj);
|
sexp_gc_preserve(ctx, obj, s_obj);
|
||||||
env = sexp_context_env(ctx);
|
env = sexp_context_env(ctx);
|
||||||
sexp_context_tracep(ctx) = 1;
|
sexp_context_tracep(ctx) = 1;
|
||||||
in = env_global_ref(env, the_cur_in_symbol, SEXP_FALSE);
|
in = sexp_eval_string(ctx, "(current-input-port)");
|
||||||
out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE);
|
out = sexp_eval_string(ctx, "(current-output-port)");
|
||||||
err = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE);
|
err = sexp_eval_string(ctx, "(current-error-port)");
|
||||||
while (1) {
|
while (1) {
|
||||||
sexp_write_string("> ", out);
|
sexp_write_string("> ", out);
|
||||||
sexp_flush(out);
|
sexp_flush(out);
|
||||||
|
@ -21,7 +24,7 @@ void repl (sexp ctx) {
|
||||||
} else {
|
} else {
|
||||||
tmp = sexp_env_bindings(env);
|
tmp = sexp_env_bindings(env);
|
||||||
sexp_context_top(ctx) = 0;
|
sexp_context_top(ctx) = 0;
|
||||||
res = eval_in_context(ctx, obj);
|
res = sexp_eval(ctx, obj);
|
||||||
#if USE_WARN_UNDEFS
|
#if USE_WARN_UNDEFS
|
||||||
sexp_warn_undefs(sexp_env_bindings(env), tmp, err);
|
sexp_warn_undefs(sexp_env_bindings(env), tmp, err);
|
||||||
#endif
|
#endif
|
||||||
|
@ -35,34 +38,14 @@ void repl (sexp ctx) {
|
||||||
}
|
}
|
||||||
|
|
||||||
void run_main (int argc, char **argv) {
|
void run_main (int argc, char **argv) {
|
||||||
sexp env, out=NULL, res, ctx, perr_cell, err_cell, err_handler;
|
sexp env, out=NULL, res, ctx;
|
||||||
sexp_uint_t i, quit=0, init_loaded=0;
|
sexp_uint_t i, quit=0, init_loaded=0;
|
||||||
sexp_gc_var(ctx, str, s_str);
|
sexp_gc_var(ctx, str, s_str);
|
||||||
|
|
||||||
ctx = sexp_make_context(NULL, NULL, NULL);
|
ctx = sexp_make_context(NULL, NULL, NULL);
|
||||||
sexp_gc_preserve(ctx, str, s_str);
|
sexp_gc_preserve(ctx, str, s_str);
|
||||||
env = sexp_context_env(ctx);
|
env = sexp_context_env(ctx);
|
||||||
env_define(ctx, env, the_interaction_env_symbol, env);
|
out = sexp_eval_string(ctx, "(current-output-port)");
|
||||||
out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE);
|
|
||||||
err_cell = env_cell(env, the_cur_err_symbol);
|
|
||||||
perr_cell = env_cell(env, sexp_intern(ctx, "print-exception"));
|
|
||||||
sexp_context_tailp(ctx) = 0;
|
|
||||||
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
|
|
||||||
emit(ctx, OP_GLOBAL_KNOWN_REF);
|
|
||||||
emit_word(ctx, (sexp_uint_t)err_cell);
|
|
||||||
emit(ctx, OP_LOCAL_REF);
|
|
||||||
emit_word(ctx, 0);
|
|
||||||
emit(ctx, OP_FCALL2);
|
|
||||||
emit_word(ctx, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell)));
|
|
||||||
}
|
|
||||||
emit_push(ctx, SEXP_VOID);
|
|
||||||
emit(ctx, OP_DONE);
|
|
||||||
err_handler = sexp_make_procedure(ctx,
|
|
||||||
sexp_make_integer(0),
|
|
||||||
sexp_make_integer(0),
|
|
||||||
finalize_bytecode(ctx),
|
|
||||||
sexp_make_vector(ctx, 0, SEXP_VOID));
|
|
||||||
env_define(ctx, env, the_err_handler_symbol, err_handler);
|
|
||||||
|
|
||||||
/* parse options */
|
/* parse options */
|
||||||
for (i=1; i < argc && argv[i][0] == '-'; i++) {
|
for (i=1; i < argc && argv[i][0] == '-'; i++) {
|
||||||
|
@ -74,7 +57,7 @@ void run_main (int argc, char **argv) {
|
||||||
sexp_load(ctx, str=sexp_c_string(ctx, sexp_init_file, -1), env);
|
sexp_load(ctx, str=sexp_c_string(ctx, sexp_init_file, -1), env);
|
||||||
res = sexp_read_from_string(ctx, argv[i+1]);
|
res = sexp_read_from_string(ctx, argv[i+1]);
|
||||||
if (! sexp_exceptionp(res))
|
if (! sexp_exceptionp(res))
|
||||||
res = eval_in_context(ctx, res);
|
res = sexp_eval(ctx, res);
|
||||||
if (sexp_exceptionp(res)) {
|
if (sexp_exceptionp(res)) {
|
||||||
sexp_print_exception(ctx, res, out);
|
sexp_print_exception(ctx, res, out);
|
||||||
} else if (argv[i][1] == 'p') {
|
} else if (argv[i][1] == 'p') {
|
||||||
|
@ -112,7 +95,7 @@ void run_main (int argc, char **argv) {
|
||||||
}
|
}
|
||||||
|
|
||||||
int main (int argc, char **argv) {
|
int main (int argc, char **argv) {
|
||||||
scheme_init();
|
sexp_scheme_init();
|
||||||
run_main(argc, argv);
|
run_main(argc, argv);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
3
sexp.c
3
sexp.c
|
@ -2,7 +2,8 @@
|
||||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||||
/* BSD-style license: http://synthcode.com/license.txt */
|
/* BSD-style license: http://synthcode.com/license.txt */
|
||||||
|
|
||||||
#include "sexp.h"
|
#define SEXP_API
|
||||||
|
#include "chibi/sexp.h"
|
||||||
|
|
||||||
/* optional huffman-compressed immediate symbols */
|
/* optional huffman-compressed immediate symbols */
|
||||||
#if USE_HUFF_SYMS
|
#if USE_HUFF_SYMS
|
||||||
|
|
Loading…
Add table
Reference in a new issue