[m-rev.] for review: cliques on the stack and the debugger
Zoltan Somogyi
zs at unimelb.edu.au
Mon Apr 23 16:28:03 AEST 2012
I am seeking feedback particularly on the user interface aspects of this diff:
what options and arguments mdb users give, and what the format of the output
is. For that, you want to read the diff to doc/user_guide.texi.
Zoltan.
Give the Mercury debugger the ability to detect cliques of mutually recursive
predicates on the stack. Exploit this ability to enhance the debugger's
level, retry, finish and stack commands.
runtime/mercury_stack_trace.[ch]:
Add a function, MR_find_clique_entry, that detects the clique
that contains the top stack frame. This is used to implement the new
arguments "clentry" and "clparent" (short for clique entry and parent)
options of the level, retry and finish commands.
Add a function, MR_dump_stack_layout_clique, that implements the
new capabilities of the stack command. It can detect more than one
clique, anywhere on the stack.
To make this possible, modify the existing functions for printing
the lines of stack traces. These used to keep some information around
between calls in global variables. Now that information is stored in
two structures that the caller passes them. One contains the parameters
that govern what is to be printed, the other contains information about
what has been buffered up to be printed, but has not been flushed yet.
(The old code was confused in its handling of parameters. Some parts
of it looked up the global variables storing them, while other parts
were given the parameter values by their callers, values that could
have been -but weren't- inconsistent.)
Change the buffer flushing code to be idempotent, since in the new
code, sometimes it hard to avoid flushing the buffer more than once,
and we want only the first to print its contents.
Make some type names conform to our standard style.
runtime/mercury_malloc.[ch]:
Add a module containing definitions of checked_malloc and
checked_realloc. The new code in mercury_stack_trace.c uses them.
runtime/Mmakefile:
Include the new files in the lists of the .h and .c files in this
directory.
runtime/mercury_stack_layout.h:
Add a new flag in MR_ProcLayouts: a flag that indicates that the
procedure has one or more higher order arguments. The new code in
mercury_stack_trace.c handles procedures with this flag specially:
it does not consider two non-consecutive occurrences of such procedures
on the stack to be necessarily part of the same clique. This is to
avoid having two calls to e.g. list.map in different part of the
program pulling all the procedures between those parts on the stack
into a single clique. (The deep profiler has a very similar tweak.)
Add a pointer to the corresponding part of the compiler.
compiler/hlds_pred.m:
Add a predicate to test whether a predicate has any higher order args.
compiler/stack_layout.m:
When computing the flag in proc layouts, call the new procedure in
hlds_pred.m to help figure it out.
trace/mercury_trace_cmd_backward.c:
Implement the "clentry" and "clparent" options of the "retry" command.
trace/mercury_trace_cmd_forward.c:
Implement the "clentry" and "clparent" options of the "finish" command.
trace/mercury_trace_cmd_browsing.c:
Implement the "clentry" and "clparent" options of the "level" command.
Implement the new functionality of the "stack" command.
trace/mercury_trace_util.[ch]:
Add some code common to the implementations of the level, retry and
finish commands.
trace/mercury_trace_external.c:
Conform to the changes to the runtime.
doc/user_guide.texi:
Document the debugger's new capabilities.
NEWS:
Announce the debugger's new capabilities.
tests/debugger/mutrec.{m,inp,exp}:
A new test case to test the handling of the stack command
in the presence of cliques.
tests/debugger/mutrec_higher_order.{m,inp,exp}:
A new test case to test the handling of the stack command
in the presence of cliques and higher order predicates.
tests/debugger/Mmakefile:
Enable both new test cases.
cvs diff: Diffing .
Index: NEWS
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/NEWS,v
retrieving revision 1.607
diff -u -b -r1.607 NEWS
--- NEWS 2 Apr 2012 03:58:52 -0000 1.607
+++ NEWS 23 Apr 2012 03:57:16 -0000
@@ -20,6 +20,19 @@
* We have added versions of the operations in the math module that omit the
domain checks.
+Changes to the Mercury debugger:
+
+* We have added new capabilities to the "level", "retry" and "finish" mdb
+ commands. If these commands are given the argument "clentry", they will
+ operate on the ancestor of the current call that represents entry to the
+ clique of mutually recursive procedures that the current call belongs to.
+ If they are given the argument "clparent", they will operate on the parent
+ of that call.
+
+* The mdb command "stack" can now find and mark cliques of mutually recursive
+ calls on the stack, and can (and by default, will) impose a limit on the
+ number of lines it prints for each clique.
+
Changes to the extras distribution:
* We have added a binding to the GLFW library.
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/extra
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/extra
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/libatomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/doc
cvs diff: Diffing boehm_gc/libatomic_ops/src
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/armcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops/tests
cvs diff: Diffing boehm_gc/libatomic_ops-1.2
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/doc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/m4
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.279
diff -u -b -r1.279 hlds_pred.m
--- compiler/hlds_pred.m 13 Feb 2012 00:11:40 -0000 1.279
+++ compiler/hlds_pred.m 21 Apr 2012 17:42:46 -0000
@@ -2250,6 +2250,9 @@
list(prog_var)::in, list(mer_mode)::in, vartypes::in,
int::out, int::out) is semidet.
+:- pred proc_info_has_higher_order_arg_from_details(module_info::in,
+ vartypes::in, list(prog_var)::in) is semidet.
+
% Given a procedure table and the id of a procedure in that table,
% return a procedure id to be attached to a clone of that procedure.
% (The task of creating the clone proc_info and inserting into the
@@ -3048,6 +3051,16 @@
proc_info_has_io_state_pair_2(VarModes, ModuleInfo, VarTypes,
ArgNum + 1, !MaybeIn, !MaybeOut).
+proc_info_has_higher_order_arg_from_details(ModuleInfo, VarTypes,
+ [HeadVar | HeadVars]) :-
+ (
+ map.lookup(VarTypes, HeadVar, VarType),
+ type_is_higher_order(VarType)
+ ;
+ proc_info_has_higher_order_arg_from_details(ModuleInfo, VarTypes,
+ HeadVars)
+ ).
+
clone_proc_id(ProcTable, _ProcId, CloneProcId) :-
find_lowest_unused_proc_id(ProcTable, CloneProcId).
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.167
diff -u -b -r1.167 stack_layout.m
--- compiler/stack_layout.m 17 Oct 2011 04:31:30 -0000 1.167
+++ compiler/stack_layout.m 21 Apr 2012 16:13:00 -0000
@@ -1002,8 +1002,7 @@
MaybeVarNamesSlotName = no
),
- encode_exec_trace_flags(ModuleInfo, HeadVars, ArgModes, VarTypes,
- 0, Flags),
+ encode_exec_trace_flags(ModuleInfo, HeadVars, ArgModes, VarTypes, Flags),
ExecTrace = proc_layout_exec_trace(MaybeCallLabelSlotName,
EventLayoutsSlotName, NumProcEventLayouts, MaybeTable,
MaybeHeadVarsSlotName, NumHeadVars, MaybeVarNamesSlotName,
@@ -1143,9 +1142,12 @@
%---------------------------------------------------------------------------%
:- pred encode_exec_trace_flags(module_info::in, list(prog_var)::in,
- list(mer_mode)::in, vartypes::in, int::in, int::out) is det.
+ list(mer_mode)::in, vartypes::in, int::out) is det.
-encode_exec_trace_flags(ModuleInfo, HeadVars, ArgModes, VarTypes, !Flags) :-
+encode_exec_trace_flags(ModuleInfo, HeadVars, ArgModes, VarTypes, !:Flags) :-
+ % The values of the flags are defined in runtime/mercury_stack_layout.h;
+ % look for the reference to this function.
+ !:Flags = 0,
(
proc_info_has_io_state_pair_from_details(ModuleInfo, HeadVars,
ArgModes, VarTypes, _, _)
@@ -1153,6 +1155,14 @@
!:Flags = !.Flags + 1
;
true
+ ),
+ (
+ proc_info_has_higher_order_arg_from_details(ModuleInfo, VarTypes,
+ HeadVars)
+ ->
+ !:Flags = !.Flags + 2
+ ;
+ true
).
%---------------------------------------------------------------------------%
cvs diff: Diffing compiler/notes
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.650
diff -u -b -r1.650 user_guide.texi
--- doc/user_guide.texi 5 Apr 2012 05:57:45 -0000 1.650
+++ doc/user_guide.texi 23 Apr 2012 03:54:47 -0000
@@ -2680,13 +2680,34 @@
@sp 1
By default, this command is strict, and it uses the default print level.
@sp 1
- at item finish [-NSans] [@var{num}]
+ at item finish [-NSans]
+ at item finish [-NSans] @var{num}
+ at item finish [-NSans] @samp{clentry}
+ at item finish [-NSans] @samp{clparent}
@kindex finish (mdb command)
-Continues execution until it reaches a final (EXIT, FAIL or EXCP) port
+If invoked without arguments,
+continues execution until it reaches a final (EXIT, FAIL or EXCP) port
+of the current call.
+If invoked with the number @var{num} as argument,
+continues execution until it reaches a final port
of the @var{num}'th ancestor of the call to which the current event refers.
-The default value of @var{num} is zero,
-which means skipping to the end of the current call.
-Reports an error if execution is already at the desired port.
+If invoked with the argument @samp{clentry},
+continues execution until it reaches a final port of the call
+that first entered into the clique of recursive calls
+of which the current call is a part.
+(If the current call is not (mutually) recursive
+with any other currently active call,
+it will skip to the end of current call.)
+If the command is given the argument @samp{clparent},
+it skips to the end of the first call outside the current call's clique.
+This will the parent of the call that @samp{finish clentry} would finish.
+ at sp 1
+If invoked as @samp{finish clentry} and @samp{finish clparent},
+this command will report an error
+unless we have stack trace information
+about all of the current call's ancestors.
+ at sp 1
+Also reports an error if execution is already at the desired port.
@sp 1
The options @samp{-n} or @samp{--none}, @samp{-s} or @samp{--some},
@samp{-a} or @samp{--all} specify the print level to use
@@ -2827,18 +2848,37 @@
@sp 1
@table @code
- at item retry [-fio] [@var{num}]
+ at item retry [-fio]
+ at item retry [-fio] @var{num}
+ at item retry [-fio] @samp{clentry}
+ at item retry [-fio] @samp{clparent}
@c @item retry [-afio] [@var{num}]
@kindex retry (mdb command)
-If the optional number is not given,
+If the command is given no arguments,
restarts execution at the call port
of the call corresponding to the current event.
-If the optional number is given,
+If the command is given the number @var{num} as argument,
restarts execution at the call port of the call corresponding to
the @var{num}'th ancestor of the call to which the current event belongs.
For example, if @var{num} is 1, it restarts the parent of the current call.
+If the command is given the argument @samp{clentry},
+restarts execution at the call port of the call
+that first entered into the clique of recursive calls
+of which the current call is a part.
+(If the current call is not (mutually) recursive
+with any other currently active call,
+the restarted call will be the current call.)
+If the command is given the argument @samp{clparent},
+restarts execution at the call port
+of the first call outside the current call's clique.
+This will the parent of the call that @samp{retry clentry} would restart.
@sp 1
-The command will report an error unless
+If invoked as @samp{retry clentry} and @samp{retry clparent},
+this command will report an error
+unless we have stack trace information
+about all of the current call's ancestors.
+ at sp 1
+The command will also report an error unless
the values of all the input arguments of the selected call are available
at the return site at which control would reenter the selected call.
(The compiler will keep the values
@@ -3056,11 +3096,11 @@
@c for @samp{set} for more details.
@sp 1
- at item stack [-d] [-f at var{numframes}] [@var{numlines}]
+ at item stack [-a] [-d] [-c at var{cliquelines}] [-f at var{numframes}] [@var{numlines}]
@kindex stack (mdb command)
Prints the names of the ancestors of the call
specified by the current event.
-If two or more ancestor calls are for the same procedure,
+If two or more consecutive ancestor calls are for the same procedure,
the procedure identification will be printed once
with the appropriate multiplicity annotation.
@sp 1
@@ -3074,6 +3114,17 @@
@sp 1
The optional number @var{numlines}, if present,
specifies that only the topmost @var{numlines} lines should be printed.
+The default value is 100;
+the special value 0 asks for all the lines to be printed.
+ at sp 1
+By default, this command will look for cliques of mutually recursive ancestors.
+It will identify them as such in the output,
+and it will print at most 10 lines from any clique.
+The @samp{-c} option can be used to specify
+the maximum number of lines to print for a clique,
+with the special value 0 asking for all of them to be printed.
+The option @samp{-a} asks for all lines to be printed
+ at emph{without} cliques being detected or marked.
@sp 1
This command will report an error if there is no stack trace
information available about any ancestor.
@@ -3114,11 +3165,30 @@
the call's event number, sequence number and depth should also be printed
if the call is to a procedure that is being execution traced.
@sp 1
- at item level [-d] [@var{num}]
+ at item level [-d]
+ at item level [-d] @var{num}
+ at item level [-d] @samp{clentry}
+ at item level [-d] @samp{clparent}
@kindex level (mdb command)
-Sets the current environment to the stack frame of the @var{num}'th
-level ancestor of the call to which the current event belongs.
-The zero'th ancestor is the call of the event itself.
+If invoked without arguments,
+sets the current environment
+to the stack frame that belongs to the current event.
+If invoked with the number @var{num} as argument,
+sets the current environment
+to the stack frame of the @var{num}'th level ancestor
+of the call to which the current event belongs.
+If invoked with the argument @samp{clentry},
+sets the current environment to the stack frame of the call
+that first entered into the clique of recursive calls
+of which the current call is a part.
+(If the current call is not (mutually) recursive
+with any other currently active call,
+it set the current environment to the stack frame of the current event.)
+If the command is given the argument @samp{clparent},
+sets the current environment to the stack frame of the first call
+outside the current call's clique.
+This will the parent of the stack frame
+that @samp{level clentry} would set the current environment to.
@sp 1
This command will report an error
if the current environment doesn't have the required number of ancestors,
cvs diff: Diffing extras
cvs diff: Diffing extras/base64
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/fixed
cvs diff: Diffing extras/gator
cvs diff: Diffing extras/gator/generations
cvs diff: Diffing extras/gator/generations/1
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_allegro
cvs diff: Diffing extras/graphics/mercury_allegro/examples
cvs diff: Diffing extras/graphics/mercury_allegro/samples
cvs diff: Diffing extras/graphics/mercury_allegro/samples/demo
cvs diff: Diffing extras/graphics/mercury_allegro/samples/mandel
cvs diff: Diffing extras/graphics/mercury_allegro/samples/pendulum2
cvs diff: Diffing extras/graphics/mercury_allegro/samples/speed
cvs diff: Diffing extras/graphics/mercury_cairo
cvs diff: Diffing extras/graphics/mercury_cairo/samples
cvs diff: Diffing extras/graphics/mercury_cairo/samples/data
cvs diff: Diffing extras/graphics/mercury_cairo/tutorial
cvs diff: Diffing extras/graphics/mercury_glfw
cvs diff: Diffing extras/graphics/mercury_glfw/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/log4m
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/monte
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/mopenssl
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/net
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/posix/samples
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/solver_types
cvs diff: Diffing extras/solver_types/library
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/windows_installer_generator
cvs diff: Diffing extras/windows_installer_generator/sample
cvs diff: Diffing extras/windows_installer_generator/sample/images
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing m4
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.154
diff -u -b -r1.154 Mmakefile
--- runtime/Mmakefile 26 Oct 2011 14:08:45 -0000 1.154
+++ runtime/Mmakefile 8 Apr 2012 09:18:31 -0000
@@ -65,6 +65,7 @@
mercury_label.h \
mercury_layout_util.h \
mercury_library_types.h \
+ mercury_malloc.h \
mercury_memory.h \
mercury_memory_handlers.h \
mercury_memory_zones.h \
@@ -180,6 +181,7 @@
mercury_ho_call.c \
mercury_label.c \
mercury_layout_util.c \
+ mercury_malloc.c \
mercury_memory.c \
mercury_memory_handlers.c \
mercury_memory_zones.c \
Index: runtime/mercury_malloc.c
===================================================================
RCS file: runtime/mercury_malloc.c
diff -N runtime/mercury_malloc.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_malloc.c 8 Apr 2012 10:18:31 -0000
@@ -0,0 +1,53 @@
+/*
+** vim:sw=4 ts=4 expandtab
+*/
+/*
+** Copyright (C) 2012 The University of Melbourne.
+** This file may only be copied under the terms of the GNU General
+** Public License - see the file COPYING in the Mercury distribution.
+*/
+
+/*
+** File: mercury_malloc.c
+*/
+
+/* mercury_std.h includes mercury_regs.h, and must precede system headers */
+#include "mercury_conf.h"
+#include "mercury_std.h"
+#include "mercury_malloc.h"
+#include "mercury_misc.h"
+
+#include <stdlib.h>
+#include <stdio.h>
+
+/*---------------------------------------------------------------------------*/
+
+void *
+MR_checked_malloc(size_t size)
+{
+ void *ptr;
+
+ ptr = malloc(size);
+ if (ptr == NULL) {
+ MR_fatal_error("Out of memory\n");
+ /* in case the MR_fatal_error did not exit */
+ exit(EXIT_FAILURE);
+ }
+ return ptr;
+}
+
+void *
+MR_checked_realloc(void *old_ptr, size_t size)
+{
+ void *ptr;
+
+ ptr = realloc(old_ptr, size);
+ if (ptr == NULL) {
+ MR_fatal_error("Out of memory\n");
+ /* in case the MR_fatal_error did not exit */
+ exit(EXIT_FAILURE);
+ }
+ return ptr;
+}
+
+/*---------------------------------------------------------------------------*/
Index: runtime/mercury_malloc.h
===================================================================
RCS file: runtime/mercury_malloc.h
diff -N runtime/mercury_malloc.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_malloc.h 8 Apr 2012 09:00:12 -0000
@@ -0,0 +1,18 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2012 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+#ifndef MERCURY_MALLOC_H
+#define MERCURY_MALLOC_H
+
+#include <stdlib.h>
+
+extern void *MR_checked_malloc(size_t size);
+extern void *MR_checked_realloc(void *old_ptr, size_t size);
+
+#endif /* MERCURY_STACK_TRACE_H */
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.124
diff -u -b -r1.124 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 17 Oct 2011 04:31:32 -0000 1.124
+++ runtime/mercury_stack_layout.h 21 Apr 2012 16:07:20 -0000
@@ -388,7 +388,7 @@
** making that change was posted to the mercury-reviews mailing list on
** 30 Sep 2011, but it was not committed, since it lead to a 4% *increase*
** in the size of asm_fast.gc.debug executables. Even though different goal
-** paths that share a tail (the part of the path near the root) with the
+** paths share a tail (the part of the path near the root) with the
** static reverse_goal_path term representation but not with the string
** representation, the string representation is so much more compact
** (usually taking 4 to 6 bytes for most steps) than the Mercury term
@@ -964,7 +964,13 @@
max_mr_num = MR_max(max_r_num, MR_FIRST_UNREAL_R_SLOT); \
} while (0)
+/*
+** The code in the compiler that creates the flag field is
+** encode_exec_trace_flags in stack_layout.m.
+*/
+
#define MR_PROC_LAYOUT_FLAG_HAS_IO_STATE_PAIR 0x1
+#define MR_PROC_LAYOUT_FLAG_HAS_HIGHER_ORDER_ARG 0x2
#define MR_trace_find_reused_frames(proc_layout, sp, reused_frames) \
do { \
@@ -1143,6 +1149,10 @@
((proc_layout_ptr)->MR_sle_exec_trace->MR_exec_flags \
& MR_PROC_LAYOUT_FLAG_HAS_IO_STATE_PAIR)
+#define MR_proc_has_higher_order_arg(proc_layout_ptr) \
+ ((proc_layout_ptr)->MR_sle_exec_trace->MR_exec_flags \
+ & MR_PROC_LAYOUT_FLAG_HAS_HIGHER_ORDER_ARG)
+
/* Adjust the arity of functions for printing. */
#define MR_sle_user_adjusted_arity(entry) \
((entry)->MR_sle_user.MR_user_arity - \
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.85
diff -u -b -r1.85 mercury_stack_trace.c
--- runtime/mercury_stack_trace.c 30 Oct 2009 03:33:29 -0000 1.85
+++ runtime/mercury_stack_trace.c 21 Apr 2012 17:13:26 -0000
@@ -20,12 +20,16 @@
#include "mercury_array_macros.h"
#include "mercury_trace_base.h"
#include "mercury_tabling.h"
+#include "mercury_malloc.h"
#include <stdio.h>
#if defined(MR_HAVE__SNPRINTF) && ! defined(MR_HAVE_SNPRINTF)
#define snprintf _snprintf
#endif
+static int MR_compare_proc_layout_ptrs(
+ const void *pl1, const void *pl2);
+
static MR_StackWalkStepResult
MR_stack_walk_succip_layout(MR_Code *success,
const MR_LabelLayout **return_label_layout_ptr,
@@ -39,23 +43,30 @@
MR_INTERNAL_FRAME_ON_SIDE_BRANCH,
MR_TOP_FRAME_ON_SIDE_BRANCH,
MR_TERMINAL_TOP_FRAME_ON_SIDE_BRANCH
-} MR_Nondet_Frame_Category;
+} MR_NondetFrameCategory;
typedef struct {
- MR_Traverse_Nondet_Frame_Func *func;
+ MR_TraverseNondetFrameFunc *func;
void *func_data;
-} MR_Traverse_Nondet_Frame_Func_Info;
+} MR_TraverseNondetFrameFuncInfo;
-typedef void MR_Dump_Or_Traverse_Nondet_Frame_Func(void *user_data,
- MR_Nondet_Frame_Category category, MR_Word *top_fr,
+typedef void MR_DumpOrTraverseNondetFrameFunc(void *user_data,
+ MR_NondetFrameCategory category, MR_Word *top_fr,
const MR_LabelLayout *layout, MR_Word *base_sp,
MR_Word *base_curfr, int level_number);
-static MR_Dump_Or_Traverse_Nondet_Frame_Func MR_dump_nondet_stack_frame;
-static MR_Dump_Or_Traverse_Nondet_Frame_Func MR_traverse_nondet_stack_frame;
+/* These are two possible functions of type MR_DumpOrTraverseNondetFrameFunc */
+static void MR_dump_nondet_stack_frame(void *fp,
+ MR_NondetFrameCategory category, MR_Word *top_fr,
+ const MR_LabelLayout *top_layout, MR_Word *base_sp,
+ MR_Word *base_curfr, int level_number);
+static void MR_traverse_nondet_stack_frame(void *fp,
+ MR_NondetFrameCategory category, MR_Word *top_fr,
+ const MR_LabelLayout *top_layout, MR_Word *base_sp,
+ MR_Word *base_curfr, int level_number);
static const char *MR_step_over_nondet_frame(
- MR_Dump_Or_Traverse_Nondet_Frame_Func *func,
+ MR_DumpOrTraverseNondetFrameFunc *func,
void *func_data, int level_number, MR_Word *fr);
static void MR_init_nondet_branch_infos(MR_Word *base_maxfr,
const MR_LabelLayout *top_layout, MR_Word *base_sp,
@@ -68,16 +79,65 @@
#endif /* !MR_HIGHLEVEL_CODE */
-static void MR_dump_stack_record_init(MR_bool include_trace_data,
- MR_bool include_contexts);
+typedef struct {
+ const MR_ProcLayout *pte_proc_layout;
+ int pte_first_level;
+ int pte_last_level;
+ int pte_num_frames;
+ MR_bool pte_some_nonseq_frames;
+ int pte_left; /* negative -> no left subtree */
+ int pte_right; /* negative -> no right subtree */
+} MR_ProcTableEntry;
+
+static int MR_find_proc_in_proc_table(
+ const MR_ProcTableEntry *proc_table,
+ int proc_table_next,
+ const MR_ProcLayout *proc_layout,
+ int *parent_ptr, int *side_ptr);
+static void MR_add_parent_ptr(MR_ProcTableEntry *proc_table,
+ int parent, int side, int slot);
+
+typedef struct MR_Clique_struct MR_Clique;
+
+struct MR_Clique_struct {
+ int cl_first_level;
+ int cl_last_level;
+ MR_Clique *cl_prev_clique;
+ MR_Clique *cl_next_clique;
+};
+
+typedef struct {
+ const MR_ProcLayout *ste_proc_layout;
+ const MR_LabelLayout *ste_label_layout;
+ MR_Word *ste_trace_sp;
+ MR_Word *ste_trace_curfr;
+ MR_Unsigned ste_reused_frames;
+ // int ste_last_frame_in_proc;
+ int ste_proc_table_entry_slot;
+} MR_WalkedStackEntry;
+
+typedef struct {
+ MR_StackFrameDumpInfo sdi_prev_frame_dump_info;
+ int sdi_current_level;
+} MR_StackDumpInfo;
+
+typedef struct {
+ MR_bool sdp_include_trace_data;
+ MR_bool sdp_include_contexts;
+} MR_StackDumpParams;
+
+static void MR_init_stack_dump_info(MR_StackDumpInfo *dump_info);
static int MR_dump_stack_record_frame(FILE *fp,
+ MR_StackDumpParams *params,
+ MR_StackDumpInfo *dump_info,
const MR_LabelLayout *label_layout,
MR_Word *base_sp, MR_Word *base_curfr,
MR_Unsigned reused_frames,
MR_PrintStackRecord print_stack_record,
MR_bool at_line_limit);
static void MR_dump_stack_record_flush(FILE *fp,
- MR_bool include_trace_data,
+ MR_StackDumpParams *params,
+ MR_StackDumpInfo *dump_info,
MR_PrintStackRecord print_stack_record);
static void MR_print_proc_id_internal(FILE *fp,
@@ -155,6 +215,8 @@
MR_PrintStackRecord print_stack_record)
{
MR_StackWalkStepResult result;
+ MR_StackDumpParams params;
+ MR_StackDumpInfo dump_info;
const MR_ProcLayout *proc_layout;
const MR_LabelLayout *cur_label_layout;
const MR_LabelLayout *prev_label_layout;
@@ -163,30 +225,41 @@
MR_Word *stack_trace_curfr;
MR_Word *old_trace_sp;
MR_Word *old_trace_curfr;
- int frames_dumped_so_far;
- int lines_dumped_so_far;
+ MR_FrameLimit frames_dumped_so_far;
+ MR_SpecLineLimit lines_dumped_so_far;
MR_Unsigned reused_frames;
MR_do_init_modules();
- MR_dump_stack_record_init(include_trace_data, include_contexts);
+
+ params.sdp_include_trace_data = include_trace_data;
+ params.sdp_include_contexts = include_contexts;
+ MR_init_stack_dump_info(&dump_info);
stack_trace_sp = det_stack_pointer;
stack_trace_curfr = current_frame;
cur_label_layout = label_layout;
+ if (line_limit == 0) {
+ line_limit = MR_UINT_LEAST32_MAX;
+ }
+
+ if (frame_limit == 0) {
+ frame_limit = MR_UINT_LEAST32_MAX;
+ }
+
frames_dumped_so_far = 0;
lines_dumped_so_far = 0;
do {
if (frame_limit > 0 && frames_dumped_so_far >= frame_limit) {
- MR_dump_stack_record_flush(fp, include_trace_data,
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
print_stack_record);
fprintf(fp, "<more stack frames snipped>\n");
return NULL;
}
- if (line_limit > 0 && lines_dumped_so_far >= line_limit) {
- MR_dump_stack_record_flush(fp, include_trace_data,
+ if (lines_dumped_so_far >= line_limit) {
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
print_stack_record);
fprintf(fp, "<more stack frames snipped>\n");
return NULL;
@@ -201,28 +274,636 @@
result = MR_stack_walk_step(proc_layout, &cur_label_layout,
&stack_trace_sp, &stack_trace_curfr, &reused_frames, &problem);
if (result == MR_STEP_ERROR_BEFORE) {
- MR_dump_stack_record_flush(fp, include_trace_data,
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
print_stack_record);
return problem;
} else if (result == MR_STEP_ERROR_AFTER) {
- (void) MR_dump_stack_record_frame(fp, prev_label_layout,
- old_trace_sp, old_trace_curfr, reused_frames,
- print_stack_record, MR_FALSE);
+ (void) MR_dump_stack_record_frame(fp, ¶ms, &dump_info,
+ prev_label_layout, old_trace_sp, old_trace_curfr,
+ reused_frames, print_stack_record, MR_FALSE);
- MR_dump_stack_record_flush(fp, include_trace_data,
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
print_stack_record);
return problem;
} else {
lines_dumped_so_far += MR_dump_stack_record_frame(fp,
- prev_label_layout, old_trace_sp, old_trace_curfr,
+ ¶ms, &dump_info, prev_label_layout,
+ old_trace_sp, old_trace_curfr,
reused_frames, print_stack_record,
- lines_dumped_so_far == line_limit);
+ lines_dumped_so_far >= line_limit);
}
frames_dumped_so_far++;
} while (cur_label_layout != NULL);
- MR_dump_stack_record_flush(fp, include_trace_data, print_stack_record);
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info, print_stack_record);
+ return NULL;
+}
+
+const char *
+MR_dump_stack_from_layout_clique(FILE *fp, const MR_LabelLayout *label_layout,
+ MR_Word *det_stack_pointer, MR_Word *current_frame,
+ MR_bool include_trace_data, MR_bool include_contexts,
+ MR_bool detect_cliques, MR_SpecLineLimit clique_line_limit,
+ MR_FrameLimit frame_limit, MR_SpecLineLimit line_limit,
+ MR_PrintStackRecord print_stack_record)
+{
+ MR_StackWalkStepResult result;
+ MR_StackDumpParams params;
+ MR_StackDumpInfo dump_info;
+ const MR_ProcLayout *proc_layout;
+ const MR_LabelLayout *cur_label_layout;
+ const MR_LabelLayout *prev_label_layout;
+ const char *problem;
+ MR_bool stopped;
+ MR_Word *stack_trace_sp;
+ MR_Word *stack_trace_curfr;
+ MR_Word *old_trace_sp;
+ MR_Word *old_trace_curfr;
+ MR_WalkedStackEntry *walked_stack;
+ MR_FrameLimit walked_stack_size;
+ MR_FrameLimit walked_stack_next;
+ MR_ProcTableEntry *proc_table;
+ int proc_table_next;
+ MR_Unsigned reused_frames;
+ MR_FrameLimit level;
+ MR_SpecLineLimit lines_dumped_so_far;
+ MR_Clique *cliques_first;
+ MR_Clique *cliques_last;
+ MR_Clique *cl;
+ MR_FrameLimit rec_first_level;
+ MR_FrameLimit rec_last_level;
+
+ if (clique_line_limit == 0) {
+ clique_line_limit = MR_UINT_LEAST32_MAX;
+ }
+
+ if (line_limit == 0) {
+ line_limit = MR_UINT_LEAST32_MAX;
+ }
+
+ if (frame_limit == 0) {
+ frame_limit = MR_UINT_LEAST32_MAX;
+ }
+
+ MR_do_init_modules();
+
+ stack_trace_sp = det_stack_pointer;
+ stack_trace_curfr = current_frame;
+
+ cur_label_layout = label_layout;
+
+ walked_stack_next = 0;
+ walked_stack_size = 100;
+ walked_stack = MR_checked_malloc(walked_stack_size
+ * sizeof(MR_WalkedStackEntry));
+
+ stopped = MR_FALSE;
+ problem = NULL;
+ do {
+ if (frame_limit > 0 && walked_stack_next >= frame_limit) {
+ stopped = MR_TRUE;
+ break;
+ }
+
+ proc_layout = cur_label_layout->MR_sll_entry;
+ prev_label_layout = cur_label_layout;
+
+ old_trace_sp = stack_trace_sp;
+ old_trace_curfr = stack_trace_curfr;
+
+ result = MR_stack_walk_step(proc_layout, &cur_label_layout,
+ &stack_trace_sp, &stack_trace_curfr, &reused_frames, &problem);
+
+ if (result == MR_STEP_ERROR_BEFORE) {
+ break;
+ }
+
+ if (walked_stack_next >= walked_stack_size) {
+ walked_stack_size = 2 * walked_stack_size;
+ walked_stack = MR_checked_realloc(walked_stack,
+ walked_stack_size * sizeof(MR_WalkedStackEntry));
+ }
+
+ walked_stack[walked_stack_next].ste_proc_layout = proc_layout;
+ walked_stack[walked_stack_next].ste_label_layout =
+ prev_label_layout;
+ walked_stack[walked_stack_next].ste_trace_sp = old_trace_sp;
+ walked_stack[walked_stack_next].ste_trace_curfr = old_trace_curfr;
+ walked_stack[walked_stack_next].ste_reused_frames = reused_frames;
+ walked_stack[walked_stack_next].ste_proc_table_entry_slot = -1;
+ walked_stack_next++;
+
+ if (result == MR_STEP_ERROR_AFTER) {
+ break;
+ }
+ } while (cur_label_layout != NULL);
+
+ params.sdp_include_trace_data = include_trace_data;
+ params.sdp_include_contexts = include_contexts;
+ MR_init_stack_dump_info(&dump_info);
+
+ if (!detect_cliques) {
+ for (level = 0; level < walked_stack_next; level++) {
+ if (lines_dumped_so_far >= line_limit) {
+ fprintf(fp, "<more stack frames snipped>\n");
+ problem = NULL;
+ goto done;
+ }
+
+ lines_dumped_so_far += MR_dump_stack_record_frame(fp,
+ ¶ms, &dump_info, walked_stack[level].ste_label_layout,
+ walked_stack[level].ste_trace_sp,
+ walked_stack[level].ste_trace_curfr,
+ walked_stack[level].ste_reused_frames, print_stack_record,
+ lines_dumped_so_far >= line_limit);
+ }
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+
+ free(walked_stack);
+ return problem;
+ }
+
+ proc_table = MR_checked_malloc(walked_stack_next *
+ sizeof(MR_ProcTableEntry));
+ proc_table_next = 0;
+ cliques_first = NULL;
+ cliques_last = NULL;
+
+ level = 0;
+ rec_first_level = level;
+ proc_layout = walked_stack[rec_first_level].ste_proc_layout;
+ while (level+1 < walked_stack_next &&
+ walked_stack[level+1].ste_proc_layout == proc_layout)
+ {
+ level++;
+ }
+ rec_last_level = level;
+ level++;
+
+ proc_table[0].pte_proc_layout = proc_layout;
+ proc_table[0].pte_first_level = rec_first_level;
+ proc_table[0].pte_last_level = rec_last_level;
+ proc_table[0].pte_num_frames = rec_last_level + 1 - rec_first_level;
+ proc_table[0].pte_some_nonseq_frames = MR_FALSE;
+ proc_table[0].pte_left = -1;
+ proc_table[0].pte_right = -1;
+ proc_table_next = 1;
+
+ while (level < walked_stack_next) {
+ MR_bool has_higher_order_arg;
+ int slot;
+ int parent;
+ int side;
+
+ rec_first_level = level;
+ proc_layout = walked_stack[rec_first_level].ste_proc_layout;
+ while (level+1 < walked_stack_next &&
+ walked_stack[level+1].ste_proc_layout == proc_layout)
+ {
+ level++;
+ }
+ rec_last_level = level;
+ level++;
+
+ /*
+ ** XXX for higher order predicates like list.map, we should
+ ** pretend that we have not seen them before.
+ */
+
+ slot = MR_find_proc_in_proc_table(proc_table, proc_table_next,
+ proc_layout, &parent, &side);
+
+ has_higher_order_arg = MR_proc_has_higher_order_arg(proc_layout);
+
+ if (slot < 0 || has_higher_order_arg) {
+ /*
+ ** Either we have not seen this procedure before, or we are
+ ** pretending that we have not seen it before.
+ **
+ ** The reason for such pretense is that we don't want calls
+ ** to e.g. list.map in different places in the program
+ ** to collapse every call between those places into a single
+ ** clique.
+ */
+ slot = proc_table_next;
+ proc_table[slot].pte_proc_layout =
+ walked_stack[rec_first_level].ste_proc_layout;
+ proc_table[slot].pte_first_level = rec_first_level;
+ proc_table[slot].pte_last_level = rec_last_level;
+ proc_table[slot].pte_num_frames =
+ rec_last_level + 1 - rec_first_level;
+ proc_table[slot].pte_some_nonseq_frames = MR_FALSE;
+ proc_table[slot].pte_left = -1;
+ proc_table[slot].pte_right = -1;
+ proc_table_next++;
+ MR_add_parent_ptr(proc_table, parent, side, slot);
+
+ walked_stack[rec_first_level].ste_proc_table_entry_slot = slot;
+ } else {
+ /* We have seen this procedure before. */
+ proc_table[slot].pte_last_level = rec_last_level;
+ proc_table[slot].pte_num_frames +=
+ rec_last_level + 1 - rec_first_level;
+ proc_table[slot].pte_some_nonseq_frames = MR_TRUE;
+
+ if (cliques_last == NULL) {
+ /* Add the first clique to the list. */
+
+ cl = MR_checked_malloc(sizeof(MR_Clique));
+ cl->cl_first_level = proc_table[slot].pte_first_level;
+ cl->cl_last_level = rec_last_level;
+ cl->cl_prev_clique = NULL;
+ cl->cl_next_clique = NULL;
+ cliques_first = cl;
+ cliques_last = cl;
+ } else if (cliques_last->cl_last_level
+ < proc_table[slot].pte_first_level)
+ {
+ /*
+ ** The current clique does not overlap with the last clique,
+ ** so add a new clique to the list.
+ */
+
+ cl = MR_checked_malloc(sizeof(MR_Clique));
+ cl->cl_first_level = proc_table[slot].pte_first_level;
+ cl->cl_last_level = rec_last_level;
+ cl->cl_prev_clique = cliques_last;
+ cl->cl_next_clique = NULL;
+ cliques_last->cl_next_clique = cl;
+ cliques_last = cl;
+ } else {
+ /*
+ ** The current clique does overlap with the last old clique,
+ ** and maybe others. Replace all the cliques in the list it
+ ** overlaps with with just one clique. Put this clique
+ ** in the storage of the clique node that was nearest
+ ** to cliques_first.
+ */
+
+ cl = cliques_last;
+ /* assert cl != NULL */
+ while (cl->cl_prev_clique != NULL &&
+ cl->cl_prev_clique->cl_last_level >
+ proc_table[slot].pte_first_level)
+ {
+ MR_Clique *old_cl;
+
+ old_cl = cl;
+ cl = cl->cl_prev_clique;
+ MR_free(old_cl);
+ }
+
+ cl->cl_first_level = MR_min(cl->cl_first_level,
+ proc_table[slot].pte_first_level);
+ cl->cl_last_level = rec_last_level;
+ cliques_last = cl;
+ }
+ }
+ }
+
+#ifdef MR_DEBUG_STACK_DUMP_CLIQUE
+ for (cl = cliques_first; cl != NULL; cl = cl->cl_next_clique) {
+ fprintf(fp, "clique: %d to %d\n",
+ cl->cl_first_level, cl->cl_last_level);
+ }
+#endif
+
+ lines_dumped_so_far = 0;
+ level = 0;
+ for (cl = cliques_first; cl != NULL; cl = cl->cl_next_clique) {
+ MR_SpecLineLimit lines_dumped_before_clique;
+
+ for (; level < cl->cl_first_level; level++) {
+ if (lines_dumped_so_far >= line_limit) {
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+ fprintf(fp, "<more stack frames snipped>\n");
+ problem = NULL;
+ goto done;
+ }
+
+ lines_dumped_so_far += MR_dump_stack_record_frame(fp,
+ ¶ms, &dump_info, walked_stack[level].ste_label_layout,
+ walked_stack[level].ste_trace_sp,
+ walked_stack[level].ste_trace_curfr,
+ walked_stack[level].ste_reused_frames, print_stack_record,
+ lines_dumped_so_far >= line_limit);
+ }
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+
+ fprintf(fp, "<mutually recursive set of stack frames start>\n");
+ lines_dumped_before_clique = lines_dumped_so_far;
+ for (; level <= cl->cl_last_level; level++) {
+ if (lines_dumped_so_far >= line_limit) {
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+ fprintf(fp, "<more stack frames snipped>\n");
+ problem = NULL;
+ goto done;
+ }
+
+ if (lines_dumped_so_far - lines_dumped_before_clique
+ >= clique_line_limit)
+ {
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+ fprintf(fp, "<more stack frames in clique snipped>\n");
+ level = cl->cl_last_level + 1;
+ dump_info.sdi_current_level = level;
+ break;
+ }
+
+ lines_dumped_so_far += MR_dump_stack_record_frame(fp,
+ ¶ms, &dump_info, walked_stack[level].ste_label_layout,
+ walked_stack[level].ste_trace_sp,
+ walked_stack[level].ste_trace_curfr,
+ walked_stack[level].ste_reused_frames, print_stack_record,
+ lines_dumped_so_far >= line_limit);
+ }
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+ fprintf(fp, "<mutually recursive set of stack frames end>\n");
+ }
+
+ for (; level < walked_stack_next; level++) {
+ if (lines_dumped_so_far >= line_limit) {
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+ fprintf(fp, "<more stack frames snipped>\n");
+ problem = NULL;
+ goto done;
+ }
+
+ lines_dumped_so_far += MR_dump_stack_record_frame(fp,
+ ¶ms, &dump_info, walked_stack[level].ste_label_layout,
+ walked_stack[level].ste_trace_sp,
+ walked_stack[level].ste_trace_curfr,
+ walked_stack[level].ste_reused_frames, print_stack_record,
+ lines_dumped_so_far >= line_limit);
+ }
+ MR_dump_stack_record_flush(fp, ¶ms, &dump_info,
+ print_stack_record);
+
+ if (stopped) {
+ fprintf(fp, "<more stack frames snipped>\n");
+ }
+
+done:
+ free(walked_stack);
+ free(proc_table);
+ cl = cliques_last;
+ while (cl != NULL) {
+ MR_Clique *old_cl;
+
+ old_cl = cl;
+ cl = cl->cl_prev_clique;
+ MR_free(old_cl);
+ }
+
+ return problem;
+}
+
+static int
+MR_find_proc_in_proc_table(const MR_ProcTableEntry *proc_table,
+ int proc_table_next, const MR_ProcLayout *proc_layout,
+ int *parent_ptr, int *side_ptr)
+{
+ int cur;
+ int parent;
+ int side;
+
+ /* XXX we don't need proc_table_next for anything else */
+ if (proc_table_next == 0) {
+ MR_fatal_error("MR_find_proc_in_proc_table: table is empty");
+ }
+
+ cur = 0;
+ do {
+ if (proc_layout == proc_table[cur].pte_proc_layout) {
+ return cur;
+ } else if (proc_layout < proc_table[cur].pte_proc_layout) {
+ parent = cur;
+ side = 0;
+ cur = proc_table[cur].pte_left;
+ } else {
+ parent = cur;
+ side = 1;
+ cur = proc_table[cur].pte_right;
+ }
+ } while (cur >= 0);
+
+ *parent_ptr = parent;
+ *side_ptr = side;
+ return -1;
+}
+
+static void
+MR_add_parent_ptr(MR_ProcTableEntry *proc_table, int parent, int side,
+ int slot)
+{
+ if (side == 0) {
+ proc_table[parent].pte_left = slot;
+ } else {
+ proc_table[parent].pte_right = slot;
+ }
+}
+
+static int
+MR_compare_proc_layout_ptrs(const void *v1, const void *v2)
+{
+ const MR_ProcLayout *pl1 = * (const MR_ProcLayout **) v1;
+ const MR_ProcLayout *pl2 = * (const MR_ProcLayout **) v2;
+
+ if ((MR_Unsigned) pl1 > (MR_Unsigned) pl2) {
+ return 1;
+ } else if ((MR_Unsigned) pl1 < (MR_Unsigned) pl2) {
+ return -1;
+ } else {
+ return 0;
+ }
+}
+
+const char *
+MR_find_clique_entry(const MR_LabelLayout *label_layout,
+ MR_Word *det_stack_pointer, MR_Word *current_frame,
+ int *clique_entry_level, int *first_outside_ancestor_level)
+{
+ MR_StackWalkStepResult result;
+ const MR_LabelLayout *cur_label_layout;
+ const MR_ProcLayout *cur_proc_layout;
+ const char *problem;
+ MR_Word *stack_trace_sp;
+ MR_Word *stack_trace_curfr;
+ MR_Word *old_trace_sp;
+ MR_Word *old_trace_curfr;
+ MR_Unsigned reused_frames;
+
+ const MR_ProcLayout **procs_table;
+ int procs_table_size; /* allocated */
+ int procs_table_next; /* next free slot */
+ int num_procs_in_clique; /* filled in */
+
+ int highest_level_in_clique;
+ int ancestor_level;
+ MR_bool in_clique;
+ int last_filled;
+ int i;
+
+ MR_do_init_modules();
+
+ stack_trace_sp = det_stack_pointer;
+ stack_trace_curfr = current_frame;
+
+ cur_label_layout = label_layout;
+ cur_proc_layout = cur_label_layout->MR_sll_entry;
+
+ /*
+ ** procs_table is an array containing proc_table_size slots.
+ ** Of these, the slots at index 0 .. num_procs_in_clique-1 contain
+ ** pointers to the proc layouts of the procedures currently known
+ ** to be in the same clique as the original top level label_layout.
+ ** The slots from num_procs_in_clique to procs_table_next contain
+ ** pointers to the proc_layouts of the other procedures we have
+ ** encountered so far during our walk of the stack.
+ **
+ ** The slots at 0 .. num_procs_in_clique-1 are sorted, and have no
+ ** duplicates. The slots at num_procs_in_clique .. procs_table_next
+ ** are not sorted, and may have duplicates.
+ */
+
+ procs_table_size = 256;
+ procs_table = MR_checked_malloc(procs_table_size *
+ sizeof(const MR_ProcLayout *));
+ procs_table[0] = cur_proc_layout;
+ num_procs_in_clique = 1;
+ procs_table_next = 1;
+
+#ifdef MR_DEBUG_FIND_CLIQUE_ENTRY
+ printf("INIT %x\n", cur_proc_layout);
+#endif
+
+ ancestor_level = 0;
+ highest_level_in_clique = 0;
+ do {
+
+ old_trace_sp = stack_trace_sp;
+ old_trace_curfr = stack_trace_curfr;
+
+ result = MR_stack_walk_step(cur_proc_layout, &cur_label_layout,
+ &stack_trace_sp, &stack_trace_curfr, &reused_frames, &problem);
+ if (result == MR_STEP_ERROR_BEFORE) {
+ free(procs_table);
+ return problem;
+ } else if (result == MR_STEP_ERROR_AFTER) {
+ free(procs_table);
+ return problem;
+ }
+
+ if (cur_label_layout == NULL) {
+ break;
+ }
+
+ cur_proc_layout = cur_label_layout->MR_sll_entry;
+
+ ancestor_level++;
+ /*
+ ** Since the part of the procs_table up to num_procs_in_clique
+ ** is guaranteed to be sorted, we have the option of using either
+ ** linear search or binary search. We use linear search because
+ ** we expect the number of procedures in cliques to be small, and
+ ** linear search is likely to be faster for searching small arrays.
+ */
+ in_clique = MR_FALSE;
+ for (i = 0; i < num_procs_in_clique; i++) {
+ if (cur_proc_layout == procs_table[i]) {
+ in_clique = MR_TRUE;
+ break;
+ }
+ }
+
+ if (!in_clique) {
+#ifdef MR_DEBUG_FIND_CLIQUE_ENTRY
+ printf("NONREC %d %d %x\n",
+ num_procs_in_clique, procs_table_next, cur_proc_layout);
+#endif
+
+ if (procs_table_next >= procs_table_size) {
+ procs_table_size = 2 * procs_table_size;
+ procs_table = MR_checked_realloc(procs_table,
+ procs_table_size * sizeof(const MR_ProcLayout *));
+ }
+
+ procs_table[procs_table_next] = cur_proc_layout;
+ procs_table_next++;
+
+ } else {
+#ifdef MR_DEBUG_FIND_CLIQUE_ENTRY
+ printf("REC %d %d %d %d %x\n",
+ ancestor_level, highest_level_in_clique,
+ num_procs_in_clique, procs_table_next, cur_proc_layout);
+#endif
+
+ if (ancestor_level > highest_level_in_clique+1) {
+ /*
+ ** There are some slots in the part of procs_table
+ ** that contains unsorted, possibly duplicate entries,
+ ** so first sort the whole table ...
+ */
+
+ qsort(procs_table, procs_table_next,
+ sizeof(const MR_ProcLayout *),
+ MR_compare_proc_layout_ptrs);
+
+#ifdef MR_DEBUG_FIND_CLIQUE_ENTRY
+ printf("\n");
+ for (i = 0; i < procs_table_next; i++) {
+ printf("SORTED %d %x\n", i, procs_table[i]);
+ }
+#endif
+ /*
+ ** ... and then eliminate any duplicates, which are now
+ ** guaranteed to be consecutive.
+ */
+ last_filled = 0;
+ for (i = 1; i < procs_table_next; i++) {
+ if (procs_table[i] != procs_table[last_filled]) {
+ last_filled++;
+ procs_table[last_filled] = procs_table[i];
+ }
+ }
+
+ procs_table_next = last_filled + 1;
+ num_procs_in_clique = procs_table_next;
+
+#ifdef MR_DEBUG_FIND_CLIQUE_ENTRY
+ printf("\n");
+ for (i = 0; i < procs_table_next; i++) {
+ printf("UNIQ %d %x\n", i, procs_table[i]);
+ }
+ printf("\n");
+#endif
+ }
+
+ highest_level_in_clique = ancestor_level;
+ }
+ } while (MR_TRUE);
+
+ if (clique_entry_level != NULL) {
+ *clique_entry_level = highest_level_in_clique;
+ }
+
+ if (first_outside_ancestor_level != NULL) {
+ if (ancestor_level > highest_level_in_clique) {
+ *first_outside_ancestor_level = highest_level_in_clique + 1;
+ } else {
+ *first_outside_ancestor_level = -1;
+ }
+ }
+
+ free(procs_table);
return NULL;
}
@@ -449,9 +1130,9 @@
MR_Word *branch_curfr;
const MR_LabelLayout *branch_layout;
MR_Word *branch_topfr;
-} MR_Nondet_Branch_Info;
+} MR_NondetBranchInfo;
-static MR_Nondet_Branch_Info *MR_nondet_branch_infos = NULL;
+static MR_NondetBranchInfo *MR_nondet_branch_infos = NULL;
static int MR_nondet_branch_info_next = 0;
static int MR_nondet_branch_info_max = 0;
@@ -459,8 +1140,9 @@
void
MR_dump_nondet_stack_from_layout(FILE *fp, MR_Word *limit_addr,
- MR_FrameLimit frame_limit, MR_SpecLineLimit line_limit, MR_Word *base_maxfr,
- const MR_LabelLayout *top_layout, MR_Word *base_sp, MR_Word *base_curfr)
+ MR_FrameLimit frame_limit, MR_SpecLineLimit line_limit,
+ MR_Word *base_maxfr, const MR_LabelLayout *top_layout,
+ MR_Word *base_sp, MR_Word *base_curfr)
{
int frame_size;
int level_number;
@@ -611,7 +1293,7 @@
}
static void
-MR_dump_nondet_stack_frame(void *fp, MR_Nondet_Frame_Category category,
+MR_dump_nondet_stack_frame(void *fp, MR_NondetFrameCategory category,
MR_Word *top_fr, const MR_LabelLayout *top_layout, MR_Word *base_sp,
MR_Word *base_curfr, int level_number)
{
@@ -639,7 +1321,7 @@
fprintf(dump_fp, "\n");
break;
default:
- MR_fatal_error("invalid MR_Nondet_Frame_Category");
+ MR_fatal_error("invalid MR_NondetFrameCategory");
}
if (category != MR_TERMINAL_TOP_FRAME_ON_SIDE_BRANCH) {
@@ -661,7 +1343,7 @@
void
MR_traverse_nondet_stack_from_layout(MR_Word *base_maxfr,
const MR_LabelLayout *top_layout, MR_Word *base_sp, MR_Word *base_curfr,
- MR_Traverse_Nondet_Frame_Func *func, void *func_data)
+ MR_TraverseNondetFrameFunc *func, void *func_data)
{
int frame_size;
int level_number;
@@ -693,7 +1375,7 @@
} else {
level_number++;
if (base_maxfr > MR_nondet_stack_trace_bottom) {
- MR_Traverse_Nondet_Frame_Func_Info func_info;
+ MR_TraverseNondetFrameFuncInfo func_info;
func_info.func = func;
func_info.func_data = func_data;
problem = MR_step_over_nondet_frame(
@@ -711,13 +1393,13 @@
}
static void
-MR_traverse_nondet_stack_frame(void *info, MR_Nondet_Frame_Category category,
+MR_traverse_nondet_stack_frame(void *info, MR_NondetFrameCategory category,
MR_Word *top_fr, const MR_LabelLayout *top_layout, MR_Word *base_sp,
MR_Word *base_curfr, int level_number)
{
- MR_Traverse_Nondet_Frame_Func_Info *func_info;
+ MR_TraverseNondetFrameFuncInfo *func_info;
- func_info = (MR_Traverse_Nondet_Frame_Func_Info *) info;
+ func_info = (MR_TraverseNondetFrameFuncInfo *) info;
if (category != MR_TERMINAL_TOP_FRAME_ON_SIDE_BRANCH) {
func_info->func(func_info->func_data, top_layout, base_sp, base_curfr);
}
@@ -759,7 +1441,7 @@
assert(current_frame == base_curfr);
if (label_layout != NULL) {
- MR_ensure_room_for_next(MR_nondet_branch_info, MR_Nondet_Branch_Info,
+ MR_ensure_room_for_next(MR_nondet_branch_info, MR_NondetBranchInfo,
MR_INIT_NONDET_BRANCH_ARRAY_SIZE);
MR_nondet_branch_infos[0].branch_sp = stack_pointer;
MR_nondet_branch_infos[0].branch_curfr = current_frame;
@@ -770,7 +1452,7 @@
}
static const char *
-MR_step_over_nondet_frame(MR_Dump_Or_Traverse_Nondet_Frame_Func *func,
+MR_step_over_nondet_frame(MR_DumpOrTraverseNondetFrameFunc *func,
void *func_data, int level_number, MR_Word *fr)
{
MR_StackWalkStepResult result;
@@ -786,7 +1468,7 @@
MR_Code *redoip;
MR_Code *success;
const char *problem;
- MR_Nondet_Frame_Category category;
+ MR_NondetFrameCategory category;
MR_Unsigned reused_frames;
if (MR_find_matching_branch(fr, &branch)) {
@@ -914,7 +1596,7 @@
}
if (! MR_find_matching_branch(base_curfr, &branch)) {
- MR_ensure_room_for_next(MR_nondet_branch_info, MR_Nondet_Branch_Info,
+ MR_ensure_room_for_next(MR_nondet_branch_info, MR_NondetBranchInfo,
MR_INIT_NONDET_BRANCH_ARRAY_SIZE);
last = MR_nondet_branch_info_next;
MR_nondet_branch_infos[last].branch_layout = label_layout;
@@ -1056,23 +1738,16 @@
/**************************************************************************/
-static MR_StackDumpInfo prev_dump_info;
-
-static int current_level;
-static MR_bool trace_data_enabled;
-static MR_bool contexts_enabled;
-
static void
-MR_dump_stack_record_init(MR_bool include_trace_data, MR_bool include_contexts)
+MR_init_stack_dump_info(MR_StackDumpInfo *dump_info)
{
- prev_dump_info.MR_sdi_proc_layout = NULL;
- current_level = 0;
- trace_data_enabled = include_trace_data;
- contexts_enabled = include_contexts;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_proc_layout = NULL;
+ dump_info->sdi_current_level = 0;
}
static int
-MR_dump_stack_record_frame(FILE *fp, const MR_LabelLayout *label_layout,
+MR_dump_stack_record_frame(FILE *fp, MR_StackDumpParams *params,
+ MR_StackDumpInfo *dump_info, const MR_LabelLayout *label_layout,
MR_Word *base_sp, MR_Word *base_curfr, MR_Unsigned reused_frames,
MR_PrintStackRecord print_stack_record, MR_bool at_line_limit)
{
@@ -1084,7 +1759,7 @@
proc_layout = label_layout->MR_sll_entry;
if (! MR_find_context(label_layout, &filename, &linenumber)
- || ! contexts_enabled)
+ || ! params->sdp_include_contexts)
{
filename = "";
linenumber = 0;
@@ -1099,62 +1774,72 @@
** Note that it is not possible for two calls to the same procedure
** to differ on whether the procedure has trace layout data or not.
*/
- must_flush = (proc_layout != prev_dump_info.MR_sdi_proc_layout)
- || trace_data_enabled;
+ must_flush =
+ (proc_layout != dump_info->sdi_prev_frame_dump_info.MR_sdi_proc_layout)
+ || params->sdp_include_trace_data;
if (must_flush) {
if (! at_line_limit) {
- MR_dump_stack_record_flush(fp, trace_data_enabled,
+ MR_dump_stack_record_flush(fp, params, dump_info,
print_stack_record);
}
- prev_dump_info.MR_sdi_proc_layout = proc_layout;
- prev_dump_info.MR_sdi_num_frames = 1;
- prev_dump_info.MR_sdi_min_level = current_level;
- prev_dump_info.MR_sdi_max_level = current_level + reused_frames;
- prev_dump_info.MR_sdi_filename = filename;
- prev_dump_info.MR_sdi_linenumber = linenumber;
- prev_dump_info.MR_sdi_context_mismatch = MR_FALSE;
-
- prev_dump_info.MR_sdi_base_sp = base_sp;
- prev_dump_info.MR_sdi_base_curfr = base_curfr;
- prev_dump_info.MR_sdi_goal_path = MR_label_goal_path(label_layout);
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_proc_layout = proc_layout;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_num_frames = 1;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_min_level =
+ dump_info->sdi_current_level;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_max_level =
+ dump_info->sdi_current_level + reused_frames;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_filename = filename;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_linenumber = linenumber;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_context_mismatch = MR_FALSE;
+
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_base_sp = base_sp;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_base_curfr = base_curfr;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_goal_path =
+ MR_label_goal_path(label_layout);
lines_printed = 1;
} else {
- prev_dump_info.MR_sdi_num_frames++;
- prev_dump_info.MR_sdi_max_level = current_level + reused_frames;
- if (prev_dump_info.MR_sdi_filename != filename
- || prev_dump_info.MR_sdi_linenumber != linenumber)
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_num_frames++;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_max_level =
+ dump_info->sdi_current_level + reused_frames;
+ if (dump_info->sdi_prev_frame_dump_info.MR_sdi_filename != filename
+ || dump_info->sdi_prev_frame_dump_info.MR_sdi_linenumber
+ != linenumber)
{
- prev_dump_info.MR_sdi_context_mismatch = MR_TRUE;
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_context_mismatch =
+ MR_TRUE;
}
lines_printed = 0;
}
- current_level += 1 + reused_frames;
+ dump_info->sdi_current_level += 1 + reused_frames;
return lines_printed;
}
static void
-MR_dump_stack_record_flush(FILE *fp, MR_bool include_trace_data,
- MR_PrintStackRecord print_stack_record)
+MR_dump_stack_record_flush(FILE *fp, MR_StackDumpParams *params,
+ MR_StackDumpInfo *dump_info, MR_PrintStackRecord print_stack_record)
{
- if (prev_dump_info.MR_sdi_proc_layout != NULL) {
- print_stack_record(fp, include_trace_data, prev_dump_info);
+ if (dump_info->sdi_prev_frame_dump_info.MR_sdi_proc_layout != NULL) {
+ (*print_stack_record)(fp, params->sdp_include_trace_data,
+ &(dump_info->sdi_prev_frame_dump_info));
}
+ dump_info->sdi_prev_frame_dump_info.MR_sdi_proc_layout = NULL;
}
void
MR_dump_stack_record_print(FILE *fp, MR_bool include_trace_data,
- const MR_StackDumpInfo dump_info)
+ const MR_StackFrameDumpInfo *frame_dump_info)
{
MR_Level num_levels;
- num_levels = dump_info.MR_sdi_max_level + 1 - dump_info.MR_sdi_min_level;
+ num_levels = frame_dump_info->MR_sdi_max_level + 1
+ - frame_dump_info->MR_sdi_min_level;
fprintf(fp, "%4" MR_INTEGER_LENGTH_MODIFIER "d ",
- dump_info.MR_sdi_min_level);
+ frame_dump_info->MR_sdi_min_level);
/*
** If we are printing trace data, we need all the horizontal room
@@ -1163,7 +1848,7 @@
*/
if (! include_trace_data) {
if (num_levels > 1) {
- if (num_levels != dump_info.MR_sdi_num_frames) {
+ if (num_levels != frame_dump_info->MR_sdi_num_frames) {
fprintf(fp, " %3" MR_INTEGER_LENGTH_MODIFIER "ux ",
num_levels);
} else {
@@ -1175,21 +1860,22 @@
}
}
- MR_maybe_print_call_trace_info(fp, trace_data_enabled,
- dump_info.MR_sdi_proc_layout,
- dump_info.MR_sdi_base_sp, dump_info.MR_sdi_base_curfr);
- MR_print_proc_id(fp, dump_info.MR_sdi_proc_layout);
- if (MR_strdiff(dump_info.MR_sdi_filename, "")
- && dump_info.MR_sdi_linenumber > 0)
+ MR_maybe_print_call_trace_info(fp, include_trace_data,
+ frame_dump_info->MR_sdi_proc_layout,
+ frame_dump_info->MR_sdi_base_sp, frame_dump_info->MR_sdi_base_curfr);
+ MR_print_proc_id(fp, frame_dump_info->MR_sdi_proc_layout);
+ if (MR_strdiff(frame_dump_info->MR_sdi_filename, "")
+ && frame_dump_info->MR_sdi_linenumber > 0)
{
fprintf(fp, " (%s:%d%s)",
- dump_info.MR_sdi_filename, dump_info.MR_sdi_linenumber,
- dump_info.MR_sdi_context_mismatch ? " and others" : "");
+ frame_dump_info->MR_sdi_filename,
+ frame_dump_info->MR_sdi_linenumber,
+ frame_dump_info->MR_sdi_context_mismatch ? " and others" : "");
}
- if (trace_data_enabled) {
- if (MR_strdiff(dump_info.MR_sdi_goal_path, "")) {
- fprintf(fp, " %s", dump_info.MR_sdi_goal_path);
+ if (include_trace_data) {
+ if (MR_strdiff(frame_dump_info->MR_sdi_goal_path, "")) {
+ fprintf(fp, " %s", frame_dump_info->MR_sdi_goal_path);
} else {
fprintf(fp, " (empty)");
}
Index: runtime/mercury_stack_trace.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_trace.h,v
retrieving revision 1.43
diff -u -b -r1.43 mercury_stack_trace.h
--- runtime/mercury_stack_trace.h 16 Jul 2011 07:51:30 -0000 1.43
+++ runtime/mercury_stack_trace.h 21 Apr 2012 03:25:55 -0000
@@ -30,23 +30,22 @@
** MR_dump_stack
**
** Given the succip, det stack pointer and current frame, generate a
-** stack dump showing the name of each active procedure on the
-** stack. If include_trace_data data is set, also print the
-** call event number, call sequence number and depth for every
-** traced procedure.
-** NOTE: MR_dump_stack will assume that the succip is for the
-** topmost stack frame. If you call MR_dump_stack from some
-** pragma c_code, that may not be the case.
+** stack dump showing the name of each active procedure on the stack.
+** If include_trace_data data is set, also print the call event number,
+** call sequence number and depth for every traced procedure.
+** NOTE: MR_dump_stack will assume that the succip is for the topmost
+** stack frame. If you call MR_dump_stack from some foreign_proc,
+** that may not be the case.
** Due to some optimizations (or lack thereof) the MR_dump_stack call
** may end up inside code that has a stack frame allocated, but
** that has a succip for the previous stack frame.
-** Don't call MR_dump_stack from Mercury pragma c_code (calling
-** from other C code in the runtime is probably ok, provided the
+** Don't call MR_dump_stack from a Mercury procedure defined by a foreign_proc
+** (calling from other C code in the runtime is probably ok, provided the
** succip corresponds to the topmost stack frame).
** (See library/require.m for a technique for calling MR_dump_stack
** from Mercury).
-** If you need a more convenient way of calling from Mercury code,
-** it would probably be best to make an impure predicate defined
+** If you need a more convenient way of calling this from Mercury code,
+** it would probably be best to do it using an impure predicate defined
** using `:- external'.
*/
@@ -96,11 +95,11 @@
MR_Word *MR_sdi_base_sp;
MR_Word *MR_sdi_base_curfr;
const char *MR_sdi_goal_path;
-} MR_StackDumpInfo;
+} MR_StackFrameDumpInfo;
typedef void (*MR_PrintStackRecord)(FILE *fp,
MR_bool include_trace_data,
- MR_StackDumpInfo dump_info);
+ const MR_StackFrameDumpInfo *frame_dump_info);
extern const char *MR_dump_stack_from_layout(FILE *fp,
const MR_LabelLayout *label_layout,
@@ -112,6 +111,18 @@
MR_SpecLineLimit line_limit,
MR_PrintStackRecord print_stack_record);
+extern const char *MR_dump_stack_from_layout_clique(FILE *fp,
+ const MR_LabelLayout *label_layout,
+ MR_Word *det_stack_pointer,
+ MR_Word *current_frame,
+ MR_bool include_trace_data,
+ MR_bool include_contexts,
+ MR_bool detect_cliques,
+ MR_SpecLineLimit clique_line_limit,
+ MR_FrameLimit frame_limit,
+ MR_SpecLineLimit line_limit,
+ MR_PrintStackRecord print_stack_record);
+
/*
** MR_dump_nondet_stack
**
@@ -147,17 +158,49 @@
** function for each frame.
*/
-typedef void MR_Traverse_Nondet_Frame_Func(void *user_data,
+typedef void MR_TraverseNondetFrameFunc(void *user_data,
const MR_LabelLayout *layout, MR_Word *base_sp,
MR_Word *base_curfr);
extern void MR_traverse_nondet_stack_from_layout(
MR_Word *maxfr, const MR_LabelLayout *label_layout,
MR_Word *base_sp, MR_Word *base_curfr,
- MR_Traverse_Nondet_Frame_Func *traverse_frame_func,
+ MR_TraverseNondetFrameFunc *traverse_frame_func,
void *traverse_frame_func_data);
/*
+** MR_find_clique_entry
+**
+** Walk the stack from the current event to the stack frame of main.
+** The initial part of this walk visits the stack frames of procedures
+** that are mutually recursive with the current event's procedure;
+** the rest of the walk visits the frames of other procedures.
+** This function find the boundary between these two parts.
+**
+** If we cannot walk all the way to main (e.g. because some stack frames
+** have no layout information, or because the stack does not have the required
+** depth), we return a pointer to an error message, and neither
+** *clique_entry_level nor *first_outside_ancestor_level will be meaningful.
+**
+** If we can walk all the way to main, then we will set *clique_entry_level
+** to be the level on the stack (in the sense of a number you can give to
+** MR_find_nth_ancestor) of the stack frame that is in the initial mutually
+** recursive group, but whose caller is not, and it will set
+** *first_outside_ancestor_level to the level of the caller, unless there
+** is no such caller, in which case we set *first_outside_ancestor_level
+** to a negative number.
+**
+** Either clique_entry_level or first_outside_ancestor_level may be NULL,
+** if the caller does not need one or other of these numbers.
+*/
+
+extern const char *MR_find_clique_entry(
+ const MR_LabelLayout *label_layout,
+ MR_Word *det_stack_pointer, MR_Word *current_frame,
+ int *clique_entry_level,
+ int *first_outside_ancestor_level);
+
+/*
** MR_find_nth_ancestor
**
** Return the layout structure of the return label of the call
@@ -354,7 +397,7 @@
extern void MR_dump_stack_record_print(FILE *fp,
MR_bool include_trace_data,
- const MR_StackDumpInfo dump_info);
+ const MR_StackFrameDumpInfo *frame_dump_info);
/*
** Find the first call event on the stack whose event number or sequence number
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/appengine
cvs diff: Diffing samples/appengine/war
cvs diff: Diffing samples/appengine/war/WEB-INF
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/standalone_c
cvs diff: Diffing samples/concurrency
cvs diff: Diffing samples/concurrency/dining_philosophers
cvs diff: Diffing samples/concurrency/midimon
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/java_interface
cvs diff: Diffing samples/java_interface/java_calls_mercury
cvs diff: Diffing samples/java_interface/mercury_calls_java
cvs diff: Diffing samples/lazy_list
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/solver_types
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing slice
cvs diff: Diffing ssdb
cvs diff: Diffing tests
cvs diff: Diffing tests/analysis
cvs diff: Diffing tests/analysis/ctgc
cvs diff: Diffing tests/analysis/excp
cvs diff: Diffing tests/analysis/ext
cvs diff: Diffing tests/analysis/sharing
cvs diff: Diffing tests/analysis/table
cvs diff: Diffing tests/analysis/trail
cvs diff: Diffing tests/analysis/unused_args
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.147
diff -u -b -r1.147 Mmakefile
--- tests/debugger/Mmakefile 16 Jun 2011 06:42:18 -0000 1.147
+++ tests/debugger/Mmakefile 21 Apr 2012 16:59:05 -0000
@@ -45,6 +45,8 @@
lval_desc_array \
mdbrc_test \
multi_parameter \
+ mutrec \
+ mutrec_higher_order \
poly_io_retry \
poly_io_retry2 \
polymorphic_ground_term \
@@ -472,6 +474,17 @@
$(MDB) ./mmos_print < mmos_print.inp \
> mmos_print.out 2>&1
+mmos_print.out: mmos_print mmos_print.inp
+ $(MDB) ./mmos_print < mmos_print.inp \
+ > mmos_print.out 2>&1
+
+mutrec.out: mutrec mutrec.inp
+ $(MDB) ./mutrec < mutrec.inp > mutrec.out 2>&1
+
+mutrec_higher_order.out: mutrec_higher_order mutrec_higher_order.inp
+ $(MDB) ./mutrec_higher_order < mutrec_higher_order.inp \
+ > mutrec_higher_order.out 2>&1
+
# We need to pipe the output through sed to avoid hard-coding dependencies on
# particular line numbers in the standard library source code.
output_term_dep.out: output_term_dep output_term_dep.inp
Index: tests/debugger/mutrec.exp
===================================================================
RCS file: tests/debugger/mutrec.exp
diff -N tests/debugger/mutrec.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec.exp 21 Apr 2012 06:31:22 -0000
@@ -0,0 +1,256 @@
+ 1: 1 1 CALL pred mutrec.main/2-0 (det) mutrec.m:25
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p2
+ 0: + stop interface pred mutrec.p2/3-0 (det)
+mdb> continue
+ 16: 6 6 CALL pred mutrec.p2/3-0 (det) mutrec.m:91 (mutrec.m:122)
+mdb> stack
+ 0 pred mutrec.p2/3-0 (det) (mutrec.m:91)
+ 1 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 2 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 4 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 5 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.p2/3-0 (det)
+mdb> break p3
+ 0: + stop interface pred mutrec.p3/3-0 (det)
+mdb> continue
+ 24: 8 8 CALL pred mutrec.p3/3-0 (det) mutrec.m:111 (mutrec.m:102)
+mdb> stack
+<mutually recursive set of stack frames start>
+ 0 pred mutrec.p3/3-0 (det) (mutrec.m:111)
+ 1 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 3 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 4 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 6 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 7 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> stack -a
+ 0 pred mutrec.p3/3-0 (det) (mutrec.m:111)
+ 1 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 3 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 4 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 6 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 7 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.p3/3-0 (det)
+mdb> break q1
+ 0: + stop interface pred mutrec.q1/3-0 (det)
+mdb> continue
+ 35: 11 11 CALL pred mutrec.q1/3-0 (det) mutrec.m:133 (mutrec.m:106)
+mdb> stack
+ 0 pred mutrec.q1/3-0 (det) (mutrec.m:133)
+<mutually recursive set of stack frames start>
+ 1 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 3 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 4 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 6 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 7 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 9 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 10 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.q1/3-0 (det)
+mdb> break q3
+ 0: + stop interface pred mutrec.q3/3-0 (det)
+mdb> continue
+ 40: 12 12 CALL pred mutrec.q3/3-0 (det) mutrec.m:173 (mutrec.m:144)
+mdb> stack
+ 0 pred mutrec.q3/3-0 (det) (mutrec.m:173)
+ 1 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 2 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 4 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 5 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 7 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 8 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 10 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 11 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.q3/3-0 (det)
+mdb> break q2
+ 0: + stop interface pred mutrec.q2/3-0 (det)
+mdb> continue
+ 45: 13 13 CALL pred mutrec.q2/3-0 (det) mutrec.m:153 (mutrec.m:184)
+mdb> stack
+ 0 pred mutrec.q2/3-0 (det) (mutrec.m:153)
+ 1 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 2 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 3 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 5 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 6 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 8 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 9 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 11 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 12 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.q2/3-0 (det)
+mdb> break r0c
+ 0: + stop interface pred mutrec.r0c/3-0 (det)
+mdb> continue
+ 69: 19 19 CALL pred mutrec.r0c/3-0 (det) mutrec.m:207 (mutrec.m:188)
+mdb> stack
+ 0 pred mutrec.r0c/3-0 (det) (mutrec.m:207)
+<mutually recursive set of stack frames start>
+ 1 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 4 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 5 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 6 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 7 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<mutually recursive set of stack frames end>
+ 8 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 9 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 11 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 12 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 14 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 15 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 17 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 18 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> stack -c 3
+ 0 pred mutrec.r0c/3-0 (det) (mutrec.m:207)
+<mutually recursive set of stack frames start>
+ 1 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 4 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 5 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<more stack frames in clique snipped>
+<mutually recursive set of stack frames end>
+ 8 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 9 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 11 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 12 pred mutrec.p2/3-0 (det) (mutrec.m:102)
+<more stack frames in clique snipped>
+<mutually recursive set of stack frames end>
+ 15 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 17 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 18 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.r0c/3-0 (det)
+mdb> break r2
+ 0: + stop interface pred mutrec.r2/3-0 (det)
+mdb> continue
+ 78: 22 22 CALL pred mutrec.r2/3-0 (det) mutrec.m:233 (mutrec.m:222)
+mdb> stack
+ 0 pred mutrec.r2/3-0 (det) (mutrec.m:233)
+ 1 2* pred mutrec.r1/3-0 (det) (mutrec.m:222 and others)
+ 3 pred mutrec.r0c/3-0 (det) (mutrec.m:209)
+<mutually recursive set of stack frames start>
+ 4 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 7 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 8 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 9 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 10 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<mutually recursive set of stack frames end>
+ 11 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 12 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 14 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 15 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 17 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 18 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 20 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 21 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.r2/3-0 (det)
+mdb> break r3
+ 0: + stop interface pred mutrec.r3/3-0 (det)
+mdb> continue
+ 83: 23 23 CALL pred mutrec.r3/3-0 (det) mutrec.m:253 (mutrec.m:244)
+mdb> stack
+ 0 pred mutrec.r3/3-0 (det) (mutrec.m:253)
+ 1 pred mutrec.r2/3-0 (det) (mutrec.m:244)
+ 2 2* pred mutrec.r1/3-0 (det) (mutrec.m:222 and others)
+ 4 pred mutrec.r0c/3-0 (det) (mutrec.m:209)
+<mutually recursive set of stack frames start>
+ 5 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 8 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 9 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 10 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 11 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<mutually recursive set of stack frames end>
+ 12 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 13 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 15 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 16 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 18 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 19 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 21 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 22 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.r3/3-0 (det)
+mdb> break r2
+ 0: + stop interface pred mutrec.r2/3-0 (det)
+mdb> continue
+ 91: 25 25 CALL pred mutrec.r2/3-0 (det) mutrec.m:233 (mutrec.m:264)
+mdb> stack
+<mutually recursive set of stack frames start>
+ 0 pred mutrec.r2/3-0 (det) (mutrec.m:233)
+ 1 2* pred mutrec.r3/3-0 (det) (mutrec.m:264 and others)
+ 3 pred mutrec.r2/3-0 (det) (mutrec.m:244)
+<mutually recursive set of stack frames end>
+ 4 2* pred mutrec.r1/3-0 (det) (mutrec.m:222 and others)
+ 6 pred mutrec.r0c/3-0 (det) (mutrec.m:209)
+<mutually recursive set of stack frames start>
+ 7 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 10 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 11 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 12 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 13 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<mutually recursive set of stack frames end>
+ 14 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 15 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 17 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 18 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 20 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 21 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 23 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 24 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.r2/3-0 (det)
+mdb> break s
+ 0: + stop interface pred mutrec.s/3-0 (det)
+mdb> continue
+ 97: 27 27 CALL pred mutrec.s/3-0 (det) mutrec.m:275 (mutrec.m:248)
+mdb> stack
+ 0 pred mutrec.s/3-0 (det) (mutrec.m:275)
+<mutually recursive set of stack frames start>
+ 1 2* pred mutrec.r2/3-0 (det) (mutrec.m:248 and others)
+ 3 2* pred mutrec.r3/3-0 (det) (mutrec.m:264 and others)
+ 5 pred mutrec.r2/3-0 (det) (mutrec.m:244)
+<mutually recursive set of stack frames end>
+ 6 2* pred mutrec.r1/3-0 (det) (mutrec.m:222 and others)
+ 8 pred mutrec.r0c/3-0 (det) (mutrec.m:209)
+<mutually recursive set of stack frames start>
+ 9 3* pred mutrec.q3/3-0 (det) (mutrec.m:188 and others)
+ 12 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 13 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+ 14 pred mutrec.q2/3-0 (det) (mutrec.m:164)
+ 15 pred mutrec.q3/3-0 (det) (mutrec.m:184)
+<mutually recursive set of stack frames end>
+ 16 pred mutrec.q1/3-0 (det) (mutrec.m:144)
+<mutually recursive set of stack frames start>
+ 17 2* pred mutrec.p2/3-0 (det) (mutrec.m:106 and others)
+ 19 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+ 20 2* pred mutrec.p2/3-0 (det) (mutrec.m:102 and others)
+ 22 pred mutrec.p3/3-0 (det) (mutrec.m:122)
+<mutually recursive set of stack frames end>
+ 23 2* pred mutrec.p1/3-0 (det) (mutrec.m:82 and others)
+ 25 pred mutrec.test/2-0 (det) (mutrec.m:42)
+ 26 pred mutrec.main/2-0 (det) (mutrec.m:33)
+mdb> delete *
+ 0: E stop interface pred mutrec.s/3-0 (det)
+mdb> continue
+[p1, p1, p3, p2, p2, p3, p2, p2, q1, q3, q2, q3, q2, q3, q3, q3, r0c, r1, r1, r2, r3, r3, r2, r2, s, s]
+[p1, p1, p3, p2, p2, p3, p2, p2, q1, q3, q2, q3, q2, q3, q3, q3, r0c, r1, r1, r1, r1, r1, r3, r3, s, s, s, s]
Index: tests/debugger/mutrec.inp
===================================================================
RCS file: tests/debugger/mutrec.inp
diff -N tests/debugger/mutrec.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec.inp 21 Apr 2012 03:45:23 -0000
@@ -0,0 +1,45 @@
+echo on
+register --quiet
+break p2
+continue
+stack
+delete *
+break p3
+continue
+stack
+stack -a
+delete *
+break q1
+continue
+stack
+delete *
+break q3
+continue
+stack
+delete *
+break q2
+continue
+stack
+delete *
+break r0c
+continue
+stack
+stack -c 3
+delete *
+break r2
+continue
+stack
+delete *
+break r3
+continue
+stack
+delete *
+break r2
+continue
+stack
+delete *
+break s
+continue
+stack
+delete *
+continue
Index: tests/debugger/mutrec.m
===================================================================
RCS file: tests/debugger/mutrec.m
diff -N tests/debugger/mutrec.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec.m 21 Apr 2012 16:51:26 -0000
@@ -0,0 +1,283 @@
+%----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%----------------------------------------------------------------------------%
+
+:- module mutrec.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+%----------------------------------------------------------------------------%
+
+:- import_module int.
+:- import_module list.
+
+:- type step
+ ---> self
+ ; mut(int)
+ ; down.
+
+main(!IO) :-
+ Steps1 = [self, mut(1), mut(3), self, mut(2), mut(2), self, down,
+ mut(1), mut(3), mut(3), mut(3), mut(3), self, self, down,
+ self, mut(2), mut(2), self, mut(3), self, down],
+ Steps2 = [self, mut(1), mut(3), self, mut(2), mut(2), self, down,
+ mut(1), mut(3), mut(3), mut(3), mut(3), self, self, down,
+ self, self, self, self, mut(3), self, down],
+
+ test(Steps1, RevStrs1),
+ test(Steps2, RevStrs2),
+
+ test_output(RevStrs1, !IO),
+ test_output(RevStrs2, !IO).
+
+:- pred test(list(step)::in, list(string)::out) is det.
+
+test(Steps, RevStrs) :-
+ p1(Steps, [], RevStrs).
+
+:- pred test_output(list(string)::in, io::di, io::uo) is det.
+
+test_output(RevStrs, !IO) :-
+ list.reverse(RevStrs, Strs),
+ (
+ Strs = [],
+ io.write_string("[]\n", !IO)
+ ;
+ Strs = [HeadStr | TailStrs],
+ io.write_string("[", !IO),
+ io.write_string(HeadStr, !IO),
+ write_comma_strings(TailStrs, !IO),
+ io.write_string("]\n", !IO)
+ ).
+
+:- pred write_comma_strings(list(string)::in, io::di, io::uo) is det.
+
+write_comma_strings([], !IO).
+write_comma_strings([Str | Strs], !IO) :-
+ io.write_string(", ", !IO),
+ io.write_string(Str, !IO),
+ write_comma_strings(Strs, !IO).
+
+%----------------------------------------------------------------------------%
+
+:- pred p1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p1([], A, A).
+p1([Step | Steps], A, R) :-
+ B = ["p1" | A],
+ (
+ Step = self,
+ p1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ p2(Steps, B, R)
+ ;
+ p3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+:- pred p2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p2([], A, A).
+p2([Step | Steps], A, R) :-
+ B = ["p2" | A],
+ (
+ Step = self,
+ p2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ p1(Steps, B, R)
+ ;
+ p3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+:- pred p3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p3([], A, A).
+p3([Step | Steps], A, R) :-
+ B = ["p3" | A],
+ (
+ Step = self,
+ p3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ p1(Steps, B, R)
+ ;
+ p2(Steps, B, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred q1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q1([], A, A).
+q1([Step | Steps], A, R) :-
+ B = ["q1" | A],
+ (
+ Step = self,
+ q1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ q2(Steps, B, R)
+ ;
+ q3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ r0a(Steps, B, R)
+ ).
+
+:- pred q2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q2([], A, A).
+q2([Step | Steps], A, R) :-
+ B = ["q2" | A],
+ (
+ Step = self,
+ q2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ q1(Steps, B, R)
+ ;
+ q3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ r0b(Steps, B, R)
+ ).
+
+:- pred q3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q3([], A, A).
+q3([Step | Steps], A, R) :-
+ B = ["q3" | A],
+ (
+ Step = self,
+ q3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ q1(Steps, B, R)
+ ;
+ q2(Steps, B, R)
+ )
+ ;
+ Step = down,
+ r0c(Steps, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred r0a(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0a(Steps, A, R) :-
+ B = ["r0a" | A],
+ r0b(Steps, B, R).
+
+:- pred r0b(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0b(Steps, A, R) :-
+ B = ["r0b" | A],
+ r0c(Steps, B, R).
+
+:- pred r0c(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0c(Steps, A, R) :-
+ B = ["r0c" | A],
+ r1(Steps, B, R).
+
+:- pred r1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r1([], A, A).
+r1([Step | Steps], A, R) :-
+ B = ["r1" | A],
+ (
+ Step = self,
+ r1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ r2(Steps, B, R)
+ ;
+ r3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ R = B
+ ).
+
+:- pred r2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r2([], A, A).
+r2([Step | Steps], A, R) :-
+ B = ["r2" | A],
+ (
+ Step = self,
+ r2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ r1(Steps, B, R)
+ ;
+ r3(Steps, B, R)
+ )
+ ;
+ Step = down,
+ s(1, B, R)
+ ).
+
+:- pred r3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r3([], A, A).
+r3([Step | Steps], A, R) :-
+ B = ["r3" | A],
+ (
+ Step = self,
+ r3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ r1(Steps, B, R)
+ ;
+ r2(Steps, B, R)
+ )
+ ;
+ Step = down,
+ s(3, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred s(int::in, list(string)::in, list(string)::out) is det.
+
+s(N, A, R) :-
+ B = ["s" | A],
+ ( N > 0 ->
+ s(N-1, B, R)
+ ;
+ R = B
+ ).
+
+%----------------------------------------------------------------------------%
Index: tests/debugger/mutrec_higher_order.exp
===================================================================
RCS file: tests/debugger/mutrec_higher_order.exp
diff -N tests/debugger/mutrec_higher_order.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec_higher_order.exp 21 Apr 2012 17:44:13 -0000
@@ -0,0 +1,271 @@
+ 1: 1 1 CALL pred mutrec_higher_order.main/2-0 (det) mutrec_higher_order.m:26
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> break p2
+ 0: + stop interface pred mutrec_higher_order.p2/3-0 (det)
+mdb> continue
+ 16: 6 6 CALL pred mutrec_higher_order.p2/3-0 (det) mutrec_higher_order.m:115 (mutrec_higher_order.m:155)
+mdb> stack
+ 0 pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:115)
+ 1 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 2 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 4 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 5 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.p2/3-0 (det)
+mdb> break p3
+ 0: + stop interface pred mutrec_higher_order.p3/3-0 (det)
+mdb> continue
+ 24: 8 8 CALL pred mutrec_higher_order.p3/3-0 (det) mutrec_higher_order.m:144 (mutrec_higher_order.m:126)
+mdb> stack
+<mutually recursive set of stack frames start>
+ 0 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:144)
+ 1 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 3 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 4 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 6 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 7 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> stack -a
+ 0 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:144)
+ 1 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 3 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 4 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 6 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 7 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.p3/3-0 (det)
+mdb> break q1
+ 0: + stop interface pred mutrec_higher_order.q1/3-0 (det)
+mdb> continue
+ 49: 14 13 CALL pred mutrec_higher_order.q1/3-0 (det) mutrec_higher_order.m:175 (mutrec_higher_order.m:213)
+mdb> stack
+ 0 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:175)
+ 1 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+ 2 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 3 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 5 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 6 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 8 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 9 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 11 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 12 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.q1/3-0 (det)
+mdb> break q3
+ 0: + stop interface pred mutrec_higher_order.q3/3-0 (det)
+mdb> continue
+ 54: 15 14 CALL pred mutrec_higher_order.q3/3-0 (det) mutrec_higher_order.m:233 (mutrec_higher_order.m:186)
+mdb> stack
+ 0 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:233)
+ 1 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 2 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+ 3 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 4 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 6 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 7 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 9 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 10 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 12 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 13 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.q3/3-0 (det)
+mdb> break q2
+ 0: + stop interface pred mutrec_higher_order.q2/3-0 (det)
+mdb> continue
+ 59: 16 15 CALL pred mutrec_higher_order.q2/3-0 (det) mutrec_higher_order.m:204 (mutrec_higher_order.m:244)
+mdb> stack
+<mutually recursive set of stack frames start>
+ 0 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:204)
+ 1 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 2 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 3 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 4 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 5 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 7 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 8 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 10 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 11 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 13 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 14 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.q2/3-0 (det)
+mdb> break r1
+ 0: + stop interface pred mutrec_higher_order.r1/3-0 (det)
+mdb> continue
+ 85: 23 21 CALL pred mutrec_higher_order.r1/3-0 (det) mutrec_higher_order.m:282 (mutrec_higher_order.m:78)
+mdb> stack
+ 0 pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:282)
+ 1 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 2 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 5 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 6 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+ 7 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 8 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 9 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 10 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 11 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 13 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 14 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 16 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 17 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 19 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 20 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> stack -c 3
+ 0 pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:282)
+ 1 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 2 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 5 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 6 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+<more stack frames in clique snipped>
+<mutually recursive set of stack frames end>
+ 10 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 11 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 13 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 14 pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126)
+<more stack frames in clique snipped>
+<mutually recursive set of stack frames end>
+ 17 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 19 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 20 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.r1/3-0 (det)
+mdb> break r2
+ 0: + stop interface pred mutrec_higher_order.r2/3-0 (det)
+mdb> continue
+ 93: 25 23 CALL pred mutrec_higher_order.r2/3-0 (det) mutrec_higher_order.m:305 (mutrec_higher_order.m:291)
+mdb> stack
+ 0 pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:305)
+ 1 2* pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:291 and others)
+ 3 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 4 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 7 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 8 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+ 9 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 10 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 11 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 12 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 13 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 15 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 16 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 18 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 19 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 21 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 22 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.r2/3-0 (det)
+mdb> break r3
+ 0: + stop interface pred mutrec_higher_order.r3/3-0 (det)
+mdb> continue
+ 98: 26 24 CALL pred mutrec_higher_order.r3/3-0 (det) mutrec_higher_order.m:328 (mutrec_higher_order.m:316)
+mdb> stack
+ 0 pred mutrec_higher_order.r3/3-0 (det) (mutrec_higher_order.m:328)
+ 1 pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:316)
+ 2 2* pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:291 and others)
+ 4 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 5 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 8 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 9 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+ 10 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 11 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 12 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 13 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 14 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 16 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 17 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 19 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 20 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 22 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 23 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.r3/3-0 (det)
+mdb> break r2
+ 0: + stop interface pred mutrec_higher_order.r2/3-0 (det)
+mdb> continue
+ 106: 28 26 CALL pred mutrec_higher_order.r2/3-0 (det) mutrec_higher_order.m:305 (mutrec_higher_order.m:339)
+mdb> stack
+<mutually recursive set of stack frames start>
+ 0 pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:305)
+ 1 2* pred mutrec_higher_order.r3/3-0 (det) (mutrec_higher_order.m:339 and others)
+ 3 pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:316)
+<mutually recursive set of stack frames end>
+ 4 2* pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:291 and others)
+ 6 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 7 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 10 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 11 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+ 12 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 13 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 14 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 15 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 16 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 18 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 19 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 21 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 22 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 24 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 25 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.r2/3-0 (det)
+mdb> break s
+ 0: + stop interface pred mutrec_higher_order.s/3-0 (det)
+mdb> continue
+ 112: 30 28 CALL pred mutrec_higher_order.s/3-0 (det) mutrec_higher_order.m:353 (mutrec_higher_order.m:323)
+mdb> stack
+ 0 pred mutrec_higher_order.s/3-0 (det) (mutrec_higher_order.m:353)
+<mutually recursive set of stack frames start>
+ 1 2* pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:323 and others)
+ 3 2* pred mutrec_higher_order.r3/3-0 (det) (mutrec_higher_order.m:339 and others)
+ 5 pred mutrec_higher_order.r2/3-0 (det) (mutrec_higher_order.m:316)
+<mutually recursive set of stack frames end>
+ 6 2* pred mutrec_higher_order.r1/3-0 (det) (mutrec_higher_order.m:291 and others)
+ 8 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 9 3* pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:220 and others)
+ 12 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 13 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:215)
+ 14 pred mutrec_higher_order.q3/3-0 (det) (mutrec_higher_order.m:244)
+ 15 pred mutrec_higher_order.q1/3-0 (det) (mutrec_higher_order.m:186)
+ 16 pred mutrec_higher_order.q2/3-0 (det) (mutrec_higher_order.m:213)
+<mutually recursive set of stack frames end>
+ 17 pred mutrec_higher_order.repeat_steps/5-0 (det) (mutrec_higher_order.m:78)
+<mutually recursive set of stack frames start>
+ 18 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:133 and others)
+ 20 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+ 21 2* pred mutrec_higher_order.p2/3-0 (det) (mutrec_higher_order.m:126 and others)
+ 23 pred mutrec_higher_order.p3/3-0 (det) (mutrec_higher_order.m:155)
+<mutually recursive set of stack frames end>
+ 24 2* pred mutrec_higher_order.p1/3-0 (det) (mutrec_higher_order.m:97 and others)
+ 26 pred mutrec_higher_order.test/2-0 (det) (mutrec_higher_order.m:43)
+ 27 pred mutrec_higher_order.main/2-0 (det) (mutrec_higher_order.m:34)
+mdb> delete *
+ 0: E stop interface pred mutrec_higher_order.s/3-0 (det)
+mdb> continue
+[p1, p1, p3, p2, p2, p3, p2, q2, q1, q3, q2, q3, q2, q2, r1, r1, r2, r3, r3, r2, r2, s, s, q2, q1, q3, q2, q3, q2, q2, r1, r1, r2, r3, r3, r2, r2, s, s]
+[p1, p1, p3, p2, p2, p3, p2, q3, q1, q3, q2, q3, q2, q2, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s, q3, q1, q3, q2, q3, q2, q2, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s, q3, q1, q3, q2, q3, q2, q2, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s, r3, r3, r3, r3, r3, r2, r2, s, s]
Index: tests/debugger/mutrec_higher_order.inp
===================================================================
RCS file: tests/debugger/mutrec_higher_order.inp
diff -N tests/debugger/mutrec_higher_order.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec_higher_order.inp 21 Apr 2012 17:03:58 -0000
@@ -0,0 +1,45 @@
+echo on
+register --quiet
+break p2
+continue
+stack
+delete *
+break p3
+continue
+stack
+stack -a
+delete *
+break q1
+continue
+stack
+delete *
+break q3
+continue
+stack
+delete *
+break q2
+continue
+stack
+delete *
+break r1
+continue
+stack
+stack -c 3
+delete *
+break r2
+continue
+stack
+delete *
+break r3
+continue
+stack
+delete *
+break r2
+continue
+stack
+delete *
+break s
+continue
+stack
+delete *
+continue
Index: tests/debugger/mutrec_higher_order.m
===================================================================
RCS file: tests/debugger/mutrec_higher_order.m
diff -N tests/debugger/mutrec_higher_order.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/mutrec_higher_order.m 21 Apr 2012 17:02:25 -0000
@@ -0,0 +1,361 @@
+%----------------------------------------------------------------------------%
+% vim: ts=4 sw=4 et ft=mercury
+%----------------------------------------------------------------------------%
+
+:- module mutrec_higher_order.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+%----------------------------------------------------------------------------%
+
+:- import_module int.
+:- import_module list.
+
+:- type step
+ ---> self
+ ; mut(int)
+ ; rep(int)
+ ; down.
+
+main(!IO) :-
+ Steps1 = [self, mut(1), mut(3), self, mut(2), mut(2), self, rep(2),
+ mut(1), mut(3), mut(3), mut(3), mut(3), self, self, rep(1),
+ self, mut(2), mut(2), self, mut(3), self, down],
+ Steps2 = [self, mut(1), mut(3), self, mut(2), mut(2), self, rep(3),
+ mut(1), mut(3), mut(3), mut(3), mut(3), self, self, rep(4),
+ self, self, self, self, mut(3), self, down],
+
+ test(Steps1, RevStrs1),
+ test(Steps2, RevStrs2),
+
+ test_output(RevStrs1, !IO),
+ test_output(RevStrs2, !IO).
+
+:- pred test(list(step)::in, list(string)::out) is det.
+
+test(Steps, RevStrs) :-
+ p1(Steps, [], RevStrs).
+
+:- pred test_output(list(string)::in, io::di, io::uo) is det.
+
+test_output(RevStrs, !IO) :-
+ list.reverse(RevStrs, Strs),
+ (
+ Strs = [],
+ io.write_string("[]\n", !IO)
+ ;
+ Strs = [HeadStr | TailStrs],
+ io.write_string("[", !IO),
+ io.write_string(HeadStr, !IO),
+ write_comma_strings(TailStrs, !IO),
+ io.write_string("]\n", !IO)
+ ).
+
+:- pred write_comma_strings(list(string)::in, io::di, io::uo) is det.
+
+write_comma_strings([], !IO).
+write_comma_strings([Str | Strs], !IO) :-
+ io.write_string(", ", !IO),
+ io.write_string(Str, !IO),
+ write_comma_strings(Strs, !IO).
+
+%----------------------------------------------------------------------------%
+
+:- pred repeat_steps(
+ pred(list(step), list(string), list(string))::in(pred(in, in, out) is det),
+ list(step)::in, int::in, list(string)::in, list(string)::out) is det.
+
+repeat_steps(P, Steps, N, A, R) :-
+ ( N =< 0 ->
+ R = A
+ ;
+ P(Steps, A, B),
+ repeat_steps(P, Steps, N-1, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred p1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p1([], A, A).
+p1([Step | Steps], A, R) :-
+ B = ["p1" | A],
+ (
+ Step = self,
+ p1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ p2(Steps, B, R)
+ ;
+ p3(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(q1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(q2, Steps, 2, A, R)
+ ;
+ repeat_steps(q3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+:- pred p2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p2([], A, A).
+p2([Step | Steps], A, R) :-
+ B = ["p2" | A],
+ (
+ Step = self,
+ p2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ p1(Steps, B, R)
+ ;
+ p3(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(q1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(q2, Steps, 2, A, R)
+ ;
+ repeat_steps(q3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+:- pred p3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+p3([], A, A).
+p3([Step | Steps], A, R) :-
+ B = ["p3" | A],
+ (
+ Step = self,
+ p3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ p1(Steps, B, R)
+ ;
+ p2(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(q1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(q2, Steps, 2, A, R)
+ ;
+ repeat_steps(q3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ q1(Steps, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred q1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q1([], A, A).
+q1([Step | Steps], A, R) :-
+ B = ["q1" | A],
+ (
+ Step = self,
+ q1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ q2(Steps, B, R)
+ ;
+ q3(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(r1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(r2, Steps, 2, A, R)
+ ;
+ repeat_steps(r3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ r0a(Steps, B, R)
+ ).
+
+:- pred q2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q2([], A, A).
+q2([Step | Steps], A, R) :-
+ B = ["q2" | A],
+ (
+ Step = self,
+ q2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ q1(Steps, B, R)
+ ;
+ q3(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(r1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(r2, Steps, 2, A, R)
+ ;
+ repeat_steps(r3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ r0b(Steps, B, R)
+ ).
+
+:- pred q3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+q3([], A, A).
+q3([Step | Steps], A, R) :-
+ B = ["q3" | A],
+ (
+ Step = self,
+ q3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ q1(Steps, B, R)
+ ;
+ q2(Steps, B, R)
+ )
+ ;
+ Step = rep(N),
+ ( N = 1 ->
+ repeat_steps(r1, Steps, 1, A, R)
+ ; N = 2 ->
+ repeat_steps(r2, Steps, 2, A, R)
+ ;
+ repeat_steps(r3, Steps, 3, A, R)
+ )
+ ;
+ Step = down,
+ r0c(Steps, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred r0a(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0a(Steps, A, R) :-
+ B = ["r0a" | A],
+ r0b(Steps, B, R).
+
+:- pred r0b(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0b(Steps, A, R) :-
+ B = ["r0b" | A],
+ r0c(Steps, B, R).
+
+:- pred r0c(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r0c(Steps, A, R) :-
+ B = ["r0c" | A],
+ r1(Steps, B, R).
+
+:- pred r1(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r1([], A, A).
+r1([Step | Steps], A, R) :-
+ B = ["r1" | A],
+ (
+ Step = self,
+ r1(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 2 ->
+ r2(Steps, B, R)
+ ;
+ r3(Steps, B, R)
+ )
+ ;
+ Step = rep(_),
+ R = B
+ ;
+ Step = down,
+ R = B
+ ).
+
+:- pred r2(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r2([], A, A).
+r2([Step | Steps], A, R) :-
+ B = ["r2" | A],
+ (
+ Step = self,
+ r2(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ r1(Steps, B, R)
+ ;
+ r3(Steps, B, R)
+ )
+ ;
+ Step = rep(_),
+ R = B
+ ;
+ Step = down,
+ s(1, B, R)
+ ).
+
+:- pred r3(list(step)::in, list(string)::in, list(string)::out) is det.
+
+r3([], A, A).
+r3([Step | Steps], A, R) :-
+ B = ["r3" | A],
+ (
+ Step = self,
+ r3(Steps, B, R)
+ ;
+ Step = mut(N),
+ ( N = 1 ->
+ r1(Steps, B, R)
+ ;
+ r2(Steps, B, R)
+ )
+ ;
+ Step = rep(_),
+ R = B
+ ;
+ Step = down,
+ s(3, B, R)
+ ).
+
+%----------------------------------------------------------------------------%
+
+:- pred s(int::in, list(string)::in, list(string)::out) is det.
+
+s(N, A, R) :-
+ B = ["s" | A],
+ ( N > 0 ->
+ s(N-1, B, R)
+ ;
+ R = B
+ ).
+
+%----------------------------------------------------------------------------%
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/feedback
cvs diff: Diffing tests/feedback/mandelbrot
cvs diff: Diffing tests/feedback/mmc
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/par_conj
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/stm
cvs diff: Diffing tests/stm/orig
cvs diff: Diffing tests/stm/orig/stm-compiler
cvs diff: Diffing tests/stm/orig/stm-compiler/test1
cvs diff: Diffing tests/stm/orig/stm-compiler/test10
cvs diff: Diffing tests/stm/orig/stm-compiler/test2
cvs diff: Diffing tests/stm/orig/stm-compiler/test3
cvs diff: Diffing tests/stm/orig/stm-compiler/test4
cvs diff: Diffing tests/stm/orig/stm-compiler/test5
cvs diff: Diffing tests/stm/orig/stm-compiler/test6
cvs diff: Diffing tests/stm/orig/stm-compiler/test7
cvs diff: Diffing tests/stm/orig/stm-compiler/test8
cvs diff: Diffing tests/stm/orig/stm-compiler/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/bm2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/stmqueue
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test10
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test11
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par/test9
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test1
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test2
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test3
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test4
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test5
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test6
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test7
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test8
cvs diff: Diffing tests/stm/orig/stm-compiler-par-asm_fast/test9
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/trailing
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
Index: trace/mercury_trace_cmd_backward.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_backward.c,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_trace_cmd_backward.c
--- trace/mercury_trace_cmd_backward.c 20 Feb 2008 02:59:38 -0000 1.5
+++ trace/mercury_trace_cmd_backward.c 18 Apr 2012 06:12:38 -0000
@@ -67,6 +67,24 @@
&words, &word_count))
{
; /* the usage message has already been printed */
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "entry") || MR_streq(words[1], "clentry")))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
+ &ancestor_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "parent") || MR_streq(words[1], "clparent")))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
+ &ancestor_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
} else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
ancestor_level = n;
} else if (word_count == 1) {
@@ -83,8 +101,7 @@
result = MR_trace_retry(event_info, ancestor_level,
across_io, assume_all_io_is_tabled, MR_UNTABLED_IO_RETRY_MESSAGE,
- &unsafe_retry, &problem, MR_mdb_in, MR_mdb_out,
- jumpaddr);
+ &unsafe_retry, &problem, MR_mdb_in, MR_mdb_out, jumpaddr);
switch (result) {
case MR_RETRY_OK_DIRECT:
Index: trace/mercury_trace_cmd_browsing.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_browsing.c,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_trace_cmd_browsing.c
--- trace/mercury_trace_cmd_browsing.c 30 Sep 2010 04:21:18 -0000 1.12
+++ trace/mercury_trace_cmd_browsing.c 23 Apr 2012 06:18:33 -0000
@@ -67,9 +67,11 @@
static MR_bool MR_trace_options_detailed(MR_bool *detailed, char ***words,
int *word_count);
-static MR_bool MR_trace_options_stack_trace(MR_bool *detailed,
- MR_FrameLimit *frame_limit, char ***words,
- int *word_count);
+static MR_bool MR_trace_options_stack_trace(MR_bool *print_all,
+ MR_bool *detailed, MR_SpecLineLimit *line_limit,
+ MR_SpecLineLimit *clique_line_limit,
+ MR_FrameLimit *frame_limit,
+ char ***words, int *word_count);
static MR_bool MR_trace_options_format(MR_BrowseFormat *format,
MR_bool *xml, char ***words, int *word_count);
static MR_bool MR_trace_options_view(const char **window_cmd,
@@ -90,16 +92,38 @@
{
MR_Unsigned n;
MR_bool detailed;
+ int selected_level;
detailed = MR_FALSE;
if (! MR_trace_options_detailed(&detailed, &words, &word_count)) {
; /* the usage message has already been printed */
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "entry") || MR_streq(words[1], "clentry") ))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
+ &selected_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "parent") || MR_streq(words[1], "clparent") ))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
+ &selected_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
} else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
- MR_trace_set_level_and_report(n, detailed, MR_print_optionals);
+ selected_level = n;
} else {
MR_trace_usage_cur_cmd();
+ return KEEP_INTERACTING;
}
+ MR_trace_set_level_and_report(selected_level, detailed,
+ MR_print_optionals);
return KEEP_INTERACTING;
}
@@ -461,25 +485,65 @@
MR_trace_cmd_stack(char **words, int word_count, MR_TraceCmdInfo *cmd,
MR_EventInfo *event_info, MR_Code **jumpaddr)
{
+ MR_bool print_all;
MR_bool detailed;
- MR_FrameLimit frame_limit = 0;
- int line_limit = MR_stack_default_line_limit;
+ MR_FrameLimit frame_limit;
+ MR_SpecLineLimit clique_line_limit;
+ MR_SpecLineLimit line_limit;
MR_SpecLineLimit spec_line_limit;
+ const MR_LabelLayout *layout;
+ MR_Word *saved_regs;
+ const char *msg;
detailed = MR_FALSE;
- if (! MR_trace_options_stack_trace(&detailed, &frame_limit,
- &words, &word_count))
+ print_all = MR_FALSE;
+ frame_limit = 0;
+ clique_line_limit = 10;
+ line_limit = 100;
+ if (! MR_trace_options_stack_trace(&print_all, &detailed,
+ &line_limit, &clique_line_limit, &frame_limit, &words, &word_count))
{
- ; /* the usage message has already been printed */
+ /* the usage message has already been printed */
+ return KEEP_INTERACTING;
} else if (word_count == 1) {
- MR_trace_cmd_stack_2(event_info, detailed, frame_limit, line_limit);
+ line_limit = MR_stack_default_line_limit;
} else if (word_count == 2 &&
MR_trace_is_natural_number(words[1], &spec_line_limit))
{
- MR_trace_cmd_stack_2(event_info, detailed, frame_limit,
- spec_line_limit);
+ line_limit = spec_line_limit;
} else {
MR_trace_usage_cur_cmd();
+ return KEEP_INTERACTING;
+ }
+
+ layout = event_info->MR_event_sll;
+ saved_regs = event_info->MR_saved_regs;
+
+#ifdef MR_DEBUG_STACK_DUMP_CLIQUE
+ MR_trace_init_modules();
+ fprintf(MR_mdb_out, "OLD STACK DUMP:\n");
+ msg = MR_dump_stack_from_layout(MR_mdb_out, layout,
+ MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
+ detailed, MR_context_position != MR_CONTEXT_NOWHERE,
+ frame_limit, line_limit,
+ &MR_dump_stack_record_print);
+
+ if (msg != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "%s.\n", msg);
+ }
+
+ fprintf(MR_mdb_out, "\nNEW STACK DUMP:\n");
+#endif
+ msg = MR_dump_stack_from_layout_clique(MR_mdb_out, layout,
+ MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
+ detailed, MR_context_position != MR_CONTEXT_NOWHERE,
+ !print_all, clique_line_limit, frame_limit, line_limit,
+ &MR_dump_stack_record_print);
+
+ if (msg != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "%s.\n", msg);
}
return KEEP_INTERACTING;
@@ -939,29 +1003,6 @@
MR_trace_save_and_invoke_xml_browser(browser_term);
}
-static void
-MR_trace_cmd_stack_2(MR_EventInfo *event_info, MR_bool detailed,
- MR_FrameLimit frame_limit, int line_limit)
-{
- const MR_LabelLayout *layout;
- MR_Word *saved_regs;
- const char *msg;
-
- layout = event_info->MR_event_sll;
- saved_regs = event_info->MR_saved_regs;
-
- MR_trace_init_modules();
- msg = MR_dump_stack_from_layout(MR_mdb_out, layout,
- MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
- detailed, MR_context_position != MR_CONTEXT_NOWHERE,
- frame_limit, line_limit, &MR_dump_stack_record_print);
-
- if (msg != NULL) {
- fflush(MR_mdb_out);
- fprintf(MR_mdb_err, "%s.\n", msg);
- }
-}
-
/*
** Implement the `view' command. First, check if there is a server attached.
** If so, either stop it or abort the command, depending on whether '-f'
@@ -1143,16 +1184,30 @@
}
static MR_bool
-MR_trace_options_stack_trace(MR_bool *detailed, MR_FrameLimit *frame_limit,
- char ***words, int *word_count)
+MR_trace_options_stack_trace(MR_bool *print_all, MR_bool *detailed,
+ MR_SpecLineLimit *line_limit, MR_SpecLineLimit *clique_line_limit,
+ MR_FrameLimit *frame_limit, char ***words, int *word_count)
{
int c;
MR_optind = 0;
- while ((c = MR_getopt_long(*word_count, *words, "df:",
+ while ((c = MR_getopt_long(*word_count, *words, "ac:df:",
MR_trace_detailed_opts, NULL)) != EOF)
{
switch (c) {
+ case 'a':
+ *print_all = MR_TRUE;
+ *line_limit = 0;
+ break;
+
+ case 'c':
+ if (! MR_trace_is_natural_number(MR_optarg, clique_line_limit))
+ {
+ MR_trace_usage_cur_cmd();
+ return MR_FALSE;
+ }
+ *print_all = MR_FALSE;
+ break;
case 'd':
*detailed = MR_TRUE;
Index: trace/mercury_trace_cmd_forward.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_forward.c,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_trace_cmd_forward.c
--- trace/mercury_trace_cmd_forward.c 25 Nov 2008 07:46:57 -0000 1.6
+++ trace/mercury_trace_cmd_forward.c 18 Apr 2012 05:41:58 -0000
@@ -194,6 +194,7 @@
MR_Unsigned depth;
MR_Unsigned stop_depth;
MR_Unsigned n;
+ MR_Level ancestor_level;
MR_TracePort port;
MR_Word *base_sp;
MR_Word *base_curfr;
@@ -208,11 +209,28 @@
if (! MR_trace_options_movement_cmd(cmd, &words, &word_count)) {
; /* the usage message has already been printed */
return KEEP_INTERACTING;
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "entry") || MR_streq(words[1], "clentry")))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_FRAME,
+ &ancestor_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
+ } else if (word_count == 2 &&
+ ( MR_streq(words[1], "parent") || MR_streq(words[1], "clparent")))
+ {
+ if (MR_find_clique_entry_mdb(event_info, MR_CLIQUE_ENTRY_PARENT_FRAME,
+ &ancestor_level))
+ {
+ /* the error message has already been printed */
+ return KEEP_INTERACTING;
+ }
} else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
- stop_depth = depth - n;
+ ancestor_level = n;
} else if (word_count == 1) {
- n = 0;
- stop_depth = depth;
+ ancestor_level = 0;
} else {
MR_trace_usage_cur_cmd();
return KEEP_INTERACTING;
@@ -224,6 +242,7 @@
MR_trace_find_reused_frames(proc_layout, base_sp, reused_frames);
port = event_info->MR_trace_port;
+ stop_depth = depth - ancestor_level;
if (MR_port_is_final(port) && depth == stop_depth) {
MR_trace_do_noop();
} else if (MR_port_is_final(port) &&
@@ -232,7 +251,7 @@
MR_trace_do_noop_tail_rec();
} else {
ancestor_layout = MR_find_nth_ancestor(event_info->MR_event_sll,
- n, &base_sp, &base_curfr, &actual_level, &problem);
+ ancestor_level, &base_sp, &base_curfr, &actual_level, &problem);
if (ancestor_layout == NULL) {
fflush(MR_mdb_out);
if (problem != NULL) {
@@ -241,9 +260,10 @@
fprintf(MR_mdb_err, "mdb: not that many ancestors.\n");
}
return KEEP_INTERACTING;
- } else if (actual_level != n) {
+ } else if (actual_level != ancestor_level) {
fflush(MR_mdb_out);
- fprintf(MR_mdb_err, "%d %d\n", (int) n, (int) actual_level);
+ fprintf(MR_mdb_err, "%d %d\n",
+ (int) ancestor_level, (int) actual_level);
fprintf(MR_mdb_err,
"mdb: that stack frame has been reused, "
"will stop at finish of reusing call.\n");
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.87
diff -u -b -r1.87 mercury_trace_external.c
--- trace/mercury_trace_external.c 17 Oct 2011 04:31:33 -0000 1.87
+++ trace/mercury_trace_external.c 11 Apr 2012 07:55:40 -0000
@@ -230,7 +230,8 @@
static void MR_print_proc_id_to_socket(const MR_ProcLayout *entry,
const char *extra, MR_Word *base_sp, MR_Word *base_curfr);
static void MR_dump_stack_record_print_to_socket(FILE *fp,
- MR_bool include_trace_data, MR_StackDumpInfo dump_info);
+ MR_bool include_trace_data,
+ const MR_StackFrameDumpInfo *frame_dump_info);
static void MR_get_list_modules_to_import(MR_Word debugger_request,
MR_Integer *modules_list_length_ptr,
MR_Word *modules_list_ptr);
@@ -1265,7 +1266,7 @@
static void
MR_dump_stack_record_print_to_socket(FILE *fp, MR_bool include_trace_data,
- MR_StackDumpInfo dump_info)
+ const MR_StackFrameDumpInfo *frame_dump_info)
{
/*
** XXX If the external debugger is ever needed again, it should be updated
@@ -1273,16 +1274,17 @@
** frame by tail recursion events.
*/
- if (dump_info.MR_sdi_min_level != dump_info.MR_sdi_max_level) {
+ if (frame_dump_info->MR_sdi_min_level != frame_dump_info->MR_sdi_max_level)
+ {
MR_fatal_error(
"dumping stack frames of multiple calls to external debugger");
}
MR_send_message_to_socket_format(
"level(%" MR_INTEGER_LENGTH_MODIFIER "u).\n",
- dump_info.MR_sdi_min_level);
- MR_print_proc_id_to_socket(dump_info.MR_sdi_proc_layout, NULL,
- dump_info.MR_sdi_base_sp, dump_info.MR_sdi_base_curfr);
+ frame_dump_info->MR_sdi_min_level);
+ MR_print_proc_id_to_socket(frame_dump_info->MR_sdi_proc_layout, NULL,
+ frame_dump_info->MR_sdi_base_sp, frame_dump_info->MR_sdi_base_curfr);
}
static void
Index: trace/mercury_trace_util.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_util.c,v
retrieving revision 1.25
diff -u -b -r1.25 mercury_trace_util.c
--- trace/mercury_trace_util.c 2 Oct 2007 03:37:29 -0000 1.25
+++ trace/mercury_trace_util.c 18 Apr 2012 05:39:02 -0000
@@ -15,6 +15,7 @@
*/
#include "mercury_imp.h"
+#include "mercury_trace_internal.h"
#include "mercury_trace_util.h"
#include "mercury_file.h"
@@ -241,6 +242,45 @@
return MR_FALSE;
}
+MR_bool
+MR_find_clique_entry_mdb(MR_EventInfo *event_info,
+ MR_SelectedStackFrame which_frame, MR_Level *selected_level_ptr)
+{
+ const MR_LabelLayout *layout;
+ MR_Word *saved_regs;
+ int clique_entry_level;
+ int clique_parent_level;
+ const char *problem;
+
+ layout = event_info->MR_event_sll;
+ saved_regs = event_info->MR_saved_regs;
+
+ problem = MR_find_clique_entry(layout,
+ MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
+ &clique_entry_level, &clique_parent_level);
+
+ if (problem != NULL) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "mdb: %s.\n", problem);
+ return MR_TRUE;
+ }
+
+ if (which_frame == MR_CLIQUE_ENTRY_PARENT_FRAME) {
+ if (clique_parent_level < 0) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "mdb: All the frames on the stack"
+ "are recursive with the current procedure.\n");
+ return MR_TRUE;
+ }
+
+ *selected_level_ptr = clique_parent_level;
+ } else {
+ *selected_level_ptr = clique_entry_level;
+ }
+
+ return MR_FALSE;
+}
+
void
MR_trace_call_system_display_error_on_failure(FILE *err_stream, char *command)
{
Index: trace/mercury_trace_util.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_util.h,v
retrieving revision 1.21
diff -u -b -r1.21 mercury_trace_util.h
--- trace/mercury_trace_util.h 2 Oct 2007 03:37:29 -0000 1.21
+++ trace/mercury_trace_util.h 18 Apr 2012 05:39:10 -0000
@@ -91,6 +91,31 @@
const MR_ProcLayout *layout);
/*
+** Find the stack frame that represents the entry point to the clique
+** of the procedure that the current event is in.
+**
+** If we cannot walk the stack all the way to main, or if there is
+** some other error that prevents us from doing what are asked to do,
+** then return true. If there are no problems, return false, and fill
+** in *selected_level_ptr with a level number that can be given directly
+** to MR_find_nth_ancestor.
+**
+** If which_frame == MR_CLIQUE_ENTRY_FRAME, set *selected_level_ptr
+** to the level of the stack frame of the entry point of that clique.
+** If which_frame == MR_CLIQUE_ENTRY_PARENT_FRAME, set *selected_level_ptr
+** to the level of the parent of that stack frame, i.e. the level of
+** the first stack frame outside the clique (first when looking UP the stack).
+*/
+
+typedef enum {
+ MR_CLIQUE_ENTRY_FRAME, MR_CLIQUE_ENTRY_PARENT_FRAME
+} MR_SelectedStackFrame;
+
+extern MR_bool MR_find_clique_entry_mdb(MR_EventInfo *event_info,
+ MR_SelectedStackFrame which_frame,
+ MR_Level *selected_level_ptr);
+
+/*
** MR_trace_call_system_display_error_on_failure executes the given command
** and displays an error message if the command returned a non-zero exit
** status, there was a problem executing the command, or no usable shell was
cvs diff: Diffing util
Index: util/info_to_mdb.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/info_to_mdb.c,v
retrieving revision 1.6
diff -u -b -r1.6 info_to_mdb.c
--- util/info_to_mdb.c 18 Feb 2002 07:01:33 -0000 1.6
+++ util/info_to_mdb.c 8 Apr 2012 08:48:39 -0000
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1998-1999 The University of Melbourne.
** This file may only be copied under the terms of the GNU General
** Public License - see the file COPYING in the Mercury distribution.
@@ -64,8 +67,7 @@
/* the underlined heading */
while ((line = get_next_line(infp)) != NULL) {
- if (is_all_same_char(line, '-') || is_all_same_char(line, '='))
- {
+ if (is_all_same_char(line, '-') || is_all_same_char(line, '=')) {
break;
}
}
@@ -105,24 +107,19 @@
get_command(line, next_command);
if (strcmp(command, next_command) != 0) {
/*
- ** Sometimes several commands
- ** are documented together, e.g.
+ ** Sometimes several commands are documented together, e.g.
**
** cmd1 args...
** cmd2 args...
** cmd3 args...
** description...
**
- ** It's difficult for us to handle
- ** that case properly here, so we
- ** just insert cross references
- ** ("cmd1: see cmd2", "cmd2: see cmd3",
- ** etc.)
+ ** It is difficult for us to handle that case properly
+ ** here, so we just insert cross references
+ ** ("cmd1: see cmd2", "cmd2: see cmd3", etc.)
*/
if (num_lines == 0) {
- printf(" See help for "
- "`%s'.\n",
- next_command);
+ printf(" See help for `%s'.\n", next_command);
}
put_line_back(line);
break;
Index: util/mfiltercc.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mfiltercc.c,v
retrieving revision 1.3
diff -u -b -r1.3 mfiltercc.c
--- util/mfiltercc.c 7 Dec 2010 07:50:29 -0000 1.3
+++ util/mfiltercc.c 8 Apr 2012 08:48:59 -0000
@@ -26,8 +26,7 @@
#define MAX_LINE_LENGTH 2000
-static int
-drop_line(const char *line, size_t len);
+static int drop_line(const char *line, size_t len);
int
main(void)
Index: util/mkinit_common.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit_common.c,v
retrieving revision 1.2
diff -u -b -r1.2 mkinit_common.c
--- util/mkinit_common.c 18 Jun 2007 05:41:31 -0000 1.2
+++ util/mkinit_common.c 8 Apr 2012 08:52:02 -0000
@@ -44,7 +44,6 @@
static int size_of_files;
-
/* List of directories to search for init files */
static String_List *init_file_dirs = NULL;
@@ -89,7 +88,7 @@
if (num_files >= size_of_files) {
size_of_files *= FACTOR;
files = (char **)
- realloc(files, size_of_files * sizeof(char *));
+ checked_realloc(files, size_of_files * sizeof(char *));
if (files == NULL) {
fprintf(stderr, "%s: unable to realloc\n", MR_progname);
@@ -119,8 +118,7 @@
if (result == NULL) {
fprintf(stderr,
"%s: error opening output file `%s': %s\n",
- MR_progname, output_file_name,
- strerror(errno));
+ MR_progname, output_file_name, strerror(errno));
exit(EXIT_FAILURE);
}
}
@@ -282,7 +280,6 @@
}
}
-
int
get_line(FILE *file, char *line, int line_max)
{
@@ -318,27 +315,35 @@
void *
checked_malloc(size_t size)
{
- void *mem;
+ void *ptr;
- mem = malloc(size);
- if (mem == NULL) {
+ ptr = malloc(size);
+ if (ptr == NULL) {
fprintf(stderr, "Out of memory\n");
exit(EXIT_FAILURE);
}
- return mem;
+ return ptr;
}
-char *
-checked_strdup(const char *str)
+void *
+checked_realloc(void *old_ptr, size_t size)
{
- char *mem;
+ void *ptr;
- mem = malloc(strlen(str) + 1);
- if (mem == NULL) {
+ ptr = realloc(old_ptr, size);
+ if (ptr == NULL) {
fprintf(stderr, "Out of memory\n");
exit(EXIT_FAILURE);
}
+ return ptr;
+}
+char *
+checked_strdup(const char *str)
+{
+ char *mem;
+
+ mem = checked_malloc(strlen(str) + 1);
strcpy(mem, str);
return mem;
}
@@ -348,12 +353,7 @@
{
char *mem;
- mem = malloc(strlen(str) + strlen(suffix) + 1);
- if (mem == NULL) {
- fprintf(stderr, "Out of memory\n");
- exit(EXIT_FAILURE);
- }
-
+ mem = checked_malloc(strlen(str) + strlen(suffix) + 1);
strcpy(mem, str);
strcat(mem, suffix);
return mem;
Index: util/mkinit_common.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit_common.h,v
retrieving revision 1.2
diff -u -b -r1.2 mkinit_common.h
--- util/mkinit_common.h 18 Jun 2007 05:41:31 -0000 1.2
+++ util/mkinit_common.h 8 Apr 2012 08:53:36 -0000
@@ -49,6 +49,7 @@
extern char *read_line(const char *filename, FILE *fp, int max);
extern int get_line(FILE *file, char *line, int line_max);
extern void *checked_malloc(size_t size);
+extern void *checked_realloc(void *old_ptr, size_t size);
extern char *checked_strdup(const char *str);
extern char *checked_strdupcat(const char *str, const char *suffix);
Index: util/mkinit_erl.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit_erl.c,v
retrieving revision 1.5
diff -u -b -r1.5 mkinit_erl.c
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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