diff options
| -rw-r--r-- | ChangeLog | 39 | ||||
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | debug.c | 106 | ||||
| -rw-r--r-- | debug.h | 52 | ||||
| -rw-r--r-- | dep.mk | 5 | ||||
| -rw-r--r-- | match.c | 16 | ||||
| -rw-r--r-- | stream.c | 29 | ||||
| -rw-r--r-- | stream.h | 1 | ||||
| -rw-r--r-- | txr.c | 13 | ||||
| -rw-r--r-- | unwind.c | 21 | ||||
| -rw-r--r-- | unwind.h | 19 |
11 files changed, 295 insertions, 8 deletions
@@ -1,5 +1,44 @@ 2011-11-13 Kaz Kylheku <kaz@kylheku.com> + Adding a debugger. This is an experimental prototype. + + * Makefile (OBJS): New object file debug.o. + + * dep.mk: Updated. + + * match.c (h_fun): Use debug_begin and debug_end macros + to set up a debug frame for backtracing. + (match_line, match_files): Call debug_check to give debugger a chance + to instrument call. + (v_fun): Use debug_begin and debug_end macros to set up a debug frame + for backtracing. Call debug_check to give debugger a chance to + instrument call. + + * stream.c (struct strm_ops): New function pointer, flush. + (stdio_maybe_write_error): Wrong word in error message corrected. + (stdio_flush): New static function. + (stdio_ops, pipe_ops): New function entered into tables. + (flush_stream): New function. + + * stream.h (flush_stream): Declared. + + * txr.c (help): New options documented. + (main): call to debug_init added. New debug options parsed and + opt_debugger set accordingly. + + * unwind.c (uw_push_debug, uw_current_frame): New function. + + * unwind.h (uw_frtype): New enumeration member UW_DBG. + (struct uw_debug): New frame variant. + (union uw_frame): New member, db. + (uw_push_debug, uw_current_frame): Declared, + + * debug.c: New file. + + * debug.h: New file. + +2011-11-13 Kaz Kylheku <kaz@kylheku.com> + Fix regression in earlier commit: "Eliminate line numbers from the abstract syntax @@ -37,7 +37,7 @@ CFLAGS := $(filter-out -Wmissing-prototypes -Wstrict-prototypes,$(CFLAGS)) endif OBJS := txr.o lex.yy.o y.tab.o match.o lib.o regex.o gc.o unwind.o stream.o -OBJS += hash.o utf8.o filter.o +OBJS += hash.o utf8.o filter.o debug.o PROG := ./txr diff --git a/debug.c b/debug.c new file mode 100644 index 00000000..f5c74188 --- /dev/null +++ b/debug.c @@ -0,0 +1,106 @@ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <errno.h> +#include <dirent.h> +#include <setjmp.h> +#include <stdarg.h> +#include <wchar.h> +#include "config.h" +#include "lib.h" +#include "debug.h" +#include "gc.h" +#include "unwind.h" +#include "stream.h" +#include "parser.h" + +int opt_debugger; +static int step_mode; +val breakpoints; +val last_command; + +static void help(void) +{ +} + +val debug(val form, val bindings, val data, val line, val chr) +{ + val lineno = source_loc(form); + + if (!step_mode && !memqual(lineno, breakpoints)) { + return nil; + } else { + format(std_output, lit("stopped at line ~a\n"), lineno, nao); + format(std_output, lit("form: ~s\n"), form, nao); + format(std_output, lit("data (~s):\n~s\n"), line, data, nao); + if (chr) + format(std_output, lit("(character ~s)\n"), chr, nao); + + for (;;) { + val input, command; + + format(std_output, lit("txr> "), nao); + flush_stream(std_output); + + input = split_str_set(get_line(std_input), lit("\t ")); + command = or2(first(input), last_command); + last_command = command; + + if (equal(command, lit("?")) || equal(command, lit("help"))) { + help(); + continue; + } else if (equal(command, lit("c"))) { + step_mode = 0; + return nil; + } else if (equal(command, lit("n"))) { + step_mode = 1; + return nil; + } else if (equal(command, lit("v"))) { + format(std_output, lit("bindings: ~s\n"), bindings, nao); + } else if (equal(command, lit("f"))) { + format(std_output, lit("stopped at line ~a\n"), lineno, nao); + format(std_output, lit("form: ~s\n"), form, nao); + } else if (equal(command, lit("d"))) { + if (data) { + format(std_output, lit("data (~s):\n~s\n"), line, data, nao); + if (chr) + format(std_output, lit("(character ~s)\n"), chr, nao); + } + } else if (equal(command, lit("b")) || equal(command, lit("d"))) { + if (!rest(input)) { + format(std_output, lit("b needs argument\n"), nao); + continue; + } else { + long n = wcstol(c_str(second(input)), NULL, 10); + if (equal(command, lit("b"))) + push(num(n), &breakpoints); + } + } else if (equal(command, lit("l"))) { + format(std_output, lit("breakpoints: ~s\n"), breakpoints, nao); + } else if (equal(command, lit("w"))) { + format(std_output, lit("backtrace:\n"), nao); + { + uw_frame_t *iter; + + for (iter = uw_current_frame(); iter != 0; iter = iter->uw.up) { + if (iter->uw.type == UW_DBG) { + format(std_output, lit("(~s ~s)\n"), iter->db.func, iter->db.args, nao); + } + } + } + } else if (equal(command, lit("q"))) { + uw_throwf(query_error_s, lit("terminated via debugger"), nao); + } else { + format(std_output, lit("unrecognized command: ~a\n"), command, nao); + } + } + + return nil; + } +} + +void debug_init(void) +{ + step_mode = 1; + protect(&breakpoints, &last_command, (val *) 0); +} diff --git a/debug.h b/debug.h new file mode 100644 index 00000000..b7248459 --- /dev/null +++ b/debug.h @@ -0,0 +1,52 @@ +/* Copyright 2011 + * Kaz Kylheku <kaz@kylheku.com> + * Vancouver, Canada + * All rights reserved. + * + * BSD License: + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in + * the documentation and/or other materials provided with the + * distribution. + * 3. The name of the author may not be used to endorse or promote + * products derived from this software without specific prior + * written permission. + * + * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED + * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. + */ + +extern int opt_debugger; + +val debug(val form, val bindings, val data, val line, val chr); + +INLINE val debug_check(val form, val bindings, val data, val line, val chr) +{ + return (opt_debugger) ? debug(form, bindings, data, line, chr) : nil; +} + +void debug_init(void); + +#define debug_begin(FUNC, ARGS, UBP, \ + BINDINGS, DATA, \ + LINE, CHR) \ + do { \ + uw_frame_t db_env; \ + if (opt_debugger) \ + uw_push_debug(&db_env, FUNC, ARGS,\ + UBP, BINDINGS, DATA,\ + LINE, CHR); \ + (void) 0 + +#define debug_end \ + if (opt_debugger) \ + uw_pop_frame(&db_env); \ + } while (0) @@ -1,7 +1,7 @@ -txr.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/stream.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/parser.h $(top_srcdir)/match.h $(top_srcdir)/utf8.h $(top_srcdir)/txr.h +txr.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/stream.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h $(top_srcdir)/parser.h $(top_srcdir)/match.h $(top_srcdir)/utf8.h $(top_srcdir)/debug.h $(top_srcdir)/txr.h lex.yy.o: config.h $(top_srcdir)/lib.h y.tab.h $(top_srcdir)/gc.h $(top_srcdir)/stream.h $(top_srcdir)/utf8.h $(top_srcdir)/unwind.h $(top_srcdir)/hash.h $(top_srcdir)/parser.h y.tab.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/regex.h $(top_srcdir)/utf8.h $(top_srcdir)/match.h $(top_srcdir)/hash.h $(top_srcdir)/parser.h -match.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)/txr.h $(top_srcdir)/utf8.h $(top_srcdir)/filter.h $(top_srcdir)/hash.h $(top_srcdir)/match.h +match.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)/txr.h $(top_srcdir)/utf8.h $(top_srcdir)/filter.h $(top_srcdir)/hash.h $(top_srcdir)/debug.h $(top_srcdir)/match.h lib.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/hash.h $(top_srcdir)/unwind.h $(top_srcdir)/stream.h $(top_srcdir)/utf8.h $(top_srcdir)/filter.h regex.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/unwind.h $(top_srcdir)/regex.h $(top_srcdir)/txr.h gc.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/stream.h $(top_srcdir)/hash.h $(top_srcdir)/txr.h $(top_srcdir)/gc.h @@ -10,3 +10,4 @@ stream.o: config.h $(top_srcdir)/lib.h $(top_srcdir)/gc.h $(top_srcdir)/unwind.h 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 @@ -43,6 +43,7 @@ #include "utf8.h" #include "filter.h" #include "hash.h" +#include "debug.h" #include "match.h" int output_produced; @@ -928,9 +929,11 @@ static val h_fun(match_line_ctx c, match_line_ctx *cout) { uw_block_begin(nil, result); uw_env_begin; + debug_begin(sym, args, ub_p_a_pairs, c.bindings, c.dataline, c.data_lineno, c.pos); result = match_line(ml_bindings_specline(c, bindings_cp, body)); + debug_end; uw_env_end; uw_block_end; @@ -995,6 +998,8 @@ static val match_line(match_line_ctx c) elem = first(c.specline); + debug_check(elem, c.bindings, c.dataline, c.data_lineno, c.pos); + switch (elem ? type(elem) : 0) { case CONS: /* directive */ { @@ -2844,6 +2849,8 @@ static val v_fun(match_files_ctx *c) val piter, aiter; val bindings_cp = copy_alist(c->bindings); + debug_check(specline, c->bindings, if2(consp(c->data), car(c->data)), c->data_lineno, nil); + if (!equal(length(args), length(params))) sem_error(specline, lit("function ~a takes ~a argument(s)"), sym, length(params), nao); @@ -2873,7 +2880,10 @@ static val v_fun(match_files_ctx *c) { uw_block_begin(nil, result); uw_env_begin; + debug_begin(sym, args, ub_p_a_pairs, c->bindings, if2(consp(c->data), car(c->data)), + c->data_lineno, nil); result = match_files(mf_spec_bindings(*c, body, bindings_cp)); + debug_end; uw_env_end; uw_block_end; @@ -2979,7 +2989,11 @@ repeat_spec_same_data: if (entry) { v_match_func vmf = (v_match_func) cptr_get(entry); - val result = vmf(&c); + val result; + + debug_check(first_spec, c.bindings, if2(consp(c.data), car(c.data)), c.data_lineno, nil); + + result = vmf(&c); if (result == next_spec_k) { if ((c.spec = rest(c.spec)) == nil) @@ -54,6 +54,7 @@ struct strm_ops { val (*get_char)(val); val (*get_byte)(val); val (*close)(val, val); + val (*flush)(val); }; static void common_destroy(val obj) @@ -103,7 +104,7 @@ static val stdio_maybe_write_error(val stream) { struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; if (h->f == 0) - uw_throwf(file_error_s, lit("error reading ~a: file closed"), stream, nao); + uw_throwf(file_error_s, lit("error writing ~a: file closed"), stream, nao); clearerr(h->f); uw_throwf(file_error_s, lit("error writing ~a: ~a/~s"), stream, num(errno), string_utf8(strerror(errno)), nao); @@ -141,6 +142,14 @@ static val stdio_put_char(val stream, val ch) ? t : stdio_maybe_write_error(stream); } +static val stdio_flush(val stream) +{ + struct stdio_handle *h = (struct stdio_handle *) stream->co.handle; + if (fflush(h->f)) + stdio_maybe_write_error(stream); + return t; +} + static wchar_t *snarf_line(struct stdio_handle *h) { const size_t min_size = 512; @@ -233,7 +242,8 @@ static struct strm_ops stdio_ops = { stdio_get_line, stdio_get_char, stdio_get_byte, - stdio_close + stdio_close, + stdio_flush }; static val pipe_close(val stream, val throw_on_error) @@ -286,7 +296,8 @@ static struct strm_ops pipe_ops = { stdio_get_line, stdio_get_char, stdio_get_byte, - pipe_close + pipe_close, + stdio_flush, }; static void string_in_stream_mark(val stream) @@ -1051,6 +1062,18 @@ val put_line(val stream, val string) return (put_string(stream, string), put_char(stream, chr('\n'))); } +val flush_stream(val stream) +{ + type_check (stream, COBJ); + type_assert (stream->co.cls == stream_s, (lit("~a is not a stream"), + stream, nao)); + + { + struct strm_ops *ops = (struct strm_ops *) stream->co.ops; + return ops->flush ? ops->flush(stream) : t; + } +} + void stream_init(void) { protect(&std_input, &std_output, &std_error, (val *) 0); @@ -45,5 +45,6 @@ val format(val stream, val string, ...); val put_string(val stream, val string); val put_line(val stream, val string); val put_char(val stream, val ch); +val flush_stream(val stream); void stream_init(void); @@ -40,6 +40,7 @@ #include "parser.h" #include "match.h" #include "utf8.h" +#include "debug.h" #include "txr.h" const wchli_t *version = wli("041"); @@ -91,6 +92,8 @@ static void help(void) "-q Quiet: don't report errors during query matching.\n" "-v Verbose: extra logging from matcher.\n" "-b Don't dump list of bindings.\n" +"-l If dumping bindings, use a Lisp format.\n" +"-d Debugger mode.\n" "-a num Generate array variables up to num-dimensions.\n" " Default is 1. Additional dimensions are fudged\n" " by generating numeric suffixes\n" @@ -103,6 +106,8 @@ static void help(void) " to the utility.\n" "--help You already know!\n" "--version Display program version\n" +"--lisp-bindings Synonym for -l\n" +"--debugger Synonym for -d\n" "\n" "Options that take no argument can be combined. The -q and -v options\n" "are mutually exclusive; the right-most one dominates.\n" @@ -145,6 +150,7 @@ int main(int argc, char **argv) init(progname, oom_realloc_handler, &stack_bottom); match_init(); parse_init(); + debug_init(); return txr_main(argc, argv); } @@ -288,6 +294,10 @@ int txr_main(int argc, char **argv) opt_lisp_bindings = 1; argv++, argc--; continue; + } else if (!strcmp(*argv, "--debugger")) { + opt_debugger = 1; + argv++, argc--; + continue; } @@ -307,6 +317,9 @@ int txr_main(int argc, char **argv) case 'l': opt_lisp_bindings = 1; break; + case 'd': + opt_debugger = 1; + break; case 'a': case 'c': case 'D': @@ -166,6 +166,22 @@ val uw_set_match_context(val context) return context; } +void uw_push_debug(uw_frame_t *fr, val func, val args, + val ub_p_a_pairs, val bindings, val data, + val line, val chr) +{ + fr->db.type = UW_DBG; + fr->db.func = func; + fr->db.args = args; + fr->db.ub_p_a_pairs = args; + fr->db.bindings = bindings; + fr->db.data = data; + fr->db.line = line; + fr->db.chr = chr; + fr->db.up = uw_stack; + uw_stack = fr; +} + void uw_pop_frame(uw_frame_t *fr) { assert (fr == uw_stack); @@ -176,6 +192,11 @@ void uw_pop_frame(uw_frame_t *fr) } } +uw_frame_t *uw_current_frame(void) +{ + return uw_stack; +} + val uw_block_return(val tag, val result) { uw_frame_t *ex; @@ -31,7 +31,7 @@ #endif typedef union uw_frame uw_frame_t; -typedef enum uw_frtype { UW_BLOCK, UW_ENV, UW_CATCH } uw_frtype_t; +typedef enum uw_frtype { UW_BLOCK, UW_ENV, UW_CATCH, UW_DBG } uw_frtype_t; struct uw_common { uw_frame_t *up; @@ -65,11 +65,24 @@ struct uw_catch { jmp_buf jb; }; +struct uw_debug { + uw_frame_t *up; + uw_frtype_t type; + val func; + val args; + val ub_p_a_pairs; + val bindings; + val data; + val line; + val chr; +}; + union uw_frame { struct uw_common uw; struct uw_block bl; struct uw_dynamic_env ev; struct uw_catch ca; + struct uw_debug db; }; void uw_push_block(uw_frame_t *, val tag); @@ -86,7 +99,11 @@ noreturn val uw_errorf(val fmt, ...); val uw_register_subtype(val sub, val super); val uw_exception_subtype_p(val sub, val sup); void uw_continue(uw_frame_t *curr, uw_frame_t *target); +void uw_push_debug(uw_frame_t *, val func, val args, + val ub_p_a_pairs, val bindings, val data, + val line, val chr); void uw_pop_frame(uw_frame_t *); +uw_frame_t *uw_current_frame(void); void uw_init(void); noreturn val type_mismatch(val, ...); |