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

removing accidentally committed debug code

Browse source
This commit is contained in:
Alex Shinn 2011-04-03 22:25:48 +09:00
parent 0f9a23f94f
commit a85cc23f31
4 changed files with 12 additions and 85 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
gc.c
View file

@ -177,16 +177,6 @@ int stack_references_pointer_p (sexp ctx, sexp x) {
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) {
sexp_heap h = sexp_context_heap(ctx);
sexp p, end;
@ -206,33 +196,11 @@ void sexp_conservative_mark (sexp ctx) {
#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 (1) {
#if SEXP_USE_DEBUG_GC > 3
if (p && sexp_pointerp(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);
fprintf(stderr, SEXP_BANNER("MISS: %p: %s"), p,
sexp_pointer_source(p));
fflush(stderr);
}
#endif

6
include/chibi/eval.h
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_compile_error (sexp ctx, const char *message, sexp obj);
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_apply1 (sexp ctx, sexp f, sexp x);
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_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_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_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 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);

4
include/chibi/sexp.h
View file

@ -1150,10 +1150,6 @@ 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)
#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_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)))

49
sexp.c
View file

@ -1044,45 +1044,14 @@ int sstream_read (void *vec, char *dst, int 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) {
sexp_uint_t len, pos, newpos;
sexp newbuf, ctx;
sexp newbuf;
len = sexp_unbox_fixnum(sexp_stream_size(vec));
pos = sexp_unbox_fixnum(sexp_stream_pos(vec));
newpos = pos+n;
ctx = sexp_last_context(sexp_stream_ctx(vec), &ctx);
if (newpos >= len) {
newbuf = sexp_make_string(ctx, /* sexp_stream_ctx(vec) */
newbuf = sexp_make_string(sexp_stream_ctx(vec),
sexp_make_fixnum(newpos*2),
SEXP_VOID);
memcpy(sexp_string_data(newbuf),
@ -1218,12 +1187,8 @@ sexp sexp_buffered_write_char (sexp ctx, int c, sexp p) {
sexp sexp_buffered_write_string_n (sexp ctx, const char *str,
sexp_uint_t len, sexp 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);
str += diff;
@ -1239,7 +1204,7 @@ sexp sexp_buffered_write_string (sexp ctx, const char *str, sexp p) {
}
sexp sexp_buffered_flush (sexp ctx, sexp p) {
sexp_gc_var2(tmp, ls);
sexp_gc_var1(tmp);
if (! sexp_oportp(p))
return sexp_type_exception(ctx, NULL, SEXP_OPORT, p);
if (! sexp_port_openp(p))
@ -1249,12 +1214,10 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
fwrite(sexp_port_buf(p), 1, sexp_port_offset(p), sexp_port_stream(p));
fflush(sexp_port_stream(p));
} else if (sexp_port_offset(p) > 0) {
sexp_gc_preserve2(ctx, tmp, ls);
ls = sexp_port_cookie(p);
sexp_gc_preserve1(ctx, tmp);
tmp = sexp_c_string(ctx, sexp_port_buf(p), sexp_port_offset(p));
/* sexp_push(ctx, sexp_port_cookie(p), tmp); */
sexp_port_cookie(p) = sexp_cons(ctx, tmp, ls);
sexp_gc_release2(ctx);
sexp_push(ctx, sexp_port_cookie(p), tmp);
sexp_gc_release1(ctx);
}
sexp_port_offset(p) = 0;
return SEXP_VOID;