[m-rev.] review: make source to source debugging available in any grade

Peter Ross pro at missioncriticalit.com
Thu Jul 19 21:43:45 AEST 2012


On Thu, Jul 19, 2012 at 04:07:42PM +1000, Peter Wang wrote:
> On Thu, 19 Jul 2012 02:03:58 +0200, Peter Ross <pro at missioncriticalit.com> wrote:
> > Hi,
> > 
> > The following code makes a much more useful source to source debugger
> > for me in the csharp grade.
> > 
> > Note the ssdb is currently undocumented, so I haven't had to modify
> > much documentation.
> 
> > ===================================================================
> > 
> > 
> > Estimated hours taken: 4
> > Branches: main
> > 
> > Make source to source debugging available in any grade.  This
> > is becuase ssdb doesn't require libraries to built with any
> > special extra information, so no need to an extra grade.
> 
> because
> 
> It's only true for the standard library, though.  You wouldn't be able
> to install 3rd party libraries in ssdebug-enabled and non-ssdebug
> enabled grades, for example.
> 
> Probably no one else is using the ssdebug grade so if it's easier for
> you to remove the grade component, then that's fine by me.
> 

I've addressed the changes of pwa and zs and also implemented
not stopping at shallow traced interface events when the parent
frame is also shallow traced.


===================================================================


Estimated hours taken: 8
Branches: main

Add option --ssdb-trace which allows one to control which modules are traced in
the ssdebug grade and to what level.

Add option --link-ssdb-libs which allows one to link the ssdebug libraries into
an executable not compiled in a .ssdebug grade.

README.ssdebug:
	Document the new options.

compiler/compile_target_code.m:
compiler/module_cmds.m:
	Use link_ssdb_libs rather than source_to_source_debug.

compiler/globals.m:
	Add ssdb_trace_level.
	Set the correct ssdb_trace_level according to the value
	of source_to_source_debug.

compiler/handle_options.m:
	Determine the value of --ssdb-trace according to the values
	of --ssdb and --force-disable-ssdb.
	Set --link-ssdb-libs to true is --ssdb is set.

compiler/mercury_compile_middle_passes.m:
	Always apply the ssdb transformation pass.

compiler/module_imports.m:
	If the SSDB trace level implies the transformation
	has been done, then import the ssdb module.

compiler/options.m:
	Add ssdb_trace_level and link_ssdb_libs options.

compiler/ssdebug.m:
	Use ssdb_trace_level to determine which transformations are applied
	to which procedures.

	Change the transformation so that it's now aware of which level
	tracing is in effect.

ssdb/ssdb.m:
	Record which level of tracing is applicable at each level of the stack.
	Use that information to decide whether or not to stop at an event.

	Avoid aborts when attempting to install the sigint handler in the C# grade.

	Allow the read_and_execute_cmd code to handle 10 io errors in a row before
	finally quiting, this avoids problems in the C# grade where some keypresses
	lead to transient io errors.

Index: README.ssdebug
===================================================================
RCS file: /home/mercury1/repository/mercury/README.ssdebug,v
retrieving revision 1.7
diff -u -r1.7 README.ssdebug
--- README.ssdebug	4 Nov 2010 01:36:05 -0000	1.7
+++ README.ssdebug	19 Jul 2012 11:39:08 -0000
@@ -15,7 +15,7 @@
 
 INSTALLATION
 
-To use the source-to-source debugger you must install grades containing the
+To use the source-to-source debugger you can install the grades containing the
 ".ssdebug" grade component.  One way to do this is to invoke configure
 with the option `--enable-ssdebug-grades'.  This will add the grades
 hlc.gc.ssdebug, csharp.ssdebug and java.ssdebug to the set of library grades
@@ -23,10 +23,35 @@
 
 -----------------------------------------------------------------------------
 
-THE .ssdebug GRADE COMPONENT
+COMPILATION
 
-Compile your program in a grade with the ".ssdebug" grade component,
-e.g. java.ssdebug or hlc.gc.ssdebug.
+Compile your program in a grade with the ".ssdebug" grade component, e.g.
+java.ssdebug or hlc.gc.ssdebug.  Your entire program will be then compiled
+with --ssdb-trace level of deep.
+
+An alternative way is to use `mmc --make --link-ssdb-libs' to compile your
+program in any grade.  You then just need to set --ssdb-trace shallow or deep
+on the modules you wish to debug.
+
+-----------------------------------------------------------------------------
+
+TRACING LEVELS
+
+--ssdb-trace none
+	None of the procedures in the module will generate trace events.
+
+--ssdb-trace shallow
+	All the procedures in the interface of the module will generate events
+	of trace level shallow.  Events of trace level shallow are only
+	displayed if the parent procedure in the call stack is compiled in
+	trace level deep.
+
+--ssdb-trace deep
+	All procedures in the module will generate events of trace level deep..
+
+-----------------------------------------------------------------------------
+
+USING THE SOURCE TO SOURCE DEBUGGER
 
 You may run the program as usual.  To bring up the debugger prompt, set
 the environment variable SSDB beforehand.
@@ -35,6 +60,9 @@
                 1:      1  1    CALL calculator.main
         ssdb>
 
