-e/-p options in main had a long-standing stupid gc bug

This commit is contained in:
Alex Shinn 2011-04-03 22:15:48 +09:00
parent 17afe65125
commit 0f9a23f94f
9 changed files with 126 additions and 38 deletions

2
eval.c
View file

@ -377,6 +377,7 @@ sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size, s
if (!res || sexp_exceptionp(res)) if (!res || sexp_exceptionp(res))
return res; return res;
if (ctx) sexp_gc_preserve1(ctx, res); if (ctx) sexp_gc_preserve1(ctx, res);
sexp_context_env(res) = (env ? env : sexp_make_primitive_env(res, SEXP_FIVE));
sexp_context_bc(res) = sexp_alloc_bytecode(res, SEXP_INIT_BCODE_SIZE); sexp_context_bc(res) = sexp_alloc_bytecode(res, SEXP_INIT_BCODE_SIZE);
sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE; sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE; sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE;
@ -387,7 +388,6 @@ sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env, sexp_uint_t size, s
sexp_stack_top(stack) = 0; sexp_stack_top(stack) = 0;
} }
sexp_context_stack(res) = stack; sexp_context_stack(res) = stack;
sexp_context_env(res) = (env ? env : sexp_make_primitive_env(res, SEXP_FIVE));
if (! ctx) sexp_init_eval_context_globals(res); if (! ctx) sexp_init_eval_context_globals(res);
if (ctx) { if (ctx) {
sexp_context_params(res) = sexp_context_params(ctx); sexp_context_params(res) = sexp_context_params(ctx);

43
gc.c
View file

@ -177,6 +177,16 @@ int stack_references_pointer_p (sexp ctx, sexp x) {
return 0; return 0;
} }
const char* sexp_debug_string(sexp ctx, sexp p) {
static char buf[32];
if (sexp_pointerp(p))
return sexp_object_type_name(ctx, p);
else if (sexp_nullp(p))
return "()";
sprintf(buf, "%p", p);
return buf;
}
void sexp_conservative_mark (sexp ctx) { void sexp_conservative_mark (sexp ctx) {
sexp_heap h = sexp_context_heap(ctx); sexp_heap h = sexp_context_heap(ctx);
sexp p, end; sexp p, end;
@ -193,17 +203,42 @@ void sexp_conservative_mark (sexp ctx) {
continue; continue;
} }
if (!sexp_markedp(p) && stack_references_pointer_p(ctx, p)) { if (!sexp_markedp(p) && stack_references_pointer_p(ctx, p)) {
#ifdef SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG
if (sexp_pointer_tag(p) == SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG)
#endif
if (sexp_pairp(p) && sexp_pairp(sexp_car(p))
&& sexp_symbolp(sexp_caar(p))
&& (sexp_caar(p)==(sexp)0x6c7677
/* || sexp_caar(p)==(sexp)0xffd27 */
)
) {
#if SEXP_USE_DEBUG_GC > 3 #if SEXP_USE_DEBUG_GC > 3
if (p && sexp_pointerp(p)) { if (p && sexp_pointerp(p)) {
fprintf(stderr, SEXP_BANNER("MISS: %p: %s"), p,sexp_pointer_source(p)); if (sexp_pairp(p)) {
fprintf(stderr, SEXP_BANNER("MISS: %p (%s . %s): %s"), p,
sexp_debug_string(ctx, sexp_car(p)),
sexp_debug_string(ctx, sexp_cdr(p)),
sexp_pointer_source(p));
if (sexp_pairp(sexp_car(p))) {
fprintf(stderr, "car: (%s . %s)\n",
sexp_debug_string(ctx, sexp_caar(p)),
sexp_debug_string(ctx, sexp_cdar(p)));
if (sexp_pairp(sexp_cdar(p)))
fprintf(stderr, "cdar: (%s . %s)\n",
sexp_debug_string(ctx, sexp_cadar(p)),
sexp_debug_string(ctx, sexp_cddar(p)));
}
} else {
fprintf(stderr, SEXP_BANNER("MISS: %p: %s"), p,
sexp_pointer_source(p));
}
sexp_stack_trace(ctx, SEXP_FALSE);
fflush(stderr); fflush(stderr);
} }
#endif
#if SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG
if (sexp_pointer_tag(p) == SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG)
#endif #endif
sexp_mark(ctx, p); sexp_mark(ctx, p);
} }
}
p = (sexp) (((char*)p)+sexp_heap_align(sexp_allocated_bytes(ctx, p))); p = (sexp) (((char*)p)+sexp_heap_align(sexp_allocated_bytes(ctx, p)));
} }
} }

