[m-rev.] diff: list functionality for ssdebug

Peter Wang novalazy at gmail.com
Wed Jun 16 17:25:39 AEST 2010


Branches: main, 10.04

Add `list' functionality to ssdebug.

browser/listing.m:
        Implement a version of `list_path' which doesn't use C foreign code.

        Close opened streams in `list_path'. (not ssdebug related)

ssdb/ssdb.m:
        Add commands `list', `list_path', `push_list_dir', `pop_list_dir',
        `list_context_lines using the listing.m module.  Unlike in mdb, `list'
        prints the source code at the call site as that is the information we
        currently have.

diff --git a/browser/listing.m b/browser/listing.m
index e6cff27..9347410 100644
--- a/browser/listing.m
+++ b/browser/listing.m
@@ -80,12 +80,21 @@
 :- pred list_file(c_file_ptr::in, c_file_ptr::in, file_name::in, line_no::in,
     line_no::in, line_no::in, search_path::in, io::di, io::uo) is det.
 
+    % As above, but implemented without foreign code.  This is used by the
+    % source-to-source debugger which does not enable debugging in standard
+    % library so does not suffer the problem of excessive stack usage.
+    %
+:- pred list_file_portable(io.output_stream::in, io.output_stream::in,
+    file_name::in, line_no::in, line_no::in, line_no::in, search_path::in,
+    io::di, io::uo) is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 :- implementation.
 
 :- import_module dir.
+:- import_module int.
 :- import_module maybe.
 :- import_module type_desc.
 
@@ -150,8 +159,9 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
         (
             Result0 = ok(InStream),
             InStrm = mercury_stream_to_c_FILE_star(InStream),
-            print_lines_in_range(InStrm, OutStrm, 1, FirstLine, LastLine,
-                MarkLine, !IO)
+            print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
+                MarkLine, !IO),
+            io.close_input(InStream, !IO)
         ;
             Result0 = error(Error),
             ErrorMsg = io.error_message(Error),