+If you set SSDB=0 then you will need to explicitly enable the debugger later in
+your code by calling ssdb.enable_debugging/2.
+
 As in mdb, the three numbers are the event number, call sequence number (CSN)
 and the stack depth.  Type "help" to show a list of commands.  All commands act
 like their mdb counterparts (with reduced functionality), except for `list'
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.189
diff -u -r1.189 compile_target_code.m
--- compiler/compile_target_code.m	15 Jul 2012 07:39:29 -0000	1.189
+++ compiler/compile_target_code.m	19 Jul 2012 11:39:12 -0000
@@ -1615,7 +1615,7 @@
         InitFileNamesList3 = InitFileNamesList2
     ),
 
-    globals.lookup_bool_option(Globals, source_to_source_debug, SourceDebug),
+    globals.lookup_bool_option(Globals, link_ssdb_libs, SourceDebug),
     (
         SourceDebug = yes,
         InitFileNamesList = InitFileNamesList3 ++ SourceDebugInitFileNames
@@ -2256,8 +2256,7 @@
         ),
 
         % Source-to-source debugging libraries.
-        globals.lookup_bool_option(Globals, source_to_source_debug,
-            SourceDebug),
+        globals.lookup_bool_option(Globals, link_ssdb_libs, SourceDebug),
         (
             SourceDebug = yes,
             link_lib_args(Globals, TargetType, StdLibDir, GradeDir, LibExt,
@@ -3363,7 +3362,7 @@
         TraceOpt = "",
         InitFiles3 = InitFiles2
     ),
-    globals.lookup_bool_option(Globals, source_to_source_debug, SourceDebug),
+    globals.lookup_bool_option(Globals, link_ssdb_libs, SourceDebug),
     (
         SourceDebug = yes,
         InitFiles = InitFiles3 ++ SourceDebugInitFiles
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.105
diff -u -r1.105 globals.m
--- compiler/globals.m	15 Jan 2012 23:38:20 -0000	1.105
+++ compiler/globals.m	19 Jul 2012 11:39:16 -0000
@@ -189,6 +189,19 @@
             % XXX there are probably more variants of Windows, but it isn't
             % clear what they are yet.
 
+    % The tracing levels to use for a module when doing the source to source
+    % debugging tranformation.
+:- type ssdb_trace_level
+    --->    none
+            % No tracing of this module
+            
+    ;       shallow
+            % Shallow trace all procedures in this module
+
+    ;       deep
+            % Deep trace all procedures in this module
+    .
+
     % Map from module name to file name.
     %
 :- type source_file_map == map(module_name, string).
@@ -207,6 +220,7 @@
 :- pred convert_reuse_strategy(string::in, int::in, reuse_strategy::out)
     is semidet.
 :- pred convert_env_type(string::in, env_type::out) is semidet.
+:- pred convert_ssdb_trace_level(string::in, bool::in, ssdb_trace_level::out) is semidet.
 
 %-----------------------------------------------------------------------------%
 %
@@ -223,7 +237,7 @@
 
 :- pred globals_init(option_table::in, compilation_target::in, gc_method::in,
     tags_method::in, termination_norm::in, termination_norm::in,
-    trace_level::in, trace_suppress_items::in,
+    trace_level::in, trace_suppress_items::in, ssdb_trace_level::in,
     may_be_thread_safe::in, c_compiler_type::in, csharp_compiler_type::in,
     reuse_strategy::in,
     maybe(il_version_number)::in, maybe(feedback_info)::in, env_type::in,
@@ -239,6 +253,7 @@
 :- pred get_termination2_norm(globals::in, termination_norm::out) is det.
 :- pred get_trace_level(globals::in, trace_level::out) is det.
 :- pred get_trace_suppress(globals::in, trace_suppress_items::out) is det.
+:- pred get_ssdb_trace_level(globals::in, ssdb_trace_level::out) is det.
 :- pred get_maybe_thread_safe(globals::in, may_be_thread_safe::out) is det.
 :- pred get_c_compiler_type(globals::in, c_compiler_type::out) is det.
 :- pred get_csharp_compiler_type(globals::in, csharp_compiler_type::out) is det.
@@ -256,6 +271,7 @@
 :- pred set_tags_method(tags_method::in, globals::in, globals::out) is det.
 :- pred set_trace_level(trace_level::in, globals::in, globals::out) is det.
 :- pred set_trace_level_none(globals::in, globals::out) is det.
+:- pred set_ssdb_trace_level(ssdb_trace_level::in, globals::in, globals::out) is det.
 :- pred set_maybe_feedback_info(maybe(feedback_info)::in, 
     globals::in, globals::out) is det.
 
@@ -525,6 +541,12 @@
 convert_env_type("msys",    env_type_msys).
 convert_env_type("windows", env_type_win_cmd).
 
+convert_ssdb_trace_level("default", yes, deep).
+convert_ssdb_trace_level("default", no, none).
+convert_ssdb_trace_level("none", _, none).
+convert_ssdb_trace_level("shallow", _, shallow).
+convert_ssdb_trace_level("deep", _, deep).
+
 convert_reuse_strategy("same_cons_id", _, same_cons_id).
 convert_reuse_strategy("within_n_cells_difference", NCells,
     within_n_cells_difference(NCells)).
@@ -569,6 +591,7 @@
                 g_termination2_norm         :: termination_norm,
                 g_trace_level               :: trace_level,
                 g_trace_suppress_items      :: trace_suppress_items,
+                g_ssdb_trace_level            :: ssdb_trace_level,
                 g_may_be_thread_safe        :: bool,
                 g_c_compiler_type           :: c_compiler_type,
                 g_csharp_compiler_type      :: csharp_compiler_type,
@@ -581,12 +604,12 @@
 
 globals_init(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
-        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
+        SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion,
         MaybeFeedback, HostEnvType, TargetEnvType, Globals) :-
     Globals = globals(Options, Target, GC_Method, TagsMethod,
         TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
-        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
+        SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion,
         MaybeFeedback, HostEnvType, TargetEnvType).
 
@@ -598,6 +621,7 @@
 get_termination2_norm(Globals, Globals ^ g_termination2_norm).
 get_trace_level(Globals, Globals ^ g_trace_level).
 get_trace_suppress(Globals, Globals ^ g_trace_suppress_items).
+get_ssdb_trace_level(Globals, Globals ^ g_ssdb_trace_level).
 get_maybe_thread_safe(Globals, Globals ^ g_may_be_thread_safe).
 get_c_compiler_type(Globals, Globals ^ g_c_compiler_type).
 get_csharp_compiler_type(Globals, Globals ^ g_csharp_compiler_type).
@@ -635,6 +659,9 @@
 set_trace_level_none(!Globals) :-
     !Globals ^ g_trace_level := trace_level_none.
 
+set_ssdb_trace_level(SSTraceLevel, !Globals) :-
+    !Globals ^ g_ssdb_trace_level := SSTraceLevel.
+
 set_maybe_feedback_info(MaybeFeedback, !Globals) :-
     !Globals ^ g_maybe_feedback := MaybeFeedback.
 
@@ -854,5 +881,6 @@
     set_maybe_source_file_map(MaybeSourceFileMap, !IO).
 
 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 :- end_module libs.globals.
 %-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.383
diff -u -r1.383 handle_options.m
--- compiler/handle_options.m	17 Jul 2012 04:43:53 -0000	1.383
+++ compiler/handle_options.m	19 Jul 2012 11:39:16 -0000
@@ -216,14 +216,14 @@
         Globals, !IO) :-
     check_option_values(OptionTable0, OptionTable, Target, GC_Method,
         TagsMethod, TermNorm, Term2Norm, TraceLevel, TraceSuppress,
-        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
+        SSTraceLevel, MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion,
         MaybeFeedbackInfo, HostEnvType, TargetEnvType, [], CheckErrors, !IO),
     (
         CheckErrors = [],
         convert_options_to_globals(OptionTable, Target, GC_Method,
             TagsMethod, TermNorm, Term2Norm, TraceLevel,
-            TraceSuppress, MaybeThreadSafe, C_CompilerType,
+            TraceSuppress, SSTraceLevel, MaybeThreadSafe, C_CompilerType,
             CSharp_CompilerType, ReuseStrategy,
             MaybeILVersion, MaybeFeedbackInfo, HostEnvType, TargetEnvType,
             [], Errors, Globals, !IO)
@@ -236,15 +236,15 @@
 :- pred check_option_values(option_table::in, option_table::out,
     compilation_target::out, gc_method::out, tags_method::out,
     termination_norm::out, termination_norm::out, trace_level::out,
-    trace_suppress_items::out, may_be_thread_safe::out,
+    trace_suppress_items::out, ssdb_trace_level::out, may_be_thread_safe::out,
     c_compiler_type::out, csharp_compiler_type::out,
     reuse_strategy::out, maybe(il_version_number)::out,
     maybe(feedback_info)::out, env_type::out, env_type::out,
     list(string)::in, list(string)::out, io::di, io::uo) is det.
 
 check_option_values(!OptionTable, Target, GC_Method, TagsMethod,
-        TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, CSharp_CompilerType,
+        TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel,
+        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo,
         HostEnvType, TargetEnvType, !Errors, !IO) :-
     map.lookup(!.OptionTable, target, Target0),
@@ -367,6 +367,24 @@
         add_error("Invalid argument to option `--suppress-trace'.", !Errors)
     ),
 
