diff --git a/browser/parse.m b/browser/parse.m index 2f214ea3d..e0ec773b4 100644 --- a/browser/parse.m +++ b/browser/parse.m @@ -136,22 +136,13 @@ . parse__read_command(Prompt, Comm) --> - util__trace_getline(Prompt, Result), - ( { Result = ok(Line) }, - { string__to_char_list(Line, Cs) }, - { lexer(Cs, Tokens) }, - ( { parse(Tokens, Comm2) } -> - { Comm = Comm2 } - ; - { Comm = unknown } - ) - ; { Result = eof }, - { Comm = quit } - ; { Result = error(Error) }, - { io__error_message(Error, Msg) }, - io__write_string(Msg), - io__nl, - parse__read_command(Prompt, Comm) + util__trace_get_command(Prompt, Line), + { string__to_char_list(Line, Cs) }, + { lexer(Cs, Tokens) }, + ( { parse(Tokens, Comm2) } -> + { Comm = Comm2 } + ; + { Comm = unknown } ). parse__read_command_external(Comm) --> diff --git a/browser/util.m b/browser/util.m index 071c77d99..46a845573 100644 --- a/browser/util.m +++ b/browser/util.m @@ -46,6 +46,16 @@ io__output_stream, io__state, io__state). :- mode util__trace_getline(in, out, in, in, di, uo) is det. + % trace_get_command is similar to trace_getline except that it + % breaks lines into semicolon separated commands, and replaces + % EOF with the command 'quit'. +:- pred util__trace_get_command(string, string, io__state, io__state). +:- mode util__trace_get_command(in, out, di, uo) is det. + +:- pred util__trace_get_command(string, string, io__input_stream, + io__output_stream, io__state, io__state). +:- mode util__trace_get_command(in, out, in, in, di, uo) is det. + :- pred util__zip_with(pred(T1, T2, T3), list(T1), list(T2), list(T3)). :- mode util__zip_with(pred(in, in, out) is det, in, in, out) is det. @@ -113,6 +123,37 @@ util__trace_getline(Prompt, Result, MdbIn, MdbOut) --> " ). +util__trace_get_command(Prompt, Result) --> + io__input_stream(MdbIn), + io__output_stream(MdbOut), + util__trace_get_command(Prompt, Result, MdbIn, MdbOut). + +:- pragma c_code(util__trace_get_command(Prompt::in, Line::out, MdbIn::in, + MdbOut::in, State0::di, State::uo), + [will_not_call_mercury], + " + char *line; + char *mercury_string; + MercuryFile *mdb_in = (MercuryFile *) MdbIn; + MercuryFile *mdb_out = (MercuryFile *) MdbOut; + + if (MR_address_of_trace_getline != NULL) { + line = (*MR_address_of_trace_get_command)( + (char *) Prompt, + MR_file(*mdb_in), MR_file(*mdb_out)); + } else { + MR_tracing_not_enabled(); + /* not reached */ + } + + MR_make_aligned_string_copy(mercury_string, line); + free(line); + Line = (String) mercury_string; + + State = State0; + " +). + util__zip_with(Pred, XXs, YYs, Zipped) :- ( (XXs = [], YYs = []) -> Zipped = [] diff --git a/runtime/mercury_init.h b/runtime/mercury_init.h index da7bbc64e..65e2bb6b4 100644 --- a/runtime/mercury_init.h +++ b/runtime/mercury_init.h @@ -121,6 +121,7 @@ extern void ML_io_print_to_cur_stream(MR_Word, MR_Box); /* in trace/mercury_trace_internal.h */ extern char *MR_trace_getline(const char *, FILE *mdb_in, FILE *mdb_out); +extern char *MR_trace_get_command(const char *, FILE *, FILE *); /* in trace/mercury_trace_external.h */ extern void MR_trace_init_external(void); diff --git a/runtime/mercury_wrapper.c b/runtime/mercury_wrapper.c index 2176073eb..5a419f053 100644 --- a/runtime/mercury_wrapper.c +++ b/runtime/mercury_wrapper.c @@ -175,6 +175,7 @@ void (*address_of_init_modules)(void); int (*MR_address_of_do_load_aditi_rl_code)(void); char * (*MR_address_of_trace_getline)(const char *, FILE *, FILE *); +char * (*MR_address_of_trace_get_command)(const char *, FILE *, FILE *); #ifdef MR_USE_EXTERNAL_DEBUGGER void (*MR_address_of_trace_init_external)(void); diff --git a/runtime/mercury_wrapper.h b/runtime/mercury_wrapper.h index ba8dc8ace..f2be4d01c 100644 --- a/runtime/mercury_wrapper.h +++ b/runtime/mercury_wrapper.h @@ -89,14 +89,17 @@ extern void (*address_of_init_gc)(void); extern int (*MR_address_of_do_load_aditi_rl_code)(void); /* -** MR_trace_getline(const char *, FILE *, FILE *) is defined in -** trace/mercury_trace_internal.c but is called in browser/util.m. As -** we cannot do direct calls from browser/ to trace/, we do an indirect -** call via the following pointer. +** MR_trace_getline(const char *, FILE *, FILE *) and +** MR_trace_get_command(const char *, FILE *, FILE *) are defined in +** trace/mercury_trace_internal.c but are called in browser/util.m. As +** we cannot do direct calls from browser/ to trace/, we do indirect +** calls via the following pointers. */ extern char * (*MR_address_of_trace_getline)(const char *, FILE *, FILE *); +extern char * (*MR_address_of_trace_get_command)(const char *, + FILE *, FILE *); /* ** MR_trace_init_external() and MR_trace_final_external() are defined diff --git a/tests/debugger/browser_test.exp b/tests/debugger/browser_test.exp index d5e0eb2e6..dc43e11d8 100644 --- a/tests/debugger/browser_test.exp +++ b/tests/debugger/browser_test.exp @@ -5,10 +5,8 @@ mdb> goto 3 3: 2 2 EXIT pred browser_test:big_data/1-0 (det) browser_test.m:18 (browser_test.m:12) mdb> print * HeadVar__1 big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big/3), 6, small)) -mdb> browse 1 -browser> print +mdb> browse 1; print; quit big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big/3), 6, small)) -browser> quit mdb> browse HeadVar__1 browser> ls big diff --git a/tests/debugger/browser_test.exp2 b/tests/debugger/browser_test.exp2 index 1f3394ba2..565d0ef57 100644 --- a/tests/debugger/browser_test.exp2 +++ b/tests/debugger/browser_test.exp2 @@ -5,10 +5,8 @@ mdb> goto 3 3: 2 2 EXIT pred browser_test:big_data/1-0 (det) browser_test.m:18 (browser_test.m:12) mdb> print * HeadVar__1 big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big/3), 6, small)) -mdb> browse 1 -browser> print +mdb> browse 1; print; quit big(big(big(small, 1, small), 2, small), 3, big(big(small, 4, big/3), 6, small)) -browser> quit mdb> browse HeadVar__1 browser> ls big diff --git a/tests/debugger/browser_test.inp b/tests/debugger/browser_test.inp index bf647ed41..d0eaa2179 100644 --- a/tests/debugger/browser_test.inp +++ b/tests/debugger/browser_test.inp @@ -1,9 +1,7 @@ echo on goto 3 print * -browse 1 -print -quit +browse 1; print; quit browse HeadVar__1 ls cd /1 diff --git a/trace/mercury_trace_internal.c b/trace/mercury_trace_internal.c index 2ab23af0a..cfa2bf870 100644 --- a/trace/mercury_trace_internal.c +++ b/trace/mercury_trace_internal.c @@ -250,7 +250,7 @@ MR_trace_event_internal(MR_Trace_Cmd_Info *cmd, bool interactive, jumpaddr = NULL; do { - line = MR_trace_getline("mdb> ", MR_mdb_in, MR_mdb_out); + line = MR_trace_get_command("mdb> ", MR_mdb_in, MR_mdb_out); res = MR_trace_debug_cmd(line, cmd, event_info, &event_details, &jumpaddr); } while (res == KEEP_INTERACTING); @@ -484,28 +484,8 @@ MR_trace_debug_cmd(char *line, MR_Trace_Cmd_Info *cmd, int word_max; int word_count; const char *problem; - char *semicolon; MR_Next next; - if (line == NULL) { - /* - ** We got an EOF. - ** We arrange things so we don't have to treat this case - ** specially in the command interpreter below. - */ - line = MR_copy_string("quit"); - } - - if ((semicolon = strchr(line, ';')) != NULL) { - /* - ** The line contains at least two commands. - ** Execute only the first command now; put the others - ** back in the input to be processed later. - */ - *semicolon = '\0'; - MR_insert_line_at_head(MR_copy_string(semicolon + 1)); - } - problem = MR_trace_parse_line(line, &words, &word_max, &word_count); if (problem != NULL) { fflush(MR_mdb_out); @@ -2309,6 +2289,36 @@ MR_trace_source_from_open_file(FILE *fp) MR_trace_internal_interacting = FALSE; } +char * +MR_trace_get_command(const char *prompt, FILE *mdb_in, FILE *mdb_out) +{ + char *line; + char *semicolon; + + line = MR_trace_getline(prompt, mdb_in, mdb_out); + + if (line == NULL) { + /* + ** We got an EOF. + ** We arrange things so we don't have to treat this case + ** specially in the command interpreter below. + */ + line = MR_copy_string("quit"); + } + + if ((semicolon = strchr(line, ';')) != NULL) { + /* + ** The line contains at least two commands. + ** Execute only the first command now; put the others + ** back in the input to be processed later. + */ + *semicolon = '\0'; + MR_insert_line_at_head(MR_copy_string(semicolon + 1)); + } + + return line; +} + /* ** If there any lines waiting in the queue, return the first of these. ** If not, print the prompt to mdb_out, read a line from mdb_in, diff --git a/trace/mercury_trace_internal.h b/trace/mercury_trace_internal.h index cfd3e449c..616f1275a 100644 --- a/trace/mercury_trace_internal.h +++ b/trace/mercury_trace_internal.h @@ -64,5 +64,7 @@ extern void MR_trace_interrupt_message(void); extern char *MR_trace_getline(const char *prompt, FILE *mdb_in, FILE *mdb_out); +extern char *MR_trace_get_command(const char *prompt, FILE *mdb_in, + FILE *mdb_out); #endif /* MERCURY_TRACE_INTERNAL_H */ diff --git a/util/mkinit.c b/util/mkinit.c index 1ab076046..76a156171 100644 --- a/util/mkinit.c +++ b/util/mkinit.c @@ -186,6 +186,7 @@ static const char mercury_funcs[] = " MR_trace_func_ptr = MR_trace_real;\n" " MR_register_module_layout = MR_register_module_layout_real;\n" " MR_address_of_trace_getline = MR_trace_getline;\n" + " MR_address_of_trace_get_command = MR_trace_get_command;\n" " MR_address_of_trace_interrupt_handler =\n" " MR_trace_interrupt_handler;\n" " #ifdef MR_USE_EXTERNAL_DEBUGGER\n" @@ -196,6 +197,7 @@ static const char mercury_funcs[] = " MR_trace_func_ptr = MR_trace_fake;\n" " MR_register_module_layout = NULL;\n" " MR_address_of_trace_getline = NULL;\n" + " MR_address_of_trace_get_command = NULL;\n" " MR_address_of_trace_interrupt_handler = NULL;\n" " #ifdef MR_USE_EXTERNAL_DEBUGGER\n" " MR_address_of_trace_init_external = NULL;\n"