Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

passing context through all calls that can allocate memory

Browse source 
in preparation for a native, thread-safe gc.
This commit is contained in:
Alex Shinn 2009-05-05 03:16:09 +09:00
parent 8cf371cfe5
commit 4d78a28d8c
10 changed files with 658 additions and 584 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
Makefile
View file

@ -10,7 +10,9 @@ INCDIR=$(PREFIX)/include/chibi-scheme
MODDIR=$(PREFIX)/share/chibi-scheme MODDIR=$(PREFIX)/share/chibi-scheme
LDFLAGS=-lm LDFLAGS=-lm
CFLAGS=-Wall -g -Os
# -Oz for smaller size on darwin
CFLAGS=-Wall -g -Os -save-temps
GC_OBJ=./gc/gc.a GC_OBJ=./gc/gc.a

30
defaults.h
View file

@ -20,6 +20,10 @@
#define USE_BOEHM 1 #define USE_BOEHM 1
#endif #endif
#ifndef USE_MALLOC
#define USE_MALLOC 0
#endif
#ifndef USE_FLONUMS #ifndef USE_FLONUMS
#define USE_FLONUMS 1 #define USE_FLONUMS 1
#endif #endif
@ -58,16 +62,22 @@
#if USE_BOEHM #if USE_BOEHM
#include "gc/include/gc.h" #include "gc/include/gc.h"
#define sexp_alloc GC_malloc #define sexp_alloc(ctx, size) GC_malloc(size)
#define sexp_alloc_atomic GC_malloc_atomic #define sexp_alloc_atomic(ctx, size) GC_malloc_atomic(size)
#define sexp_realloc GC_realloc #define sexp_realloc(ctx, x, size) GC_realloc(x, size)
#define sexp_free(x) #define sexp_free(ctx, x)
#define sexp_deep_free(x) #define sexp_deep_free(ctx, x)
#else #elif USE_MALLOC
#define sexp_alloc 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)
#define sexp_free(ctx, x) free(x)
void sexp_deep_free(sexp ctx, sexp obj);
#else /* native gc */
void *sexp_alloc(sexp ctx, size_t size);
#define sexp_alloc_atomic sexp_alloc #define sexp_alloc_atomic sexp_alloc
#define sexp_realloc realloc void *sexp_realloc(sexp ctx, sexp x, size_t size);
#define sexp_free free #define sexp_free(ctx, x)
void sexp_deep_free(sexp obj); #define sexp_deep_free(ctx, x)
#endif #endif

586
eval.c
View file

File diff suppressed because it is too large Load diff

1
eval.h
View file