@@ -164,9 +174,11 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
     ;
         find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
         (
-            Result = yes(InStrm),
-            print_lines_in_range(InStrm, OutStrm, 1, FirstLine, LastLine,
-                MarkLine, !IO)
+            Result = yes(InStream),
+            InStrm = mercury_stream_to_c_FILE_star(InStream),
+            print_lines_in_range_c(InStrm, OutStrm, 1, FirstLine, LastLine,
+                MarkLine, !IO),
+            io.close_input(InStream, !IO)
         ;
             Result = no,
             write_to_c_file(ErrStrm, "mdb: cannot find file ", !IO),
@@ -187,20 +199,54 @@ list_file(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
 
 %-----------------------------------------------------------------------------%
 
+list_file_portable(OutStrm, ErrStrm, FileName, FirstLine, LastLine, MarkLine, Path,
+        !IO) :-
+    ( dir.path_name_is_absolute(FileName) ->
+        io.open_input(FileName, Result0, !IO),
+        (
+            Result0 = ok(InStrm),
+            print_lines_in_range_m(InStrm, OutStrm, 1, FirstLine, LastLine,
+                MarkLine, !IO),
+            io.close_input(InStrm, !IO)
+        ;
+            Result0 = error(Error),
+            ErrorMsg = io.error_message(Error),
+            io.write_string(ErrStrm, "mdb: cannot open file ", !IO),
+            io.write_string(ErrStrm, FileName, !IO),
+            io.write_string(ErrStrm, ": ", !IO),
+            io.write_string(ErrStrm, ErrorMsg, !IO),
+            io.write_string(ErrStrm, "\n", !IO)
+        )
+    ;
+        find_and_open_file([dir.this_directory | Path], FileName, Result, !IO),
+        (
+            Result = yes(InStrm),
+            print_lines_in_range_m(InStrm, OutStrm, 1, FirstLine, LastLine,
+                MarkLine, !IO),
+            io.close_input(InStrm, !IO)
+        ;
+            Result = no,
+            io.write_string(ErrStrm, "mdb: cannot find file ", !IO),
+            io.write_string(ErrStrm, FileName, !IO),
+            io.write_string(ErrStrm, "\n", !IO)
+        )
+    ).
+
+%-----------------------------------------------------------------------------%
+
     % Search for the first file with the given name on the search path
     % that we can open for reading and return the complete file name
     % (including the path component) and input stream handle.
     %
 :- pred find_and_open_file(search_path::in, file_name::in,
-    maybe(c_file_ptr)::out, io::di, io::uo) is det.
+    maybe(io.input_stream)::out, io::di, io::uo) is det.
 
 find_and_open_file([], _, no, !IO).
 find_and_open_file([Dir | Path], FileName, Result, !IO) :-
     io.open_input(Dir / FileName, Result0, !IO),
     (
         Result0 = ok(InStream),
-        InStrm = mercury_stream_to_c_FILE_star(InStream),
-        Result  = yes(InStrm)
+        Result  = yes(InStream)
     ;
         Result0 = error(_),
         find_and_open_file(Path, FileName, Result, !IO)
@@ -226,11 +272,11 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
     % numbered MarkLine, if it occurs in the range FirstLine .. LastLine,
     % which is indented with "> ".
     %
-:- pred print_lines_in_range(c_file_ptr::in, c_file_ptr::in,
+:- pred print_lines_in_range_c(c_file_ptr::in, c_file_ptr::in,
     line_no::in, line_no::in, line_no::in, line_no::in, io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    print_lines_in_range(InStrm::in, OutStrm::in, ThisLine::in, FirstLine::in,
+    print_lines_in_range_c(InStrm::in, OutStrm::in, ThisLine::in, FirstLine::in,
         LastLine::in, MarkLine::in, IO0::di, IO::uo),
     [promise_pure, thread_safe, will_not_call_mercury],
 "
@@ -259,4 +305,35 @@ find_and_open_file([Dir | Path], FileName, Result, !IO) :-
 ").
 
 %-----------------------------------------------------------------------------%
+
+:- pred print_lines_in_range_m(io.input_stream::in, io.output_stream::in,
+    line_no::in, line_no::in, line_no::in, line_no::in, io::di, io::uo) is det.
+
+print_lines_in_range_m(InStrm, OutStrm, ThisLine, FirstLine, LastLine,
+        MarkLine, !IO) :-
+    io.read_line_as_string(InStrm, Res, !IO),
+    (
+        Res = ok(Line),
+        ( FirstLine =< ThisLine, ThisLine =< LastLine ->
+            ( ThisLine = MarkLine ->
+                io.write_string(OutStrm, "> ", !IO)
+            ;
+                io.write_string(OutStrm, "  ", !IO)
+            ),
+            io.write_string(OutStrm, Line, !IO)
+        ;
+            true
+        ),
+        print_lines_in_range_m(InStrm, OutStrm, ThisLine + 1, FirstLine,
+            LastLine, MarkLine, !IO)
+    ;
+        Res = eof
+    ;
+        Res = error(Error),
+        io.write_string(OutStrm, "Error: ", !IO),
+        io.write_string(OutStrm, io.error_message(Error), !IO),
+        io.write_string(OutStrm, "\n", !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
diff --git a/ssdb/ssdb.m b/ssdb/ssdb.m
index c2cd0af..a621cec 100755
--- a/ssdb/ssdb.m
+++ b/ssdb/ssdb.m
@@ -124,6 +124,7 @@
 :- import_module mdb.browse.
 :- import_module mdb.browser_info.
 :- import_module mdb.browser_term.
+:- import_module mdb.listing.
 
 :- pragma foreign_decl("C",
 "
@@ -167,6 +168,12 @@
                 sf_list_var_value   :: list(var_value)
             ).
 
+:- type list_params
+    --->    list_params(
+                list_path           :: listing.search_path,
+                list_context_lines  :: int
+            ).
+
 %----------------------------------------------------------------------------%
 
     % Type used by the read_and_execute_cmd predicate to configure
@@ -279,6 +286,13 @@
 init_browser_persistent_state = State :-
     browser_info.init_persistent_state(State).
 
+:- mutable(list_params, list_params, init_list_params, ground,
+    [untrailed, attach_to_io_state]).
+
+:- func init_list_params = list_params.
+
+init_list_params = list_params(new_list_path, 2).
+
 %-----------------------------------------------------------------------------%
 
 :- mutable(tty_in, io.input_stream, io.stdin_stream, ground,
@@ -1172,9 +1186,7 @@ pred_catches_exceptions(ProcId) :-
 %----------------------------------------------------------------------------%
 
 :- type ssdb_cmd
-    --->    ssdb_help
-
-    ;       ssdb_step
+    --->    ssdb_step
     ;       ssdb_next
     ;       ssdb_goto
     ;       ssdb_continue
@@ -1196,21 +1208,24 @@ pred_catches_exceptions(ProcId) :-
     ;       ssdb_format
     ;       ssdb_format_param
 
+    ;       ssdb_list
+    ;       ssdb_list_path
+    ;       ssdb_push_list_dir
+    ;       ssdb_pop_list_dir
+    ;       ssdb_list_context_lines
+
     ;       ssdb_break
     ;       ssdb_enable
     ;       ssdb_disable
     ;       ssdb_delete
 
+    ;       ssdb_help
     ;       ssdb_quit.
 
 :- pred ssdb_cmd_name(string, ssdb_cmd).
 :- mode ssdb_cmd_name(in, out) is semidet.
 :- mode ssdb_cmd_name(out, in) is multi.
 
-ssdb_cmd_name("h",          ssdb_help).
-ssdb_cmd_name("help",       ssdb_help).
-ssdb_cmd_name("?",          ssdb_help).
-
 ssdb_cmd_name("s",          ssdb_step).
 ssdb_cmd_name("step",       ssdb_step).
 ssdb_cmd_name("n",          ssdb_next).
@@ -1248,12 +1263,23 @@ ssdb_cmd_name("cur",        ssdb_current).
 ssdb_cmd_name("format",     ssdb_format).
 ssdb_cmd_name("format_param", ssdb_format_param).
 
+ssdb_cmd_name("list",               ssdb_list).
+ssdb_cmd_name("l",                  ssdb_list).
+ssdb_cmd_name("list_path",          ssdb_list_path).
+ssdb_cmd_name("push_list_dir",      ssdb_push_list_dir).
+ssdb_cmd_name("pld",                ssdb_push_list_dir).
+ssdb_cmd_name("pop_list_dir",       ssdb_pop_list_dir).
+ssdb_cmd_name("list_context_lines", ssdb_list_context_lines).
+
 ssdb_cmd_name("b",          ssdb_break).
 ssdb_cmd_name("break",      ssdb_break).
 ssdb_cmd_name("enable",     ssdb_enable).
 ssdb_cmd_name("disable",    ssdb_disable).
 ssdb_cmd_name("delete",     ssdb_delete).
 
+ssdb_cmd_name("h",          ssdb_help).
+ssdb_cmd_name("help",       ssdb_help).
+ssdb_cmd_name("?",          ssdb_help).
 ssdb_cmd_name("q",          ssdb_quit).
 ssdb_cmd_name("quit",       ssdb_quit).
 
@@ -1261,6 +1287,10 @@ ssdb_cmd_name("quit",       ssdb_quit).
     is semidet.
 
 ssdb_cmd_name("P", ssdb_print, ["*"]).
+ssdb_cmd_name("depth", ssdb_format_param, ["depth"]).
+ssdb_cmd_name("lines", ssdb_format_param, ["lines"]).
+ssdb_cmd_name("size", ssdb_format_param, ["size"]).
+ssdb_cmd_name("width", ssdb_format_param, ["width"]).
 
 %---------------------------------------------------------------------------%
 
@@ -1320,10 +1350,6 @@ read_and_execute_cmd(Event, Depth, WhatNext, !IO) :-
 
 execute_cmd(Cmd, Args, Event, Depth, WhatNext, !IO) :-
     (
-        Cmd = ssdb_help,
-        execute_ssdb_help(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
         Cmd = ssdb_step,
         execute_ssdb_step(Args, Event, Depth, WhatNext, !IO)
     ;
@@ -1348,64 +1374,73 @@ execute_cmd(Cmd, Args, Event, Depth, WhatNext, !IO) :-
         Cmd = ssdb_retry,
         execute_ssdb_retry(Args, Event, Depth, WhatNext, !IO)
     ;
-        Cmd = ssdb_stack,
-        execute_ssdb_stack(Args, Depth, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_print,
-        execute_ssdb_print(Args, Depth, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_browse,
-        execute_ssdb_browse(Args, Depth, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_vars,
-        execute_ssdb_vars(Args, Depth, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_down,
-        execute_ssdb_down(Args, Depth, NewDepth, !IO),
-        read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_up,
-        execute_ssdb_up(Args, Depth, NewDepth, !IO),
-        read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_level,
-        execute_ssdb_level(Args, Depth, NewDepth, !IO),
+        (
+            Cmd = ssdb_down,
+            execute_ssdb_down(Args, Depth, NewDepth, !IO)
+        ;
+            Cmd = ssdb_up,
+            execute_ssdb_up(Args, Depth, NewDepth, !IO)
+        ;
+            Cmd = ssdb_level,
+            execute_ssdb_level(Args, Depth, NewDepth, !IO)
+        ),
         read_and_execute_cmd(Event, NewDepth, WhatNext, !IO)
     ;
-        Cmd = ssdb_current,
-        execute_ssdb_current(Args, Event, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_format,
-        execute_ssdb_format(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_format_param,
-        execute_ssdb_format_param(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_break,
-        execute_ssdb_break(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_enable,
-        execute_ssdb_enable(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_disable,
-        execute_ssdb_disable(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_delete,
-        execute_ssdb_delete(Args, !IO),
-        read_and_execute_cmd(Event, Depth, WhatNext, !IO)
-    ;
-        Cmd = ssdb_quit,
-        execute_ssdb_quit(Args, !IO),
+        (
+            Cmd = ssdb_stack,
+            execute_ssdb_stack(Args, Depth, !IO)
+        ;
+            Cmd = ssdb_print,
+            execute_ssdb_print(Args, Depth, !IO)
+        ;
+            Cmd = ssdb_browse,
+            execute_ssdb_browse(Args, Depth, !IO)
+        ;
+            Cmd = ssdb_vars,
+            execute_ssdb_vars(Args, Depth, !IO)
+        ;
+            Cmd = ssdb_current,
+            execute_ssdb_current(Args, Event, !IO)
+        ;
+            Cmd = ssdb_format,
+            execute_ssdb_format(Args, !IO)
+        ;
+            Cmd = ssdb_format_param,
+            execute_ssdb_format_param(Args, !IO)
+        ;
+            Cmd = ssdb_list,
+            execute_ssdb_list(Args, Depth, !IO)
+        ;
+            Cmd = ssdb_list_path,
+            execute_ssdb_list_path(Args, !IO)
+        ;
+            Cmd = ssdb_push_list_dir,
+            execute_ssdb_push_list_dir(Args, !IO)
+        ;
+            Cmd = ssdb_pop_list_dir,
+            execute_ssdb_pop_list_dir(Args, !IO)
+        ;
+            Cmd = ssdb_list_context_lines,
+            execute_ssdb_list_context_lines(Args, !IO)
+        ;
+            Cmd = ssdb_break,
+            execute_ssdb_break(Args, !IO)
+        ;
+            Cmd = ssdb_enable,
+            execute_ssdb_enable(Args, !IO)
+        ;
+            Cmd = ssdb_disable,
+            execute_ssdb_disable(Args, !IO)
+        ;
+            Cmd = ssdb_delete,
+            execute_ssdb_delete(Args, !IO)
+        ;
+            Cmd = ssdb_help,
+            execute_ssdb_help(Args, !IO)
+        ;
+            Cmd = ssdb_quit,
+            execute_ssdb_quit(Args, !IO)
+        ),
         read_and_execute_cmd(Event, Depth, WhatNext, !IO)
     ).
 
@@ -2068,6 +2103,132 @@ format_param_setting([Word, ValueStr], Setting) :-
 
 %-----------------------------------------------------------------------------%
 
+:- pred execute_ssdb_list(list(string)::in, int::in, io::di, io::uo) is det.
+
+execute_ssdb_list(Args, Depth, !IO) :-
+    (
+        Args = [],
+        get_list_params(Params, !IO),
+        ContextLines = Params ^ list_context_lines,
+        execute_ssdb_list_2(ContextLines, Depth, !IO)
+    ;
+        Args = [Arg],
+        (
+            string.to_int(Arg, ContextLines),
+            ContextLines >= 0
+        ->
+            execute_ssdb_list_2(ContextLines, Depth, !IO)
+        ;
+            io.write_string("ssdb: invalid argument.\n", !IO)
+        )
+    ;
+        Args = [_, _ | _],
+        io.write_string("ssdb: too many arguments.\n", !IO)
+    ).
+
+:- pred execute_ssdb_list_2(int::in, int::in, io::di, io::uo) is det.
+
+execute_ssdb_list_2(ContextLines, Depth, !IO) :-
+    stack_index(Depth, StackFrame, !IO),
+    FileName = StackFrame ^ sf_call_site_file,
+    MarkLine = StackFrame ^ sf_call_site_line,
+    ( FileName = "" ->
+        io.write_string("ssdb: sorry, call site is unknown.\n", !IO)
+    ;
+        FirstLine = int.max(0, MarkLine - ContextLines),
+        LastLine = MarkLine + ContextLines,
+        io.stdout_stream(StdOut, !IO),
+        io.stderr_stream(StdErr, !IO),
+        get_list_params(Params, !IO),
+        ListPath = Params ^ list_path,
+        list_file_portable(StdOut, StdErr, FileName, FirstLine, LastLine,
+            MarkLine, ListPath, !IO)
+    ).
+
+:- pred execute_ssdb_list_path(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_list_path(Args, !IO) :-
+    (
+        Args = [],
+        get_list_params(Params, !IO),
+        Dirs = get_list_path(Params ^ list_path),
+        (
+            Dirs = [],
+            io.write_string("Context search path is empty\n", !IO)
+        ;
+            Dirs = [_ | _],
+            io.write_string("Context search path: ", !IO),
+            io.write_list(Dirs, " ", io.write_string, !IO),
+            io.nl(!IO)
+        )
+    ;
+        Args = [_ | _],
+        get_list_params(Params0, !IO),
+        ListPath0 = Params0 ^ list_path,
+        set_list_path(Args, ListPath0, ListPath),
+        Params = Params0 ^ list_path := ListPath,
+        set_list_params(Params, !IO)
+    ).
+
+:- pred execute_ssdb_push_list_dir(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_push_list_dir(Args, !IO) :-
+    (
+        Args = [],
+        io.write_string("ssdb: command expects arguments.\n", !IO)
+    ;
+        Args = [_ | _],
+        get_list_params(Params0, !IO),
+        ListPath0 = Params0 ^ list_path,
+        list.foldr(push_list_path, Args, ListPath0, ListPath),
+        Params = Params0 ^ list_path := ListPath,
+        set_list_params(Params, !IO)
+    ).
+
+:- pred execute_ssdb_pop_list_dir(list(string)::in, io::di, io::uo) is det.
+
+execute_ssdb_pop_list_dir(Args, !IO) :-
+    (
+        Args = [],
+        get_list_params(Params0, !IO),
+        ListPath0 = Params0 ^ list_path,
+        pop_list_path(ListPath0, ListPath),
+        Params = Params0 ^ list_path := ListPath,
+        set_list_params(Params, !IO)
+    ;
+        Args = [_ | _],
+        io.write_string("ssdb: unexpected argument.\n", !IO)
+    ).
+
+:- pred execute_ssdb_list_context_lines(list(string)::in, io::di, io::uo)
+    is det.
+
+execute_ssdb_list_context_lines(Args, !IO) :-
+    (
+        Args = [],
+        get_list_params(Params, !IO),
+        Lines = Params ^ list_context_lines,
+        io.format("Printing %d lines around each context listing.\n",
+            [i(Lines)], !IO)
+    ;
+        Args = [Arg],
+        (
+            string.to_int(Arg, N),
+            N >= 0
+        ->
+            get_list_params(Params0, !IO),
+            Params = Params0 ^ list_context_lines := N,
+            set_list_params(Params, !IO)
+        ;
+            io.write_string("ssdb: invalid argument.\n", !IO)
+        )
+    ;
+        Args = [_, _ | _],
+        io.write_string("ssdb: too many arguments.\n", !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+
 :- pred execute_ssdb_break(list(string)::in, io::di, io::uo) is det.
 
 execute_ssdb_break(Args, !IO) :-
@@ -2704,6 +2865,10 @@ print_help(!IO) :-
         "current (cur)",
         "format [-APB] flat|raw_pretty|pretty|verbose",
         "format_param [-APBfpv] depth|size|width|lines NUM",
+        "list [NUM] (l)",
+        "list_path [DIR ...]",
+        "push_list_dir DIR ... (pld)",
+        "pop_list_dir",
         "break MODULE PRED (b)",
         "break info",
         "enable NUM|*",

--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the reviews mailing list