+    map.lookup(!.OptionTable, force_disable_ssdebug, ForceDisableSSDB),
+    ( ForceDisableSSDB = bool(yes) ->
+        SSTraceLevel = none
+    ;
+        map.lookup(!.OptionTable, ssdb_trace_level, SSTrace),
+        map.lookup(!.OptionTable, source_to_source_debug, SSDB),
+        ( 
+            SSTrace = string(SSTraceStr),
+            SSDB = bool(IsInSSDebugGrade),
+            convert_ssdb_trace_level(SSTraceStr, IsInSSDebugGrade, SSTL)
+        ->
+            SSTraceLevel = SSTL
+        ;
+            SSTraceLevel = none,
+            add_error("Invalid argument to option `--ssdb-trace'.", !Errors)
+        )
+    ),
+
     map.lookup(!.OptionTable, maybe_thread_safe_opt, MaybeThreadSafeOption),
     (
         MaybeThreadSafeOption = string(MaybeThreadSafeString),
@@ -592,20 +610,20 @@
 :- pred convert_options_to_globals(option_table::in,
     compilation_target::in, gc_method::in, tags_method::in,
     termination_norm::in, termination_norm::in, trace_level::in,
-    trace_suppress_items::in, may_be_thread_safe::in, c_compiler_type::in,
-    csharp_compiler_type::in,
+    trace_suppress_items::in, ssdb_trace_level::in, may_be_thread_safe::in,
+    c_compiler_type::in, csharp_compiler_type::in,
     reuse_strategy::in, maybe(il_version_number)::in, maybe(feedback_info)::in,
     env_type::in, env_type::in, list(string)::in, list(string)::out,
     globals::out, io::di, io::uo) is det.
 
 convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
-        TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, CSharp_CompilerType,
+        TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel,
+        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo,
         HostEnvType, TargetEnvType, !Errors, !:Globals, !IO) :-
     globals_init(OptionTable0, Target, GC_Method, TagsMethod0,
-        TermNorm, Term2Norm, TraceLevel, TraceSuppress, MaybeThreadSafe,
-        C_CompilerType, CSharp_CompilerType,
+        TermNorm, Term2Norm, TraceLevel, TraceSuppress, SSTraceLevel,
+        MaybeThreadSafe, C_CompilerType, CSharp_CompilerType,
         ReuseStrategy, MaybeILVersion, MaybeFeedbackInfo,
         HostEnvType, TargetEnvType, !:Globals),
 
@@ -1500,6 +1518,10 @@
     % --decl-debug is an extension of --debug
     option_implies(decl_debug, exec_trace, bool(yes), !Globals),
 
+    % --ssdb implies --link-ssdb-libs
+    option_implies(source_to_source_debug,
+        link_ssdb_libs, bool(yes), !Globals),
+
     % We need to be able to simulate exits for calls between where an
     % exception is thrown to where it is caught both in the debugger and
     % for deep profiling.
Index: compiler/mercury_compile_middle_passes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile_middle_passes.m,v
retrieving revision 1.17
diff -u -r1.17 mercury_compile_middle_passes.m
--- compiler/mercury_compile_middle_passes.m	13 Feb 2012 00:11:41 -0000	1.17
+++ compiler/mercury_compile_middle_passes.m	19 Jul 2012 11:39:22 -0000
@@ -859,15 +859,13 @@
 
 maybe_ssdb(Verbose, Stats, !HLDS, !IO) :-
     module_info_get_globals(!.HLDS, Globals),
-    globals.lookup_bool_option(Globals, source_to_source_debug, SSDB),
     globals.lookup_bool_option(Globals, force_disable_ssdebug,
         ForceDisableSSDB),
     (
-        SSDB = yes,
         ForceDisableSSDB = no
     ->
         maybe_write_string(Verbose,
-            "% Apply debugging source to source transformation ...\n", !IO),
+            "% Maybe apply source to source debugging transformation ...\n", !IO),
         ssdebug_transform_module(!HLDS, !IO),
         maybe_write_string(Verbose, "% done.\n", !IO),
         maybe_report_stats(Stats, !IO)