@ -24,6 +24,7 @@ typedef sexp (*sexp_proc3) (sexp, sexp, sexp);
typedef sexp (*sexp_proc4) (sexp, sexp, sexp, sexp); typedef sexp (*sexp_proc4) (sexp, sexp, sexp, sexp);
typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp); typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp);
typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp); typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp);
typedef sexp (*sexp_proc7) (sexp, sexp, sexp, sexp, sexp, sexp, sexp);
enum core_form_names { enum core_form_names {
CORE_DEFINE = 1, CORE_DEFINE = 1,

53
gc.c
View file

@ -11,7 +11,37 @@ static char* sexp_heap;
static char* sexp_heap_end; static char* sexp_heap_end;
static sexp sexp_free_list; static sexp sexp_free_list;
void *sexp_alloc (size_t size) { sexp_uint_t sexp_allocated_bytes (sexp x) {
switch (sexp_tag(x)) {
case SEXP_PAIR: return sexp_sizeof(pair);
case SEXP_SYMBOL: return sexp_sizeof(symbol);
case SEXP_STRING: return sexp_sizeof(string)+sexp_string_length(x);
case SEXP_VECTOR:
return sexp_sizeof(vector)+(sexp_vector_length(x)*sizeof(sexp));
case SEXP_FLONUM: return sexp_sizeof(flonum);
case SEXP_BIGNUM: return sexp_sizeof(bignum);
case SEXP_IPORT:
case SEXP_OPORT: return sexp_sizeof(port);
case SEXP_EXCEPTION: return sexp_sizeof(exception);
case SEXP_PROCEDURE: return sexp_sizeof(procedure);
case SEXP_MACRO: return sexp_sizeof(macro);
case SEXP_SYNCLO: return sexp_sizeof(synclo);
case SEXP_ENV: return sexp_sizeof(env);
case SEXP_BYTECODE: return sexp_sizeof(bytecode)+sexp_bytecode_length(x);
case SEXP_CORE: return sexp_sizeof(core);
case SEXP_OPCODE: return sexp_sizeof(opcode);
case SEXP_LAMBDA: return sexp_sizeof(lambda);
case SEXP_CND: return sexp_sizeof(cnd);
case SEXP_REF: return sexp_sizeof(ref);
case SEXP_SET: return sexp_sizeof(set);
case SEXP_SEQ: return sexp_sizeof(seq);
case SEXP_LIT: return sexp_sizeof(lit);
case SEXP_CONTEXT: return sexp_sizeof(context);
default: return 0;
}
}
void *sexp_alloc (sexp ctx, size_t size) {
sexp ls1, ls2, ls3; sexp ls1, ls2, ls3;
try_alloc: try_alloc:
ls1=sexp_free_list; ls1=sexp_free_list;
@ -27,7 +57,7 @@ void *sexp_alloc (size_t size) {
} }
return ls2; return ls2;
} }
if (sexp_unbox_integer(sexp_gc()) >= size) { if (sexp_unbox_integer(sexp_gc(ctx)) >= size) {
goto try_alloc; goto try_alloc;
} else { } else {
fprintf(stderr, "chibi: out of memory trying to allocate %ld bytes, aborting\n", size); fprintf(stderr, "chibi: out of memory trying to allocate %ld bytes, aborting\n", size);
@ -41,7 +71,7 @@ void sexp_mark (sexp x) {
loop: loop:
if ((! sexp_pointerp(x)) || sexp_mark(x)) if ((! sexp_pointerp(x)) || sexp_mark(x))
return; return;
sexp_mark(x) = 1; sexp_gc_mark(x) = 1;
switch (sexp_tag(x)) { switch (sexp_tag(x)) {
case SEXP_PAIR: case SEXP_PAIR:
sexp_mark(sexp_car(x)); sexp_mark(sexp_car(x));
@ -56,9 +86,10 @@ void sexp_mark (sexp x) {
sexp sexp_sweep () { sexp sexp_sweep () {
sexp_uint_t freed=0, size; sexp_uint_t freed=0, size;
sexp p=(sexp)sexp_heap, f=sexp_free_list; sexp p=(sexp)sexp_heap, f1=sexp_free_list, f2;
/* XXXX make p skip over areas already in the free_list */
while (p<sexp_heap_end) { while (p<sexp_heap_end) {
for (f2=sexp_cdr(f1); sexp_pairp(f2) && (f2 < p); f1=f2, f2=sexp_cdr(f2))
;
size = sexp_allocated_bytes(p); size = sexp_allocated_bytes(p);
if (! sexp_mark(p)) { if (! sexp_mark(p)) {
freed += size; freed += size;
@ -74,8 +105,16 @@ sexp sexp_sweep () {
return sexp_make_integer(freed); return sexp_make_integer(freed);
} }
sexp sexp_gc () { sexp sexp_gc (sexp ctx) {
/* XXXX change FFI to pass context for marking */ int i;
sexp ctx2, stack = sexp_context_stack(ctx);
for (i=0; i<sexp_context_top(ctx); i++)
sexp_mark(stack[i]);
for ( ; ctx; ctx=sexp_context_(ctx)) {
sexp_gc_mark(ctx) = 1;
sexp_gc_mark(sexp_context_bc(ctx)) = 1;
sexp_mark(sexp_context_env(ctx));
}
return sexp_sweep(); return sexp_sweep();
} }

40
init.scm
View file

@ -43,19 +43,23 @@
(define (list-ref ls k) (car (list-tail ls k))) (define (list-ref ls k) (car (list-tail ls k)))
(define (append-reverse a b) (define (append-helper ls res)
(if (pair? a) (if (null? ls)
(append-reverse (cdr a) (cons (car a) b)) res
b)) (append-helper (cdr ls) (append2 (car ls) res))))
(define (append a b) (define (append . o)
(append-reverse (reverse a) b)) (if (null? o)
'()
((lambda (lol)
(append-helper (cdr lol) (car lol)))
(reverse o))))
(define (apply proc . args) (define (apply proc . args)
(if (null? args) (if (null? args)
(proc) (proc)
((lambda (lol) ((lambda (lol)
(apply1 proc (append (reverse (cdr lol)) (car lol)))) (apply1 proc (append2 (reverse (cdr lol)) (car lol))))
(reverse args)))) (reverse args))))
;; map with a fast-path for single lists ;; map with a fast-path for single lists
@ -335,17 +339,17 @@
(define (string-append . args) (string-concatenate args)) (define (string-append . args) (string-concatenate args))
(define (string-copy s) (substring s 0 (string-length s))) (define (string-copy s) (substring s 0 (string-length s)))
(define (string=? s1 s2) (eq? (string-cmp s1 s2) 0)) (define (string=? s1 s2) (eq? (string-cmp s1 s2 #f) 0))
(define (string<? s1 s2) (< (string-cmp s1 s2) 0)) (define (string<? s1 s2) (< (string-cmp s1 s2 #f) 0))
(define (string<=? s1 s2) (<= (string-cmp s1 s2) 0)) (define (string<=? s1 s2) (<= (string-cmp s1 s2 #f) 0))
(define (string>? s1 s2) (> (string-cmp s1 s2) 0)) (define (string>? s1 s2) (> (string-cmp s1 s2 #f) 0))
(define (string>=? s1 s2) (>= (string-cmp s1 s2) 0)) (define (string>=? s1 s2) (>= (string-cmp s1 s2 #f) 0))
(define (string-ci=? s1 s2) (eq? (string-cmp-ci s1 s2) 0)) (define (string-ci=? s1 s2) (eq? (string-cmp s1 s2 #t) 0))
(define (string-ci<? s1 s2) (< (string-cmp-ci s1 s2) 0)) (define (string-ci<? s1 s2) (< (string-cmp s1 s2 #t) 0))
(define (string-ci<=? s1 s2) (<= (string-cmp-ci s1 s2) 0)) (define (string-ci<=? s1 s2) (<= (string-cmp s1 s2 #t) 0))
(define (string-ci>? s1 s2) (> (string-cmp-ci s1 s2) 0)) (define (string-ci>? s1 s2) (> (string-cmp s1 s2 #t) 0))
(define (string-ci>=? s1 s2) (>= (string-cmp-ci s1 s2) 0)) (define (string-ci>=? s1 s2) (>= (string-cmp s1 s2 #t) 0))
;; list utils ;; list utils
@ -418,6 +422,8 @@
(define magnitude abs) (define magnitude abs)
(define (angle z) (if (< z 0) 3.141592653589793 0)) (define (angle z) (if (< z 0) 3.141592653589793 0))
(define (atan x . o) (if (null? o) (atan1 x) (atan1 (/ x (car o)))))
(define (digit-char n) (integer->char (+ n (char->integer #\0)))) (define (digit-char n) (integer->char (+ n (char->integer #\0))))
(define (digit-value ch) (define (digit-value ch)
(if (char-numeric? ch) (if (char-numeric? ch)

36
main.c
View file

@ -11,15 +11,15 @@ void repl (sexp context) {
while (1) { while (1) {
sexp_write_string("> ", out); sexp_write_string("> ", out);
sexp_flush(out); sexp_flush(out);
obj = sexp_read(in); obj = sexp_read(context, in);
if (obj == SEXP_EOF) if (obj == SEXP_EOF)
break; break;
if (sexp_exceptionp(obj)) { if (sexp_exceptionp(obj)) {
sexp_print_exception(obj, err); sexp_print_exception(context, obj, err);
} else { } else {
tmp = sexp_env_bindings(env); tmp = sexp_env_bindings(env);
res = eval_in_context(obj, context); res = eval_in_context(obj, context);
#ifdef 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
if (res != SEXP_VOID) { if (res != SEXP_VOID) {
@ -34,12 +34,13 @@ void run_main (int argc, char **argv) {
sexp env, out=NULL, res, context, perr_cell, err_cell, err_handler; sexp env, out=NULL, res, context, perr_cell, err_cell, err_handler;
sexp_uint_t i, quit=0, init_loaded=0; sexp_uint_t i, quit=0, init_loaded=0;
env = sexp_make_standard_env(sexp_make_integer(5)); context = sexp_make_context(NULL, NULL, NULL);
env_define(env, the_interaction_env_symbol, env); env = sexp_make_standard_env(context, sexp_make_integer(5));
env_define(context, env, the_interaction_env_symbol, env);
out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE); out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE);
err_cell = env_cell(env, the_cur_err_symbol); err_cell = env_cell(env, the_cur_err_symbol);
perr_cell = env_cell(env, sexp_intern("print-exception")); perr_cell = env_cell(env, sexp_intern(context, "print-exception"));
context = sexp_make_context(NULL, env); sexp_context_env(context) = env;
sexp_context_tailp(context) = 0; sexp_context_tailp(context) = 0;
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) { if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
emit(OP_GLOBAL_KNOWN_REF, context); emit(OP_GLOBAL_KNOWN_REF, context);
@ -51,11 +52,12 @@ void run_main (int argc, char **argv) {
} }
emit_push(SEXP_VOID, context); emit_push(SEXP_VOID, context);
emit(OP_DONE, context); emit(OP_DONE, context);
err_handler = sexp_make_procedure(sexp_make_integer(0), err_handler = sexp_make_procedure(context,
sexp_make_integer(0),
sexp_make_integer(0), sexp_make_integer(0),
finalize_bytecode(context), finalize_bytecode(context),
sexp_make_vector(0, SEXP_VOID)); sexp_make_vector(context, 0, SEXP_VOID));
env_define(env, the_err_handler_symbol, err_handler); env_define(context, 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++) {
@ -64,12 +66,12 @@ void run_main (int argc, char **argv) {
case 'e': case 'e':
case 'p': case 'p':
if (! init_loaded++) if (! init_loaded++)
sexp_load(sexp_c_string(sexp_init_file), env); sexp_load(context, sexp_c_string(context, sexp_init_file), env);
res = sexp_read_from_string(argv[i+1]); res = sexp_read_from_string(context, argv[i+1]);
if (! sexp_exceptionp(res)) if (! sexp_exceptionp(res))
res = eval_in_context(res, context); res = eval_in_context(res, context);
if (sexp_exceptionp(res)) { if (sexp_exceptionp(res)) {
sexp_print_exception(res, out); sexp_print_exception(context, res, out);
} else if (argv[i][1] == 'p') { } else if (argv[i][1] == 'p') {
sexp_write(res, out); sexp_write(res, out);
sexp_write_char('\n', out); sexp_write_char('\n', out);
@ -80,8 +82,8 @@ void run_main (int argc, char **argv) {
#endif #endif
case 'l': case 'l':
if (! init_loaded++) if (! init_loaded++)
sexp_load(sexp_c_string(sexp_init_file), env); sexp_load(context, sexp_c_string(context, sexp_init_file), env);
sexp_load(sexp_c_string(argv[++i]), env); sexp_load(context, sexp_c_string(context, argv[++i]), env);
break; break;
case 'q': case 'q':
init_loaded = 1; init_loaded = 1;
@ -93,10 +95,10 @@ void run_main (int argc, char **argv) {
if (! quit) { if (! quit) {
if (! init_loaded) if (! init_loaded)
sexp_load(sexp_c_string(sexp_init_file), env); sexp_load(context, sexp_c_string(context, sexp_init_file), env);
if (i < argc) if (i < argc)
for ( ; i < argc; i++) for ( ; i < argc; i++)
sexp_load(sexp_c_string(argv[i]), env); sexp_load(context, sexp_c_string(context, argv[i]), env);
else else
repl(context); repl(context);
} }

7
opcodes.c
View file

@ -77,6 +77,8 @@ _FN1(0, "identifier->symbol", 0, sexp_syntactic_closure_expr),
_FN4(0, SEXP_ENV, "identifier=?", 0, sexp_identifier_eq), _FN4(0, SEXP_ENV, "identifier=?", 0, sexp_identifier_eq),
_FN1(SEXP_PAIR, "length", 0, sexp_length), _FN1(SEXP_PAIR, "length", 0, sexp_length),
_FN1(SEXP_PAIR, "reverse", 0, sexp_reverse), _FN1(SEXP_PAIR, "reverse", 0, sexp_reverse),
_FN1(SEXP_PAIR, "reverse!", 0, sexp_nreverse),
_FN2(SEXP_PAIR, SEXP_PAIR, "append2", 0, sexp_append2),
_FN1(SEXP_PAIR, "list->vector", 0, sexp_list_to_vector), _FN1(SEXP_PAIR, "list->vector", 0, sexp_list_to_vector),
_FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file), _FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file),
_FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file), _FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file),
@ -89,8 +91,7 @@ _FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception),
_FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func), _FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func),
_FN6(SEXP_SYMBOL, SEXP_STRING, "make-exception", 0, sexp_make_exception), _FN6(SEXP_SYMBOL, SEXP_STRING, "make-exception", 0, sexp_make_exception),
_FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string), _FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string),
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp), _FN3(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp),
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp-ci", 0, sexp_string_cmp_ci),
_FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring), _FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring),
_FN1(SEXP_STRING, "string->symbol", 0, sexp_string_to_symbol), _FN1(SEXP_STRING, "string->symbol", 0, sexp_string_to_symbol),
_FN1(SEXP_PAIR, "string-concatenate", 0, sexp_string_concatenate), _FN1(SEXP_PAIR, "string-concatenate", 0, sexp_string_concatenate),
@ -110,7 +111,7 @@ _FN1(0, "cos", 0, sexp_cos),
_FN1(0, "tan", 0, sexp_tan), _FN1(0, "tan", 0, sexp_tan),
_FN1(0, "asin", 0, sexp_asin), _FN1(0, "asin", 0, sexp_asin),
_FN1(0, "acos", 0, sexp_acos), _FN1(0, "acos", 0, sexp_acos),
_FN1(0, "atan", 0, sexp_atan), _FN1(0, "atan1", 0, sexp_atan),
_FN1(0, "sqrt", 0, sexp_sqrt), _FN1(0, "sqrt", 0, sexp_sqrt),
_FN1(0, "round", 0, sexp_round), _FN1(0, "round", 0, sexp_round),
_FN1(0, "truncate", 0, sexp_trunc), _FN1(0, "truncate", 0, sexp_trunc),

373
sexp.c
View file

@ -53,8 +53,8 @@ static int is_separator(int c) {
static sexp symbol_table[SEXP_SYMBOL_TABLE_SIZE]; static sexp symbol_table[SEXP_SYMBOL_TABLE_SIZE];
sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag) { sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
sexp res = (sexp) sexp_alloc(size); sexp res = (sexp) sexp_alloc(ctx, size);
if (! res) if (! res)
errx(EX_OSERR, "out of memory: couldn't allocate %ld bytes for %ld", errx(EX_OSERR, "out of memory: couldn't allocate %ld bytes for %ld",
size ,tag); size ,tag);
@ -63,7 +63,7 @@ sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag) {
} }
#if ! USE_BOEHM #if ! USE_BOEHM
void sexp_deep_free (sexp obj) { void sexp_deep_free (sexp ctx, sexp obj) {
int len, i; int len, i;
sexp *elts; sexp *elts;
if (sexp_pointerp(obj)) { if (sexp_pointerp(obj)) {
@ -77,23 +77,23 @@ void sexp_deep_free (sexp obj) {
elts = sexp_vector_data(obj); elts = sexp_vector_data(obj);
for (i=0; i<len; i++) for (i=0; i<len; i++)
sexp_deep_free(elts[i]); sexp_deep_free(elts[i]);
sexp_free(elts); sexp_free(ctx, elts);
break; break;
case SEXP_STRING: case SEXP_STRING:
case SEXP_SYMBOL: case SEXP_SYMBOL:
sexp_free(sexp_string_data(obj)); sexp_free(ctx, sexp_string_data(obj));
break; break;
} }
sexp_free(obj); sexp_free(ctx, obj);
} }
} }
#endif #endif
/***************************** exceptions *****************************/ /***************************** exceptions *****************************/
sexp sexp_make_exception (sexp kind, sexp message, sexp irritants, sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants,
sexp procedure, sexp file, sexp line) { sexp procedure, sexp file, sexp line) {
sexp exn = sexp_alloc_type(exception, SEXP_EXCEPTION); sexp exn = sexp_alloc_type(ctx, exception, SEXP_EXCEPTION);
sexp_exception_kind(exn) = kind; sexp_exception_kind(exn) = kind;
sexp_exception_message(exn) = message; sexp_exception_message(exn) = message;
sexp_exception_irritants(exn) = irritants; sexp_exception_irritants(exn) = irritants;
@ -103,28 +103,28 @@ sexp sexp_make_exception (sexp kind, sexp message, sexp irritants,
return exn; return exn;
} }
sexp sexp_user_exception (sexp self, char *message, sexp irritants) { sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) {
return sexp_make_exception(sexp_intern("user"), return sexp_make_exception(ctx, sexp_intern(ctx, "user"),
sexp_c_string(message), sexp_c_string(ctx, message),
((sexp_pairp(irritants) || sexp_nullp(irritants)) ((sexp_pairp(irritants) || sexp_nullp(irritants))
? irritants : sexp_list1(irritants)), ? irritants : sexp_list1(ctx, irritants)),
self, SEXP_FALSE, SEXP_FALSE); self, SEXP_FALSE, SEXP_FALSE);
} }
sexp sexp_type_exception (char *message, sexp obj) { sexp sexp_type_exception (sexp ctx, char *message, sexp obj) {
return sexp_make_exception(sexp_intern("type"), return sexp_make_exception(ctx, sexp_intern(ctx, "type"),
sexp_c_string(message), sexp_list1(obj), sexp_c_string(ctx, message), sexp_list1(ctx, obj),
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
} }
sexp sexp_range_exception (sexp obj, sexp start, sexp end) { sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
return sexp_make_exception(sexp_intern("range"), return sexp_make_exception(ctx, sexp_intern(ctx, "range"),
sexp_c_string("bad index range"), sexp_c_string(ctx, "bad index range"),
sexp_list3(obj, start, end), sexp_list3(ctx, obj, start, end),
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE); SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
} }
sexp sexp_print_exception (sexp exn, sexp out) { sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
sexp ls; sexp ls;
sexp_write_string("ERROR", out); sexp_write_string("ERROR", out);
if (sexp_exceptionp(exn)) { if (sexp_exceptionp(exn)) {
@ -176,27 +176,25 @@ sexp sexp_print_exception (sexp exn, sexp out) {
return SEXP_VOID; return SEXP_VOID;
} }
static sexp sexp_read_error (char *message, sexp irritants, sexp port) { static sexp sexp_read_error (sexp ctx, char *message, sexp irritants, sexp port) {
sexp name = (sexp_port_name(port) sexp name = (sexp_port_name(port)
? sexp_c_string(sexp_port_name(port)) : SEXP_FALSE); ? sexp_c_string(ctx, sexp_port_name(port)) : SEXP_FALSE);
return sexp_make_exception(the_read_error_symbol, return sexp_make_exception(ctx, the_read_error_symbol,
sexp_c_string(message), sexp_c_string(ctx, message),
irritants, irritants, SEXP_FALSE, name,
SEXP_FALSE,
name,
sexp_make_integer(sexp_port_line(port))); sexp_make_integer(sexp_port_line(port)));
} }
/*************************** list utilities ***************************/ /*************************** list utilities ***************************/
sexp sexp_cons (sexp head, sexp tail) { sexp sexp_cons (sexp ctx, sexp head, sexp tail) {
sexp pair = sexp_alloc_type(pair, SEXP_PAIR); sexp pair = sexp_alloc_type(ctx, pair, SEXP_PAIR);
sexp_car(pair) = head; sexp_car(pair) = head;
sexp_cdr(pair) = tail; sexp_cdr(pair) = tail;
return pair; return pair;
} }
sexp sexp_listp (sexp hare) { sexp sexp_listp (sexp ctx, sexp hare) {
sexp turtle; sexp turtle;
if (! sexp_pairp(hare)) if (! sexp_pairp(hare))
return sexp_make_boolean(hare == SEXP_NULL); return sexp_make_boolean(hare == SEXP_NULL);
@ -210,7 +208,7 @@ sexp sexp_listp (sexp hare) {
return sexp_make_boolean(hare == SEXP_NULL); return sexp_make_boolean(hare == SEXP_NULL);
} }
sexp sexp_memq (sexp x, sexp ls) { sexp sexp_memq (sexp ctx, sexp x, sexp ls) {
while (sexp_pairp(ls)) while (sexp_pairp(ls))
if (x == sexp_car(ls)) if (x == sexp_car(ls))
return ls; return ls;
@ -219,7 +217,7 @@ sexp sexp_memq (sexp x, sexp ls) {
return SEXP_FALSE; return SEXP_FALSE;
} }
sexp sexp_assq (sexp x, sexp ls) { sexp sexp_assq (sexp ctx, sexp x, sexp ls) {
while (sexp_pairp(ls)) while (sexp_pairp(ls))
if (sexp_pairp(sexp_car(ls)) && (x == sexp_caar(ls))) if (sexp_pairp(sexp_car(ls)) && (x == sexp_caar(ls)))
return sexp_car(ls); return sexp_car(ls);
@ -228,14 +226,14 @@ sexp sexp_assq (sexp x, sexp ls) {
return SEXP_FALSE; return SEXP_FALSE;
} }
sexp sexp_reverse (sexp ls) { sexp sexp_reverse (sexp ctx, sexp ls) {
sexp res = SEXP_NULL; sexp res = SEXP_NULL;
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
res = sexp_cons(sexp_car(ls), res); res = sexp_cons(ctx, sexp_car(ls), res);
return res; return res;
} }
sexp sexp_nreverse (sexp ls) { sexp sexp_nreverse (sexp ctx, sexp ls) {
sexp a, b, tmp; sexp a, b, tmp;
if (ls == SEXP_NULL) { if (ls == SEXP_NULL) {
return ls; return ls;
@ -253,20 +251,20 @@ sexp sexp_nreverse (sexp ls) {
} }
} }
sexp sexp_append (sexp a, sexp b) { sexp sexp_append2 (sexp ctx, sexp a, sexp b) {
for (a=sexp_reverse(a); sexp_pairp(a); a=sexp_cdr(a)) for (a=sexp_reverse(ctx, a); sexp_pairp(a); a=sexp_cdr(a))
b = sexp_cons(sexp_car(a), b); b = sexp_cons(ctx, sexp_car(a), b);
return b; return b;
} }
sexp sexp_length (sexp ls) { sexp sexp_length (sexp ctx, sexp ls) {
sexp_uint_t res=0; sexp_uint_t res=0;
for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls)) for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls))
; ;
return sexp_make_integer(res); return sexp_make_integer(res);
} }
sexp sexp_equalp (sexp a, sexp b) { sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
sexp_uint_t len; sexp_uint_t len;
sexp *v1, *v2; sexp *v1, *v2;
loop: loop:
@ -284,7 +282,7 @@ sexp sexp_equalp (sexp a, sexp b) {
return SEXP_FALSE; return SEXP_FALSE;
switch (sexp_pointer_tag(a)) { switch (sexp_pointer_tag(a)) {
case SEXP_PAIR: case SEXP_PAIR:
if (sexp_equalp(sexp_car(a), sexp_car(b)) == SEXP_FALSE) if (sexp_equalp(ctx, sexp_car(a), sexp_car(b)) == SEXP_FALSE)
return SEXP_FALSE; return SEXP_FALSE;
a = sexp_cdr(a); a = sexp_cdr(a);
b = sexp_cdr(b); b = sexp_cdr(b);
@ -296,7 +294,7 @@ sexp sexp_equalp (sexp a, sexp b) {
v1 = sexp_vector_data(a); v1 = sexp_vector_data(a);
v2 = sexp_vector_data(b); v2 = sexp_vector_data(b);
for (len--; len > 0; len--) for (len--; len > 0; len--)
if (sexp_equalp(v1[len], v2[len]) == SEXP_FALSE) if (sexp_equalp(ctx, v1[len], v2[len]) == SEXP_FALSE)
return SEXP_FALSE; return SEXP_FALSE;
return SEXP_TRUE; return SEXP_TRUE;
case SEXP_STRING: case SEXP_STRING:
@ -313,18 +311,18 @@ sexp sexp_equalp (sexp a, sexp b) {
/********************* strings, symbols, vectors **********************/ /********************* strings, symbols, vectors **********************/
sexp sexp_make_flonum(double f) { sexp sexp_make_flonum(sexp ctx, double f) {
sexp x = sexp_alloc_type(flonum, SEXP_FLONUM); sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
sexp_flonum_value(x) = f; sexp_flonum_value(x) = f;
return x; return x;
} }
sexp sexp_make_string(sexp len, sexp ch) { sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
char *cstr; char *cstr;
sexp s = sexp_alloc_type(string, SEXP_STRING); sexp s = sexp_alloc_type(ctx, string, SEXP_STRING);
sexp_sint_t clen = sexp_unbox_integer(len); sexp_sint_t clen = sexp_unbox_integer(len);
if (clen < 0) return sexp_type_exception("negative length", len); if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
cstr = sexp_alloc(clen+1); cstr = sexp_alloc(ctx, clen+1);
if (sexp_charp(ch)) if (sexp_charp(ch))
memset(cstr, sexp_unbox_character(ch), clen); memset(cstr, sexp_unbox_character(ch), clen);
cstr[clen] = '\0'; cstr[clen] = '\0';
@ -333,31 +331,30 @@ sexp sexp_make_string(sexp len, sexp ch) {
return s; return s;
} }
sexp sexp_c_string(char *str) { sexp sexp_c_string(sexp ctx, char *str) {
sexp_uint_t len = strlen(str); sexp_uint_t len = strlen(str);
sexp s = sexp_make_string(sexp_make_integer(len), SEXP_VOID); sexp s = sexp_make_string(ctx, sexp_make_integer(len), SEXP_VOID);
memcpy(sexp_string_data(s), str, len); memcpy(sexp_string_data(s), str, len);
return s; return s;
} }
sexp sexp_substring (sexp str, sexp start, sexp end) { sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
sexp res; sexp res;
if (! sexp_stringp(str)) if (! sexp_stringp(str))
return sexp_type_exception("not a string", str); return sexp_type_exception(ctx, "not a string", str);
if (! sexp_integerp(start)) if (! sexp_integerp(start))
return sexp_type_exception("not a number", start); return sexp_type_exception(ctx, "not a number", start);
if (end == SEXP_FALSE) if (end == SEXP_FALSE)
end = sexp_make_integer(sexp_string_length(str)); end = sexp_make_integer(sexp_string_length(str));
if (! sexp_integerp(end)) if (! sexp_integerp(end))
return sexp_type_exception("not a number", end); return sexp_type_exception(ctx, "not a number", end);
if ((sexp_unbox_integer(start) < 0) if ((sexp_unbox_integer(start) < 0)
|| (sexp_unbox_integer(start) > sexp_string_length(str)) || (sexp_unbox_integer(start) > sexp_string_length(str))
|| (sexp_unbox_integer(end) < 0) || (sexp_unbox_integer(end) < 0)
|| (sexp_unbox_integer(end) > sexp_string_length(str)) || (sexp_unbox_integer(end) > sexp_string_length(str))
|| (end < start)) || (end < start))
return sexp_range_exception(str, start, end); return sexp_range_exception(ctx, str, start, end);
res = sexp_make_string(sexp_fx_sub(end, start), res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID);
SEXP_VOID);
memcpy(sexp_string_data(res), memcpy(sexp_string_data(res),
sexp_string_data(str)+sexp_unbox_integer(start), sexp_string_data(str)+sexp_unbox_integer(start),
sexp_string_length(res)); sexp_string_length(res));
@ -372,7 +369,7 @@ sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
return acc; return acc;
} }
sexp sexp_intern(char *str) { sexp sexp_intern(sexp ctx, char *str) {
struct huff_entry he; struct huff_entry he;
sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket; sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket;
char c, *mystr, *p=str; char c, *mystr, *p=str;
@ -404,26 +401,26 @@ sexp sexp_intern(char *str) {
return sexp_car(ls); return sexp_car(ls);
/* not found, make a new symbol */ /* not found, make a new symbol */
sym = sexp_alloc_type(symbol, SEXP_SYMBOL); sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
mystr = sexp_alloc(len+1); mystr = sexp_alloc(ctx, len+1);
memcpy(mystr, str, len+1); memcpy(mystr, str, len+1);
mystr[len]=0; mystr[len]=0;
sexp_symbol_length(sym) = len; sexp_symbol_length(sym) = len;
sexp_symbol_data(sym) = mystr; sexp_symbol_data(sym) = mystr;
sexp_push(symbol_table[bucket], sym); sexp_push(ctx, symbol_table[bucket], sym);
return sym; return sym;
} }
sexp sexp_string_to_symbol (sexp str) { sexp sexp_string_to_symbol (sexp ctx, sexp str) {
return sexp_intern(sexp_string_data(str)); return sexp_intern(ctx, sexp_string_data(str));
} }
sexp sexp_make_vector(sexp len, sexp dflt) { sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
sexp v, *x; sexp v, *x;
int i, clen = sexp_unbox_integer(len); int i, clen = sexp_unbox_integer(len);
if (! clen) return the_empty_vector; if (! clen) return the_empty_vector;
v = sexp_alloc_type(vector, SEXP_VECTOR); v = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
x = (sexp*) sexp_alloc(clen*sizeof(sexp)); x = (sexp*) sexp_alloc(ctx, clen*sizeof(sexp));
for (i=0; i<clen; i++) for (i=0; i<clen; i++)
x[i] = dflt; x[i] = dflt;
sexp_vector_length(v) = clen; sexp_vector_length(v) = clen;
@ -431,8 +428,8 @@ sexp sexp_make_vector(sexp len, sexp dflt) {
return v; return v;
} }
sexp sexp_list_to_vector(sexp ls) { sexp sexp_list_to_vector(sexp ctx, sexp ls) {
sexp x, vec = sexp_make_vector(sexp_length(ls), SEXP_VOID); sexp x, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
sexp *elts = sexp_vector_data(vec); sexp *elts = sexp_vector_data(vec);
int i; int i;
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x)) for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
@ -440,8 +437,8 @@ sexp sexp_list_to_vector(sexp ls) {
return vec; return vec;
} }
sexp sexp_vector(int count, ...) { sexp sexp_vector(sexp ctx, int count, ...) {
sexp vec = sexp_make_vector(sexp_make_integer(count), SEXP_VOID); sexp vec = sexp_make_vector(ctx, sexp_make_integer(count), SEXP_VOID);
sexp *elts = sexp_vector_data(vec); sexp *elts = sexp_vector_data(vec);
va_list ap; va_list ap;
int i; int i;
@ -482,7 +479,7 @@ int sstream_write (void *vec, const char *src, int n) {
pos = sexp_unbox_integer(sexp_stream_pos(vec)); pos = sexp_unbox_integer(sexp_stream_pos(vec));
newpos = pos+n; newpos = pos+n;
if (newpos >= len) { if (newpos >= len) {
newbuf = sexp_make_string(sexp_make_integer(newpos*2), SEXP_VOID); newbuf = sexp_make_string(NULL, sexp_make_integer(newpos*2), SEXP_VOID);
memcpy(sexp_string_data(newbuf), memcpy(sexp_string_data(newbuf),
sexp_string_data(sexp_stream_buf(vec)), sexp_string_data(sexp_stream_buf(vec)),
pos); pos);
@ -507,54 +504,55 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
return pos; return pos;
} }
sexp sexp_make_input_string_port (sexp str) { sexp sexp_make_input_string_port (sexp ctx, sexp str) {
FILE *in; FILE *in;
sexp res, cookie; sexp res, cookie;
cookie = sexp_vector(3, str, sexp_make_integer(sexp_string_length(str)), cookie = sexp_vector(ctx, 3, str, sexp_make_integer(sexp_string_length(str)),
sexp_make_integer(0)); sexp_make_integer(0));
in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL); in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL);
res = sexp_make_input_port(in, NULL); res = sexp_make_input_port(ctx, in, NULL);
sexp_port_cookie(res) = cookie; sexp_port_cookie(res) = cookie;
return res; return res;
} }
sexp sexp_make_output_string_port () { sexp sexp_make_output_string_port (sexp ctx) {
FILE *out; FILE *out;
sexp res, size, cookie; sexp res, size, cookie;
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE); size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE);
cookie = sexp_vector(3, sexp_make_string(size, SEXP_VOID), cookie = sexp_vector(ctx, 3, sexp_make_string(NULL, size, SEXP_VOID),
size, sexp_make_integer(0)); size, sexp_make_integer(0));
out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL); out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL);
res = sexp_make_output_port(out, NULL); res = sexp_make_output_port(ctx, out, NULL);
sexp_port_cookie(res) = cookie; sexp_port_cookie(res) = cookie;
return res; return res;
} }
sexp sexp_get_output_string (sexp port) { sexp sexp_get_output_string (sexp ctx, sexp port) {
sexp cookie = sexp_port_cookie(port); sexp cookie = sexp_port_cookie(port);
fflush(sexp_port_stream(port)); fflush(sexp_port_stream(port));
return sexp_substring(sexp_stream_buf(cookie), return sexp_substring(ctx,
sexp_stream_buf(cookie),
sexp_make_integer(0), sexp_make_integer(0),
sexp_stream_pos(cookie)); sexp_stream_pos(cookie));
} }
#else #else
sexp sexp_make_input_string_port (sexp str) { sexp sexp_make_input_string_port (sexp ctx, sexp str) {
FILE *in = fmemopen(sexp_string_data(str), sexp_string_length(str), "r"); FILE *in = fmemopen(sexp_string_data(str), sexp_string_length(str), "r");
return sexp_make_input_port(in, NULL); return sexp_make_input_port(in, NULL);
} }
sexp sexp_make_output_string_port () { sexp sexp_make_output_string_port (sexp ctx) {
FILE *out; FILE *out;
sexp buf = sexp_alloc_type(string, SEXP_STRING), res; sexp buf = sexp_alloc_type(ctx, string, SEXP_STRING), res;
out = open_memstream(&sexp_string_data(buf), &sexp_string_length(buf)); out = open_memstream(&sexp_string_data(buf), &sexp_string_length(buf));
res = sexp_make_input_port(out, NULL); res = sexp_make_input_port(out, NULL);
sexp_port_cookie(res) = buf; sexp_port_cookie(res) = buf;
return res; return res;
} }
sexp sexp_get_output_string (sexp port) { sexp sexp_get_output_string (sexp ctx, sexp port) {
sexp cookie = sexp_port_cookie(port); sexp cookie = sexp_port_cookie(port);
fflush(sexp_port_stream(port)); fflush(sexp_port_stream(port));
return sexp_substring(cookie, return sexp_substring(cookie,
@ -566,16 +564,16 @@ sexp sexp_get_output_string (sexp port) {
#endif #endif
sexp sexp_make_input_port (FILE* in, char *path) { sexp sexp_make_input_port (sexp ctx, FILE* in, char *path) {
sexp p = sexp_alloc_type(port, SEXP_IPORT); sexp p = sexp_alloc_type(ctx, port, SEXP_IPORT);
sexp_port_stream(p) = in; sexp_port_stream(p) = in;
sexp_port_name(p) = path; sexp_port_name(p) = path;
sexp_port_line(p) = 0; sexp_port_line(p) = 0;
return p; return p;
} }
sexp sexp_make_output_port (FILE* out, char *path) { sexp sexp_make_output_port (sexp ctx, FILE* out, char *path) {
sexp p = sexp_alloc_type(port, SEXP_OPORT); sexp p = sexp_alloc_type(ctx, port, SEXP_OPORT);
sexp_port_stream(p) = out; sexp_port_stream(p) = out;
sexp_port_name(p) = path; sexp_port_name(p) = path;
sexp_port_line(p) = 0; sexp_port_line(p) = 0;
@ -761,15 +759,15 @@ void sexp_write (sexp obj, sexp out) {
} }
} }
char* sexp_read_string(sexp in) { char* sexp_read_string(sexp ctx, sexp in) {
char *buf, *tmp, *res; char *buf, *tmp, *res;
int c, i=0, size=128; int c, i=0, size=128;
buf = sexp_alloc(size); buf = sexp_alloc(ctx, size);
for (c=sexp_read_char(in); c != '"'; c=sexp_read_char(in)) { for (c=sexp_read_char(in); c != '"'; c=sexp_read_char(in)) {
if (c == EOF) { if (c == EOF) {
sexp_free(buf); sexp_free(ctx, buf);
return NULL; return NULL;
} }
if (c == '\\') { if (c == '\\') {
@ -783,25 +781,25 @@ char* sexp_read_string(sexp in) {
buf[i++] = c; buf[i++] = c;
} }
if (i >= size) { if (i >= size) {
tmp = sexp_alloc(2*size); tmp = sexp_alloc(ctx, 2*size);
memcpy(tmp, buf, i); memcpy(tmp, buf, i);
sexp_free(buf); sexp_free(ctx, buf);
buf = tmp; buf = tmp;
} }
} }
buf[i] = '\0'; buf[i] = '\0';
res = sexp_alloc(i); res = sexp_alloc(ctx, i);
memcpy(res, buf, i); memcpy(res, buf, i);
sexp_free(buf); sexp_free(ctx, buf);
return res; return res;
} }
char* sexp_read_symbol(sexp in, int init) { char* sexp_read_symbol(sexp ctx, sexp in, int init) {
char *buf, *tmp, *res; char *buf, *tmp, *res;
int c, i=0, size=128; int c, i=0, size=128;
buf = sexp_alloc(size); buf = sexp_alloc(ctx, size);
if (init != EOF) if (init != EOF)
buf[i++] = init; buf[i++] = init;
@ -814,21 +812,21 @@ char* sexp_read_symbol(sexp in, int init) {
} }
buf[i++] = c; buf[i++] = c;
if (i >= size) { if (i >= size) {
tmp = sexp_alloc(2*size); tmp = sexp_alloc(ctx, 2*size);
memcpy(tmp, buf, i); memcpy(tmp, buf, i);
sexp_free(buf); sexp_free(ctx, buf);
buf = tmp; buf = tmp;
} }
} }
buf[i] = '\0'; buf[i] = '\0';
res = sexp_alloc(i); res = sexp_alloc(ctx, i);
memcpy(res, buf, i); memcpy(res, buf, i);
sexp_free(buf); sexp_free(ctx, buf);
return res; return res;
} }
sexp sexp_read_float_tail(sexp in, sexp_sint_t whole) { sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_sint_t whole) {
sexp exponent; sexp exponent;
double res=0.0, scale=0.1, e=0.0; double res=0.0, scale=0.1, e=0.0;
int c; int c;
@ -836,17 +834,17 @@ sexp sexp_read_float_tail(sexp in, sexp_sint_t whole) {
res += digit_value(c)*scale; res += digit_value(c)*scale;
sexp_push_char(c, in); sexp_push_char(c, in);
if (c=='e' || c=='E') { if (c=='e' || c=='E') {
exponent = sexp_read_number(in, 10); exponent = sexp_read_number(ctx, in, 10);
if (sexp_exceptionp(exponent)) return exponent; if (sexp_exceptionp(exponent)) return exponent;
e = (sexp_integerp(exponent) ? sexp_unbox_integer(exponent) e = (sexp_integerp(exponent) ? sexp_unbox_integer(exponent)
: sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0); : sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0);
} else if ((c!=EOF) && ! is_separator(c)) } else if ((c!=EOF) && ! is_separator(c))
return sexp_read_error("invalid numeric syntax", return sexp_read_error(ctx, "invalid numeric syntax",
sexp_list1(sexp_make_character(c)), in); sexp_list1(ctx, sexp_make_character(c)), in);
return sexp_make_flonum((whole + res) * pow(10, e)); return sexp_make_flonum(ctx, (whole + res) * pow(10, e));
} }
sexp sexp_read_number(sexp in, int base) { sexp sexp_read_number(sexp ctx, sexp in, int base) {
sexp f; sexp f;
sexp_sint_t res = 0, negativep = 0, c; sexp_sint_t res = 0, negativep = 0, c;
@ -864,10 +862,10 @@ sexp sexp_read_number(sexp in, int base) {
if (c=='.' || c=='e' || c=='E') { if (c=='.' || c=='e' || c=='E') {
if (base != 10) if (base != 10)
return sexp_read_error("decimal found in non-base 10", SEXP_NULL, in); return sexp_read_error(ctx, "decimal found in non-base 10", SEXP_NULL, in);
if (c!='.') if (c!='.')
sexp_push_char(c, in); sexp_push_char(c, in);
f = sexp_read_float_tail(in, res); f = sexp_read_float_tail(ctx, in, res);
if (! sexp_flonump(f)) return f; if (! sexp_flonump(f)) return f;
if ((c!='.') && (sexp_flonum_value(f) == round(sexp_flonum_value(f)))) { if ((c!='.') && (sexp_flonum_value(f) == round(sexp_flonum_value(f)))) {
res = (sexp_sint_t) sexp_flonum_value(f); res = (sexp_sint_t) sexp_flonum_value(f);
@ -878,14 +876,14 @@ sexp sexp_read_number(sexp in, int base) {
} else { } else {
sexp_push_char(c, in); sexp_push_char(c, in);
if ((c!=EOF) && ! is_separator(c)) if ((c!=EOF) && ! is_separator(c))
return sexp_read_error("invalid numeric syntax", return sexp_read_error(ctx, "invalid numeric syntax",
sexp_list1(sexp_make_character(c)), in); sexp_list1(ctx, sexp_make_character(c)), in);
} }
return sexp_make_integer(negativep ? -res : res); return sexp_make_integer(negativep ? -res : res);
} }
sexp sexp_read_raw (sexp in) { sexp sexp_read_raw (sexp ctx, sexp in) {
sexp res, tmp, tmp2; sexp res, tmp, tmp2;
char *str; char *str;
int c1, c2; int c1, c2;
@ -909,82 +907,82 @@ sexp sexp_read_raw (sexp in) {
sexp_port_line(in)++; sexp_port_line(in)++;
goto scan_loop; goto scan_loop;
case '\'': case '\'':
res = sexp_read(in); res = sexp_read(ctx, in);
res = sexp_list2(the_quote_symbol, res); res = sexp_list2(ctx, the_quote_symbol, res);
break; break;
case '`': case '`':
res = sexp_read(in); res = sexp_read(ctx, in);
res = sexp_list2(the_quasiquote_symbol, res); res = sexp_list2(ctx, the_quasiquote_symbol, res);
break; break;
case ',': case ',':
if ((c1 = sexp_read_char(in)) == '@') { if ((c1 = sexp_read_char(in)) == '@') {
res = sexp_read(in); res = sexp_read(ctx, in);
res = sexp_list2(the_unquote_splicing_symbol, res); res = sexp_list2(ctx, the_unquote_splicing_symbol, res);
} else { } else {
sexp_push_char(c1, in); sexp_push_char(c1, in);
res = sexp_read(in); res = sexp_read(ctx, in);
res = sexp_list2(the_unquote_symbol, res); res = sexp_list2(ctx, the_unquote_symbol, res);
} }
break; break;
case '"': case '"':
str = sexp_read_string(in); str = sexp_read_string(ctx, in);
if (! str) if (! str)
res = sexp_read_error("premature end of string", SEXP_NULL, in); res = sexp_read_error(ctx, "premature end of string", SEXP_NULL, in);
else else
res = sexp_c_string(str); res = sexp_c_string(ctx, str);
sexp_free(str); sexp_free(ctx, str);
break; break;
case '(': case '(':
res = SEXP_NULL; res = SEXP_NULL;
tmp = sexp_read_raw(in); tmp = sexp_read_raw(ctx, in);
while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) { while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) {
if (tmp == SEXP_RAWDOT) { if (tmp == SEXP_RAWDOT) {
if (res == SEXP_NULL) { if (res == SEXP_NULL) {
return sexp_read_error("dot before any elements in list", return sexp_read_error(ctx, "dot before any elements in list",
SEXP_NULL, in); SEXP_NULL, in);
} else { } else {
tmp = sexp_read_raw(in); tmp = sexp_read_raw(ctx, in);
if (sexp_read_raw(in) != SEXP_CLOSE) { if (sexp_read_raw(ctx, in) != SEXP_CLOSE) {
sexp_deep_free(res); sexp_deep_free(ctx, res);
return sexp_read_error("multiple tokens in dotted tail", return sexp_read_error(ctx, "multiple tokens in dotted tail",
SEXP_NULL, in); SEXP_NULL, in);
} else { } else {
tmp2 = res; tmp2 = res;
res = sexp_nreverse(res); res = sexp_nreverse(ctx, res);
sexp_cdr(tmp2) = tmp; sexp_cdr(tmp2) = tmp;
return res; return res;
} }
} }
} else { } else {
res = sexp_cons(tmp, res); res = sexp_cons(ctx, tmp, res);
tmp = sexp_read_raw(in); tmp = sexp_read_raw(ctx, in);
} }
} }
if (tmp != SEXP_CLOSE) { if (tmp != SEXP_CLOSE) {
sexp_deep_free(res); sexp_deep_free(ctx, res);
return sexp_read_error("missing trailing ')'", SEXP_NULL, in); return sexp_read_error(ctx, "missing trailing ')'", SEXP_NULL, in);
} }
res = (sexp_pairp(res) ? sexp_nreverse(res) : res); res = (sexp_pairp(res) ? sexp_nreverse(ctx, res) : res);
break; break;
case '#': case '#':
switch (c1=sexp_read_char(in)) { switch (c1=sexp_read_char(in)) {
case 'b': case 'b':
res = sexp_read_number(in, 2); break; res = sexp_read_number(ctx, in, 2); break;
case 'o': case 'o':
res = sexp_read_number(in, 8); break; res = sexp_read_number(ctx, in, 8); break;
case 'd': case 'd':
res = sexp_read_number(in, 10); break; res = sexp_read_number(ctx, in, 10); break;
case 'x': case 'x':
res = sexp_read_number(in, 16); break; res = sexp_read_number(ctx, in, 16); break;
case 'e': case 'e':
res = sexp_read(in); res = sexp_read(ctx, in);
if (sexp_flonump(res)) if (sexp_flonump(res))
res = sexp_make_integer((sexp_sint_t)sexp_flonum_value(res)); res = sexp_make_integer((sexp_sint_t)sexp_flonum_value(res));
break; break;
case 'i': case 'i':
res = sexp_read(in); res = sexp_read(ctx, in);
if (sexp_integerp(res)) if (sexp_integerp(res))
res = sexp_make_flonum(sexp_unbox_integer(res)); res = sexp_make_flonum(ctx, sexp_unbox_integer(res));
break; break;
case 'f': case 'f':
case 't': case 't':
@ -993,21 +991,22 @@ sexp sexp_read_raw (sexp in) {
res = (c1 == 't' ? SEXP_TRUE : SEXP_FALSE); res = (c1 == 't' ? SEXP_TRUE : SEXP_FALSE);
sexp_push_char(c2, in); sexp_push_char(c2, in);
} else { } else {
res = sexp_read_error("invalid syntax #%c%c", res = sexp_read_error(ctx, "invalid syntax #%c%c",
sexp_list2(sexp_make_character(c1), sexp_list2(ctx,
sexp_make_character(c1),
sexp_make_character(c2)), sexp_make_character(c2)),
in); in);
} }
break; break;
case ';': case ';':
sexp_read_raw(in); sexp_read_raw(ctx, in);
goto scan_loop; goto scan_loop;
case '\\': case '\\':
c1 = sexp_read_char(in); c1 = sexp_read_char(in);
str = sexp_read_symbol(in, c1); str = sexp_read_symbol(ctx, in, c1);
if (str[0] == '\0') if (str[0] == '\0')
res = res =
sexp_read_error("unexpected end of character literal", SEXP_NULL, in); sexp_read_error(ctx, "unexpected end of character literal", SEXP_NULL, in);
if (str[1] == '\0') { if (str[1] == '\0') {
res = sexp_make_character(c1); res = sexp_make_character(c1);
} else if ((c1 == 'x' || c1 == 'X') && } else if ((c1 == 'x' || c1 == 'X') &&
@ -1023,30 +1022,30 @@ sexp sexp_read_raw (sexp in) {
else if (strcasecmp(str, "tab") == 0) else if (strcasecmp(str, "tab") == 0)
res = sexp_make_character('\t'); res = sexp_make_character('\t');
else { else {
res = sexp_read_error("unknown character name", res = sexp_read_error(ctx, "unknown character name",
sexp_list1(sexp_c_string(str)), sexp_list1(ctx, sexp_c_string(ctx, str)),
in); in);
} }
} }
sexp_free(str); sexp_free(ctx, str);
break; break;
case '(': case '(':
sexp_push_char(c1, in); sexp_push_char(c1, in);
res = sexp_read(in); res = sexp_read(ctx, in);
if (sexp_listp(res) == SEXP_FALSE) { if (sexp_listp(ctx, res) == SEXP_FALSE) {
if (! sexp_exceptionp(res)) { if (! sexp_exceptionp(res)) {
sexp_deep_free(res); sexp_deep_free(ctx, res);
res = sexp_read_error("dotted list not allowed in vector syntax", res = sexp_read_error(ctx, "dotted list not allowed in vector syntax",
SEXP_NULL, SEXP_NULL,
in); in);
} }
} else { } else {
res = sexp_list_to_vector(res); res = sexp_list_to_vector(ctx, res);
} }
break; break;
default: default:
res = sexp_read_error("invalid # syntax", res = sexp_read_error(ctx, "invalid # syntax",
sexp_list1(sexp_make_character(c1)), in); sexp_list1(ctx, sexp_make_character(c1)), in);
} }
break; break;
case '.': case '.':
@ -1055,12 +1054,12 @@ sexp sexp_read_raw (sexp in) {
res = SEXP_RAWDOT; res = SEXP_RAWDOT;
} else if (isdigit(c1)) { } else if (isdigit(c1)) {
sexp_push_char(c1,in ); sexp_push_char(c1,in );
res = sexp_read_float_tail(in, 0); res = sexp_read_float_tail(ctx, in, 0);
} else { } else {
sexp_push_char(c1, in); sexp_push_char(c1, in);
str = sexp_read_symbol(in, '.'); str = sexp_read_symbol(ctx, in, '.');
res = sexp_intern(str); res = sexp_intern(ctx, str);
sexp_free(str); sexp_free(ctx, str);
} }
break; break;
case ')': case ')':
@ -1071,7 +1070,7 @@ sexp sexp_read_raw (sexp in) {
c2 = sexp_read_char(in); c2 = sexp_read_char(in);
if (c2 == '.' || isdigit(c2)) { if (c2 == '.' || isdigit(c2)) {
sexp_push_char(c2, in); sexp_push_char(c2, in);
res = sexp_read_number(in, 10); res = sexp_read_number(ctx, in, 10);
if (sexp_exceptionp(res)) return res; if (sexp_exceptionp(res)) return res;
if (c1 == '-') { if (c1 == '-') {
#ifdef USE_FLONUMS #ifdef USE_FLONUMS
@ -1083,47 +1082,48 @@ sexp sexp_read_raw (sexp in) {
} }
} else { } else {
sexp_push_char(c2, in); sexp_push_char(c2, in);
str = sexp_read_symbol(in, c1); str = sexp_read_symbol(ctx, in, c1);
res = sexp_intern(str); res = sexp_intern(ctx, str);
sexp_free(str); sexp_free(ctx, str);
} }
break; break;
case '0': case '1': case '2': case '3': case '4': case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': case '5': case '6': case '7': case '8': case '9':
sexp_push_char(c1, in); sexp_push_char(c1, in);
res = sexp_read_number(in, 10); res = sexp_read_number(ctx, in, 10);
break; break;
default: default:
str = sexp_read_symbol(in, c1); str = sexp_read_symbol(ctx, in, c1);
res = sexp_intern(str); res = sexp_intern(ctx, str);
sexp_free(str); sexp_free(ctx, str);
break; break;
} }
return res; return res;
} }
sexp sexp_read (sexp in) { sexp sexp_read (sexp ctx, sexp in) {
sexp res = sexp_read_raw(in); sexp res = sexp_read_raw(ctx, in);
if (res == SEXP_CLOSE) if (res == SEXP_CLOSE)
return sexp_read_error("too many ')'s", SEXP_NULL, in); return sexp_read_error(ctx, "too many ')'s", SEXP_NULL, in);
if (res == SEXP_RAWDOT) if (res == SEXP_RAWDOT)
return sexp_read_error("unexpected '.'", SEXP_NULL, in); return sexp_read_error(ctx, "unexpected '.'", SEXP_NULL, in);
return res; return res;
} }
#if USE_STRING_STREAMS #if USE_STRING_STREAMS
sexp sexp_read_from_string(char *str) { sexp sexp_read_from_string(sexp ctx, char *str) {
sexp s = sexp_c_string(str); sexp s = sexp_c_string(ctx, str);
sexp in = sexp_make_input_string_port(s); sexp in = sexp_make_input_string_port(ctx, s);
sexp res = sexp_read(in); sexp res = sexp_read(ctx, in);
sexp_deep_free(s); sexp_free(ctx, s);
sexp_deep_free(in); sexp_deep_free(ctx, in);
return res; return res;
} }
#endif #endif
void sexp_init() { void sexp_init() {
int i; int i;
sexp ctx;
if (! sexp_initialized_p) { if (! sexp_initialized_p) {
sexp_initialized_p = 1; sexp_initialized_p = 1;
#if USE_BOEHM #if USE_BOEHM
@ -1133,13 +1133,14 @@ void sexp_init() {
#endif #endif
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++) for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
symbol_table[i] = SEXP_NULL; symbol_table[i] = SEXP_NULL;
the_dot_symbol = sexp_intern("."); ctx = sexp_alloc_type(NULL, context, SEXP_CONTEXT);
the_quote_symbol = sexp_intern("quote"); the_dot_symbol = sexp_intern(ctx, ".");
the_quasiquote_symbol = sexp_intern("quasiquote"); the_quote_symbol = sexp_intern(ctx, "quote");
the_unquote_symbol = sexp_intern("unquote"); the_quasiquote_symbol = sexp_intern(ctx, "quasiquote");
the_unquote_splicing_symbol = sexp_intern("unquote-splicing"); the_unquote_symbol = sexp_intern(ctx, "unquote");
the_read_error_symbol = sexp_intern("read"); the_unquote_splicing_symbol = sexp_intern(ctx, "unquote-splicing");
the_empty_vector = sexp_alloc_type(vector, SEXP_VECTOR); the_read_error_symbol = sexp_intern(ctx, "read");
the_empty_vector = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
sexp_vector_length(the_empty_vector) = 0; sexp_vector_length(the_empty_vector) = 0;
sexp_vector_data(the_empty_vector) = NULL; sexp_vector_data(the_empty_vector) = NULL;
} }

98
sexp.h
View file

@ -82,7 +82,7 @@ typedef struct sexp_struct *sexp;
struct sexp_struct { struct sexp_struct {
sexp_tag_t tag; sexp_tag_t tag;
char immutablep; char immutablep;
char mark; char gc_mark;
union { union {
/* basic types */ /* basic types */
double flonum; double flonum;
@ -171,7 +171,7 @@ struct sexp_struct {
#define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \ #define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
+ sizeof(((sexp)0)->value.x)) + sizeof(((sexp)0)->value.x))
#define sexp_alloc_type(type, tag) sexp_alloc_tagged(sexp_sizeof(type), tag) #define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
#define SEXP_MAKE_IMMEDIATE(n) ((sexp) ((n<<SEXP_EXTENDED_BITS) \ #define SEXP_MAKE_IMMEDIATE(n) ((sexp) ((n<<SEXP_EXTENDED_BITS) \
+ SEXP_EXTENDED_TAG)) + SEXP_EXTENDED_TAG))
@ -236,9 +236,9 @@ struct sexp_struct {
#define sexp_flonum_value(f) ((f)->value.flonum) #define sexp_flonum_value(f) ((f)->value.flonum)
#if USE_FLONUMS #if USE_FLONUMS
#define sexp_integer_to_flonum(x) (sexp_make_flonum(sexp_unbox_integer(x))) #define sexp_integer_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_integer(x)))
#else #else
#define sexp_integer_to_flonum(x) (x) #define sexp_integer_to_flonum(ctx, x) (x)
#endif #endif
/*************************** field accessors **************************/ /*************************** field accessors **************************/
@ -357,20 +357,20 @@ struct sexp_struct {
#define sexp_fx_rem(a, b) (sexp_make_integer(sexp_unbox_integer(a) % sexp_unbox_integer(b))) #define sexp_fx_rem(a, b) (sexp_make_integer(sexp_unbox_integer(a) % sexp_unbox_integer(b)))
#define sexp_fx_sign(a) (-((sexp_sint_t)(a) < 0)) /* -1 or 0 */ #define sexp_fx_sign(a) (-((sexp_sint_t)(a) < 0)) /* -1 or 0 */
#define sexp_fp_add(a, b) (sexp_make_flonum(sexp_flonum_value(a) + sexp_flonum_value(b))) #define sexp_fp_add(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) + sexp_flonum_value(b)))
#define sexp_fp_sub(a, b) (sexp_make_flonum(sexp_flonum_value(a) - sexp_flonum_value(b))) #define sexp_fp_sub(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) - sexp_flonum_value(b)))
#define sexp_fp_mul(a, b) (sexp_make_flonum(sexp_flonum_value(a) * sexp_flonum_value(b))) #define sexp_fp_mul(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) * sexp_flonum_value(b)))
#define sexp_fp_div(a, b) (sexp_make_flonum(sexp_flonum_value(a) / sexp_flonum_value(b))) #define sexp_fp_div(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) / sexp_flonum_value(b)))
/****************************** utilities *****************************/ /****************************** utilities *****************************/
#define sexp_list1(a) sexp_cons(a, SEXP_NULL) #define sexp_list1(x,a) sexp_cons((x), (a), SEXP_NULL)
#define sexp_list2(a, b) sexp_cons(a, sexp_cons(b, SEXP_NULL)) #define sexp_list2(x,a,b) sexp_cons((x), (a), sexp_cons((x), (b), SEXP_NULL))
#define sexp_list3(a, b, c) sexp_cons(a, sexp_cons(b, sexp_cons(c, SEXP_NULL))) #define sexp_list3(x,a,b,c) sexp_cons((x), (a), sexp_cons((x), (b), sexp_cons((x), (c), SEXP_NULL)))
#define sexp_list4(a, b, c, d) sexp_cons(a, sexp_cons(b, sexp_cons(c, sexp_cons(d, SEXP_NULL)))) #define sexp_list4(x,a,b,c,d) sexp_cons((x), (a), sexp_cons((x), (b), sexp_cons((x), (c), sexp_cons((x), (d), SEXP_NULL))))
#define sexp_push(ls, x) ((ls) = sexp_cons((x), (ls))) #define sexp_push(ctx, ls, x) ((ls) = sexp_cons((ctx), (x), (ls)))
#define sexp_insert(ls, x) ((sexp_memq((x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ls), (x))) #define sexp_insert(ctx, ls, x) ((sexp_memq(NULL, (x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ctx), (ls), (x)))
#define sexp_car(x) ((x)->value.pair.car) #define sexp_car(x) ((x)->value.pair.car)
#define sexp_cdr(x) ((x)->value.pair.cdr) #define sexp_cdr(x) ((x)->value.pair.cdr)
@ -400,43 +400,43 @@ struct sexp_struct {
#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(size_t size, sexp_uint_t tag); sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
sexp sexp_cons(sexp head, sexp tail); sexp sexp_cons(sexp ctx, sexp head, sexp tail);
sexp sexp_equalp (sexp a, sexp b); sexp sexp_equalp (sexp ctx, sexp a, sexp b);
sexp sexp_listp(sexp obj); sexp sexp_listp(sexp ctx, sexp obj);
sexp sexp_reverse(sexp ls); sexp sexp_reverse(sexp ctx, sexp ls);
sexp sexp_nreverse(sexp ls); sexp sexp_nreverse(sexp ctx, sexp ls);
sexp sexp_append(sexp a, sexp b); sexp sexp_append2(sexp ctx, sexp a, sexp b);
sexp sexp_memq(sexp x, sexp ls); sexp sexp_memq(sexp ctx, sexp x, sexp ls);
sexp sexp_assq(sexp x, sexp ls); sexp sexp_assq(sexp ctx, sexp x, sexp ls);
sexp sexp_length(sexp ls); sexp sexp_length(sexp ctx, sexp ls);
sexp sexp_c_string(char *str); sexp sexp_c_string(sexp ctx, char *str);
sexp sexp_make_string(sexp len, sexp ch); sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
sexp sexp_substring (sexp str, sexp start, sexp end); sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
sexp sexp_make_flonum(double f); sexp sexp_make_flonum(sexp ctx, double f);
sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc); sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc);
sexp sexp_intern(char *str); sexp sexp_intern(sexp ctx, char *str);
sexp sexp_string_to_symbol(sexp str); sexp sexp_string_to_symbol(sexp ctx, sexp str);
sexp sexp_make_vector(sexp len, sexp dflt); sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
sexp sexp_list_to_vector(sexp ls); sexp sexp_list_to_vector(sexp ctx, sexp ls);
sexp sexp_vector(int count, ...); sexp sexp_vector(sexp ctx, int count, ...);
void sexp_write(sexp obj, sexp out); void sexp_write(sexp obj, sexp out);
char* sexp_read_string(sexp in); char* sexp_read_string(sexp ctx, sexp in);
char* sexp_read_symbol(sexp in, int init); char* sexp_read_symbol(sexp ctx, sexp in, int init);
sexp sexp_read_number(sexp in, int base); sexp sexp_read_number(sexp ctx, sexp in, int base);
sexp sexp_read_raw(sexp in); sexp sexp_read_raw(sexp ctx, sexp in);
sexp sexp_read(sexp in); sexp sexp_read(sexp ctx, sexp in);
sexp sexp_read_from_string(char *str); sexp sexp_read_from_string(sexp ctx, char *str);
sexp sexp_make_input_port(FILE* in, char *path); sexp sexp_make_input_port(sexp ctx, FILE* in, char *path);
sexp sexp_make_output_port(FILE* out, char *path); sexp sexp_make_output_port(sexp ctx, FILE* out, char *path);
sexp sexp_make_input_string_port(sexp str); sexp sexp_make_input_string_port(sexp ctx, sexp str);
sexp sexp_make_output_string_port(); sexp sexp_make_output_string_port(sexp ctx);
sexp sexp_get_output_string(sexp port); sexp sexp_get_output_string(sexp ctx, sexp port);
sexp sexp_make_exception(sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line); sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
sexp sexp_user_exception (sexp self, char *message, sexp obj); sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj);
sexp sexp_type_exception (char *message, sexp obj); sexp sexp_type_exception (sexp ctx, char *message, sexp obj);
sexp sexp_range_exception (sexp obj, sexp start, sexp end); sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
sexp sexp_print_exception(sexp exn, sexp out); sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
void sexp_init(); void sexp_init();
#endif /* ! SEXP_H */ #endif /* ! SEXP_H */