View file

@ -136,7 +136,7 @@ SEXP_API sexp sexp_make_eval_context (sexp context, sexp stack, sexp env, sexp_u
SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda); SEXP_API sexp sexp_make_child_context (sexp context, sexp lambda);
SEXP_API sexp sexp_compile_error (sexp ctx, const char *message, sexp obj); SEXP_API sexp sexp_compile_error (sexp ctx, const char *message, sexp obj);
SEXP_API sexp sexp_analyze (sexp context, sexp x); SEXP_API sexp sexp_analyze (sexp context, sexp x);
SEXP_API void sexp_stack_trace (sexp ctx, sexp out); /* SEXP_API void sexp_stack_trace (sexp ctx, sexp out); */
SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args); SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
SEXP_API sexp sexp_apply1 (sexp ctx, sexp f, sexp x); SEXP_API sexp sexp_apply1 (sexp ctx, sexp f, sexp x);
SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv); SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv);
@ -164,9 +164,9 @@ SEXP_API sexp sexp_open_output_file_op(sexp ctx sexp_api_params(self, n), sexp x
SEXP_API sexp sexp_close_port_op(sexp ctx sexp_api_params(self, n), sexp x); SEXP_API sexp sexp_close_port_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val); SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym); SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt); /* SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt); */
SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt); SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param); /* SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param); */
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to); SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to);
SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1); SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);
SEXP_API sexp sexp_make_procedure_op (sexp ctx sexp_api_params(self, n), sexp flags, sexp num_args, sexp bc, sexp vars); SEXP_API sexp sexp_make_procedure_op (sexp ctx sexp_api_params(self, n), sexp flags, sexp num_args, sexp bc, sexp vars);

View file

@ -316,10 +316,6 @@
#define SEXP_USE_CONSERVATIVE_GC 0 #define SEXP_USE_CONSERVATIVE_GC 0
#endif #endif
#ifndef SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG
#define SEXP_USE_CONSERVATIVE_GC_PRESERVE_TAG 0
#endif
#ifndef SEXP_USE_TRACK_ALLOC_SOURCE #ifndef SEXP_USE_TRACK_ALLOC_SOURCE
#define SEXP_USE_TRACK_ALLOC_SOURCE SEXP_USE_DEBUG_GC > 2 #define SEXP_USE_TRACK_ALLOC_SOURCE SEXP_USE_DEBUG_GC > 2
#endif #endif

View file

@ -1150,6 +1150,10 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj)
SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer) SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, (sexp_proc2)finalizer)
#endif #endif
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_parameter_ref (sexp ctx, sexp param);
SEXP_API void sexp_stack_trace (sexp ctx, sexp out);
#define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE)) #define sexp_current_error_port(ctx) sexp_parameter_ref(ctx, sexp_env_ref(sexp_context_env(ctx), sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL), SEXP_FALSE))
#define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx))) #define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx)))

View file