Index: compiler/module_cmds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_cmds.m,v
retrieving revision 1.21
diff -u -r1.21 module_cmds.m
--- compiler/module_cmds.m	23 May 2011 05:08:08 -0000	1.21
+++ compiler/module_cmds.m	19 Jul 2012 11:39:28 -0000
@@ -826,7 +826,7 @@
         MaybeStdlibDir = yes(StdLibDir),
         grade_directory_component(Globals, GradeDir),
         % Source-to-source debugging libraries.
-        globals.lookup_bool_option(Globals, source_to_source_debug,
+        globals.lookup_bool_option(Globals, link_ssdb_libs,
             SourceDebug),
         (
             SourceDebug = yes,
Index: compiler/module_imports.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/module_imports.m,v
retrieving revision 1.12
diff -u -r1.12 module_imports.m
--- compiler/module_imports.m	23 May 2011 05:08:08 -0000	1.12
+++ compiler/module_imports.m	19 Jul 2012 11:39:28 -0000
@@ -561,10 +561,12 @@
     ;
         UseRegions = no
     ),
-    globals.lookup_bool_option(Globals, source_to_source_debug, SSDB),
+    globals.get_ssdb_trace_level(Globals, SSDBTraceLevel),
     globals.lookup_bool_option(Globals, force_disable_ssdebug, DisableSSDB),
     (
-        SSDB = yes,
+        ( SSDBTraceLevel = shallow
+        ; SSDBTraceLevel = deep
+        ),
         DisableSSDB = no
     ->
         !:UseDeps = [mercury_ssdb_builtin_module | !.UseDeps]
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.716
diff -u -r1.716 options.m
--- compiler/options.m	8 Jun 2012 15:36:59 -0000	1.716
+++ compiler/options.m	19 Jul 2012 11:39:29 -0000
@@ -400,6 +400,8 @@
     ;       use_regions_debug
     ;       use_regions_profiling
     ;       source_to_source_debug
+    ;       ssdb_trace_level
+    ;       link_ssdb_libs
 
     % Data representation compilation model options
     ;       tags
@@ -1338,6 +1340,8 @@
     single_prec_float                   -   bool(no),
     type_layout                         -   bool(yes),
     source_to_source_debug              -   bool(no),
+    ssdb_trace_level                    -   string("default"),
+    link_ssdb_libs                      -   bool(no),
 
     % Data representation compilation model options
     pic_reg                             -   bool(no),
@@ -2102,6 +2106,9 @@
 long_option("generate-mmc-make-module-dependencies",
                                         generate_mmc_make_module_dependencies).
 long_option("generate-mmc-deps",        generate_mmc_make_module_dependencies).
+long_option("ssdb-trace",               ssdb_trace_level).
+long_option("link-ssdb-libs",           link_ssdb_libs).
+long_option("link-ssdebug-libs",        link_ssdb_libs).
 long_option("trace",                    trace_level).
 long_option("trace-optimised",          trace_optimized).
 long_option("trace-optimized",          trace_optimized).
@@ -3859,6 +3866,16 @@
         "\twhen using Mmake. This is recommended when building a",
         "\tlibrary for installation.",
 
+% XXX The source-to-source debugging transform is not ready for public
+% consumption.
+        %"--link-ssdebug-libs",
+        %"--link-ssdb-libs",
+        %"\tLink the source to source debugging libraries into the",
+        %"\tthe executable.",
+        %"--ss-trace {none, shallow, deep}",
+        %"\tThe trace level to use for source to source debugging of",
+        %"\tthe given module.",
+
 % "--trace decl" is not documented, because it is for backwards
 % compatibility only.  It is now equivalent to `--trace rep'.
 %       "--trace {minimum, shallow, deep, decl, rep, default}",
Index: compiler/ssdebug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ssdebug.m,v
retrieving revision 1.38
diff -u -r1.38 ssdebug.m
--- compiler/ssdebug.m	2 Jul 2012 01:16:37 -0000	1.38
+++ compiler/ssdebug.m	19 Jul 2012 11:39:35 -0000
@@ -43,7 +43,8 @@
 %   p(...) :-
 %       promise_<original_purity> (
 %           CallVarDescs = [ ... ],
-%           impure handle_event_call(ProcId, CallVarDescs),
+%           Level = ...,
+%           impure handle_event_call(ProcId, CallVarDescs, Level),
 %           promise_equivalent_solutions [ ... ] (
 %               <original body>     % renaming outputs
 %           ),
@@ -66,7 +67,8 @@
 %   p(...) :-
 %       promise_<original_purity> (
 %           CallVarDescs = [ ... ],
-%           impure handle_event_call(ProcId, CallVarDescs),
+%           Level = ...,
+%           impure handle_event_call(ProcId, CallVarDescs, Level),
 %           (
 %               promise_equivalent_solutions [...] (
 %                   <original body>     % renaming outputs
@@ -99,7 +101,8 @@
 %       promise_<original_purity> (
 %           (
 %               CallVarDescs = [ ... ],
-%               impure handle_event_call_nondet(ProcId, CallVarDescs),
+%               Level = ...,
+%               impure handle_event_call_nondet(ProcId, CallVarDescs, Level),
 %               <original body>,
 %               ExitVarDescs = [ ... | CallVarDescs ],
 %               (
@@ -129,7 +132,8 @@
 %   p(...) :-
 %       promise_<original_purity> (
 %           CallVarDescs = [ ... ],
-%           impure handle_event_call(ProcId, CallVarDescs),
+%           Level = ...,
+%           impure handle_event_call(ProcId, CallVarDescs, Level),
 %           (
 %               <original body>
 %           ;
@@ -150,11 +154,13 @@
 %   p(...) :-
 %       promise_<original_purity> (
 %           CallVarDescs = [ ... ],
-%           impure handle_event_call(ProcId, CallVarDescs),
+%           Level = ...,
+%           impure handle_event_call(ProcId, CallVarDescs, Level),
 %           <original body>
 %       ).
 %
-% where CallVarDescs, ExitVarDescs are lists of var_value
+% where CallVarDescs, ExitVarDescs are lists of var_value and Level
+% is a ssdb.ssdb_tracel_level.
 %
 %    :- type var_value
 %        --->    unbound_head_var(var_name, pos)           :: out      variable
@@ -165,6 +171,8 @@
 %
 %    :- type pos == int.
 %
+%    :- type ssdb_tracel_level ---> shallow ; deep.
+%
 % Output head variables may appear twice in a variable description list --
 % initially unbound, then overridden by a bound_head_var functor.  Then the
 % ExitVarDescs can add output variable bindings to the CallVarDescs list,
@@ -201,6 +209,9 @@
 :- import_module hlds.passes_aux.
 :- import_module hlds.pred_table.
 :- import_module hlds.quantification.
+:- import_module libs.
+:- import_module libs.globals.
+:- import_module libs.trace_params.
 :- import_module mdbcomp.prim_data.
 :- import_module parse_tree.builtin_lib_types.
 :- import_module parse_tree.file_names.
@@ -220,9 +231,31 @@
 %-----------------------------------------------------------------------------%
 
 ssdebug_transform_module(!ModuleInfo, !IO) :-
-    ssdebug_first_pass(!ModuleInfo),
-    process_all_nonimported_procs(update_module(ssdebug_process_proc),
-        !ModuleInfo).
+    module_info_ssdb_trace_level(!.ModuleInfo, SSTraceLevel),
+    (
+        SSTraceLevel = none,
+        true
+    ;
+        SSTraceLevel = shallow,
+        % In the shallow trace level the parent of the library
+        % procedure also be of trace level shallow, thus we
+        % don't need to proxy the library methods.
+        process_all_nonimported_procs(
+            update_module(ssdebug_process_proc(SSTraceLevel)),
+            !ModuleInfo)
+    ;
+        SSTraceLevel = deep,
+        ssdebug_first_pass(!ModuleInfo),
+        process_all_nonimported_procs(
+            update_module(ssdebug_process_proc(SSTraceLevel)),
+            !ModuleInfo)
+    ).
+
+:- pred module_info_ssdb_trace_level(module_info::in, ssdb_trace_level::out) is det.
+
+module_info_ssdb_trace_level(ModuleInfo, SSTraceLevel) :-
+    module_info_get_globals(ModuleInfo, Globals),
+    globals.get_ssdb_trace_level(Globals, SSTraceLevel).
 
 %-----------------------------------------------------------------------------%
 %
@@ -478,10 +511,31 @@
 % The main transformation.
 %
 
-:- pred ssdebug_process_proc(pred_proc_id::in, proc_info::in, proc_info::out,
+:- pred ssdebug_process_proc(ssdb_trace_level::in,
+    pred_proc_id::in, proc_info::in, proc_info::out,
     module_info::in, module_info::out) is det.
 
-ssdebug_process_proc(proc(PredId, ProcId), !ProcInfo, !ModuleInfo) :-
+ssdebug_process_proc(none, proc(_PredId, _ProcId), !ProcInfo, !ModuleInfo).
+ssdebug_process_proc(shallow, proc(PredId, ProcId), !ProcInfo, !ModuleInfo) :-
+        % Only transform the procedures in the interface
+        % XXX We still need to fix the ssdb so that events generated
+        % below the shallow call event aren't seen.
+    module_info_pred_info(!.ModuleInfo, PredId, PredInfo),
+    ( pred_info_is_exported(PredInfo) ->
+        ssdebug_process_proc_2(proc(PredId, ProcId), !ProcInfo, !ModuleInfo)
+    ;
+        true
+    ).
+ssdebug_process_proc(deep, proc(PredId, ProcId), !ProcInfo, !ModuleInfo) :-
+        % Transfrom all procedures
+    ssdebug_process_proc_2(proc(PredId, ProcId), !ProcInfo, !ModuleInfo).
+    
+    
+:- pred ssdebug_process_proc_2(
+    pred_proc_id::in, proc_info::in, proc_info::out,
+    module_info::in, module_info::out) is det.
+
+ssdebug_process_proc_2(proc(PredId, ProcId), !ProcInfo, !ModuleInfo) :-
     proc_info_get_argmodes(!.ProcInfo, ArgModes),
     ( check_arguments_modes(!.ModuleInfo, ArgModes) ->
         % We have different transformations for procedures of different
@@ -546,9 +600,14 @@
             CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
             !VarTypes, map.init, BoundVarDescsAtCall),
 
+        % Set the ssdb_tracing_level.
+        make_level_construction(!.ModuleInfo,
+            ConstructLevelGoal, LevelVar, !VarSet, !VarTypes),
+
         % Generate the call to handle_event_call(ProcId, VarList).
-        make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
-            HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
+        make_handle_event("handle_event_call",
+            [ProcIdVar, CallArgListVar, LevelVar], HandleEventCallGoal,
+            !ModuleInfo, !VarSet, !VarTypes),
 
         % In the case of a retry, the output variables will be bound by the
         % retried call.
@@ -597,6 +656,7 @@
         BodyGoals = list.condense([
             ProcIdGoals,
             CallArgListGoals,
+            [ConstructLevelGoal],
             [HandleEventCallGoal],
             [ScopedRenamedBodyGoal],
             ExitArgListGoals,
@@ -632,8 +692,13 @@
             CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
             !VarTypes, map.init, BoundVarDescsAtCall),
 
+        % Set the ssdb_tracing_level.
+        make_level_construction(!.ModuleInfo,
+            ConstructLevelGoal, LevelVar, !VarSet, !VarTypes),
+
         % Generate the call to handle_event_call.
-        make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+        make_handle_event("handle_event_call",
+            [ProcIdVar, CallArgListVar, LevelVar],
             HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
 
         % In the case of a retry, the output variables will be bound by the
@@ -722,6 +787,7 @@
         BodyGoals = list.condense([
             ProcIdGoals,
             CallArgListGoals,
+            [ConstructLevelGoal],
             [HandleEventCallGoal],
             [IteGoal]
         ]),
@@ -754,9 +820,13 @@
             CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
             !VarTypes, map.init, BoundVarDescsAtCall),
 
+        % Set the ssdb_tracing_level.
+        make_level_construction(!.ModuleInfo,
+            ConstructLevelGoal, LevelVar, !VarSet, !VarTypes),
+
         % Generate the call to handle_event_call.
         make_handle_event("handle_event_call_nondet",
-            [ProcIdVar, CallArgListVar],
+            [ProcIdVar, CallArgListVar, LevelVar],
             HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
 
         % Make the variable list at the exit port. It's currently a
@@ -786,6 +856,7 @@
             impure_goal_info(detism_non)),
         CallExitRedoDisjunctGoals = list.condense([
             CallArgListGoals,
+            [ConstructLevelGoal],
             [HandleEventCallGoal],
             [OrigBodyGoal],
             ExitArgListGoals,
@@ -848,8 +919,13 @@
             CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
             !VarTypes, map.init, _BoundVarDescsAtCall),
 
+        % Set the ssdb_tracing_level.
+        make_level_construction(!.ModuleInfo,
+            ConstructLevelGoal, LevelVar, !VarSet, !VarTypes),
+
         % Generate the call to handle_event_call.
-        make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+        make_handle_event("handle_event_call",
+            [ProcIdVar, CallArgListVar, LevelVar],
             HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
 
         % Generate the call to handle_event_fail.
@@ -876,6 +952,7 @@
         BodyGoals = list.condense([
             ProcIdGoals,
             CallArgListGoals,
+            [ConstructLevelGoal],
             [HandleEventCallGoal],
             [DisjGoal]
         ]),
@@ -909,14 +986,20 @@
             CallArgListGoals, !ModuleInfo, !ProcInfo, !PredInfo, !VarSet,
             !VarTypes, map.init, _BoundVarDescsAtCall),
 
+        % Set the ssdb_tracing_level.
+        make_level_construction(!.ModuleInfo,
+            ConstructLevelGoal, LevelVar, !VarSet, !VarTypes),
+
         % Generate the call to handle_event_call(ProcId, VarList).
-        make_handle_event("handle_event_call", [ProcIdVar, CallArgListVar],
+        make_handle_event("handle_event_call",
+            [ProcIdVar, CallArgListVar, LevelVar],
             HandleEventCallGoal, !ModuleInfo, !VarSet, !VarTypes),
 
         % Put it all together.
         BodyGoals = list.condense([
             ProcIdGoals,
             CallArgListGoals,
+            [ConstructLevelGoal],
             [HandleEventCallGoal],
             [OrigBodyGoal]
         ]),
@@ -1156,6 +1239,28 @@
 
     Goals = [ConstructModuleName, ConstructPredName, ConstructProcIdGoal].
 
+    % Construct the goal which sets the ssdb_tracing_level for
+    % the current goal. ie Level = shallow
+    %
+:- pred make_level_construction(module_info::in,
+    hlds_goal::out, prog_var::out, prog_varset::in, prog_varset::out,
+    vartypes::in, vartypes::out) is det.
+
+make_level_construction(ModuleInfo, Goal, LevelVar, !VarSet, !VarTypes) :-
+    module_info_ssdb_trace_level(ModuleInfo, SSTraceLevel),
+    (
+        SSTraceLevel = none,
+        unexpected($module, $pred, "unexpected ss trace level")
+    ;
+        SSTraceLevel = shallow,
+        ConsId = shallow_cons_id
+    ;
+        SSTraceLevel = deep,
+        ConsId = deep_cons_id
+    ),
+    make_const_construction_alloc(ConsId, ssdb_tracing_level_type,
+        yes("Level"), Goal, LevelVar, !VarSet, !VarTypes).
+
     % Detect if all argument's mode are fully input or output.
     % XXX Other mode than fully input or output are not handled for the
     % moment. So the code of these procedures will not be generated.
@@ -1349,5 +1454,34 @@
     ).
 
 %-----------------------------------------------------------------------------%
+
+:- func shallow_cons_id = cons_id.
+
+shallow_cons_id = ssdb_tracing_level_cons_id("shallow").
+
+:- func deep_cons_id = cons_id.
+
+deep_cons_id = ssdb_tracing_level_cons_id("deep").
+
+:- func ssdb_tracing_level_cons_id(string) = cons_id.
+
+ssdb_tracing_level_cons_id(Level) = Cons :-
+    DataCtor = qualified(mercury_ssdb_builtin_module, Level),
+    Cons = cons(DataCtor, 0, ssdb_tracing_level_type_ctor).
+
+:- func ssdb_tracing_level_type_ctor = type_ctor.
+
+ssdb_tracing_level_type_ctor = type_ctor(ssdb_tracing_level_name, 0).
+
+:- func ssdb_tracing_level_type = mer_type.
+
+ssdb_tracing_level_type = defined_type(ssdb_tracing_level_name, [], kind_star).
+
+:- func ssdb_tracing_level_name = sym_name.
+
+ssdb_tracing_level_name =
+    qualified(mercury_ssdb_builtin_module, "ssdb_tracing_level").
+
+%-----------------------------------------------------------------------------%
 :- end_module transform_hlds.ssdebug.
 %-----------------------------------------------------------------------------%
Index: ssdb/ssdb.m
===================================================================
RCS file: /home/mercury1/repository/mercury/ssdb/ssdb.m,v
retrieving revision 1.40
diff -u -r1.40 ssdb.m
--- ssdb/ssdb.m	28 Oct 2011 14:30:31 -0000	1.40
+++ ssdb/ssdb.m	19 Jul 2012 11:39:41 -0000
@@ -42,6 +42,11 @@
     ;       ssdb_fail_nondet
     ;       ssdb_excp.
 
+:- type ssdb_tracing_level
+    --->    deep
+    ;       shallow
+    .
+
     % Type to determine if it is necessary to do a retry.
     %
 :- type ssdb_retry
@@ -75,12 +80,13 @@
 
     % This routine is called at each call event that occurs.
     %
-:- impure pred handle_event_call(ssdb_proc_id::in, list_var_value::in) is det.
+:- impure pred handle_event_call(ssdb_proc_id::in,
+    list_var_value::in, ssdb_tracing_level::in) is det.
 
     % This routine is called at each call event in a nondet procedure.
     %
 :- impure pred handle_event_call_nondet(ssdb_proc_id::in,
-    list_var_value::in) is det.
+    list_var_value::in, ssdb_tracing_level::in) is det.
 
     % This routine is called at each exit event that occurs.
     %
@@ -196,7 +202,10 @@
                 sf_call_site_line   :: int,
 
                 % The list of the procedure's arguments.
-                sf_list_var_value   :: list(var_value)
+                sf_list_var_value   :: list(var_value),
+
+                % The tracing level of the current call
+                sf_tracing_level    :: ssdb_tracing_level
             ).
 
 :- type list_params
@@ -472,10 +481,18 @@
     install_sigint_handler(_IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
 "
-    System.Console.TreatControlCAsInput = false;
-    System.Console.CancelKeyPress += new System.ConsoleCancelEventHandler(
-        ssdb.sigint_handler
-    );
+    // Don't abort if we can't install the sigint handler.
+    try {
+        System.Console.TreatControlCAsInput = false;
+    }
+    catch (System.Exception e) {}
+
+    try {
+        System.Console.CancelKeyPress += new System.ConsoleCancelEventHandler(
+            ssdb.sigint_handler
+        );
+    }
+    catch (System.Exception e) {}
 ").
 
 :- pragma foreign_code("C#",
@@ -552,26 +569,27 @@
 
 %----------------------------------------------------------------------------%
 
-handle_event_call(ProcId, ListVarValue) :-
+handle_event_call(ProcId, ListVarValue, Level) :-
     some [!IO] (
         impure invent_io(!:IO),
         get_debugger_state_safer(DebuggerState, !IO),
         (
             DebuggerState = debugger_on,
-            handle_event_call_2(ssdb_call, ProcId, ListVarValue, !IO)
+            handle_event_call_2(ssdb_call, ProcId, ListVarValue, Level, !IO)
         ;
             DebuggerState = debugger_off
         ),
         impure consume_io(!.IO)
     ).
 
-handle_event_call_nondet(ProcId, ListVarValue) :-
+handle_event_call_nondet(ProcId, ListVarValue, Level) :-
     some [!IO] (
         impure invent_io(!:IO),
         get_debugger_state_safer(DebuggerState, !IO),
         (
             DebuggerState = debugger_on,
-            handle_event_call_2(ssdb_call_nondet, ProcId, ListVarValue, !IO)
+            handle_event_call_2(ssdb_call_nondet,
+                ProcId, ListVarValue, Level, !IO)
         ;
             DebuggerState = debugger_off
         ),
@@ -579,11 +597,11 @@
     ).
 
 :- pred handle_event_call_2(ssdb_event_type::in(either_call), ssdb_proc_id::in,
-    list(var_value)::in, io::di, io::uo) is det.
+    list(var_value)::in, ssdb_tracing_level::in, io::di, io::uo) is det.
 
-:- pragma inline(handle_event_call_2/5).
+:- pragma inline(handle_event_call_2/6).
 
-handle_event_call_2(Event, ProcId, ListVarValue, !IO) :-
+handle_event_call_2(Event, ProcId, ListVarValue, Level, !IO) :-
     get_ssdb_event_number_inc(EventNum, !IO),
     get_ssdb_csn_inc(CSN, !IO),
     stack_depth(OldDepth, !IO),
@@ -593,7 +611,7 @@
     get_cur_filename(SiteFile, !IO),
     get_cur_line_number(SiteLine, !IO),
     StackFrame = stack_frame(EventNum, CSN, Depth, ProcId, SiteFile, SiteLine,
-        ListVarValue),
+        ListVarValue, Level),
     stack_push(StackFrame, !IO),
     (
         Event = ssdb_call
@@ -887,7 +905,8 @@
             DebuggerState = debugger_on,
             ProcId = ssdb_proc_id(ModuleName, ProcName),
             VarDescs = ['new bound_head_var'("Univ", 1, Univ)],
-            handle_event_excp_2(ProcId, VarDescs, !IO)
+            % XXX maybe we need to have a exception level
+            handle_event_excp_2(ProcId, VarDescs, deep, !IO)
         ;
             DebuggerState = debugger_off
         ),
@@ -895,9 +914,10 @@
     ).
 
 :- pred handle_event_excp_2(ssdb_proc_id::in, list(var_value)::in,
+    ssdb_tracing_level::in,
     io::di, io::uo) is det.
 
-handle_event_excp_2(ProcId, ListVarValue, !IO) :-
+handle_event_excp_2(ProcId, ListVarValue, Level, !IO) :-
     get_ssdb_event_number_inc(EventNum, !IO),
     get_ssdb_csn_inc(CSN, !IO),
     stack_depth(OldDepth, !IO),
@@ -907,7 +927,7 @@
     get_cur_filename(SiteFile, !IO),
     get_cur_line_number(SiteLine, !IO),
     StackFrame = stack_frame(EventNum, CSN, Depth, ProcId, SiteFile, SiteLine,
-        ListVarValue),
+        ListVarValue, Level),
     stack_push(StackFrame, !IO),
 
     Event = ssdb_excp,
@@ -1001,6 +1021,18 @@
         set_shadow_stack_depth(Depth - 1, !IO)
     ).
 
+:- pred top_of_stack_tracing_level(ssdb_tracing_level::out, io::di, io::uo) is det.
+
+top_of_stack_tracing_level(Level, !IO) :-
+    get_shadow_stack(Stack, !IO),
+    (
+        Stack = [],
+        Level = deep
+    ;
+        Stack = [Top | _],
+        Level = Top ^ sf_tracing_level
+    ).
+
     % Update the sf_list_var_value field of the top shadow stack element.
     %
 :- pred update_top_var_list(list(var_value)::in, io::di, io::uo) is det.
@@ -1100,15 +1132,15 @@
     get_cur_ssdb_next_stop(NextStop, !IO),
     (
         NextStop = ns_step,
-        ShouldStopAtEvent = yes,
+        ShouldStopAtEvent0 = yes,
         AutoRetry = do_not_retry
     ;
         NextStop = ns_next(StopCSN),
-        is_same_int(StopCSN, CSN, ShouldStopAtEvent),
+        is_same_int(StopCSN, CSN, ShouldStopAtEvent0),
         AutoRetry = do_not_retry
     ;
         NextStop = ns_continue,
-        check_breakpoint(ProcId, ShouldStopAtEvent, !IO),
+        check_breakpoint(ProcId, ShouldStopAtEvent0, !IO),
         AutoRetry = do_not_retry
     ;
         NextStop = ns_final_port(StopCSN, AutoRetry0),
@@ -1119,7 +1151,7 @@
             ; Event = ssdb_fail_nondet
             ),
             ( StopCSN = CSN ->
-                ShouldStopAtEvent = yes,
+                ShouldStopAtEvent0 = yes,
                 AutoRetry = AutoRetry0,
                 (
                     AutoRetry = do_retry,
@@ -1135,7 +1167,7 @@
                     AutoRetry = do_not_retry
                 )
             ;
-                ShouldStopAtEvent = no,
+                ShouldStopAtEvent0 = no,
                 AutoRetry = do_not_retry
             )
         ;
@@ -1144,9 +1176,9 @@
             % catch the exception before we reach the final port of StopCSN.
             get_shadow_stack(Stack, !IO),
             ( exception_handler_exists(StopCSN, Stack) ->
-                ShouldStopAtEvent = no
+                ShouldStopAtEvent0 = no
             ;
-                ShouldStopAtEvent = yes
+                ShouldStopAtEvent0 = yes
             ),
             AutoRetry = do_not_retry
         ;
@@ -1154,7 +1186,7 @@
             ; Event = ssdb_call_nondet
             ; Event = ssdb_redo_nondet
             ),
-            ShouldStopAtEvent = no,
+            ShouldStopAtEvent0 = no,
             AutoRetry = do_not_retry
         )
     ;
@@ -1162,7 +1194,7 @@
         (
             Event = ssdb_fail_nondet,
             ( StopCSN = CSN ->
-                ShouldStopAtEvent = yes,
+                ShouldStopAtEvent0 = yes,
                 AutoRetry = AutoRetry0,
                 (
                     AutoRetry = do_retry,
@@ -1177,16 +1209,16 @@
                     AutoRetry = do_not_retry
                 )
             ;
-                ShouldStopAtEvent = no,
+                ShouldStopAtEvent0 = no,
                 AutoRetry = do_not_retry
             )
         ;
             Event = ssdb_excp,
             get_shadow_stack(Stack, !IO),
             ( exception_handler_exists(StopCSN, Stack) ->
-                ShouldStopAtEvent = no
+                ShouldStopAtEvent0 = no
             ;
-                ShouldStopAtEvent = yes
+                ShouldStopAtEvent0 = yes
             ),
             AutoRetry = do_not_retry
         ;
@@ -1197,7 +1229,7 @@
             ; Event = ssdb_exit_nondet
             ; Event = ssdb_redo_nondet
             ),
-            ShouldStopAtEvent = no,
+            ShouldStopAtEvent0 = no,
             AutoRetry = do_not_retry
         )
     ;
@@ -1210,23 +1242,23 @@
             ; Event = ssdb_fail_nondet
             ; Event = ssdb_excp
             ),
-            ShouldStopAtEvent = yes
+            ShouldStopAtEvent0 = yes
         ;
             ( Event = ssdb_exit
             ; Event = ssdb_exit_nondet
             ),
-            ShouldStopAtEvent = no
+            ShouldStopAtEvent0 = no
         ),
         AutoRetry = do_not_retry
     ;
         NextStop = ns_goto(EventNumToGo),
-        is_same_int(EventNumToGo, EventNum, ShouldStopAtEvent),
+        is_same_int(EventNumToGo, EventNum, ShouldStopAtEvent0),
         AutoRetry = do_not_retry
     ;
         NextStop = ns_exception,
         (
             Event = ssdb_excp,
-            ShouldStopAtEvent = yes
+            ShouldStopAtEvent0 = yes
         ;
             ( Event = ssdb_call
             ; Event = ssdb_exit
@@ -1236,11 +1268,42 @@
             ; Event = ssdb_redo_nondet
             ; Event = ssdb_fail_nondet
             ),
-            ShouldStopAtEvent = no
+            ShouldStopAtEvent0 = no
         ),
         AutoRetry = do_not_retry
+    ),
+
+    current_and_parent_frame_tracing_levels(CurrentLevel, ParentLevel, !IO),
+    (
+        ShouldStopAtEvent0 = yes,
+        CurrentLevel = shallow,
+        ParentLevel = shallow
+    ->
+        ShouldStopAtEvent = no
+    ;
+        ShouldStopAtEvent = ShouldStopAtEvent0
     ).
 
+:- pred current_and_parent_frame_tracing_levels(
+    ssdb_tracing_level::out, ssdb_tracing_level::out, io::di, io::uo) is det.
+
+current_and_parent_frame_tracing_levels(CurrentLevel, ParentLevel, !IO) :-
+    get_shadow_stack(Stack, !IO),
+    (
+        Stack = [],
+        error("ssdb: current_frame_shallow_traced")
+    ;
+        Stack = [Current | RestStack],
+        CurrentLevel = Current ^ sf_tracing_level,
+        (
+            RestStack = [],
+            ParentLevel = deep
+        ;
+            RestStack = [Parent | _],
+            ParentLevel = Parent ^ sf_tracing_level
+        )
+    ).
+                
 :- pred is_same_int(int::in, int::in, bool::out) is det.
 
 is_same_int(IntA, IntB, IsSame) :-
@@ -1452,6 +1515,12 @@
     io::di, io::uo) is det.
 
 read_and_execute_cmd(Event, Depth, WhatNext, !IO) :-
+    read_and_execute_cmd_2(0, Event, Depth, WhatNext, !IO).
+
+:- pred read_and_execute_cmd_2(int::in, ssdb_event_type::in, int::in,
+    what_next::out, io::di, io::uo) is det.
+
+read_and_execute_cmd_2(N, Event, Depth, WhatNext, !IO) :-
     get_command_queue(Queue0, !IO),
     (
         Queue0 = [],
@@ -1478,7 +1547,14 @@
         Result = error(Error),
         io.error_message(Error, Msg),
         io.format("could not read command: %s\n", [s(Msg)], !IO),
-        execute_cmd(ssdb_quit, ["-y"], no, Event, Depth, WhatNext, !IO)
+
+        % Some errors are transient, ie unknown key press, but if we get more
+        % than 10 errors in a row it's probably not a transient error so quit
+        ( N > 10 ->
+            execute_cmd(ssdb_quit, ["-y"], no, Event, Depth, WhatNext, !IO)
+        ;
+            read_and_execute_cmd_2(N + 1, Event, Depth, WhatNext, !IO)
+        )
     ).
 
 :- pred expand_alias_and_execute(list(string)::in, bool::in,
--------------------------------------------------------------------------
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