diff options
| -rw-r--r-- | ChangeLog | 39 | ||||
| -rw-r--r-- | Makefile | 9 | ||||
| -rwxr-xr-x | configure | 26 | ||||
| -rw-r--r-- | debug.c | 22 | ||||
| -rw-r--r-- | debug.h | 57 | ||||
| -rw-r--r-- | dep.mk | 2 | ||||
| -rw-r--r-- | eval.c | 22 | ||||
| -rw-r--r-- | match.c | 49 | ||||
| -rw-r--r-- | txr.c | 16 |
9 files changed, 198 insertions, 44 deletions
@@ -1,3 +1,42 @@ +2012-01-21 Kaz Kylheku <kaz@kylheku.com> + + Improved debugging. Debug nesting depth counter maintained + and used for next/step/finish stepping. + + * Makefile (OBJS): debug.o moved to OBJS-y or OBJS-. + (OBJS-y, OBJS-): New variables. + $(PROG): Depends on OBJS-y also. + clean: clean $(OBJS-y). + depend: include $(OBJS-y) in dependency generation. + + * configure: Underscores and dashes are interchangeable in + configure variables. + (yaccname_given, yacc_given): Default value is y, not yes. + (debug_support): New config variable. + (CONFIG_DEBUG_SUPPORT): New config.h symbol. + + * debug.c (debug_depth): New global variable. + (debug_block_s): New symbol variable. + (next_depth): New static variable. + (debug): Renamed some commands. Introduced separate next, step + and finish. + (debug_init): debug_block_s initialized. + + * debug.h (debug_depth, debug_block_s): Declared. + (debug_enter, debug_leave, debug_return): New macros. + (debug_check, debug_init): Conditionally defined based on + if this is a debug build. + + * dep.mk: Regenerated. + + * eval.c (eval): Instrumented with debug_enter, debug_leave, + debug_return. + + * match.c (match_line, v_fun, match_files): Likewise. + + * txr.c (txr_main): Bail if -d or --debug used in build + that lacks debug support. + 2012-01-19 Kaz Kylheku <kaz@kylheku.com> * debug.c (last_command): Initialize to empty string rather @@ -39,7 +39,8 @@ endif # TXR objects OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o -OBJS += arith.o hash.o utf8.o filter.o debug.o eval.o rand.o +OBJS += arith.o hash.o utf8.o filter.o eval.o rand.o +OBJS-$(debug_support) := debug.o # MPI objects MPI_OBJ_BASE=mpi.o mplogic.o @@ -50,7 +51,7 @@ OBJS += $(MPI_OBJS) PROG := ./txr -$(PROG): $(OBJS) +$(PROG): $(OBJS) $(OBJS-y) $(CC) $(CFLAGS) -o $@ $^ $(LEXLIB) VPATH := $(top_srcdir) @@ -75,7 +76,7 @@ rebuild: clean repatch $(PROG) .PHONY: clean clean: - rm -f $(PROG) $(OBJS) \ + rm -f $(PROG) $(OBJS) $(OBJS-y) \ y.tab.c lex.yy.c y.tab.h y.output $(TESTS:.ok=.out) .PHONY: repatch @@ -90,7 +91,7 @@ distclean: clean .PHONY: depend depend: - txr $(top_srcdir)/depend.txr $(OBJS) > $(top_srcdir)/dep.mk + txr $(top_srcdir)/depend.txr $(OBJS) $(OBJS-y) > $(top_srcdir)/dep.mk TESTS := $(patsubst $(top_srcdir)/%.txr,./%.ok,\ $(shell find $(top_srcdir)/tests -name '*.txr' | sort)) @@ -51,8 +51,8 @@ done # while [ $# -gt 0 ] ; do case $1 in - --no-* ) - var=${1#--no-} + --no-* | --no_* ) + var=${1#--no?} val= ;; --*=* ) @@ -82,7 +82,9 @@ while [ $# -gt 0 ] ; do exit 1 esac - if ! printf $var | grep -q -E '^[A-Za-z_][A-Za-z0-9_]*$' ; then + var=$(echo "$var" | tr - _) + + if ! echo $var | grep -q -E '^[A-Za-z_][A-Za-z0-9_]*$' ; then printf "$0: '$var' isn't a proper configuration variable name\n" exit 1 fi @@ -119,9 +121,9 @@ intptr=${intptr-} tool_prefix=${tool_prefix-} lex=${lex-'$(cross)$(tool_prefix)flex'} lexlib=${lexlib--lfl} -yaccname_given=${yaccname+yes} +yaccname_given=${yaccname+y} yaccname=${yaccname-} -yacc_given=${yacc+yes} +yacc_given=${yacc+y} yacc=${yacc-'$(cross)$(tool_prefix)$(yaccname)'} nm=${nm-'$(cross)$(tool_prefix)nm'} opt_flags=${opt_flags--O2} @@ -136,6 +138,7 @@ txr_dbg_opts=${txr_dbg_opts---gc-debug} valgrind=${valgrind-} lit_align=${lit_align-} extra_debugging=${extra_debugging-} +debug_support=${debug_support-y} mpi_version=1.8.6 have_quilt= have_patch= @@ -187,6 +190,8 @@ After running $0, check that the config.make contents are sane. The following variables are supported. Note that make variable syntax may be used in paths. Default values are shown in [square brackets]. +Variables are case-sensitive, but underscores and dashes are interchangeable. + prefix [$prefix] Specifies root directory where the software will ultimately be installed and @@ -530,6 +535,9 @@ compiler_prefix := $compiler_prefix # prefix for non-compiler toolchain commands tool_prefix := $tool_prefix +# do we compile in debug support? +debug_support := $debug_support + # MPI version mpi_version := $mpi_version @@ -1104,6 +1112,14 @@ else fi # +# Some final blurbs into config.h +# + +if [ -n "$debug_support" ] ; then + printf "#define CONFIG_DEBUG_SUPPORT 1\n" >> config.h +fi + +# # Regenerate config.make # @@ -15,7 +15,10 @@ #include "parser.h" int opt_debugger; +int debug_depth; +val debug_block_s; static int step_mode; +static int next_depth = -1; val breakpoints; val last_command = lit(""); @@ -49,7 +52,9 @@ val debug(val form, val bindings, val data, val line, val chr) uses_or2; val lineno = source_loc(form); - if (!step_mode && !memqual(lineno, breakpoints)) { + if (!step_mode && !memqual(lineno, breakpoints) + && (debug_depth > next_depth)) + { return nil; } else { val print_form = t; @@ -61,6 +66,7 @@ val debug(val form, val bindings, val data, val line, val chr) if (print_form) { format(std_output, lit("stopped at line ~a\n"), lineno, nao); format(std_output, lit("form: ~s\n"), form, nao); + format(std_output, lit("depth: ~s\n"), num(debug_depth), nao); print_form = nil; } @@ -92,13 +98,22 @@ val debug(val form, val bindings, val data, val line, val chr) continue; } else if (equal(command, lit("c"))) { step_mode = 0; + next_depth = -1; return nil; - } else if (equal(command, lit("n"))) { + } else if (equal(command, lit("s"))) { step_mode = 1; return nil; + } else if (equal(command, lit("n"))) { + step_mode = 0; + next_depth = debug_depth; + return nil; + } else if (equal(command, lit("f"))) { + step_mode = 0; + next_depth = debug_depth - 1; + return nil; } else if (equal(command, lit("v"))) { show_bindings(bindings, std_output); - } else if (equal(command, lit("f"))) { + } else if (equal(command, lit("i"))) { print_form = t; } else if (equal(command, lit("d"))) { print_data = t; @@ -139,4 +154,5 @@ void debug_init(void) { step_mode = 1; protect(&breakpoints, &last_command, (val *) 0); + debug_block_s = intern(lit("debug-block"), system_package); } @@ -25,9 +25,32 @@ */ extern int opt_debugger; +extern int debug_depth; +extern val debug_block_s; val debug(val form, val bindings, val data, val line, val chr); +#ifdef CONFIG_DEBUG_SUPPORT + +#define debug_enter \ + { \ + int debug_depth_save = debug_depth++; \ + uw_block_begin(debug_block_s, debug_result); \ + uw_simple_catch_begin { + +#define debug_leave \ + } \ + uw_unwind { \ + debug_depth = debug_depth_save; \ + } \ + uw_catch_end; \ + uw_block_end; \ + return debug_result; \ + } + +#define debug_return(VAL) \ + uw_block_return(debug_block_s, VAL) + INLINE val debug_check(val form, val bindings, val data, val line, val chr) { return (opt_debugger) ? debug(form, bindings, data, line, chr) : nil; @@ -40,13 +63,43 @@ void debug_init(void); LINE, CHR) \ do { \ uw_frame_t db_env; \ - if (opt_debugger) \ + if (opt_debugger) { \ uw_push_debug(&db_env, FUNC, ARGS,\ UBP, BINDINGS, DATA,\ LINE, CHR); \ + } \ (void) 0 #define debug_end \ - if (opt_debugger) \ + if (opt_debugger) { \ uw_pop_frame(&db_env); \ + } \ } while (0) + +#else + +#define debug_enter { + +#define debug_leave } + +#define debug_return(VAL) return VAL + +INLINE val debug_check(val form, val bindings, val data, val line, val chr) +{ + return nil; +} + +#define debug_begin(FUNC, ARGS, UBP, \ + BINDINGS, DATA, \ + LINE, CHR) \ + do { \ + (void) 0 + +#define debug_end \ + } while (0) + +INLINE void debug_init(void) +{ +} + +#endif @@ -11,8 +11,8 @@ ./hash.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./hash.h ./utf8.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./unwind.h $(top_srcdir)/./utf8.h ./filter.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./hash.h $(top_srcdir)/./unwind.h $(top_srcdir)/./match.h $(top_srcdir)/./filter.h $(top_srcdir)/./gc.h -./debug.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./debug.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h ./eval.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./regex.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h $(top_srcdir)/./hash.h $(top_srcdir)/./debug.h $(top_srcdir)/./match.h $(top_srcdir)/./rand.h $(top_srcdir)/./eval.h ./rand.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./unwind.h $(top_srcdir)/./gc.h $(top_srcdir)/./arith.h $(top_srcdir)/./rand.h mpi-1.8.6/mpi.o: $(top_srcdir)/mpi-1.8.6/../config.h $(top_srcdir)/mpi-1.8.6/mpi.h $(top_srcdir)/mpi-1.8.6/logtab.h mpi-1.8.6/mplogic.o: $(top_srcdir)/mpi-1.8.6/../config.h $(top_srcdir)/mpi-1.8.6/mplogic.h +./debug.o: config.h $(top_srcdir)/./lib.h $(top_srcdir)/./debug.h $(top_srcdir)/./gc.h $(top_srcdir)/./unwind.h $(top_srcdir)/./stream.h $(top_srcdir)/./parser.h @@ -326,18 +326,20 @@ static val eval_intrinsic(val form, val env) val eval(val form, val env, val ctx_form) { + debug_enter; + type_check(env, ENV); debug_check(consp(form) ? form : ctx_form, env, nil, nil, nil); if (nullp(form)) { - return nil; + debug_return (nil); } else if (symbolp(form)) { if (!bindable(form)) { - return form; + debug_return (form); } else { val binding = lookup_var(env, form); if (binding) - return cdr(binding); + debug_return (cdr(binding)); eval_error(ctx_form, lit("unbound variable ~s"), form, nao); abort(); } @@ -345,15 +347,15 @@ val eval(val form, val env, val ctx_form) val oper = car(form); if (regexp(oper)) - return oper; + debug_return (oper); { val fbinding = lookup_fun(env, oper); if (fbinding) { - return apply(cdr(fbinding), - eval_args(rest(form), env, form), - form); + debug_return (apply(cdr(fbinding), + eval_args(rest(form), env, form), + form)); } else { val entry = gethash(op_table, oper); @@ -362,13 +364,15 @@ val eval(val form, val env, val ctx_form) abort(); } else { opfun_t fp = (opfun_t) cptr_get(entry); - return fp(form, env); + debug_return (fp(form, env)); } } } } else { - return form; + debug_return (form); } + + debug_leave; } val bindable(val obj) @@ -1091,6 +1091,8 @@ static val v_fun(match_files_ctx *c); static val match_line(match_line_ctx c) { + debug_enter; + for (;;) { val elem; @@ -1110,7 +1112,7 @@ static val match_line(match_line_ctx c) val past = match_regex(c.dataline, directive, c.pos); if (nullp(past)) { LOG_MISMATCH("regex"); - return nil; + debug_return (nil); } LOG_MATCH("regex", past); c.pos = past; @@ -1120,7 +1122,7 @@ static val match_line(match_line_ctx c) if (find == nil || !equal(find, c.pos)) { LOG_MISMATCH("string tree"); - return nil; + debug_return (nil); } newpos = plus(find, len); @@ -1140,7 +1142,7 @@ static val match_line(match_line_ctx c) c = nc; continue; } else { - return result; + debug_return (result); } } else { match_line_ctx nc; @@ -1171,10 +1173,10 @@ static val match_line(match_line_ctx c) sem_error(elem, lit("no such function or directive: ~a"), directive, nao); } else { - return vresult; + debug_return (vresult); } } else { - return result; + debug_return (result); } } } @@ -1186,7 +1188,7 @@ static val match_line(match_line_ctx c) val newpos; if (find == nil || !equal(find, c.pos)) { LOG_MISMATCH("string"); - return nil; + debug_return (nil); } newpos = plus(find, length_str(elem)); LOG_MATCH("string", newpos); @@ -1200,7 +1202,8 @@ static val match_line(match_line_ctx c) c.specline = cdr(c.specline); } - return cons(c.bindings, c.pos); + debug_return (cons(c.bindings, c.pos)); + debug_leave; } val format_field(val string_or_list, val modifier, val filter, val eval_fun) @@ -3226,6 +3229,8 @@ static val v_eof(match_files_ctx *c) static val v_fun(match_files_ctx *c) { + debug_enter; + spec_bind (specline, first_spec, c->spec); val sym = first(first_spec); val func = car(uw_get_func(sym)); @@ -3276,7 +3281,7 @@ static val v_fun(match_files_ctx *c) if (!result) { debuglf(specline, lit("function (~s ~s) failed"), sym, args, nao); - return nil; + debug_return (nil); } { @@ -3295,7 +3300,7 @@ static val v_fun(match_files_ctx *c) debuglf(specline, lit("binding mismatch on ~a " "when returning from ~a"), arg, sym, nao); - return nil; + debug_return (nil); } } } @@ -3316,10 +3321,12 @@ static val v_fun(match_files_ctx *c) } } - return next_spec_k; + debug_return (next_spec_k); } - return decline_k; + debug_return (decline_k); + + debug_leave; } static val v_do(match_files_ctx *c) @@ -3341,6 +3348,8 @@ static val h_do(match_line_ctx c, match_line_ctx *cout) static val match_files(match_files_ctx c) { + debug_enter; + gc_hint(c.data); if (listp(c.data)) { /* recursive call with lazy list */ @@ -3362,13 +3371,13 @@ static val match_files(match_files_ctx c) if (consp(source_spec) && car(source_spec) == nothrow_k) { debuglf(spec, lit("could not open ~a: " "treating as failed match due to nothrow"), name, nao); - return nil; + debug_return (nil); } else if (errno != 0) file_err(spec, lit("could not open ~a (error ~a/~a)"), name, num(errno), string_utf8(strerror(errno)), nao); else file_err(spec, lit("could not open ~a"), name, nao); - return nil; + debug_return (nil); } c.files = cons(name, cdr(c.files)); /* Get rid of cons and nothrow */ @@ -3406,7 +3415,7 @@ repeat_spec_same_data: } else if (result == decline_k) { /* go on to other processing below */ } else { - return result; + debug_return (result); } } else { val result = v_fun(&c); @@ -3418,7 +3427,7 @@ repeat_spec_same_data: } else if (result == decline_k) { /* go on to other processing below */ } else { - return result; + debug_return (result); } } } @@ -3433,20 +3442,22 @@ repeat_spec_same_data: if (fixnump(success) && c_num(success) < c_num(length_str(dataline))) { debuglf(specline, lit("spec only matches line to position ~a: ~a"), success, dataline, nao); - return nil; + debug_return (nil); } if (!success) - return nil; + debug_return (nil); c.bindings = new_bindings; } else { debuglf(specline, lit("spec ran out of data"), nao); - return nil; + debug_return (nil); } } - return cons(c.bindings, if3(c.data, cons(c.data, c.data_lineno), t)); + debug_return (cons(c.bindings, if3(c.data, cons(c.data, c.data_lineno), t))); + + debug_leave; } val match_funcall(val name, val arg, val other_args) @@ -304,7 +304,14 @@ int txr_main(int argc, char **argv) argv++, argc--; continue; } else if (!strcmp(*argv, "--debugger")) { +#if CONFIG_DEBUG_SUPPORT opt_debugger = 1; +#else + format(std_error, + lit("~a: option ~a requires debug support compiled in\n"), + prog_string, string_utf8(*argv), nao); + return EXIT_FAILURE; +#endif argv++, argc--; continue; } @@ -327,13 +334,20 @@ int txr_main(int argc, char **argv) opt_lisp_bindings = 1; break; case 'd': +#if CONFIG_DEBUG_SUPPORT opt_debugger = 1; +#else + format(std_error, + lit("~a: option ~a requires debug support compiled in\n"), + prog_string, chr(*popt), nao); + return EXIT_FAILURE; +#endif break; case 'a': case 'c': case 'D': format(std_error, lit("~a: option -~a does not clump\n"), - prog_string, chr(*popt), nao); + prog_string, chr(*popt), nao); return EXIT_FAILURE; case '-': format(std_error, lit("~a: unrecognized long option: --~a\n"), |