@ -261,14 +261,16 @@
((null? ls) #f) ((null? ls) #f)
((compare (rename 'else) (caar ls)) ((compare (rename 'else) (caar ls))
`(,(rename 'begin) ,@(cdar ls))) `(,(rename 'begin) ,@(cdar ls)))
((and (pair? (car (car ls))) (null? (cdr (car (car ls)))))
`(,(rename 'if) (,(rename 'eqv?) ,(rename 'tmp)
(,(rename 'quote) ,(caaar ls)))
(,(rename 'begin) ,@(cdar ls))
,(clause (cdr ls))))
(else (else
(if (and (pair? (caar ls)) (null? (cdaar ls))) `(,(rename 'if) (,(rename 'memv) ,(rename 'tmp)
`(,(rename 'if) (,(rename 'eqv?) ,(rename 'tmp) ',(caaar ls)) (,(rename 'quote) ,(caar ls)))
(,(rename 'begin) ,@(cdar ls)) (,(rename 'begin) ,@(cdar ls))
,(clause (cdr ls))) ,(clause (cdr ls))))))
`(,(rename 'if) (,(rename 'memv) ,(rename 'tmp) ',(caar ls))
(,(rename 'begin) ,@(cdar ls))
,(clause (cdr ls)))))))
`(let ((,(rename 'tmp) ,(cadr expr))) `(let ((,(rename 'tmp) ,(cadr expr)))
,(clause (cddr expr)))))) ,(clause (cddr expr))))))
@ -345,6 +347,11 @@
(call-with-output-string (call-with-output-string
(lambda (out) (for-each (lambda (ch) (write-char ch out)) ls)))) (lambda (out) (for-each (lambda (ch) (write-char ch out)) ls))))
;; (define (list->string ls)
;; (let lp ((ls ls) (res '()))
;; (cond ((null? ls) (string-concatenate (reverse res)))
;; (else (lp (cdr ls) (cons (make-string 1 (car ls)) res))))))
(define (string->list str) (define (string->list str)
(let lp ((i (string-cursor-prev str (string-cursor-end str))) (res '())) (let lp ((i (string-cursor-prev str (string-cursor-end str))) (res '()))
(if (< i 0) (if (< i 0)

7
main.c
View file

@ -124,7 +124,7 @@ static sexp sexp_load_standard_repl_env (sexp ctx, sexp env, sexp k) {
void run_main (int argc, char **argv) { void run_main (int argc, char **argv) {
char *arg, *impmod, *p; char *arg, *impmod, *p;
sexp out=SEXP_FALSE, res=SEXP_VOID, env=NULL, ctx=NULL; sexp out=SEXP_FALSE, env=NULL, ctx=NULL;
sexp_sint_t i, j, len, quit=0, print=0, init_loaded=0, fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS; sexp_sint_t i, j, len, quit=0, print=0, init_loaded=0, fold_case=SEXP_DEFAULT_FOLD_CASE_SYMS;
sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE; sexp_uint_t heap_size=0, heap_max_size=SEXP_MAXIMUM_HEAP_SIZE;
sexp_gc_var2(tmp, args); sexp_gc_var2(tmp, args);
@ -139,12 +139,11 @@ void run_main (int argc, char **argv) {
print = (argv[i][1] == 'p'); print = (argv[i][1] == 'p');
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2); arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
check_nonull_arg('e', arg); check_nonull_arg('e', arg);
res = check_exception(ctx, sexp_read_from_string(ctx, arg, -1)); tmp = check_exception(ctx, sexp_eval_string(ctx, arg, -1, env));
res = check_exception(ctx, sexp_eval(ctx, res, env));
if (print) { if (print) {
if (! sexp_oportp(out)) if (! sexp_oportp(out))
out = sexp_eval_string(ctx, "(current-output-port)", -1, env); out = sexp_eval_string(ctx, "(current-output-port)", -1, env);
sexp_write(ctx, res, out); sexp_write(ctx, tmp, out);
sexp_write_char(ctx, '\n', out); sexp_write_char(ctx, '\n', out);
} }
quit = 1; quit = 1;

66
sexp.c
View file

@ -1044,14 +1044,45 @@ int sstream_read (void *vec, char *dst, int n) {
return n; return n;
} }
#define SEXP_LAST_CONTEXT_CHECK_LIMIT 256
#if ! SEXP_USE_BOEHM
static int in_heap_p (sexp_heap h, sexp p) {
for ( ; h; h = h->next)
if (((sexp)h < p) && (p < (sexp)((char*)h + h->size)))
return 1;
return 0;
}
#endif
static sexp sexp_last_context (sexp ctx, sexp *cstack) {
sexp res=SEXP_FALSE;
#if ! SEXP_USE_BOEHM
sexp p;
sexp_sint_t i;
sexp_heap h = sexp_context_heap(ctx);
for (i=0; i<SEXP_LAST_CONTEXT_CHECK_LIMIT; i++) {
p = cstack[i];
if (p && (p != ctx) && sexp_pointerp(p) && in_heap_p(h, p)
&& (sexp_pointer_tag(p) == SEXP_CONTEXT)
&& (sexp_context_heap(p) == h)) {
res = p;
break;
}
}
#endif
return res;
}
int sstream_write (void *vec, const char *src, int n) { int sstream_write (void *vec, const char *src, int n) {
sexp_uint_t len, pos, newpos; sexp_uint_t len, pos, newpos;
sexp newbuf; sexp newbuf, ctx;
len = sexp_unbox_fixnum(sexp_stream_size(vec)); len = sexp_unbox_fixnum(sexp_stream_size(vec));
pos = sexp_unbox_fixnum(sexp_stream_pos(vec)); pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
newpos = pos+n; newpos = pos+n;
ctx = sexp_last_context(sexp_stream_ctx(vec), &ctx);
if (newpos >= len) { if (newpos >= len) {
newbuf = sexp_make_string(sexp_stream_ctx(vec), newbuf = sexp_make_string(ctx, /* sexp_stream_ctx(vec) */
sexp_make_fixnum(newpos*2), sexp_make_fixnum(newpos*2),
SEXP_VOID); SEXP_VOID);
memcpy(sexp_string_data(newbuf), memcpy(sexp_string_data(newbuf),
@ -1082,6 +1113,7 @@ sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str
FILE *in; FILE *in;
sexp res; sexp res;
sexp_gc_var1(cookie); sexp_gc_var1(cookie);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, str);
sexp_gc_preserve1(ctx, cookie); sexp_gc_preserve1(ctx, cookie);
cookie = sexp_make_vector(ctx, sexp_make_fixnum(4), SEXP_VOID); cookie = sexp_make_vector(ctx, sexp_make_fixnum(4), SEXP_VOID);
sexp_stream_ctx_set(cookie, ctx); sexp_stream_ctx_set(cookie, ctx);
@ -1122,7 +1154,7 @@ sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port) {
sexp_stream_pos(cookie)); sexp_stream_pos(cookie));
} }
#else #else /* SEXP_USE_STRING_STREAMS && ! SEXP_BSD */
sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str) { sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str) {
FILE *in; FILE *in;
@ -1151,13 +1183,14 @@ sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
} }
sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port) { sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port) {
sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, out);
fflush(sexp_port_stream(port)); fflush(sexp_port_stream(port));
return sexp_c_string(ctx, sexp_port_buf(port), sexp_port_size(port)); return sexp_c_string(ctx, sexp_port_buf(port), sexp_port_size(port));
} }
#endif #endif
#else #else /* ! SEXP_USE_STRING_STREAMS */
#define SEXP_PORT_BUFFER_SIZE 4096 #define SEXP_PORT_BUFFER_SIZE 4096
@ -1176,7 +1209,7 @@ int sexp_buffered_read_char (sexp ctx, sexp p) {
} }
sexp sexp_buffered_write_char (sexp ctx, int c, sexp p) { sexp sexp_buffered_write_char (sexp ctx, int c, sexp p) {
if (sexp_port_offset(p) >= sexp_port_size(p)) if (sexp_port_offset(p)+1 >= sexp_port_size(p))
sexp_buffered_flush(ctx, 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; return SEXP_VOID;
@ -1184,8 +1217,18 @@ sexp sexp_buffered_write_char (sexp ctx, int c, sexp p) {
sexp sexp_buffered_write_string_n (sexp ctx, const char *str, sexp sexp_buffered_write_string_n (sexp ctx, const char *str,
sexp_uint_t len, sexp p) { sexp_uint_t len, sexp p) {
if (sexp_port_offset(p) >= sexp_port_size(p)) int diff;
/* fprintf(stderr, "write %s: off: %ld size: %ld len: %ld\n", */
/* str, sexp_port_offset(p), sexp_port_size(p), len); */
while (sexp_port_offset(p)+len >= sexp_port_size(p)) {
diff = sexp_port_size(p) - sexp_port_offset(p);
/* fprintf(stderr, "write: off: %ld size: %ld len: %ld diff: %ld\n", */
/* sexp_port_offset(p), sexp_port_size(p), len, diff); */
memcpy(sexp_port_buf(p)+sexp_port_offset(p), str, diff);
sexp_buffered_flush(ctx, p); sexp_buffered_flush(ctx, p);
str += diff;
len -= diff;
}
memcpy(sexp_port_buf(p)+sexp_port_offset(p), str, len); memcpy(sexp_port_buf(p)+sexp_port_offset(p), str, len);
sexp_port_offset(p) += len; sexp_port_offset(p) += len;
return SEXP_VOID; return SEXP_VOID;
@ -1196,7 +1239,7 @@ sexp sexp_buffered_write_string (sexp ctx, const char *str, sexp p) {
} }
sexp sexp_buffered_flush (sexp ctx, sexp p) { sexp sexp_buffered_flush (sexp ctx, sexp p) {
sexp_gc_var1(tmp); sexp_gc_var2(tmp, ls);
if (! sexp_oportp(p)) if (! sexp_oportp(p))
return sexp_type_exception(ctx, NULL, SEXP_OPORT, p); return sexp_type_exception(ctx, NULL, SEXP_OPORT, p);
if (! sexp_port_openp(p)) if (! sexp_port_openp(p))
@ -1206,10 +1249,12 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p)); fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p));
fflush(sexp_port_stream(p)); fflush(sexp_port_stream(p));
} else if (sexp_port_offset(p) > 0) { } else if (sexp_port_offset(p) > 0) {
sexp_gc_preserve1(ctx, tmp); sexp_gc_preserve2(ctx, tmp, ls);
ls = sexp_port_cookie(p);
tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p)); tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p));
sexp_push(ctx, sexp_port_cookie(p), tmp); /* sexp_push(ctx, sexp_port_cookie(p), tmp); */
sexp_gc_release1(ctx); sexp_port_cookie(p) = sexp_cons(ctx, tmp, ls);
sexp_gc_release2(ctx);
} }
sexp_port_offset(p) = 0; sexp_port_offset(p) = 0;
return SEXP_VOID; return SEXP_VOID;
@ -1245,6 +1290,7 @@ sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp out) { sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp out) {
sexp res; sexp res;
sexp_gc_var2(ls, tmp); sexp_gc_var2(ls, tmp);
sexp_assert_type(ctx, sexp_oportp, SEXP_OPORT, out);
sexp_gc_preserve2(ctx, ls, tmp); sexp_gc_preserve2(ctx, ls, tmp);
if (sexp_port_offset(out) > 0) { if (sexp_port_offset(out) > 0) {
tmp = sexp_c_string(ctx, sexp_port_buf(out), sexp_port_offset(out)); tmp = sexp_c_string(ctx, sexp_port_buf(out), sexp_port_offset(out));

3
vm.c
View file

@ -22,7 +22,8 @@ static void sexp_print_stack (sexp ctx, sexp *stack, int top, int fp, sexp out)
void sexp_stack_trace (sexp ctx, sexp out) { void sexp_stack_trace (sexp ctx, sexp out) {
int i, fp=sexp_context_last_fp(ctx); int i, fp=sexp_context_last_fp(ctx);
sexp self, bc, ls, *stack=sexp_stack_data(sexp_context_stack(ctx)); sexp self, bc, ls, *stack=sexp_stack_data(sexp_context_stack(ctx));
if (! sexp_oportp(out)) out = sexp_current_error_port(ctx); if (! sexp_oportp(out))
out = sexp_current_error_port(ctx);
for (i=fp; i>4; i=sexp_unbox_fixnum(stack[i+3])) { for (i=fp; i>4; i=sexp_unbox_fixnum(stack[i+3])) {
self = stack[i+2]; self = stack[i+2];
if (self && sexp_procedurep(self)) { if (self && sexp_procedurep(self)) {