[m-rev.] for review: tail recursion and debugging
Zoltan Somogyi
zs at csse.unimelb.edu.au
Fri Nov 21 14:10:56 AEDT 2008
This change still needs to be documented, in both doc/user_guide.tex and
(later, once it has been tested on real code) in the NEWS file. However,
it should be reviewed before then.
Zoltan.
-----------------------------------
Implement a new compiler option, --exec-trace-tail-rec, that preserves direct
tail recursion in det and semidet procedures even when debugging is enabled.
This should allow the debugging of programs that previously ran out of stack.
The problem arose because even a directly tail-recursive call had some code
after it: the code for the EXIT event, like this:
p:
incr_sp
fill in the usual debug slots
CALL EVENT
...
/* tail call */
move arguments to registers as usual
call p, return to p_ret
p_ret:
/* code to move output arguments to right registers is empty */
EXIT EVENT
decr_sp
return
If the new option is enabled, the compiler will now generate code like this:
p:
incr_sp
fill in the usual debug slots
fill in new "stack frame reuse count" slot with 0
CALL EVENT
p_1:
...
/* tail call */
move arguments to registers as usual
update the usual debug slots
increment the "stack frame reuse count" slot
TAILCALL EVENT
goto p_1
The new TAIL event takes place in the caller's stack frame, so that the local
variables of the caller are available. This includes the arguments of the
recursive call (though if they are unnamed variables, the debugger will not
show them). The TAIL event serves as a replacement for the CALL event
of the recursive invocation.
compiler/options.m:
Add the new option.
compiler/handle_options.m:
Handle an implications of the new option: the declarative debugger
does not (yet) understand TAIL events.
compiler/mark_tail_calls.m:
New module to mark directly tail recursive calls and the procedures
containing them as such.
compiler/hlds.m:
compiler/notes/compiler_design.html:
Mention the new module.
compiler/mercury_compile.m:
Invoke the new module when the new option asks us to.
compiler/hlds_goal.m:
Add the feature used to mark tail recursive calls for the debugger.
Rename an existing feature with a similar but not identical purpose
to avoid possible confusion.
compiler/hlds_pred.m:
Add a field to proc_infos that says whether the procedure contains
tail recursive calls.
Minor style improvements.
compiler/passes_aux.m:
Minor change to accommodate the needs of the new module.
compiler/code_info.m:
Transmit the information from mark_tail_calls to the code generator.
compiler/call_gen.m:
Implement the new option.
compiler/trace_gen.m:
Reserve the extra slot needed for the new option.
Switch to state variable notation in the code that does the slot
allocation, since this is less error-prone than the previous approach.
compiler/layout.m:
compiler/layout_out.m:
compiler/stack_layout.m:
Remember what stack slot holds the stack frame reuse counter,
for transmission to the runtime system.
compiler/proc_gen.m:
Add the new label needed for tail recursion.
Put the arguments of some procedures into a more logical order.
compiler/deep_profiling.m:
compiler/deforest.m:
compiler/saved_vars.m:
compiler/table_gen.m:
Conform to the changes above.
compiler/trace_params.m:
mdbcomp/prim_data.m:
runtime/mercury_trace_base.[ch]:
Add the new event type.
Convert mercury_trace_base.h to four-space indentation.
runtime/mercury_stack_layout.h:
Add a field to the execution trace information we have for each
procedure that gives the number of the stack slot (if any) that holds
the stack frame reuse counter. Add a macro to get the value in the
counter.
Convert this header file to four-space indentation.
runtime/mercury_stack_trace.[ch]:
When walking the stack, we now have to be prepared to encounter stack
frames that have been reused. Modify the algorithms in this module
accordingly, and modify the interfaces of the exported functions
to allow the functions' callers to behave accordingly as well.
Group the information we gather about stack frame for printing into
one structure, and document it.
Convert the header to four-space indentation.
library/exception.m:
mdbcomp/trace_counts.m:
Conform to the changes above.
In trace_counts.m, fix an apparent cut-and-paste error (that hasn't
caused any test case failures yet).
trace/mercury_trace.c:
Modify the implementation of the "next" and "finish" commands
to accommodate the possibility that the procedure at the selected
depth may have had its stack frame reused. In such cases
tests/debugger/tailrec1.{m,inp,exp,data}:
A new test case to check the handling of tail recursive procedures.
cvs diff: Diffing .
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/include
cvs diff: Diffing boehm_gc/include/private
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/src/atomic_ops/sysdeps/gcc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/hpc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/ibmc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/icc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/msftc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/src/atomic_ops/sysdeps/sunc
cvs diff: Diffing boehm_gc/libatomic_ops-1.2/tests
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing boehm_gc/windows-untested
cvs diff: Diffing boehm_gc/windows-untested/vc60
cvs diff: Diffing boehm_gc/windows-untested/vc70
cvs diff: Diffing boehm_gc/windows-untested/vc71
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.194
diff -u -b -r1.194 call_gen.m
--- compiler/call_gen.m 2 Jun 2008 02:33:35 -0000 1.194
+++ compiler/call_gen.m 20 Nov 2008 04:38:28 -0000
@@ -97,7 +97,7 @@
kill_dead_input_vars(ArgsInfos, GoalInfo, NonLiveOutputs, !CI),
% Figure out what the call model is.
- call_gen.prepare_for_call(CodeModel, CallModel, TraceCode, !CI),
+ prepare_for_call(CodeModel, CallModel, TraceResetCode, !CI),
% Make the call. Note that the construction of CallCode will be moved
% *after* the code that computes ReturnLiveLvalues.
@@ -127,7 +127,23 @@
% If the call can fail, generate code to check for and handle the failure.
handle_call_failure(CodeModel, GoalInfo, FailHandlingCode, !CI),
- Code = tree_list([SetupCode, TraceCode, CallCode, FailHandlingCode]).
+ get_maybe_trace_info(!.CI, MaybeTraceInfo),
+ (
+ goal_info_has_feature(GoalInfo, feature_debug_tail_rec_call),
+ MaybeTraceInfo = yes(TraceInfo)
+ ->
+ generate_tailrec_event_code(TraceInfo, ArgsInfos, GoalPath, Context,
+ TraceTailRecResetAndEventCode, TailRecLabel, !CI),
+ JumpCode = node([
+ llds_instr(livevals(LiveVals), ""),
+ llds_instr(goto(code_label(TailRecLabel)),
+ "tail recursive jump")
+ ]),
+ Code = tree_list([SetupCode, TraceTailRecResetAndEventCode, JumpCode])
+ ;
+ Code = tree_list([SetupCode, TraceResetCode, CallCode,
+ FailHandlingCode])
+ ).
%---------------------------------------------------------------------------%
Index: compiler/code_info.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/code_info.m,v
retrieving revision 1.366
diff -u -b -r1.366 code_info.m
--- compiler/code_info.m 8 Sep 2008 03:39:03 -0000 1.366
+++ compiler/code_info.m 16 Nov 2008 01:03:32 -0000
@@ -640,11 +640,20 @@
eff_trace_level_is_none(ModuleInfo, PredInfo, ProcInfo, TraceLevel)
= no
->
- trace_setup(ModuleInfo, PredInfo, ProcInfo, Globals, TraceSlotInfo,
- TraceInfo, !CI),
+ proc_info_get_has_tail_call_events(ProcInfo, HasTailCallEvents),
+ (
+ HasTailCallEvents = tail_call_events,
+ get_next_label(TailRecLabel, !CI),
+ MaybeTailRecLabel = yes(TailRecLabel)
+ ;
+ HasTailCallEvents = no_tail_call_events,
+ MaybeTailRecLabel = no
+ ),
+ trace_setup(ModuleInfo, PredInfo, ProcInfo, Globals, MaybeTailRecLabel,
+ TraceSlotInfo, TraceInfo, !CI),
set_maybe_trace_info(yes(TraceInfo), !CI)
;
- TraceSlotInfo = trace_slot_info(no, no, no, no, no)
+ TraceSlotInfo = trace_slot_info(no, no, no, no, no, no)
).
%---------------------------------------------------------------------------%
Index: compiler/deep_profiling.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deep_profiling.m,v
retrieving revision 1.92
diff -u -b -r1.92 deep_profiling.m
--- compiler/deep_profiling.m 3 Nov 2008 03:08:01 -0000 1.92
+++ compiler/deep_profiling.m 15 Nov 2008 14:29:59 -0000
@@ -237,7 +237,8 @@
ClonePredProcId = proc(ClonePredId, CloneProcId),
GoalExpr = plain_call(ClonePredId, CloneProcId, Args,
Builtin, UnifyContext, SymName),
- goal_info_add_feature(feature_tailcall, GoalInfo0, GoalInfo),
+ goal_info_add_feature(feature_deep_tail_rec_call,
+ GoalInfo0, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo),
!:FoundTailCall = yes
;
@@ -392,7 +393,7 @@
;
GoalExpr = plain_call(_, _, _, BuiltinState, _, _),
Features = goal_info_get_features(GoalInfo),
- ( set.member(feature_tailcall, Features) ->
+ ( set.member(feature_deep_tail_rec_call, Features) ->
!:TailCallSites = [!.N | !.TailCallSites]
;
true
@@ -1142,7 +1143,7 @@
Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
ModuleInfo = !.DeepInfo ^ deep_module_info,
GoalFeatures = goal_info_get_features(GoalInfo0),
- goal_info_remove_feature(feature_tailcall, GoalInfo0, GoalInfo1),
+ goal_info_remove_feature(feature_deep_tail_rec_call, GoalInfo0, GoalInfo1),
make_impure(GoalInfo1, GoalInfo2),
goal_info_set_mdprof_inst(goal_is_mdprof_inst, GoalInfo2,
MdprofInstGoalInfo),
@@ -1172,7 +1173,7 @@
CallKind = classify_call(ModuleInfo, GoalExpr0),
(
CallKind = call_class_normal(PredProcId),
- ( set.member(feature_tailcall, GoalFeatures) ->
+ ( set.member(feature_deep_tail_rec_call, GoalFeatures) ->
generate_deep_det_call(ModuleInfo, "prepare_for_tail_call", 1,
[SiteNumVar], [], PrepareGoal)
;
@@ -1258,7 +1259,7 @@
!:DeepInfo = !.DeepInfo ^ deep_call_sites :=
(!.DeepInfo ^ deep_call_sites ++ [CallSite]),
(
- set.member(feature_tailcall, GoalFeatures),
+ set.member(feature_deep_tail_rec_call, GoalFeatures),
!.DeepInfo ^ deep_maybe_rec_info = yes(RecInfo),
RecInfo ^ role = outer_proc(_)
->
Index: compiler/deforest.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/deforest.m,v
retrieving revision 1.86
diff -u -b -r1.86 deforest.m
--- compiler/deforest.m 15 Oct 2008 04:06:02 -0000 1.86
+++ compiler/deforest.m 9 Nov 2008 01:32:56 -0000
@@ -1134,7 +1134,7 @@
->
% Create the new version.
- pd_info.define_new_pred(origin_created(deforestation),
+ pd_info.define_new_pred(origin_created(created_by_deforestation),
DeforestGoal, PredProcId, CallGoal, !PDInfo),
PredProcId = proc(PredId, _),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.326
diff -u -b -r1.326 handle_options.m
--- compiler/handle_options.m 8 Oct 2008 02:28:40 -0000 1.326
+++ compiler/handle_options.m 18 Nov 2008 15:13:48 -0000
@@ -219,8 +219,8 @@
Target = TargetPrime
;
Target = target_c, % dummy
+ % XXX When the x86_64 backend is documented modify the line below.
add_error("Invalid target option " ++
-% XXX When the x86_64 backend is documented modify the line below.
"(must be `c', `asm', `il', `java', or `erlang')", !Errors)
),
map.lookup(!.OptionTable, gc, GC_Method0),
@@ -1280,8 +1280,7 @@
% paths across optimization levels
% - enabling stack layouts
% - enabling typeinfo liveness
- globals.lookup_bool_option(!.Globals, trace_optimized,
- TraceOptimized),
+ globals.lookup_bool_option(!.Globals, trace_optimized, TraceOptimized),
( given_trace_level_is_none(TraceLevel) = no ->
(
TraceOptimized = no,
@@ -1369,9 +1368,18 @@
% To support up-level printing, we need to save variables across
% a call even if the call cannot succeed.
- globals.set_option(opt_no_return_calls, bool(no), !Globals)
+ globals.set_option(opt_no_return_calls, bool(no), !Globals),
+
+ % The declarative debugger does not (yet) know about tail calls.
+ ( trace_level_allows_tail_rec(TraceLevel) = no ->
+ globals.set_option(exec_trace_tail_rec, bool(no), !Globals)
;
true
+ )
+ ;
+ % Since there will be no call and exit events, there is no point
+ % in trying to turn them into tailcall events.
+ globals.set_option(exec_trace_tail_rec, bool(no), !Globals)
),
option_implies(profile_deep, procid_stack_layout, bool(yes), !Globals),
Index: compiler/hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds.m,v
retrieving revision 1.223
diff -u -b -r1.223 hlds.m
--- compiler/hlds.m 14 May 2007 10:58:18 -0000 1.223
+++ compiler/hlds.m 8 Nov 2008 14:02:51 -0000
@@ -50,6 +50,7 @@
:- include_module headvar_names.
:- include_module hlds_code_util.
:- include_module hlds_error_util.
+:- include_module mark_tail_calls.
:- include_module passes_aux.
%-----------------------------------------------------------------------------%
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.199
diff -u -b -r1.199 hlds_goal.m
--- compiler/hlds_goal.m 18 Sep 2008 12:41:54 -0000 1.199
+++ compiler/hlds_goal.m 15 Nov 2008 14:27:30 -0000
@@ -1302,9 +1302,13 @@
% used e.g. by the tabling transformation to preserve the set
% of events generated by a tabled procedure.
- ; feature_tailcall
- % This goal represents a tail call. This marker is used by
- % deep profiling.
+ ; feature_deep_tail_rec_call
+ % This goal represents a tail recursive call. This marker is used
+ % by deep profiling.
+
+ ; feature_debug_tail_rec_call
+ % This goal represents a tail recursive call. This marker is used
+ % by code generation for execution tracing.
; feature_keep_constant_binding
% This feature should only be attached to unsafe_cast goals
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.247
diff -u -b -r1.247 hlds_pred.m
--- compiler/hlds_pred.m 4 Sep 2008 10:49:57 -0000 1.247
+++ compiler/hlds_pred.m 14 Nov 2008 03:48:51 -0000
@@ -304,121 +304,115 @@
:- type pred_markers.
:- type marker
- ---> marker_stub % The predicate has no clauses. typecheck.m will
- % generate a body for the predicate which just throws
- % an exception. This marker is used to tell purity
- % analysis and determinism analysis not to issue
- % warnings for these predicates.
+ ---> marker_stub
+ % The predicate has no clauses. typecheck.m will generate a body
+ % for the predicate which just throws an exception. This marker
+ % is used to tell purity analysis and determinism analysis
+ % not to issue warnings for these predicates.
; marker_infer_type
- % Requests type inference for the predicate.
- % These markers are inserted by make_hlds
- % for undeclared predicates.
+ % Requests type inference for the predicate. These markers are
+ % inserted by make_hlds for undeclared predicates.
; marker_infer_modes
- % Requests mode inference for the predicate.
- % These markers are inserted by make_hlds
- % for undeclared predicates.
+ % Requests mode inference for the predicate. These markers are
+ % inserted by make_hlds for undeclared predicates.
; marker_obsolete
% Requests warnings if this predicate is used.
% Used for pragma(obsolete).
; marker_user_marked_inline
- % The user requests that this be predicate should
- % be inlined, even if it exceeds the usual size limits.
- % Used for pragma(inline).
- % Mutually exclusive with marker_user_marked_no_inline.
+ % The user requests that this be predicate should be inlined,
+ % even if it exceeds the usual size limits. Used for
+ % pragma(inline). Mutually exclusive with
+ % marker_user_marked_no_inline.
; marker_user_marked_no_inline
- % The user requests that this be predicate should
- % not be inlined. Used for pragma(no_inline).
- % Mutually exclusive with marker_user_marked_inline.
+ % The user requests that this be predicate should not be inlined.
+ % Used for pragma(no_inline). Mutually exclusive with
+ % marker_user_marked_inline.
; marker_heuristic_inline
- % The compiler (meaning probably inlining.m) requests
- % that this predicate be inlined. Does not override
+ % The compiler (meaning probably inlining.m) requests that this
+ % predicate be inlined. Does not override
% marker_user_marked_no_inline.
; marker_class_method
- % Requests that this predicate be transformed into
- % the appropriate call to a class method.
+ % Requests that this predicate be transformed into the appropriate
+ % call to a class method.
; marker_class_instance_method
- % This predicate was automatically generated for the
- % implementation of a class method for an instance.
+ % This predicate was automatically generated for the implementation
+ % of a class method for an instance.
; marker_named_class_instance_method
- % This predicate was automatically generated for the
- % implementation of a class method for an instance,
- % and the instance was defined using the named syntax
- % (e.g. "pred(...) is ...") rather than the clause
- % syntax. (For such predicates, we output slightly
+ % This predicate was automatically generated for the implementation
+ % of a class method for an instance, and the instance was defined
+ % using the named syntax (e.g. "pred(...) is ...") rather than
+ % the clause syntax. (For such predicates, we output slightly
% different error messages.)
; marker_is_impure
- % Requests that no transformation that would be
- % inappropriate for impure code be performed on calls
- % to this predicate. This includes reordering calls
- % to it relative to other goals (in both conjunctions
- % and disjunctions), and removing redundant calls
- % to it.
+ % Requests that no transformation that would be inappropriate for
+ % impure code be performed on calls to this predicate. This
+ % includes reordering calls to it relative to other goals
+ % (in both conjunctions and disjunctions), and removing
+ % redundant calls to it.
; marker_is_semipure
- % Requests that no transformation that would be
- % inappropriate for semipure code be performed on
- % calls to this predicate. This includes removing
- % redundant calls to it on different sides of an
- % impure goal.
+ % Requests that no transformation that would be inappropriate
+ % for semipure code be performed on calls to this predicate.
+ % This includes removing redundant calls to it on different sides
+ % of an impure goal.
; marker_promised_pure
- % Requests that calls to this predicate be transformed
- % as usual, despite any impure or semipure markers
- % present.
+ % Requests that calls to this predicate be transformed as usual,
+ % despite any impure or semipure markers present.
; marker_promised_semipure
- % Requests that calls to this predicate be treated as
- % semipure, despite any impure calls in the body.
+ % Requests that calls to this predicate be treated as semipure,
+ % despite any impure calls in the body.
; marker_promised_equivalent_clauses
- % Promises that all modes of the predicate have
- % equivalent semantics, event if they are defined by
- % different sets of mode-specific clauses.
+ % Promises that all modes of the predicate have equivalent
+ % semantics, event if they are defined by different sets of
+ % mode-specific clauses.
% The terminates and does_not_terminate pragmas are kept as markers
% to ensure that conflicting declarations are not made by the user.
% Otherwise, the information could be added to the ProcInfos directly.
; marker_terminates
- % The user guarantees that this predicate will
- % terminate for all (finite?) input.
+ % The user guarantees that this predicate will terminate
+ % for all (finite?) input.
+
; marker_does_not_terminate
- % States that this predicate does not terminate.
- % This is useful for pragma foreign_code, which the
- % compiler assumes to be terminating.
+ % States that this predicate does not terminate. This is useful
+ % for pragma foreign_code, which the compiler assumes to be
+ % terminating.
+
; marker_check_termination
- % The user requires the compiler to guarantee
- % the termination of this predicate. If the compiler
- % cannot guarantee termination then it must give an
- % error message.
+ % The user requires the compiler to guarantee the termination
+ % of this predicate. If the compiler cannot guarantee termination
+ % then it must give an error message.
; marker_calls_are_fully_qualified
- % All calls in this predicate are fully qualified.
- % This occurs for predicates read from `.opt' files
- % and compiler-generated predicates.
+ % All calls in this predicate are fully qualified. This occurs for
+ % predicates read from `.opt' files and compiler-generated
+ % predicates.
+
; marker_mode_check_clauses
- % Each clause of the predicate should be modechecked
- % separately. Used for predicates defined by lots of
- % clauses (usually facts) for which the compiler's
- % quadratic behavior during mode checking (in
- % inst_match.bound_inst_list_contains_instname and
+ % Each clause of the predicate should be modechecked separately.
+ % Used for predicates defined by lots of clauses (usually facts)
+ % for which the compiler's quadratic behavior during mode checking
+ % (in inst_match.bound_inst_list_contains_instname and
% instmap.merge) would be unacceptable.
; marker_mutable_access_pred.
- % This predicate is part of the machinery used to
- % access mutables. This marker is used to inform
- % inlining that we should _always_ attempt to
- % inline this predicate across module boundaries.
+ % This predicate is part of the machinery used to access mutables.
+ % This marker is used to inform inlining that we should _always_
+ % attempt to inline this predicate across module boundaries.
% An abstract set of attributes.
:- type pred_attributes.
@@ -477,10 +471,10 @@
; transform_structure_reuse.
:- type pred_creation
- ---> deforestation
+ ---> created_by_deforestation
% I/O tabling will create a new predicate if the predicate
% to be I/O tabled must not be inlined.
- ; io_tabling.
+ ; created_by_io_tabling.
:- type pred_origin
---> origin_special_pred(special_pred)
@@ -1906,6 +1900,10 @@
list(prog_var)::in, hlds_goal::in, rtti_varmaps::in,
proc_info::in, proc_info::out) is det.
+:- type tail_call_events
+ ---> tail_call_events
+ ; no_tail_call_events.
+
% Predicates to get fields of proc_infos.
:- pred proc_info_get_context(proc_info::in, prog_context::out) is det.
@@ -1939,6 +1937,8 @@
:- pred proc_info_get_need_maxfr_slot(proc_info::in, bool::out) is det.
:- pred proc_info_get_has_user_event(proc_info::in, bool::out) is det.
:- pred proc_info_get_has_parallel_conj(proc_info::in, bool::out) is det.
+:- pred proc_info_get_has_tail_call_events(proc_info::in,
+ tail_call_events::out) is det.
:- pred proc_info_get_call_table_tip(proc_info::in,
maybe(prog_var)::out) is det.
:- pred proc_info_get_maybe_proc_table_io_info(proc_info::in,
@@ -1998,6 +1998,8 @@
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_has_parallel_conj(bool::in,
proc_info::in, proc_info::out) is det.
+:- pred proc_info_set_has_tail_call_events(tail_call_events::in,
+ proc_info::in, proc_info::out) is det.
:- pred proc_info_set_call_table_tip(maybe(prog_var)::in,
proc_info::in, proc_info::out) is det.
:- pred proc_info_set_maybe_proc_table_io_info(maybe(proc_table_io_info)::in,
@@ -2287,6 +2289,8 @@
% may be a conservative approximation.
proc_has_parallel_conj :: bool,
+ proc_has_tail_call_events :: tail_call_events,
+
% If the procedure's evaluation method is memo, loopcheck or
% minimal, this slot identifies the variable that holds the tip
% of the call table. Otherwise, this field will be set to `no'.
@@ -2466,8 +2470,8 @@
SharingInfo = structure_sharing_info_init,
ReuseInfo = structure_reuse_info_init,
ProcSubInfo = proc_sub_info(no, no, Term2Info, IsAddressTaken, StackSlots,
- ArgInfo, InitialLiveness, no, no, no, no, no, no, no, no, no,
- VarNameRemap, SharingInfo, ReuseInfo),
+ ArgInfo, InitialLiveness, no, no, no, no_tail_call_events,
+ no, no, no, no, no, no, VarNameRemap, SharingInfo, ReuseInfo),
ProcInfo = proc_info(MContext, BodyVarSet, BodyTypes, HeadVars, InstVarSet,
DeclaredModes, Modes, no, MaybeArgLives, MaybeDet, InferredDet,
ClauseBody, CanProcess, ModeErrors, RttiVarMaps, eval_normal,
@@ -2497,8 +2501,8 @@
SharingInfo = structure_sharing_info_init,
ReuseInfo = structure_reuse_info_init,
ProcSubInfo = proc_sub_info(no, no, Term2Info, IsAddressTaken,
- StackSlots, no, Liveness, no, no, no, no, no, no, no, no, no,
- VarNameRemap, SharingInfo, ReuseInfo),
+ StackSlots, no, Liveness, no, no, no, no_tail_call_events,
+ no, no, no, no, no, no, VarNameRemap, SharingInfo, ReuseInfo),
ProcInfo = proc_info(Context, VarSet, VarTypes, HeadVars,
InstVarSet, no, HeadModes, no, MaybeHeadLives,
MaybeDeclaredDetism, Detism, Goal, yes, ModeErrors,
@@ -2536,6 +2540,8 @@
proc_info_get_has_user_event(PI, PI ^ proc_sub_info ^ proc_has_user_event).
proc_info_get_has_parallel_conj(PI,
PI ^ proc_sub_info ^ proc_has_parallel_conj).
+proc_info_get_has_tail_call_events(PI,
+ PI ^ proc_sub_info ^ proc_has_tail_call_events).
proc_info_get_call_table_tip(PI, PI ^ proc_sub_info ^ call_table_tip).
proc_info_get_maybe_proc_table_io_info(PI,
PI ^ proc_sub_info ^ maybe_table_io_info).
@@ -2576,6 +2582,8 @@
PI ^ proc_sub_info ^ proc_has_user_event := HUE).
proc_info_set_has_parallel_conj(HPC, PI,
PI ^ proc_sub_info ^ proc_has_parallel_conj := HPC).
+proc_info_set_has_tail_call_events(HPC, PI,
+ PI ^ proc_sub_info ^ proc_has_tail_call_events := HPC).
proc_info_set_call_table_tip(CTT, PI,
PI ^ proc_sub_info ^ call_table_tip := CTT).
proc_info_set_maybe_proc_table_io_info(MTI, PI,
Index: compiler/layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout.m,v
retrieving revision 1.39
diff -u -b -r1.39 layout.m
--- compiler/layout.m 4 Sep 2008 10:49:58 -0000 1.39
+++ compiler/layout.m 15 Nov 2008 12:52:32 -0000
@@ -206,6 +206,7 @@
maybe_maxfr_slot :: maybe(int),
eval_method :: eval_method,
maybe_call_table_slot :: maybe(int),
+ maybe_tail_rec_slot :: maybe(int),
eff_trace_level :: trace_level,
exec_trace_flags :: int
).
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.99
diff -u -b -r1.99 layout_out.m
--- compiler/layout_out.m 4 Sep 2008 10:49:58 -0000 1.99
+++ compiler/layout_out.m 18 Nov 2008 12:45:04 -0000
@@ -890,6 +890,7 @@
trace_port_to_string(port_switch) = "SWITCH".
trace_port_to_string(port_nondet_foreign_proc_first) = "FOREIGN_PROC_FIRST".
trace_port_to_string(port_nondet_foreign_proc_later) = "FOREIGN_PROC_LATER".
+trace_port_to_string(port_tailrec_call) = "TAILREC_CALL".
trace_port_to_string(port_user) = "USER".
%-----------------------------------------------------------------------------%
@@ -1092,7 +1093,7 @@
EventDataAddrs, MaybeTableInfo, _HeadVarNums, _VarNames, _MaxVarNum,
_MaxRegNum, _MaybeFromFullSlot, _MaybeIoSeqSlot,
_MaybeTrailSlot, _MaybeMaxfrSlot, _EvalMethod,
- _MaybeCallTableSlot, _EffTraceLevel, _Flags),
+ _MaybeCallTableSlot, _MaybeTailRecSlot, _EffTraceLevel, _Flags),
ProcLabel = make_proc_label_from_rtti(RttiProcLabel),
ModuleName = get_defining_module_name(ProcLabel),
output_label_layout_addrs_in_vector(EventDataAddrs, "MR_DECL_LABEL_LAYOUT",
@@ -1166,7 +1167,8 @@
ExecTrace = proc_layout_exec_trace(MaybeCallLabelDetails,
EventDataAddrs, MaybeTableInfo, HeadVarNums, _VarNames, MaxVarNum,
MaxRegNum, MaybeFromFullSlot, MaybeIoSeqSlot, MaybeTrailSlot,
- MaybeMaxfrSlot, EvalMethod, MaybeCallTableSlot, EffTraceLevel, Flags),
+ MaybeMaxfrSlot, EvalMethod, MaybeCallTableSlot, MaybeTailRecSlot,
+ EffTraceLevel, Flags),
(
EventDataAddrs = []
@@ -1246,6 +1248,8 @@
io.write_string(trace_level_rep(EffTraceLevel), !IO),
io.write_string(",\n", !IO),
io.write_int(Flags, !IO),
+ io.write_string(",\n", !IO),
+ write_maybe_slot_num(MaybeTailRecSlot, !IO),
io.write_string("\n};\n", !IO).
:- pred write_maybe_slot_num(maybe(int)::in, io::di, io::uo) is det.
Index: compiler/mark_tail_calls.m
===================================================================
RCS file: compiler/mark_tail_calls.m
diff -N compiler/mark_tail_calls.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/mark_tail_calls.m 19 Nov 2008 03:47:47 -0000
@@ -0,0 +1,307 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001-2008 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: mark_tail_calls.m.
+% Main author: zs.
+%
+% This module adds feature_tailcall to all self-recursive calls that can be
+% implemented as tail calls.
+%
+% Since an assignment unification that simply renames an output of a recursive
+% call may prevent that call from being recognized as a tail call, you probably
+% want to run excess assign elimination just before invoking this module.
+%
+%-----------------------------------------------------------------------------%
+
+:- module hlds.mark_tail_calls.
+:- interface.
+
+:- import_module hlds.hlds_goal.
+:- import_module hlds.hlds_module.
+:- import_module hlds.hlds_pred.
+
+:- pred mark_tail_calls(goal_feature::in, pred_id::in, proc_id::in,
+ module_info::in, pred_info::in, proc_info::in, proc_info::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds.mode_util.
+:- import_module libs.compiler_util.
+:- import_module parse_tree.prog_data.
+
+:- import_module list.
+:- import_module maybe.
+:- import_module require.
+
+:- type found_tail_calls
+ ---> found_tail_calls
+ ; not_found_tail_calls.
+
+mark_tail_calls(Feature, PredId, ProcId, ModuleInfo, PredInfo, !ProcInfo) :-
+ pred_info_get_arg_types(PredInfo, Types),
+ proc_info_get_goal(!.ProcInfo, Goal0),
+ proc_info_interface_determinism(!.ProcInfo, Detism),
+ determinism_components(Detism, _CanFail, SolnCount),
+ (
+ % In at_most_many procedures, we cannot in general know at compile time
+ % whether we can delete the current stack frame at a tail call.
+ % For at_most_zero procedures, there is no point in handling tail calls
+ % specially.
+ ( SolnCount = at_most_many
+ ; SolnCount = at_most_zero
+ )
+ ;
+ ( SolnCount = at_most_one
+ ; SolnCount = at_most_many_cc
+ ),
+ proc_info_get_argmodes(!.ProcInfo, Modes),
+ proc_info_get_headvars(!.ProcInfo, HeadVars),
+ find_maybe_output_args(ModuleInfo, Types, Modes, HeadVars, Outputs),
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs, _,
+ Goal0, Goal, not_found_tail_calls, FoundTailCalls),
+ proc_info_set_goal(Goal, !ProcInfo),
+ (
+ FoundTailCalls = found_tail_calls,
+ TailCallEvents = tail_call_events
+ ;
+ FoundTailCalls = not_found_tail_calls,
+ TailCallEvents = no_tail_call_events
+ ),
+ proc_info_set_has_tail_call_events(TailCallEvents, !ProcInfo)
+ ).
+
+:- pred find_maybe_output_args(module_info::in,
+ list(mer_type)::in, list(mer_mode)::in, list(prog_var)::in,
+ list(maybe(prog_var))::out) is det.
+
+find_maybe_output_args(ModuleInfo, Types, Modes, Vars, Outputs) :-
+ ( find_maybe_output_args_2(ModuleInfo, Types, Modes, Vars, OutputsPrime) ->
+ Outputs = OutputsPrime
+ ;
+ unexpected(this_file, "find_maybe_output_args: list length mismatch")
+ ).
+
+:- pred find_maybe_output_args_2(module_info::in,
+ list(mer_type)::in, list(mer_mode)::in, list(prog_var)::in,
+ list(maybe(prog_var))::out) is semidet.
+
+find_maybe_output_args_2(_, [], [], [], []).
+find_maybe_output_args_2(ModuleInfo, [Type | Types], [Mode | Modes],
+ [Var | Vars], [OutputVar | OutputVars]) :-
+ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+ (
+ ( ArgMode = top_in
+ ; ArgMode = top_unused
+ ),
+ OutputVar = no
+ ;
+ ArgMode = top_out,
+ OutputVar = yes(Var)
+ ),
+ find_maybe_output_args_2(ModuleInfo, Types, Modes, Vars, OutputVars).
+
+%-----------------------------------------------------------------------------%
+
+ % mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, MaybeOutputs,
+ % Goal0, Goal, !FoundTailCalls):
+ %
+ % This predicate transforms Goal0 into Goal by marking all tail calls
+ % in it with Feature. Tailcalls are calls to the given PredId and ProcId
+ % in which the variables of the argument list match the corresponding
+ % variables in the elements of the Outputs list that actually contain
+ % a variable.
+ %
+ % If Goal0 neither is a tailcall nor contains a tailcall, but could
+ % actually follow a tailcall (which is possible if it is either an
+ % assignment unification that simply renames an output variable,
+ % or a conjunction of such unifications), then return MaybeOutputs
+ % as copy of Outputs0 updated to account for the renaming. Otherwise,
+ % return 'no' for MaybeOutputs.
+ %
+:- pred mark_tail_calls_in_goal(goal_feature::in, pred_id::in, proc_id::in,
+ list(maybe(prog_var))::in, maybe(list(maybe(prog_var)))::out,
+ hlds_goal::in, hlds_goal::out, found_tail_calls::in, found_tail_calls::out)
+ is det.
+
+mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, MaybeOutputs,
+ Goal0, Goal, !FoundTailCalls) :-
+ Goal0 = hlds_goal(GoalExpr0, GoalInfo0),
+ (
+ ( GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
+ ; GoalExpr0 = generic_call(_, _, _, _)
+ ; GoalExpr0 = scope(_, _)
+ ; GoalExpr0 = negation(_)
+ ),
+ MaybeOutputs = no,
+ Goal = Goal0
+ ;
+ GoalExpr0 = unify(_, _, _, Unify0, _),
+ Goal = Goal0,
+ (
+ ( Unify0 = construct(_, _, _, _, _, __, _)
+ ; Unify0 = deconstruct(_, _, _, _, __, _)
+ ; Unify0 = simple_test(_, _)
+ ; Unify0 = complicated_unify(_, _, _)
+ ),
+ MaybeOutputs = no
+ ;
+ Unify0 = assign(ToVar, FromVar),
+ ( is_output_arg_rename(ToVar, FromVar, Outputs0, Outputs) ->
+ MaybeOutputs = yes(Outputs)
+ ;
+ MaybeOutputs = no
+ )
+ )
+ ;
+ GoalExpr0 = plain_call(CallPredId, CallProcId, Args, Builtin,
+ _UnifyContext, _SymName),
+ MaybeOutputs = no,
+ (
+ CallPredId = PredId,
+ CallProcId = ProcId,
+ match_output_args(Outputs0, Args),
+ Builtin = not_builtin
+ ->
+ goal_info_add_feature(Feature, GoalInfo0, GoalInfo),
+ Goal = hlds_goal(GoalExpr0, GoalInfo),
+ !:FoundTailCalls = found_tail_calls
+ ;
+ Goal = Goal0
+ )
+ ;
+ GoalExpr0 = conj(ConjType, Goals0),
+ (
+ ConjType = plain_conj,
+ list.reverse(Goals0, RevGoals0),
+ mark_tail_calls_in_conj(Feature, PredId, ProcId,
+ Outputs0, MaybeOutputs, RevGoals0, RevGoals, !FoundTailCalls),
+ list.reverse(RevGoals, Goals),
+ GoalExpr = conj(ConjType, Goals),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ ConjType = parallel_conj,
+ MaybeOutputs = no,
+ Goal = Goal0
+ )
+ ;
+ GoalExpr0 = disj(Goals0),
+ mark_tail_calls_in_goals(Feature, PredId, ProcId, Outputs0,
+ Goals0, Goals, !FoundTailCalls),
+ MaybeOutputs = no,
+ GoalExpr = disj(Goals),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0),
+ mark_tail_calls_in_cases(Feature, PredId, ProcId, Outputs0,
+ Cases0, Cases, !FoundTailCalls),
+ MaybeOutputs = no,
+ GoalExpr = switch(Var, CanFail, Cases),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0),
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, _,
+ Then0, Then, !FoundTailCalls),
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, _,
+ Else0, Else, !FoundTailCalls),
+ MaybeOutputs = no,
+ GoalExpr = if_then_else(Vars, Cond, Then, Else),
+ Goal = hlds_goal(GoalExpr, GoalInfo0)
+ ;
+ GoalExpr0 = shorthand(_),
+ unexpected(this_file, "mark_tail_calls_in_goal: shorthand")
+ ).
+
+:- pred is_output_arg_rename(prog_var::in, prog_var::in,
+ list(maybe(prog_var))::in, list(maybe(prog_var))::out) is semidet.
+
+is_output_arg_rename(ToVar, FromVar,
+ [MaybeVar0 | MaybeVars0], [MaybeVar | MaybeVars]) :-
+ (
+ MaybeVar0 = yes(ToVar),
+ MaybeVar = yes(FromVar),
+ MaybeVars = MaybeVars0
+ ;
+ MaybeVar0 = no,
+ MaybeVar = MaybeVar0,
+ is_output_arg_rename(ToVar, FromVar, MaybeVars0, MaybeVars)
+ ).
+
+:- pred mark_tail_calls_in_goals(goal_feature::in, pred_id::in, proc_id::in,
+ list(maybe(prog_var))::in, list(hlds_goal)::in, list(hlds_goal)::out,
+ found_tail_calls::in, found_tail_calls::out) is det.
+
+mark_tail_calls_in_goals(_Feature, _PredId, _ProcId, _Outputs0,
+ [], [], !FoundTailCalls).
+mark_tail_calls_in_goals(Feature, PredId, ProcId, Outputs0,
+ [Goal0 | Goals0], [Goal | Goals], !FoundTailCalls) :-
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, _, Goal0, Goal,
+ !FoundTailCalls),
+ mark_tail_calls_in_goals(Feature, PredId, ProcId, Outputs0, Goals0, Goals,
+ !FoundTailCalls).
+
+:- pred mark_tail_calls_in_cases(goal_feature::in, pred_id::in, proc_id::in,
+ list(maybe(prog_var))::in, list(case)::in, list(case)::out,
+ found_tail_calls::in, found_tail_calls::out) is det.
+
+mark_tail_calls_in_cases(_Feature, _PredId, _ProcId, _Outputs0,
+ [], [], !FoundTailCalls).
+mark_tail_calls_in_cases(Feature, PredId, ProcId, Outputs0,
+ [Case0 | Cases0], [Case | Cases], !FoundTailCalls) :-
+ Case0 = case(MainConsId, OtherConsIds, Goal0),
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, _, Goal0, Goal,
+ !FoundTailCalls),
+ Case = case(MainConsId, OtherConsIds, Goal),
+ mark_tail_calls_in_cases(Feature, PredId, ProcId, Outputs0, Cases0, Cases,
+ !FoundTailCalls).
+
+:- pred mark_tail_calls_in_conj(goal_feature::in, pred_id::in, proc_id::in,
+ list(maybe(prog_var))::in, maybe(list(maybe(prog_var)))::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ found_tail_calls::in, found_tail_calls::out) is det.
+
+mark_tail_calls_in_conj(_Feature, _PredId, _ProcId, Outputs0, yes(Outputs0),
+ [], [], !FoundTailCalls).
+mark_tail_calls_in_conj(Feature, PredId, ProcId, Outputs0, MaybeOutputs,
+ [RevGoal0 | RevGoals0], [RevGoal | RevGoals], !FoundTailCalls) :-
+ mark_tail_calls_in_goal(Feature, PredId, ProcId, Outputs0, MaybeOutputs1,
+ RevGoal0, RevGoal, !FoundTailCalls),
+ (
+ MaybeOutputs1 = yes(Outputs1),
+ mark_tail_calls_in_conj(Feature, PredId, ProcId,
+ Outputs1, MaybeOutputs, RevGoals0, RevGoals, !FoundTailCalls)
+ ;
+ MaybeOutputs1 = no,
+ MaybeOutputs = no,
+ RevGoals = RevGoals0
+ ).
+
+:- pred match_output_args(list(maybe(prog_var))::in, list(prog_var)::in)
+ is semidet.
+
+match_output_args([], []).
+match_output_args([], [_ | _]) :-
+ unexpected(this_file, "match_output_args: length mismatch").
+match_output_args([_ | _], []) :-
+ unexpected(this_file, "match_output_args: length mismatch").
+match_output_args([MaybeOutputVar | MaybeOutputVars], [ArgVar | ArgVars]) :-
+ (
+ MaybeOutputVar = no
+ ;
+ MaybeOutputVar = yes(ArgVar)
+ ),
+ match_output_args(MaybeOutputVars, ArgVars).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "mark_tail_calls.m".
+
+%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.482
diff -u -b -r1.482 mercury_compile.m
--- compiler/mercury_compile.m 15 Oct 2008 04:06:03 -0000 1.482
+++ compiler/mercury_compile.m 15 Nov 2008 14:47:04 -0000
@@ -68,6 +68,7 @@
% High-level HLDS transformations.
:- import_module check_hlds.check_typeclass.
+:- import_module hlds.mark_tail_calls.
:- import_module transform_hlds.intermod.
:- import_module transform_hlds.trans_opt.
:- import_module transform_hlds.equiv_type_hlds.
@@ -164,6 +165,7 @@
:- import_module check_hlds.unused_imports.
:- import_module check_hlds.xml_documentation.
:- import_module hlds.arg_info.
+:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_pred.
@@ -2865,6 +2867,9 @@
compute_liveness(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 330, "liveness", !DumpInfo, !IO),
+ maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !IO),
+ maybe_dump_hlds(!.HLDS, 332, "mark_debug_tailrec_calls", !DumpInfo, !IO),
+
compute_stack_vars(Verbose, Stats, !HLDS, !IO),
maybe_dump_hlds(!.HLDS, 335, "stackvars", !DumpInfo, !IO),
@@ -3050,6 +3055,17 @@
write_proc_progress_message("% Computing liveness in ", PredId, ProcId,
!.HLDS, !IO),
detect_liveness_proc(PredId, ProcId, !.HLDS, !ProcInfo, !IO),
+ globals.lookup_bool_option(Globals, exec_trace_tail_rec, ExecTraceTailRec),
+ (
+ ExecTraceTailRec = yes,
+ write_proc_progress_message(
+ "% Marking directly tail recursive calls in ", PredId, ProcId,
+ !.HLDS, !IO),
+ mark_tail_calls(feature_debug_tail_rec_call, PredId, ProcId,
+ !.HLDS, PredInfo, !ProcInfo)
+ ;
+ ExecTraceTailRec = no
+ ),
write_proc_progress_message("% Allocating stack slots in ", PredId,
ProcId, !.HLDS, !IO),
allocate_stack_slots_in_proc(PredId, ProcId, !.HLDS, !ProcInfo, !IO),
@@ -3067,7 +3083,7 @@
),
write_proc_progress_message("% Generating low-level (LLDS) code for ",
PredId, ProcId, !.HLDS, !IO),
- generate_proc_code(PredInfo, !.ProcInfo, ProcId, PredId, !.HLDS,
+ generate_proc_code(PredInfo, !.ProcInfo, PredId, ProcId, !.HLDS,
!GlobalData, ProcCode0),
globals.lookup_bool_option(Globals, optimize, Optimize),
(
@@ -4568,6 +4584,27 @@
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO).
+:- pred maybe_mark_tail_rec_calls(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+maybe_mark_tail_rec_calls(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_globals(!.HLDS, Globals),
+ globals.lookup_bool_option(Globals, exec_trace_tail_rec, ExecTraceTailRec),
+ (
+ ExecTraceTailRec = yes,
+ maybe_write_string(Verbose,
+ "% Marking directly tail recursive calls...", !IO),
+ maybe_flush_output(Verbose, !IO),
+ process_all_nonimported_procs(
+ update_proc_predprocid(
+ mark_tail_calls(feature_debug_tail_rec_call)),
+ !HLDS, !IO),
+ maybe_write_string(Verbose, " done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ;
+ ExecTraceTailRec = no
+ ).
+
:- pred compute_stack_vars(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.638
diff -u -b -r1.638 options.m
--- compiler/options.m 30 Oct 2008 06:42:28 -0000 1.638
+++ compiler/options.m 19 Nov 2008 03:51:10 -0000
@@ -207,13 +207,14 @@
; trace_table_io_all
; trace_goal_flags
; prof_optimized
- ; delay_death
+ ; exec_trace_tail_rec
; suppress_trace
; force_disable_tracing
% Force no tracing, even in .debug grades. This is used to turn off
% tracing in the browser directory while still allowing the browser
% library to be linked in with an executable compiled in a .debug
% grade.
+ ; delay_death
; stack_trace_higher_order
; force_disable_ssdebug
@@ -1096,6 +1097,7 @@
trace_table_io_all - bool(no),
trace_goal_flags - accumulating([]),
prof_optimized - bool(no),
+ exec_trace_tail_rec - bool(no),
suppress_trace - string(""),
force_disable_tracing - bool(no),
delay_death - bool(yes),
@@ -1920,6 +1922,7 @@
long_option("trace-flag", trace_goal_flags).
long_option("profile-optimised", prof_optimized).
long_option("profile-optimized", prof_optimized).
+long_option("exec-trace-tail-rec", exec_trace_tail_rec).
long_option("suppress-trace", suppress_trace).
long_option("force-disable-tracing", force_disable_tracing).
long_option("delay-death", delay_death).
@@ -3512,6 +3515,12 @@
"\tof execution tracing.",
"\tSee the Debugging chapter of the Mercury User's Guide",
"\tfor details.",
+ "--exec-trace-tail-rec",
+ "\tGenerate TAIL events for self-tail-recursive calls instead of",
+ "\tEXIT events. This allows these recursive calls to reuse",
+ "\ttheir parent call's stack frame, but it also means that",
+ "\tthe debugger won't have access to the contents of the reused",
+ "\tstack frames",
% "--suppress-trace <suppress-items>,",
% "\tSuppress the named aspects of the execution tracing system.",
% This is a developer-only option:
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.90
diff -u -b -r1.90 passes_aux.m
--- compiler/passes_aux.m 21 Jul 2008 03:10:12 -0000 1.90
+++ compiler/passes_aux.m 14 Nov 2008 03:38:13 -0000
@@ -35,7 +35,7 @@
; update_proc_predid(pred(pred_id, module_info, proc_info,
proc_info))
; update_proc_predprocid(pred(pred_id, proc_id, module_info,
- proc_info, proc_info))
+ pred_info, proc_info, proc_info))
; update_proc_io(pred(pred_id, proc_id, module_info,
proc_info, proc_info, io, io))
; update_proc_error(pred(pred_id, proc_id, module_info, module_info,
@@ -77,7 +77,7 @@
:- inst task ==
bound(( update_proc(pred(in, in, out) is det)
; update_proc_predid(pred(in, in, in, out) is det)
- ; update_proc_predprocid(pred(in, in, in, in, out) is det)
+ ; update_proc_predprocid(pred(in, in, in, in, in, out) is det)
; update_proc_io(pred(in, in, in, in, out, di, uo) is det)
; update_proc_error(pred(in, in, in, out, in, out, out, out, di, uo)
is det)
@@ -293,7 +293,7 @@
Closure(PredId, !.ModuleInfo, Proc0, Proc)
;
!.Task = update_proc_predprocid(Closure),
- Closure(PredId, ProcId, !.ModuleInfo, Proc0, Proc)
+ Closure(PredId, ProcId, !.ModuleInfo, Pred0, Proc0, Proc)
;
!.Task = update_proc_io(Closure),
Closure(PredId, ProcId, !.ModuleInfo, Proc0, Proc, !IO)
Index: compiler/proc_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/proc_gen.m,v
retrieving revision 1.28
diff -u -b -r1.28 proc_gen.m
--- compiler/proc_gen.m 4 Sep 2008 10:49:58 -0000 1.28
+++ compiler/proc_gen.m 19 Nov 2008 03:52:22 -0000
@@ -52,7 +52,7 @@
% that records information about layout structures.
%
:- pred generate_proc_code(pred_info::in, proc_info::in,
- proc_id::in, pred_id::in, module_info::in,
+ pred_id::in, proc_id::in, module_info::in,
global_data::in, global_data::out, c_procedure::out) is det.
% Return the message that identifies the procedure to pass to
@@ -273,7 +273,7 @@
!GlobalData, !Procs) :-
pred_info_get_procedures(PredInfo, ProcInfos),
map.lookup(ProcInfos, ProcId, ProcInfo),
- generate_proc_code(PredInfo, ProcInfo, ProcId, PredId, ModuleInfo0,
+ generate_proc_code(PredInfo, ProcInfo, PredId, ProcId, ModuleInfo0,
!GlobalData, Proc),
!:Procs = [Proc | !.Procs],
generate_proc_list_code(ProcIds, PredId, PredInfo, ModuleInfo0,
@@ -298,7 +298,7 @@
%---------------------------------------------------------------------------%
-generate_proc_code(PredInfo, ProcInfo0, ProcId, PredId, ModuleInfo0,
+generate_proc_code(PredInfo, ProcInfo0, PredId, ProcId, ModuleInfo0,
!GlobalData, Proc) :-
% The modified module_info and proc_info are both discarded
% on return from generate_proc_code.
@@ -640,18 +640,30 @@
(
MaybeTraceInfo = yes(TraceInfo),
generate_call_event(TraceInfo, ProcContext, MaybeTraceCallLabel,
- TraceCallCode, !CI)
+ TraceCallCode, !CI),
+ get_trace_maybe_tail_rec_info(TraceInfo, MaybeTailRecInfo),
+ (
+ MaybeTailRecInfo = yes(_TailRecLval - TailRecLabel),
+ TailRecLabelCode = node([
+ llds_instr(label(TailRecLabel), "tail recursion label")
+ ])
+ ;
+ MaybeTailRecInfo = no,
+ TailRecLabelCode = empty
+ )
;
MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
- TraceCallCode = empty
+ TraceCallCode = empty,
+ TailRecLabelCode = empty
),
generate_goal(model_det, Goal, BodyCode, !CI),
generate_entry(!.CI, model_det, Goal, ResumePoint, FrameInfo,
EntryCode),
generate_exit(model_det, FrameInfo, TraceSlotInfo, ProcContext,
_, ExitCode, !CI),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode])
+ Code = tree_list([EntryCode, TraceCallCode, TailRecLabelCode,
+ BodyCode, ExitCode])
).
generate_category_code(model_semi, ProcContext, Goal, ResumePoint,
@@ -667,6 +679,16 @@
MaybeTraceInfo = yes(TraceInfo),
generate_call_event(TraceInfo, ProcContext, MaybeTraceCallLabel,
TraceCallCode, !CI),
+ get_trace_maybe_tail_rec_info(TraceInfo, MaybeTailRecInfo),
+ (
+ MaybeTailRecInfo = yes(_TailRecLval - TailRecLabel),
+ TailRecLabelCode = node([
+ llds_instr(label(TailRecLabel), "tail recursion label")
+ ])
+ ;
+ MaybeTailRecInfo = no,
+ TailRecLabelCode = empty
+ ),
generate_goal(model_semi, Goal, BodyCode, !CI),
generate_entry(!.CI, model_semi, Goal, ResumePoint,
FrameInfo, EntryCode),
@@ -688,8 +710,9 @@
MaybeFailExternalInfo = no,
TraceFailCode = empty
),
- Code = tree_list([EntryCode, TraceCallCode, BodyCode, ExitCode,
- ResumeCode, TraceFailCode, RestoreDeallocCode, FailCode])
+ Code = tree_list([EntryCode, TraceCallCode, TailRecLabelCode,
+ BodyCode, ExitCode, ResumeCode, TraceFailCode,
+ RestoreDeallocCode, FailCode])
;
MaybeTraceInfo = no,
MaybeTraceCallLabel = no,
@@ -710,6 +733,9 @@
MaybeTraceInfo = yes(TraceInfo),
generate_call_event(TraceInfo, ProcContext, MaybeTraceCallLabel,
TraceCallCode, !CI),
+ get_trace_maybe_tail_rec_info(TraceInfo, MaybeTailRecInfo),
+ expect(unify(MaybeTailRecInfo, no), this_file,
+ "tail recursive call in model_non code"),
generate_goal(model_non, Goal, BodyCode, !CI),
generate_entry(!.CI, model_non, Goal, ResumePoint,
FrameInfo, EntryCode),
Index: compiler/saved_vars.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/saved_vars.m,v
retrieving revision 1.78
diff -u -b -r1.78 saved_vars.m
--- compiler/saved_vars.m 28 Apr 2008 00:50:54 -0000 1.78
+++ compiler/saved_vars.m 15 Nov 2008 14:32:57 -0000
@@ -222,7 +222,8 @@
ok_to_duplicate(feature_call_table_gen) = no.
ok_to_duplicate(feature_preserve_backtrack_into) = no.
ok_to_duplicate(feature_hide_debug_event) = no.
-ok_to_duplicate(feature_tailcall) = no.
+ok_to_duplicate(feature_deep_tail_rec_call) = no.
+ok_to_duplicate(feature_debug_tail_rec_call) = no.
ok_to_duplicate(feature_keep_constant_binding) = no.
ok_to_duplicate(feature_save_deep_excp_vars) = no.
ok_to_duplicate(feature_dont_warn_singleton) = yes.
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.144
diff -u -b -r1.144 stack_layout.m
--- compiler/stack_layout.m 4 Sep 2008 10:49:58 -0000 1.144
+++ compiler/stack_layout.m 18 Nov 2008 12:45:17 -0000
@@ -648,7 +648,7 @@
NeedsAllNames, MaxVarNum, VarNameVector, !Info),
list.map(convert_var_to_int(VarNumMap), HeadVars, HeadVarNumVector),
TraceSlotInfo = trace_slot_info(MaybeFromFullSlot, MaybeIoSeqSlot,
- MaybeTrailSlots, MaybeMaxfrSlot, MaybeCallTableSlot),
+ MaybeTrailSlots, MaybeMaxfrSlot, MaybeCallTableSlot, MaybeTailRecSlot),
ModuleInfo = !.Info ^ module_info,
(
MaybeCallLabel = yes(CallLabel),
@@ -689,7 +689,7 @@
EventDataAddrs, MaybeTableDataAddr, HeadVarNumVector, VarNameVector,
MaxVarNum, MaxTraceReg, MaybeFromFullSlot, MaybeIoSeqSlot,
MaybeTrailSlots, MaybeMaxfrSlot, EvalMethod,
- MaybeCallTableSlot, EffTraceLevel, Flags).
+ MaybeCallTableSlot, MaybeTailRecSlot, EffTraceLevel, Flags).
:- pred collect_event_data_addrs(list(internal_label_info)::in,
list(data_addr)::in, list(data_addr)::out,
@@ -709,6 +709,7 @@
; Port = port_exit
; Port = port_redo
; Port = port_fail
+ ; Port = port_tailrec_call
),
LayoutName = label_layout(ProcLabel, LabelNum, LabelVars),
DataAddr = layout_addr(LayoutName),
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.147
diff -u -b -r1.147 table_gen.m
--- compiler/table_gen.m 27 Feb 2008 08:35:17 -0000 1.147
+++ compiler/table_gen.m 9 Nov 2008 01:33:13 -0000
@@ -1942,9 +1942,9 @@
pred_info_get_assertions(PredInfo, PredAssertions),
pred_info_get_markers(PredInfo, Markers),
pred_info_create(ModuleName, NewPredName, PredOrFunc, PredContext,
- origin_created(io_tabling), status_local, Markers, PredArgTypes,
- PredTypeVarSet, PredExistQVars, PredClassContext, PredAssertions,
- VarNameRemap, NewProcInfo, NewProcId, NewPredInfo),
+ origin_created(created_by_io_tabling), status_local, Markers,
+ PredArgTypes, PredTypeVarSet, PredExistQVars, PredClassContext,
+ PredAssertions, VarNameRemap, NewProcInfo, NewProcId, NewPredInfo),
module_info_get_predicate_table(!.ModuleInfo, PredicateTable0),
predicate_table_insert(NewPredInfo, NewPredId,
PredicateTable0, PredicateTable),
Index: compiler/trace_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_gen.m,v
retrieving revision 1.25
diff -u -b -r1.25 trace_gen.m
--- compiler/trace_gen.m 4 Sep 2008 11:41:01 -0000 1.25
+++ compiler/trace_gen.m 21 Nov 2008 02:21:08 -0000
@@ -55,8 +55,10 @@
:- import_module ll_backend.code_info.
:- import_module ll_backend.continuation_info.
:- import_module ll_backend.llds.
+:- import_module mdbcomp.program_representation.
:- import_module parse_tree.prog_data.
+:- import_module assoc_list.
:- import_module map.
:- import_module maybe.
:- import_module set.
@@ -73,7 +75,8 @@
:- type external_trace_port
---> external_port_call
; external_port_exit
- ; external_port_fail.
+ ; external_port_fail
+ ; external_port_tailrec_call.
% These ports are different from other internal ports (even neg_enter)
% because their goal path identifies not the goal we are about to enter
@@ -89,47 +92,44 @@
:- type trace_info.
+:- pred get_trace_maybe_tail_rec_info(trace_info::in,
+ maybe(pair(lval, label))::out) is det.
+
:- type trace_slot_info
---> trace_slot_info(
+ % If the procedure is shallow traced, this will be yes(N),
+ % where stack slot N is the slot that holds the value of the
+ % from-full flag at call. Otherwise, it will be no.
slot_from_full :: maybe(int),
- % If the procedure is shallow traced,
- % this will be yes(N), where stack
- % slot N is the slot that holds the
- % value of the from-full flag at call.
- % Otherwise, it will be no.
+ % If the procedure has io state arguments this will be yes(N),
+ % where stack slot N is the slot that holds the saved value
+ % of the io sequence number. Otherwise, it will be no.
slot_io :: maybe(int),
- % If the procedure has io state
- % arguments this will be yes(N), where
- % stack slot N is the slot that holds
- % the saved value of the io sequence
- % number. Otherwise, it will be no.
+ % If --use-trail is set, this will be yes(M), where stack slots
+ % M and M+1 are the slots that hold the saved values of the
+ % trail pointer and the ticket counter respectively at the time
+ % of the call. Otherwise, it will be no.
slot_trail :: maybe(int),
- % If --use-trail is set, this will
- % be yes(M), where stack slots M
- % and M+1 are the slots that hold the
- % saved values of the trail pointer
- % and the ticket counter respectively
- % at the time of the call. Otherwise,
- % it will be no.
+ % If the procedure lives on the det stack but creates
+ % temporary frames on the nondet stack, this will be yes(M),
+ % where stack slot M is reserved to hold the value of maxfr
+ % at the time of the call. Otherwise, it will be no.
slot_maxfr :: maybe(int),
- % If the procedure lives on the det
- % stack but creates temporary frames
- % on the nondet stack, this will be
- % yes(M), where stack slot M is
- % reserved to hold the value of maxfr
- % at the time of the call. Otherwise,
- % it will be no.
-
- slot_call_table :: maybe(int)
- % If the procedure's evaluation method
- % is memo, loopcheck or minimal model,
- % this will be yes(M), where stack slot
- % M holds the variable that represents
- % the tip of the call table. Otherwise,
- % it will be no.
+
+ % If the procedure's evaluation method is memo, loopcheck
+ % or minimal model, this will be yes(M), where stack slot
+ % M holds the variable that represents the tip of the
+ % call table. Otherwise, it will be no.
+ slot_call_table :: maybe(int),
+
+ % If the procedure has tail recursive call events, this
+ % will be yes(M), where stack slot M holds the variable
+ % that represents number of times a tail recursive call
+ % has reused this stack frame. Otherwise, it will be no.
+ slot_tail_rec :: maybe(int)
).
% Return the set of input variables whose values should be preserved
@@ -164,7 +164,7 @@
% for eventual use in the constructing the procedure's layout structure.
%
:- pred trace_setup(module_info::in, pred_info::in, proc_info::in,
- globals::in, trace_slot_info::out, trace_info::out,
+ globals::in, maybe(label)::in, trace_slot_info::out, trace_info::out,
code_info::in, code_info::out) is det.
% Generate code to fill in the reserved stack slots.
@@ -202,18 +202,22 @@
:- pred generate_user_event_code(user_event_info::in, hlds_goal_info::in,
code_tree::out, code_info::in, code_info::out) is det.
+:- pred generate_tailrec_event_code(trace_info::in,
+ assoc_list(prog_var, arg_info)::in, goal_path::in, prog_context::in,
+ code_tree::out, label::out, code_info::in, code_info::out) is det.
+
:- type external_event_info
---> external_event_info(
- label, % The label associated with the
- % external event.
+ % The label associated with the external event.
+ label,
+ % The map giving the locations of the typeinfo variables
+ % needed to describe the types of the variables live at the
+ % event.
map(tvar, set(layout_locn)),
- % The map saying where the typeinfo
- % variables needed to describe the
- % types of the variables live at the
- % event are.
- code_tree % The code generated for the event.
+ % The code generated for the event.
+ code_tree
).
% Generate code for an external trace event.
@@ -238,6 +242,7 @@
:- implementation.
+:- import_module backend_libs.builtin_ops.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
@@ -252,7 +257,6 @@
:- import_module ll_backend.layout_out.
:- import_module ll_backend.llds_out.
:- import_module mdbcomp.prim_data.
-:- import_module mdbcomp.program_representation.
:- import_module parse_tree.prog_type.
:- import_module bool.
@@ -269,6 +273,11 @@
%
:- type trace_port_info
---> port_info_external
+ ; port_info_tailrec_call(
+ goal_path, % The path of the tail recursive call.
+ assoc_list(prog_var, arg_info)
+ % The list of arguments of this call.
+ )
; port_info_internal(
goal_path, % The path of the goal whose start
% this port represents.
@@ -356,7 +365,13 @@
% layout; if there is no such slot, that field will
% contain -1.
%
- % stage 7: If the procedure's evaluation method is memo, loopcheck
+ % stage 7: If the procedure has tail call events, we allocate a slot
+ % to hold a variable that counts how many tail events we have
+ % executed in this stack frame so far. The number of this slot
+ % is recorded in the maybe_tail_rec field in the proc layout;
+ % if there is no such slot, that field will contain -1.
+ %
+ % stage 8: If the procedure's evaluation method is memo, loopcheck
% or minimal model, we allocate a slot to hold the
% variable that represents the tip of the call table.
% The debugger needs this, because when it executes a
@@ -364,6 +379,10 @@
% The number of this slot is recorded in the maybe_table
% field in the proc layout; if there is no such slot,
% that field will contain -1.
+ % (This should be the last stage; add new ones before this one.)
+ %
+ % If you add any more stages, please consider that any new slots
+ % may need to be reset or adjusted before TAIL events.
%
% The procedure's layout structure does not need to include
% information about the presence or absence of the slot holding
@@ -402,7 +421,9 @@
MaybeTableVarInfo = no
;
FixedSlots = yes,
+ % Stage 1.
Fixed = 3, % event#, call#, call depth
+ % Stage 2.
(
proc_info_interface_code_model(ProcInfo) = model_non,
eff_trace_needs_port(ModuleInfo, PredInfo, ProcInfo, TraceLevel,
@@ -412,6 +433,7 @@
;
RedoLayout = 0
),
+ % Stage 3.
(
eff_trace_level_needs_from_full_slot(ModuleInfo, PredInfo,
ProcInfo, TraceLevel) = yes
@@ -420,6 +442,7 @@
;
FromFull = 0
),
+ % Stage 4.
(
TraceTableIo = yes,
IoSeq = 1
@@ -427,6 +450,7 @@
TraceTableIo = no,
IoSeq = 0
),
+ % Stage 5.
globals.lookup_bool_option(Globals, use_trail, UseTrail),
(
UseTrail = yes,
@@ -435,6 +459,7 @@
UseTrail = no,
Trail = 0
),
+ % Stage 6.
proc_info_get_need_maxfr_slot(ProcInfo, NeedMaxfr),
(
NeedMaxfr = yes,
@@ -443,7 +468,18 @@
NeedMaxfr = no,
Maxfr = 0
),
- ReservedSlots0 = Fixed + RedoLayout + FromFull + IoSeq + Trail + Maxfr,
+ % Stage 7.
+ proc_info_get_has_tail_call_events(ProcInfo, TailCallEvents),
+ (
+ TailCallEvents = tail_call_events,
+ TailRec = 1
+ ;
+ TailCallEvents = no_tail_call_events,
+ TailRec = 0
+ ),
+ ReservedSlots0 = Fixed + RedoLayout + FromFull + IoSeq + Trail +
+ Maxfr + TailRec,
+ % Stage 8.
proc_info_get_call_table_tip(ProcInfo, MaybeCallTableVar),
(
MaybeCallTableVar = yes(CallTableVar),
@@ -456,93 +492,119 @@
)
).
-trace_setup(ModuleInfo, PredInfo, ProcInfo, Globals, TraceSlotInfo, TraceInfo,
- !CI) :-
+trace_setup(ModuleInfo, PredInfo, ProcInfo, Globals, MaybeTailRecLabel,
+ TraceSlotInfo, TraceInfo, !CI) :-
CodeModel = get_proc_model(!.CI),
globals.get_trace_level(Globals, TraceLevel),
globals.get_trace_suppress(Globals, TraceSuppress),
globals.lookup_bool_option(Globals, trace_table_io, TraceTableIo),
TraceRedo = eff_trace_needs_port(ModuleInfo, PredInfo, ProcInfo,
TraceLevel, TraceSuppress, port_redo),
+ some [!NextSlot] (
+ % Stages 1 and 2.
(
TraceRedo = yes,
CodeModel = model_non
->
get_next_label(RedoLayoutLabel, !CI),
MaybeRedoLayoutLabel = yes(RedoLayoutLabel),
- NextSlotAfterRedoLayout = 5
+ % We always reserve slots 1, 2 and 3, and we reserve slot 4
+ % for the redo layout label.
+ !:NextSlot = 5
;
MaybeRedoLayoutLabel = no,
- NextSlotAfterRedoLayout = 4
+ % We always reserve slots 1, 2 and 3.
+ !:NextSlot = 4
),
- FromFullSlot = eff_trace_level_needs_from_full_slot(ModuleInfo, PredInfo,
- ProcInfo, TraceLevel),
+ % Stage 3.
+ HasFromFullSlot = eff_trace_level_needs_from_full_slot(ModuleInfo,
+ PredInfo, ProcInfo, TraceLevel),
StackId = code_model_to_main_stack(CodeModel),
(
- FromFullSlot = no,
- MaybeFromFullSlot = no,
- MaybeFromFullSlotLval = no,
- NextSlotAfterFromFull = NextSlotAfterRedoLayout
+ HasFromFullSlot = yes,
+ FromFullSlot = !.NextSlot,
+ MaybeFromFullSlot = yes(FromFullSlot),
+ FromFullSlotLval = stack_slot_num_to_lval(StackId, FromFullSlot),
+ MaybeFromFullSlotLval = yes(FromFullSlotLval),
+ !:NextSlot = !.NextSlot + 1
;
- FromFullSlot = yes,
- MaybeFromFullSlot = yes(NextSlotAfterRedoLayout),
- CallFromFullSlot = stack_slot_num_to_lval(StackId,
- NextSlotAfterRedoLayout),
- MaybeFromFullSlotLval = yes(CallFromFullSlot),
- NextSlotAfterFromFull = NextSlotAfterRedoLayout + 1
+ HasFromFullSlot = no,
+ MaybeFromFullSlot = no,
+ MaybeFromFullSlotLval = no
),
+ % Stage 4.
(
TraceTableIo = yes,
- MaybeIoSeqSlot = yes(NextSlotAfterFromFull),
- IoSeqLval = stack_slot_num_to_lval(StackId, NextSlotAfterFromFull),
+ IoSeqSlot = !.NextSlot,
+ MaybeIoSeqSlot = yes(IoSeqSlot),
+ IoSeqLval = stack_slot_num_to_lval(StackId, IoSeqSlot),
MaybeIoSeqLval = yes(IoSeqLval),
- NextSlotAfterIoSeq = NextSlotAfterFromFull + 1
+ !:NextSlot = !.NextSlot + 1
;
TraceTableIo = no,
MaybeIoSeqSlot = no,
- MaybeIoSeqLval = no,
- NextSlotAfterIoSeq = NextSlotAfterFromFull
+ MaybeIoSeqLval = no
),
+ % Stage 5.
globals.lookup_bool_option(Globals, use_trail, UseTrail),
(
UseTrail = yes,
- MaybeTrailSlot = yes(NextSlotAfterIoSeq),
- TrailLval = stack_slot_num_to_lval(StackId, NextSlotAfterIoSeq),
- TicketLval = stack_slot_num_to_lval(StackId, NextSlotAfterIoSeq + 1),
+ TrailSlot = !.NextSlot,
+ TicketSlot = !.NextSlot + 1,
+ MaybeTrailSlot = yes(TrailSlot),
+ TrailLval = stack_slot_num_to_lval(StackId, TrailSlot),
+ TicketLval = stack_slot_num_to_lval(StackId, TicketSlot),
MaybeTrailLvals = yes(TrailLval - TicketLval),
- NextSlotAfterTrail = NextSlotAfterIoSeq + 2
+ !:NextSlot = !.NextSlot + 2
;
UseTrail = no,
MaybeTrailSlot = no,
- MaybeTrailLvals = no,
- NextSlotAfterTrail = NextSlotAfterIoSeq
+ MaybeTrailLvals = no
),
+ % Stage 6.
proc_info_get_need_maxfr_slot(ProcInfo, NeedMaxfr),
(
NeedMaxfr = yes,
- MaybeMaxfrSlot = yes(NextSlotAfterTrail),
- MaxfrLval = stack_slot_num_to_lval(StackId, NextSlotAfterTrail),
+ MaxfrSlot = !.NextSlot,
+ MaybeMaxfrSlot = yes(MaxfrSlot),
+ MaxfrLval = stack_slot_num_to_lval(StackId, MaxfrSlot),
MaybeMaxfrLval = yes(MaxfrLval),
- NextSlotAfterMaxfr = NextSlotAfterTrail + 1
+ !:NextSlot = !.NextSlot + 1
;
NeedMaxfr = no,
MaybeMaxfrSlot = no,
- MaybeMaxfrLval = no,
- NextSlotAfterMaxfr = NextSlotAfterTrail
+ MaybeMaxfrLval = no
+ ),
+ % Stage 7.
+ (
+ MaybeTailRecLabel = yes(TailRecLabel),
+ TailRecSlot = !.NextSlot,
+ MaybeTailRecSlot = yes(TailRecSlot),
+ TailRecLval = stack_slot_num_to_lval(StackId, TailRecSlot),
+ MaybeTailRecInfo = yes(TailRecLval - TailRecLabel),
+ !:NextSlot = !.NextSlot + 1
+ ;
+ MaybeTailRecLabel = no,
+ MaybeTailRecSlot = no,
+ MaybeTailRecInfo = no
),
+ % Stage 8.
( proc_info_get_call_table_tip(ProcInfo, yes(_)) ->
- MaybeCallTableSlot = yes(NextSlotAfterMaxfr),
- CallTableLval = stack_slot_num_to_lval(StackId, NextSlotAfterMaxfr),
+ CallTableSlot = !.NextSlot,
+ MaybeCallTableSlot = yes(CallTableSlot),
+ CallTableLval = stack_slot_num_to_lval(StackId, CallTableSlot),
MaybeCallTableLval = yes(CallTableLval)
;
MaybeCallTableSlot = no,
MaybeCallTableLval = no
+ )
),
TraceSlotInfo = trace_slot_info(MaybeFromFullSlot, MaybeIoSeqSlot,
- MaybeTrailSlot, MaybeMaxfrSlot, MaybeCallTableSlot),
+ MaybeTrailSlot, MaybeMaxfrSlot, MaybeCallTableSlot, MaybeTailRecSlot),
TraceInfo = trace_info(TraceLevel, TraceSuppress,
MaybeFromFullSlotLval, MaybeIoSeqLval, MaybeTrailLvals,
- MaybeMaxfrLval, MaybeCallTableLval, MaybeRedoLayoutLabel).
+ MaybeMaxfrLval, MaybeCallTableLval, MaybeTailRecInfo,
+ MaybeRedoLayoutLabel).
generate_slot_fill_code(CI, TraceInfo, TraceCode) :-
CodeModel = get_proc_model(CI),
@@ -551,6 +613,7 @@
MaybeTrailLvals = TraceInfo ^ trail_lvals,
MaybeMaxfrLval = TraceInfo ^ maxfr_lval,
MaybeCallTableLval = TraceInfo ^ call_table_tip_lval,
+ MaybeTailRecInfo = TraceInfo ^ tail_rec_info,
MaybeRedoLabel = TraceInfo ^ redo_label,
event_num_slot(CodeModel, EventNumLval),
call_num_slot(CodeModel, CallNumLval),
@@ -558,37 +621,35 @@
stackref_to_string(EventNumLval, EventNumStr),
stackref_to_string(CallNumLval, CallNumStr),
stackref_to_string(CallDepthLval, CallDepthStr),
- string.append_list(["\t\tMR_trace_fill_std_slots(",
- EventNumStr, ", ", CallNumStr, ", ", CallDepthStr, ");\n"
- ], FillThreeSlots),
- (
- MaybeIoSeqSlot = yes(IoSeqLval),
- stackref_to_string(IoSeqLval, IoSeqStr),
- string.append_list([
- FillThreeSlots,
- "\t\t", IoSeqStr, " = MR_io_tabling_counter;\n"
- ], FillSlotsUptoIoSeq)
- ;
- MaybeIoSeqSlot = no,
- FillSlotsUptoIoSeq = FillThreeSlots
- ),
+ some [!CodeStr] (
+ % Stage 1.
+ !:CodeStr = "\t\tMR_trace_fill_std_slots(" ++ EventNumStr ++ ", " ++
+ CallNumStr ++ ", " ++ CallDepthStr ++ ");\n",
+ % Stage 2.
(
MaybeRedoLabel = yes(RedoLayoutLabel),
redo_layout_slot(CodeModel, RedoLayoutLval),
stackref_to_string(RedoLayoutLval, RedoLayoutStr),
LayoutAddrStr =
layout_out.make_label_layout_name(RedoLayoutLabel),
- string.append_list([
- FillSlotsUptoIoSeq,
- "\t\t", RedoLayoutStr,
- " = (MR_Word) (const MR_Word *) &", LayoutAddrStr, ";\n"
- ], FillSlotsUptoRedo),
+ !:CodeStr = !.CodeStr ++ "\t\t" ++ RedoLayoutStr ++
+ " = (MR_Word) (const MR_Word *) &" ++ LayoutAddrStr ++ ";\n",
MaybeLayoutLabel = yes(RedoLayoutLabel)
;
MaybeRedoLabel = no,
- FillSlotsUptoRedo = FillSlotsUptoIoSeq,
MaybeLayoutLabel = no
),
+ % Stage 3 is handled later.
+ % Stage 4.
+ (
+ MaybeIoSeqSlot = yes(IoSeqLval),
+ stackref_to_string(IoSeqLval, IoSeqStr),
+ !:CodeStr = !.CodeStr ++
+ "\t\t" ++ IoSeqStr ++ " = MR_io_tabling_counter;\n"
+ ;
+ MaybeIoSeqSlot = no
+ ),
+ % Stage 5.
(
% This could be done by generating proper LLDS instead of C.
% However, in shallow traced code we want to execute this
@@ -597,28 +658,27 @@
MaybeTrailLvals = yes(TrailLval - TicketLval),
stackref_to_string(TrailLval, TrailLvalStr),
stackref_to_string(TicketLval, TicketLvalStr),
- string.append_list([
- FillSlotsUptoRedo,
- "\t\tMR_mark_ticket_stack(", TicketLvalStr, ");\n",
- "\t\tMR_store_ticket(", TrailLvalStr, ");\n"
- ], FillSlotsUptoTrail)
+ !:CodeStr = !.CodeStr ++
+ "\t\tMR_mark_ticket_stack(" ++ TicketLvalStr ++ ");\n" ++
+ "\t\tMR_store_ticket(" ++ TrailLvalStr ++ ");\n"
;
- MaybeTrailLvals = no,
- FillSlotsUptoTrail = FillSlotsUptoRedo
+ MaybeTrailLvals = no
),
+ % Stage 3.
(
MaybeFromFullSlot = yes(CallFromFullSlot),
stackref_to_string(CallFromFullSlot, CallFromFullSlotStr),
- TraceStmt1 =
+ !:CodeStr =
"\t\t" ++ CallFromFullSlotStr ++ " = MR_trace_from_full;\n" ++
"\t\tif (MR_trace_from_full) {\n" ++
- FillSlotsUptoTrail ++
+ !.CodeStr ++
"\t\t} else {\n" ++
"\t\t\t" ++ CallDepthStr ++ " = MR_trace_call_depth;\n" ++
"\t\t}\n"
;
- MaybeFromFullSlot = no,
- TraceStmt1 = FillSlotsUptoTrail
+ MaybeFromFullSlot = no
+ ),
+ TraceStmt1 = !.CodeStr
),
TraceComponents1 = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init), TraceStmt1)],
@@ -627,6 +687,7 @@
proc_will_not_call_mercury, no, no, MaybeLayoutLabel,
no, yes, proc_may_not_duplicate), "")
]),
+ % Stage 6.
(
MaybeMaxfrLval = yes(MaxfrLval),
TraceCode2 = node([
@@ -636,23 +697,49 @@
MaybeMaxfrLval = no,
TraceCode2 = empty
),
+ % Stage 7.
(
- MaybeCallTableLval = yes(CallTableLval),
- stackref_to_string(CallTableLval, CallTableLvalStr),
- TraceStmt3 = "\t\t" ++ CallTableLvalStr ++ " = 0;\n",
+ MaybeTailRecInfo = yes(TailRecLval - _TailRecLabel),
+ stackref_to_string(TailRecLval, TailRecLvalStr),
+ TraceStmt3 =
+ "\t\tif (MR_trace_tailrec_have_reused_frames) {\n" ++
+ "\t\t\t" ++ TailRecLvalStr ++
+ " = MR_trace_tailrec_num_reused_frames;\n" ++
+ "\t\t\tMR_trace_tailrec_have_reused_frames = MR_FALSE;\n" ++
+ "\t\t} else {" ++
+ "\t\t\t" ++ TailRecLvalStr ++ " = 0;\n" ++
+ "\t\t}",
TraceComponents3 = [foreign_proc_raw_code(cannot_branch_away,
proc_does_not_affect_liveness, live_lvals_info(set.init),
TraceStmt3)],
TraceCode3 = node([
llds_instr(foreign_proc_code([], TraceComponents3,
proc_will_not_call_mercury, no, no, no, no, yes,
+ proc_may_not_duplicate),
+ "initialize tail recursion count")
+ ])
+ ;
+ MaybeTailRecInfo = no,
+ TraceCode3 = empty
+ ),
+ % Stage 8.
+ (
+ MaybeCallTableLval = yes(CallTableLval),
+ stackref_to_string(CallTableLval, CallTableLvalStr),
+ TraceStmt4 = "\t\t" ++ CallTableLvalStr ++ " = 0;\n",
+ TraceComponents4 = [foreign_proc_raw_code(cannot_branch_away,
+ proc_does_not_affect_liveness, live_lvals_info(set.init),
+ TraceStmt4)],
+ TraceCode4 = node([
+ llds_instr(foreign_proc_code([], TraceComponents4,
+ proc_will_not_call_mercury, no, no, no, no, yes,
proc_may_not_duplicate), "")
])
;
MaybeCallTableLval = no,
- TraceCode3 = empty
+ TraceCode4 = empty
),
- TraceCode = tree(TraceCode1, tree(TraceCode2, TraceCode3)).
+ TraceCode = tree_list([TraceCode1, TraceCode2, TraceCode3, TraceCode4]).
trace_prepare_for_call(CI, TraceCode) :-
get_maybe_trace_info(CI, MaybeTraceInfo),
@@ -821,6 +908,120 @@
MaybeExternalInfo = no
).
+generate_tailrec_event_code(TraceInfo, ArgsInfos, GoalPath, Context,
+ Code, TailRecLabel, !CI) :-
+ Port = port_tailrec_call,
+ PortInfo = port_info_tailrec_call(GoalPath, ArgsInfos),
+ HideEvent = no,
+ MaybeUserInfo = no,
+ generate_event_code(Port, PortInfo, yes(TraceInfo), Context, HideEvent,
+ MaybeUserInfo, _Label, _TvarDataMap, Code, !CI),
+ MaybeTailRecInfo = TraceInfo ^ tail_rec_info,
+ (
+ MaybeTailRecInfo = yes(_ - TailRecLabel)
+ ;
+ MaybeTailRecInfo = no,
+ unexpected(this_file, "generate_tailrec_event_code: no tail rec label")
+ ).
+
+:- pred generate_tailrec_reset_slots_code(trace_info::in,
+ code_tree::out, code_info::in, code_info::out) is det.
+
+generate_tailrec_reset_slots_code(TraceInfo, Code, !CI) :-
+ % We reset all the debugging slots that need to be reset. We handle them
+ % in the order of allocation.
+ % Stage 1.
+ CodeModel = get_proc_model(!.CI),
+ event_num_slot(CodeModel, EventNumLval),
+ call_num_slot(CodeModel, CallNumLval),
+ call_depth_slot(CodeModel, CallDepthLval),
+ stackref_to_string(EventNumLval, EventNumStr),
+ stackref_to_string(CallNumLval, CallNumStr),
+ stackref_to_string(CallDepthLval, CallDepthStr),
+ StdSlotCodeStr = "\t\tMR_trace_tailrec_std_slots(" ++
+ EventNumStr ++ ", " ++ CallNumStr ++ ", " ++ CallDepthStr ++ ");\n",
+ % Stage 2.
+ % Tail recursion events cannot happen in model_non procedures, so stage 2
+ % will not allocate any slots.
+ MaybeRedoLabelLval = TraceInfo ^ redo_label,
+ expect(unify(MaybeRedoLabelLval, no), this_file,
+ "redo label in procedure with TAIL event"),
+ % Stage 3.
+ % Tail recursion events are disabled if the trace level is shallow tracing,
+ % so stage 3 will not allocate any slots.
+ MaybeFromFullLval = TraceInfo ^ from_full_lval,
+ expect(unify(MaybeFromFullLval, no), this_file,
+ "from_full slot in procedure with TAIL event"),
+ % Stage 4.
+ MaybeIoSeqSlot = TraceInfo ^ io_seq_lval,
+ (
+ MaybeIoSeqSlot = yes(IoSeqLval),
+ stackref_to_string(IoSeqLval, IoSeqStr),
+ IoSeqCodeStr = "\t\t" ++ IoSeqStr ++ " = MR_io_tabling_counter;\n"
+ ;
+ MaybeIoSeqSlot = no,
+ IoSeqCodeStr = ""
+ ),
+ % Stage 5.
+ MaybeTrailLvals = TraceInfo ^ trail_lvals,
+ (
+ MaybeTrailLvals = yes(TrailLval - TicketLval),
+ stackref_to_string(TrailLval, TrailLvalStr),
+ stackref_to_string(TicketLval, TicketLvalStr),
+ TrailCodeStr =
+ "\t\tMR_mark_ticket_stack(" ++ TicketLvalStr ++ ");\n" ++
+ "\t\tMR_store_ticket(" ++ TrailLvalStr ++ ");\n"
+ ;
+ MaybeTrailLvals = no,
+ TrailCodeStr = ""
+ ),
+ % Stage 6.
+ MaybeMaxfrLval = TraceInfo ^ maxfr_lval,
+ (
+ MaybeMaxfrLval = yes(MaxfrLval),
+ MaxfrCode = node([
+ llds_instr(assign(MaxfrLval, lval(maxfr)), "save initial maxfr")
+ ])
+ ;
+ MaybeMaxfrLval = no,
+ MaxfrCode = empty
+ ),
+ % Stage 7.
+ TailRecInfo = TraceInfo ^ tail_rec_info,
+ (
+ TailRecInfo = yes(TailRecLval - _),
+ TailRecLvalCode = node([
+ llds_instr(assign(TailRecLval,
+ binop(int_add, lval(TailRecLval), const(llconst_int(1)))),
+ "increment tail recursion counter")
+ ])
+ ;
+ TailRecInfo = no,
+ unexpected(this_file,
+ "generate_tailrec_reset_slots_code: no tail rec lval")
+ ),
+ % Stage 8.
+ MaybeCallTableLval = TraceInfo ^ call_table_tip_lval,
+ (
+ MaybeCallTableLval = yes(CallTableLval),
+ stackref_to_string(CallTableLval, CallTableLvalStr),
+ CallTableCodeStr = "\t\t" ++ CallTableLvalStr ++ " = 0;\n"
+ ;
+ MaybeCallTableLval = no,
+ CallTableCodeStr = ""
+ ),
+ ForeignLangCodeStr = StdSlotCodeStr ++ IoSeqCodeStr ++ TrailCodeStr ++
+ CallTableCodeStr,
+ ForeignLangComponents = [foreign_proc_raw_code(cannot_branch_away,
+ proc_does_not_affect_liveness, live_lvals_info(set.init),
+ ForeignLangCodeStr)],
+ ForeignLangCode = node([
+ llds_instr(foreign_proc_code([], ForeignLangComponents,
+ proc_will_not_call_mercury, no, no, no,
+ no, yes, proc_may_duplicate), "")
+ ]),
+ Code = tree_list([ForeignLangCode, MaxfrCode, TailRecLvalCode]).
+
:- pred generate_event_code(trace_port::in, trace_port_info::in,
maybe(trace_info)::in, prog_context::in, bool::in,
maybe(user_event_info)::in, label::out,
@@ -834,19 +1035,38 @@
(
PortInfo = port_info_external,
LiveVars = LiveVars0,
- Path = empty_goal_path
+ Path = empty_goal_path,
+ TailRecResetCode = empty
+ ;
+ PortInfo = port_info_tailrec_call(Path, ArgsInfos),
+ % The pre_goal_update has added the output variables of the recursive
+ % call to the set of live variables; we must undo this.
+ find_output_vars(ArgsInfos, [], OutputVars),
+ list.delete_elems(LiveVars0, OutputVars, LiveVars),
+ (
+ MaybeTraceInfo = yes(TailRecTraceInfo),
+ generate_tailrec_reset_slots_code(TailRecTraceInfo,
+ TailRecResetCode, !CI)
+ ;
+ MaybeTraceInfo = no,
+ unexpected(this_file,
+ "generate_event_code: tailrec call without TraceInfo")
+ )
;
PortInfo = port_info_internal(Path, PreDeaths),
ResumeVars = current_resume_point_vars(!.CI),
set.difference(PreDeaths, ResumeVars, RealPreDeaths),
set.to_sorted_list(RealPreDeaths, RealPreDeathList),
- list.delete_elems(LiveVars0, RealPreDeathList, LiveVars)
+ list.delete_elems(LiveVars0, RealPreDeathList, LiveVars),
+ TailRecResetCode = empty
;
PortInfo = port_info_negation_end(Path),
- LiveVars = LiveVars0
+ LiveVars = LiveVars0,
+ TailRecResetCode = empty
;
PortInfo = port_info_user(Path),
- LiveVars = LiveVars0
+ LiveVars = LiveVars0,
+ TailRecResetCode = empty
;
PortInfo = port_info_nondet_foreign_proc,
LiveVars = [],
@@ -857,7 +1077,8 @@
;
unexpected(this_file,
"generate_event_code: bad nondet foreign_proc port")
- )
+ ),
+ TailRecResetCode = empty
),
VarTypes = get_var_types(!.CI),
get_varset(!.CI, VarSet),
@@ -938,7 +1159,23 @@
proc_may_call_mercury, no, no, yes(Label), no, yes,
proc_may_not_duplicate), "")
]),
- Code = tree(ProduceCode, TraceCode).
+ Code = tree_list([ProduceCode, TailRecResetCode, TraceCode]).
+
+:- pred find_output_vars(assoc_list(prog_var, arg_info)::in,
+ list(prog_var)::in, list(prog_var)::out) is det.
+
+find_output_vars([], !OutputVars).
+find_output_vars([Arg - Info | ArgsInfos], !OutputVars) :-
+ Info = arg_info(_ArgLoc, Mode),
+ (
+ Mode = top_out,
+ !:OutputVars = [Arg | !.OutputVars]
+ ;
+ Mode = top_in
+ ;
+ Mode = top_unused
+ ),
+ find_output_vars(ArgsInfos, !OutputVars).
:- func find_lval_in_var_info(layout_var_info) = lval.
@@ -1075,6 +1312,7 @@
convert_external_port_type(external_port_call) = port_call.
convert_external_port_type(external_port_exit) = port_exit.
convert_external_port_type(external_port_fail) = port_fail.
+convert_external_port_type(external_port_tailrec_call) = port_tailrec_call.
:- func convert_nondet_foreign_proc_port_type(nondet_foreign_proc_trace_port)
= trace_port.
@@ -1145,49 +1383,48 @@
trace_level :: trace_level,
trace_suppress_items :: trace_suppress_items,
+ % If the trace level is shallow, the lval of the slot
+ % that holds the from-full flag.
from_full_lval :: maybe(lval),
- % If the trace level is shallow,
- % the lval of the slot that holds the
- % from-full flag.
- io_seq_lval :: maybe(lval),
- % If the procedure has I/O state
- % arguments, the lval of the slot
- % that holds the initial value of the
+ % If the procedure has I/O state arguments, the lval
+ % of the slot that holds the initial value of the
% I/O action counter.
+ io_seq_lval :: maybe(lval),
+ % If trailing is enabled, the lvals of the slots that hold
+ % the value of the trail pointer and the ticket counter
+ % at the time of the call.
trail_lvals :: maybe(pair(lval)),
- % If trailing is enabled, the lvals
- % of the slots that hold the value
- % of the trail pointer and the ticket
- % counter at the time of the call.
+ % If we reserve a slot for holding the value of maxfr
+ % at entry for use in implementing retry, the lval of the slot.
maxfr_lval :: maybe(lval),
- % If we reserve a slot for holding
- % the value of maxfr at entry for use
- % in implementing retry, the lval of
- % the slot.
+ % If we reserve a slot for holding the value of the call table
+ % tip variable, the lval of this variable.
call_table_tip_lval :: maybe(lval),
- % If we reserve a slot for holding
- % the value of the call table tip
- % variable, the lval of this variable.
+ % If we reserve a slot for holding the number of times the
+ % stack frame was reused by tail recursive calls, the lval
+ % holding this counter, and the label that a tail recursive
+ % call should jump to.
+ tail_rec_info :: maybe(pair(lval, label)),
+
+ % If we are generating redo events, this has the label
+ % associated with the fail event, which we then reserve
+ % in advance, so we can put the address of its layout struct
+ % into the slot which holds the layout for the redo event
+ % (the two events have identical layouts).
redo_label :: maybe(label)
- % If we are generating redo events,
- % this has the label associated with
- % the fail event, which we then reserve
- % in advance, so we can put the
- % address of its layout struct
- % into the slot which holds the
- % layout for the redo event (the
- % two events have identical layouts).
).
+get_trace_maybe_tail_rec_info(TraceInfo, TraceInfo ^ tail_rec_info).
+
%-----------------------------------------------------------------------------%
:- func this_file = string.
-this_file = "trace.m".
+this_file = "trace_gen.m".
%-----------------------------------------------------------------------------%
Index: compiler/trace_params.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/trace_params.m,v
retrieving revision 1.42
diff -u -b -r1.42 trace_params.m
--- compiler/trace_params.m 23 Nov 2007 07:35:29 -0000 1.42
+++ compiler/trace_params.m 18 Nov 2008 15:13:17 -0000
@@ -72,6 +72,7 @@
:- func given_trace_level_is_none(trace_level) = bool.
:- func trace_level_allows_delay_death(trace_level) = bool.
:- func trace_needs_return_info(trace_level, trace_suppress_items) = bool.
+:- func trace_level_allows_tail_rec(trace_level) = bool.
% Should optimization passes maintain meaningful variable names
% where possible.
@@ -210,7 +211,8 @@
EffTraceLevel = none
;
pred_info_get_origin(PredInfo, Origin),
- ( Origin = origin_special_pred(SpecialPred - _) ->
+ (
+ Origin = origin_special_pred(SpecialPred - _),
% Unify and compare predicates can be called from the generic
% unify and compare predicates in builtin.m, so they can be called
% from outside this module even if they don't have their address
@@ -235,14 +237,39 @@
SpecialPred = spec_pred_init,
EffTraceLevel = TraceLevel
)
- ; Origin = origin_created(io_tabling) ->
- % Predicates called by a predicate that is I/O tabled should not be
- % traced. If such a predicate were allowed to generate events then
- % the event numbers of events after the I/O primitive would be
- % different between the first and subsequent (idempotent)
- % executions of the same I/O action.
+ ;
+ Origin = origin_created(PredCreation),
+ (
+ PredCreation = created_by_io_tabling,
+ % Predicates called by a predicate that is I/O tabled
+ % should not be traced. If such a predicate were allowed
+ % to generate events, then the event numbers of events
+ % after the I/O primitive would be different between
+ % the first and subsequent (idempotent) executions
+ % of the same I/O action.
EffTraceLevel = none
;
+ PredCreation = created_by_deforestation,
+ EffTraceLevel = usual_eff_trace_level(ModuleInfo,
+ PredInfo, ProcInfo, TraceLevel)
+ )
+ ;
+ ( Origin = origin_instance_method(_, _)
+ ; Origin = origin_transformed(_, _, _)
+ ; Origin = origin_assertion(_, _)
+ ; Origin = origin_lambda(_, _, _)
+ ; Origin = origin_user(_)
+ ),
+ EffTraceLevel = usual_eff_trace_level(ModuleInfo,
+ PredInfo, ProcInfo, TraceLevel)
+ )
+ ).
+
+:- func usual_eff_trace_level(module_info, pred_info, proc_info, trace_level)
+ = trace_level.
+
+usual_eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)
+ = EffTraceLevel :-
pred_info_get_import_status(PredInfo, Status),
(
TraceLevel = shallow,
@@ -267,8 +294,6 @@
)
;
EffTraceLevel = TraceLevel
- )
- )
).
given_trace_level_is_none(TraceLevel) =
@@ -364,6 +389,13 @@
trace_level_needs_meaningful_var_names(deep) = yes.
trace_level_needs_meaningful_var_names(decl_rep) = yes.
+trace_level_allows_tail_rec(none) = yes.
+trace_level_allows_tail_rec(basic) = yes.
+trace_level_allows_tail_rec(basic_user) = yes.
+trace_level_allows_tail_rec(shallow) = no.
+trace_level_allows_tail_rec(deep) = yes.
+trace_level_allows_tail_rec(decl_rep) = no.
+
trace_needs_return_info(TraceLevel, TraceSuppressItems) = Need :-
(
trace_level_has_return_info(TraceLevel) = yes,
@@ -467,6 +499,7 @@
convert_port_name("latr") = port_nondet_foreign_proc_later.
convert_port_name("nondet_foreign_proc_later") =
port_nondet_foreign_proc_later.
+convert_port_name("tail") = port_tailrec_call.
convert_port_name("user") = port_user.
:- func convert_port_class_name(string) = list(trace_port) is semidet.
@@ -552,6 +585,7 @@
trace_port_category(port_disj_later) = port_cat_internal.
trace_port_category(port_nondet_foreign_proc_first) = port_cat_internal.
trace_port_category(port_nondet_foreign_proc_later) = port_cat_internal.
+trace_port_category(port_tailrec_call) = port_cat_interface.
trace_port_category(port_user) = port_cat_user.
:- func trace_level_port_categories(trace_level) = list(port_category).
@@ -614,16 +648,17 @@
port_number(port_exit) = 1.
port_number(port_redo) = 2.
port_number(port_fail) = 3.
-port_number(port_exception) = 4.
-port_number(port_ite_cond) = 5.
-port_number(port_ite_then) = 6.
-port_number(port_ite_else) = 7.
-port_number(port_neg_enter) = 8.
-port_number(port_neg_success) = 9.
-port_number(port_neg_failure) = 10.
-port_number(port_disj_first) = 11.
-port_number(port_disj_later) = 12.
-port_number(port_switch) = 13.
-port_number(port_nondet_foreign_proc_first) = 14.
-port_number(port_nondet_foreign_proc_later) = 15.
-port_number(port_user) = 16.
+port_number(port_tailrec_call) = 4.
+port_number(port_exception) = 5.
+port_number(port_ite_cond) = 6.
+port_number(port_ite_then) = 7.
+port_number(port_ite_else) = 8.
+port_number(port_neg_enter) = 9.
+port_number(port_neg_success) = 10.
+port_number(port_neg_failure) = 11.
+port_number(port_disj_first) = 12.
+port_number(port_disj_later) = 13.
+port_number(port_switch) = 14.
+port_number(port_nondet_foreign_proc_first) = 15.
+port_number(port_nondet_foreign_proc_later) = 16.
+port_number(port_user) = 17.
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.136
diff -u -b -r1.136 compiler_design.html
--- compiler/notes/compiler_design.html 15 Oct 2008 04:06:10 -0000 1.136
+++ compiler/notes/compiler_design.html 19 Nov 2008 03:42:09 -0000
@@ -532,6 +532,10 @@
the HLDS:
<dl>
+<dt> mark_tail_calls.m
+<dd> Marks directly tail recursive calls as such,
+and marks procedures containing directly tail recursive calls as such.
+
<dt> hlds_code_util.m
<dd> Utility routines for use during HLDS generation.
cvs diff: Diffing debian
cvs diff: Diffing debian/patches
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
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/concurrency
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_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/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
Index: library/exception.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.134
diff -u -b -r1.134 exception.m
--- library/exception.m 28 Apr 2008 05:13:05 -0000 1.134
+++ library/exception.m 19 Nov 2008 03:35:58 -0000
@@ -1764,6 +1764,7 @@
MR_Code *MR_jumpaddr;
MR_StackWalkStepResult result;
const char *problem;
+ MR_Unsigned reused_frames;
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
const MR_ProcLayout *pl;
@@ -1894,9 +1895,12 @@
}
}
- /* Unwind the stacks back to the previous stack frame. */
+ /*
+ ** Unwind the stacks back to the previous stack frame.
+ ** Note that we don't care whether the frame has been reused.
+ */
result = MR_stack_walk_step(entry_layout, &return_label_layout,
- &base_sp, &base_curfr, &problem);
+ &base_sp, &base_curfr, &reused_frames, &problem);
if (result != MR_STEP_OK) {
WARNING(problem);
return NULL;
cvs diff: Diffing mdbcomp
Index: mdbcomp/prim_data.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/prim_data.m,v
retrieving revision 1.31
diff -u -b -r1.31 prim_data.m
--- mdbcomp/prim_data.m 4 Aug 2008 08:27:59 -0000 1.31
+++ mdbcomp/prim_data.m 18 Nov 2008 12:05:21 -0000
@@ -39,6 +39,7 @@
; port_exit
; port_redo
; port_fail
+ ; port_tailrec_call
; port_exception
; port_ite_cond
; port_ite_then
Index: mdbcomp/trace_counts.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/mdbcomp/trace_counts.m,v
retrieving revision 1.23
diff -u -b -r1.23 trace_counts.m
--- mdbcomp/trace_counts.m 4 Aug 2008 03:17:55 -0000 1.23
+++ mdbcomp/trace_counts.m 21 Nov 2008 03:03:09 -0000
@@ -690,6 +690,7 @@
string_to_trace_port("EXIT", port_exit).
string_to_trace_port("REDO", port_redo).
string_to_trace_port("FAIL", port_fail).
+string_to_trace_port("TAIL", port_tailrec_call).
string_to_trace_port("EXCP", port_exception).
string_to_trace_port("COND", port_ite_cond).
string_to_trace_port("THEN", port_ite_then).
@@ -720,6 +721,7 @@
make_path_port(_GoalPath, port_exit) = port_only(port_exit).
make_path_port(_GoalPath, port_redo) = port_only(port_redo).
make_path_port(_GoalPath, port_fail) = port_only(port_fail).
+make_path_port(GoalPath, port_tailrec_call) = path_only(GoalPath).
make_path_port(_GoalPath, port_exception) = port_only(port_exception).
make_path_port(GoalPath, port_ite_cond) = path_only(GoalPath).
make_path_port(GoalPath, port_ite_then) = path_only(GoalPath).
@@ -735,7 +737,7 @@
make_path_port(GoalPath, port_switch) = path_only(GoalPath).
make_path_port(GoalPath, port_nondet_foreign_proc_first) = path_only(GoalPath).
make_path_port(GoalPath, port_nondet_foreign_proc_later) = path_only(GoalPath).
-make_path_port(_GoalPath, port_user) = port_only(port_call).
+make_path_port(_GoalPath, port_user) = port_only(port_user).
%-----------------------------------------------------------------------------%
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.114
diff -u -b -r1.114 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 18 Mar 2008 01:31:33 -0000 1.114
+++ runtime/mercury_stack_layout.h 21 Nov 2008 02:41:18 -0000
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1998-2008 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.
@@ -913,6 +916,14 @@
** The flags field encodes boolean properties of the procedure. For now,
** the only property is whether the procedure has a pair of I/O state
** arguments.
+**
+XXX
+** If the procedure contains on the nondet stack, or if it cannot create any
+** temporary nondet stack frames, the maybe_maxfr field will contain a negative
+** number. If it lives on the det stack, and can create temporary nondet stack
+** frames, it will contain the number number of the stack slot that contains the
+** value of maxfr on entry, for use in executing the retry debugger command
+** from the middle of the procedure.
*/
#define MR_EVAL_METHOD_MEMO_STRICT MR_EVAL_METHOD_MEMO
@@ -964,6 +975,7 @@
MR_int_least8_t MR_exec_maybe_call_table;
MR_TraceLevelInt MR_exec_trace_level_CAST_ME;
MR_uint_least8_t MR_exec_flags;
+ MR_int_least8_t MR_exec_maybe_tail_rec;
} MR_ExecTrace;
#define MR_compute_max_mr_num(max_mr_num, layout) \
@@ -977,6 +989,28 @@
#define MR_PROC_LAYOUT_FLAG_HAS_IO_STATE_PAIR 0x1
+#define MR_trace_find_reused_frames(proc_layout, sp, reused_frames) \
+ do { \
+ const MR_ExecTrace *exec_trace; \
+ int tailrec_slot; \
+ \
+ exec_trace = proc_layout->MR_sle_exec_trace; \
+ if (exec_trace == NULL) { \
+ (reused_frames) = 0; \
+ } else { \
+ tailrec_slot = proc_layout->MR_sle_maybe_tailrec; \
+ if (tailrec_slot <= 0) { \
+ (reused_frames) = 0; \
+ } else { \
+ if (MR_DETISM_DET_STACK(proc_layout->MR_sle_detism)) { \
+ (reused_frames) = MR_based_stackvar((sp), tailrec_slot);\
+ } else { \
+ MR_fatal_error("tailrec reuses nondet stack frames"); \
+ } \
+ } \
+ } \
+ } while (0)
+
/*-------------------------------------------------------------------------*/
/*
** Definitions for MR_ProcLayout
@@ -1120,6 +1154,7 @@
#define MR_sle_maybe_maxfr MR_sle_exec_trace->MR_exec_maybe_maxfr
#define MR_sle_maybe_call_table MR_sle_exec_trace->MR_exec_maybe_call_table
#define MR_sle_maybe_decl_debug MR_sle_exec_trace->MR_exec_maybe_decl_debug
+#define MR_sle_maybe_tailrec MR_sle_exec_trace->MR_exec_maybe_tail_rec
#define MR_sle_eval_method(proc_layout_ptr) \
((MR_EvalMethod) (proc_layout_ptr)-> \
@@ -1136,8 +1171,7 @@
/* Adjust the arity of functions for printing. */
#define MR_sle_user_adjusted_arity(entry) \
((entry)->MR_sle_user.MR_user_arity - \
- (((entry)->MR_sle_user.MR_user_pred_or_func == MR_FUNCTION) \
- ? 1 : 0))
+ (((entry)->MR_sle_user.MR_user_pred_or_func == MR_FUNCTION) ? 1 : 0))
/*
** Return the name (if any) of the variable with the given HLDS variable number
@@ -1256,7 +1290,7 @@
&MR_proc_static_user_name(module, name, arity, mode))
#define MR_EXTERN_USER_PROC_STATIC_PROC_LAYOUT(detism, slots, succip_locn, \
pf, module, name, arity, mode) \
- MR_MAKE_USER_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots,\
+ MR_MAKE_USER_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots, \
succip_locn, pf, module, name, arity, mode, \
&MR_proc_static_user_name(module, name, arity, mode))
@@ -1267,7 +1301,7 @@
&MR_proc_static_uci_name(module, name, type, arity, mode))
#define MR_EXTERN_UCI_PROC_STATIC_PROC_LAYOUT(detism, slots, succip_locn, \
module, name, type, arity, mode) \
- MR_MAKE_UCI_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots,\
+ MR_MAKE_UCI_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots, \
succip_locn, module, name, type, arity, mode, \
&MR_proc_static_uci_name(module, name, type, arity, mode))
@@ -1277,7 +1311,7 @@
succip_locn, pf, module, name, arity, mode, NULL)
#define MR_EXTERN_USER_PROC_ID_PROC_LAYOUT(detism, slots, succip_locn, \
pf, module, name, arity, mode) \
- MR_MAKE_USER_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots,\
+ MR_MAKE_USER_PROC_STATIC_PROC_LAYOUT(MR_NO_EXTERN_DECL, detism, slots, \
succip_locn, pf, module, name, arity, mode, NULL)
#define MR_DECLARE_UCI_PROC_STATIC_LAYOUTS(mod, n, a) \
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.81
diff -u -b -r1.81 mercury_stack_trace.c
--- runtime/mercury_stack_trace.c 7 Aug 2008 01:16:19 -0000 1.81
+++ runtime/mercury_stack_trace.c 21 Nov 2008 03:04:04 -0000
@@ -28,7 +28,7 @@
static MR_StackWalkStepResult
MR_stack_walk_succip_layout(MR_Code *success,
- const MR_LabelLayout **return_label_layout,
+ const MR_LabelLayout **return_label_layout_ptr,
MR_Word **base_sp_ptr, MR_Word **base_curfr_ptr,
const char **problem_ptr);
@@ -73,9 +73,11 @@
static int MR_dump_stack_record_frame(FILE *fp,
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_PrintStackRecord print_stack_record);
static void MR_print_proc_id_internal(FILE *fp,
@@ -163,6 +165,7 @@
MR_Word *old_trace_curfr;
int frames_dumped_so_far;
int lines_dumped_so_far;
+ MR_Unsigned reused_frames;
MR_do_init_modules();
MR_dump_stack_record_init(include_trace_data, include_contexts);
@@ -176,13 +179,15 @@
lines_dumped_so_far = 0;
do {
if (frame_limit > 0 && frames_dumped_so_far >= frame_limit) {
- MR_dump_stack_record_flush(fp, print_stack_record);
+ MR_dump_stack_record_flush(fp, include_trace_data,
+ 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, print_stack_record);
+ MR_dump_stack_record_flush(fp, include_trace_data,
+ print_stack_record);
fprintf(fp, "<more stack frames snipped>\n");
return NULL;
}
@@ -194,43 +199,51 @@
old_trace_curfr = stack_trace_curfr;
result = MR_stack_walk_step(proc_layout, &cur_label_layout,
- &stack_trace_sp, &stack_trace_curfr, &problem);
+ &stack_trace_sp, &stack_trace_curfr, &reused_frames, &problem);
if (result == MR_STEP_ERROR_BEFORE) {
- MR_dump_stack_record_flush(fp, print_stack_record);
+ MR_dump_stack_record_flush(fp, include_trace_data,
+ 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, print_stack_record, MR_FALSE);
+ old_trace_sp, old_trace_curfr, reused_frames,
+ print_stack_record, MR_FALSE);
- MR_dump_stack_record_flush(fp, print_stack_record);
+ MR_dump_stack_record_flush(fp, include_trace_data,
+ 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,
- print_stack_record, lines_dumped_so_far == line_limit);
+ reused_frames, print_stack_record,
+ lines_dumped_so_far == line_limit);
}
frames_dumped_so_far++;
} while (cur_label_layout != NULL);
- MR_dump_stack_record_flush(fp, print_stack_record);
+ MR_dump_stack_record_flush(fp, include_trace_data, print_stack_record);
return NULL;
}
const MR_LabelLayout *
MR_find_nth_ancestor(const MR_LabelLayout *label_layout,
MR_Level ancestor_level, MR_Word **stack_trace_sp,
- MR_Word **stack_trace_curfr, const char **problem)
+ MR_Word **stack_trace_curfr, MR_Level *actual_level_ptr,
+ const char **problem)
{
MR_StackWalkStepResult result;
const MR_LabelLayout *return_label_layout;
- MR_Unsigned i;
+ MR_Unsigned level;
+ MR_Unsigned reused_frames;
MR_do_init_modules();
*problem = NULL;
- for (i = 0; i < ancestor_level && label_layout != NULL; i++) {
+ level = 0;
+ while (level < ancestor_level && label_layout != NULL) {
result = MR_stack_walk_step(label_layout->MR_sll_entry,
- &return_label_layout, stack_trace_sp, stack_trace_curfr, problem);
+ &return_label_layout, stack_trace_sp, stack_trace_curfr,
+ &reused_frames, problem);
if (result != MR_STEP_OK) {
/* *problem has already been filled in */
@@ -238,28 +251,32 @@
}
label_layout = return_label_layout;
+ level += 1 + reused_frames;
}
if (label_layout == NULL && *problem == NULL) {
*problem = "not that many ancestors";
}
+ *actual_level_ptr = level;
return label_layout;
}
MR_StackWalkStepResult
MR_stack_walk_step(const MR_ProcLayout *proc_layout,
- const MR_LabelLayout **return_label_layout,
+ const MR_LabelLayout **return_label_layout_ptr,
MR_Word **stack_trace_sp_ptr, MR_Word **stack_trace_curfr_ptr,
- const char **problem_ptr)
+ MR_Unsigned *reused_frames_ptr, const char **problem_ptr)
{
MR_LongLval location;
MR_LongLvalType type;
int number;
int determinism;
MR_Code *success;
+ MR_Unsigned reused_frames;
+ int tailrec_slot;
- *return_label_layout = NULL;
+ *return_label_layout_ptr = NULL;
determinism = proc_layout->MR_sle_detism;
if (determinism < 0) {
@@ -283,6 +300,11 @@
}
success = (MR_Code *) MR_based_stackvar(*stack_trace_sp_ptr, number);
+
+ MR_trace_find_reused_frames(proc_layout, *stack_trace_sp_ptr,
+ reused_frames);
+ *reused_frames_ptr = reused_frames;
+
*stack_trace_sp_ptr = *stack_trace_sp_ptr -
proc_layout->MR_sle_stack_slots;
} else {
@@ -297,16 +319,17 @@
*/
success = MR_succip_slot(*stack_trace_curfr_ptr);
+ *reused_frames_ptr = 0;
*stack_trace_curfr_ptr = MR_succfr_slot(*stack_trace_curfr_ptr);
}
- return MR_stack_walk_succip_layout(success, return_label_layout,
+ return MR_stack_walk_succip_layout(success, return_label_layout_ptr,
stack_trace_sp_ptr, stack_trace_curfr_ptr, problem_ptr);
}
static MR_StackWalkStepResult
MR_stack_walk_succip_layout(MR_Code *success,
- const MR_LabelLayout **return_label_layout,
+ const MR_LabelLayout **return_label_layout_ptr,
MR_Word **stack_trace_sp_ptr, MR_Word **stack_trace_curfr_ptr,
const char **problem_ptr)
{
@@ -335,7 +358,7 @@
return MR_STEP_ERROR_AFTER;
}
- *return_label_layout = label->MR_internal_layout;
+ *return_label_layout_ptr = label->MR_internal_layout;
return MR_STEP_OK;
}
@@ -693,7 +716,9 @@
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 = info;
+ MR_Traverse_Nondet_Frame_Func_Info *func_info;
+
+ func_info = (MR_Traverse_Nondet_Frame_Func_Info *) info;
if (category != MR_TERMINAL_TOP_FRAME_ON_SIDE_BRANCH) {
func_info->func(func_info->func_data, top_layout, base_sp, base_curfr);
}
@@ -709,6 +734,7 @@
MR_Word *current_frame;
MR_StackWalkStepResult result;
const char *problem;
+ MR_Unsigned reused_frames;
label_layout = top_layout;
stack_pointer = base_sp;
@@ -716,23 +742,21 @@
MR_nondet_branch_info_next = 0;
- /*
- ** Skip past any model_det frames.
- */
+ /* Skip past any model_det frames. */
do {
proc_layout = label_layout->MR_sll_entry;
if (!MR_DETISM_DET_STACK(proc_layout->MR_sle_detism)) {
break;
}
result = MR_stack_walk_step(proc_layout, &label_layout,
- &stack_pointer, ¤t_frame, &problem);
+ &stack_pointer, ¤t_frame, &reused_frames, &problem);
if (result == MR_STEP_ERROR_BEFORE || result == MR_STEP_ERROR_AFTER) {
MR_fatal_error(problem);
}
} while (label_layout != NULL);
- /* double-check that we didn't skip any model_non frames */
+ /* Double-check that we didn't skip any model_non frames. */
assert(current_frame == base_curfr);
if (label_layout != NULL) {
@@ -764,6 +788,7 @@
MR_Code *success;
const char *problem;
MR_Nondet_Frame_Category category;
+ MR_Unsigned reused_frames;
if (MR_find_matching_branch(fr, &branch)) {
base_sp = MR_nondet_branch_infos[branch].branch_sp;
@@ -785,7 +810,7 @@
*/
while (MR_TRUE) {
result = MR_stack_walk_step(proc_layout, &label_layout,
- &base_sp, &base_curfr, &problem);
+ &base_sp, &base_curfr, &reused_frames, &problem);
if (result != MR_STEP_OK) {
return problem;
@@ -862,7 +887,7 @@
proc_layout = label_layout->MR_sll_entry;
topfr = fr;
result = MR_stack_walk_step(proc_layout, &label_layout,
- &base_sp, &base_curfr, &problem);
+ &base_sp, &base_curfr, &reused_frames, &problem);
}
if (result != MR_STEP_OK) {
@@ -879,10 +904,10 @@
/*
** We must have found the common ancestor of the procedure call
** whose variables we just printed and the call currently being
- ** executed. While this common ancestor must include model_non code,
- ** this may be inside a commit in a procedure that lives on the
- ** det stack. If that is the case, the common ancestor must not be
- ** put into MR_nondet_branch_info.
+ ** executed. While this common ancestor must include model_non
+ ** code, this may be inside a commit in a procedure that lives
+ ** on the det stack. If that is the case, the common ancestor
+ ** must not be put into MR_nondet_branch_info.
*/
return NULL;
@@ -1032,15 +1057,8 @@
/**************************************************************************/
-static const MR_ProcLayout *prev_entry_layout;
-static int prev_entry_layout_count;
-static int prev_entry_start_level;
-static MR_Word *prev_entry_base_sp;
-static MR_Word *prev_entry_base_curfr;
-static const char *prev_entry_filename;
-static int prev_entry_linenumber;
-static const char *prev_entry_goal_path;
-static MR_bool prev_entry_context_mismatch;
+static MR_StackDumpInfo prev_dump_info;
+
static int current_level;
static MR_bool trace_data_enabled;
static MR_bool contexts_enabled;
@@ -1048,26 +1066,24 @@
static void
MR_dump_stack_record_init(MR_bool include_trace_data, MR_bool include_contexts)
{
- prev_entry_layout = NULL;
- prev_entry_layout_count = 0;
- prev_entry_start_level = 0;
+ prev_dump_info.MR_sdi_proc_layout = NULL;
current_level = 0;
- contexts_enabled = include_contexts;
trace_data_enabled = include_trace_data;
+ contexts_enabled = include_contexts;
}
static int
MR_dump_stack_record_frame(FILE *fp, const MR_LabelLayout *label_layout,
- MR_Word *base_sp, MR_Word *base_curfr,
+ MR_Word *base_sp, MR_Word *base_curfr, MR_Unsigned reused_frames,
MR_PrintStackRecord print_stack_record, MR_bool at_line_limit)
{
- const MR_ProcLayout *entry_layout;
+ const MR_ProcLayout *proc_layout;
const char *filename;
int linenumber;
MR_bool must_flush;
int lines_printed;
- entry_layout = label_layout->MR_sll_entry;
+ proc_layout = label_layout->MR_sll_entry;
if (! MR_find_context(label_layout, &filename, &linenumber)
|| ! contexts_enabled)
{
@@ -1081,83 +1097,98 @@
** We cannot merge two calls even to the same procedure if we are printing
** trace data, since this will differ between the calls.
**
- ** 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.
+ ** 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 = (entry_layout != prev_entry_layout) || trace_data_enabled;
+ must_flush = (proc_layout != prev_dump_info.MR_sdi_proc_layout)
+ || trace_data_enabled;
if (must_flush) {
if (! at_line_limit) {
- MR_dump_stack_record_flush(fp, print_stack_record);
+ MR_dump_stack_record_flush(fp, trace_data_enabled,
+ print_stack_record);
}
- prev_entry_layout = entry_layout;
- prev_entry_layout_count = 1;
- prev_entry_start_level = current_level;
- prev_entry_base_sp = base_sp;
- prev_entry_base_curfr = base_curfr;
- prev_entry_filename = filename;
- prev_entry_linenumber = linenumber;
- prev_entry_goal_path = MR_label_goal_path(label_layout);
- prev_entry_context_mismatch = MR_FALSE;
+ 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);
+
lines_printed = 1;
} else {
- prev_entry_layout_count++;
- if (prev_entry_filename != filename
- || prev_entry_linenumber != linenumber)
+ 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)
{
- prev_entry_context_mismatch = MR_TRUE;
+ prev_dump_info.MR_sdi_context_mismatch = MR_TRUE;
}
+
lines_printed = 0;
}
- current_level++;
+ current_level += 1 + reused_frames;
return lines_printed;
}
static void
-MR_dump_stack_record_flush(FILE *fp, MR_PrintStackRecord print_stack_record)
+MR_dump_stack_record_flush(FILE *fp, MR_bool include_trace_data,
+ MR_PrintStackRecord print_stack_record)
{
- if (prev_entry_layout != NULL) {
- print_stack_record(fp, prev_entry_layout,
- prev_entry_layout_count, prev_entry_start_level,
- prev_entry_base_sp, prev_entry_base_curfr,
- prev_entry_filename, prev_entry_linenumber,
- prev_entry_goal_path, prev_entry_context_mismatch);
+ if (prev_dump_info.MR_sdi_proc_layout != NULL) {
+ print_stack_record(fp, include_trace_data, prev_dump_info);
}
}
void
-MR_dump_stack_record_print(FILE *fp, const MR_ProcLayout *proc_layout,
- int count, MR_Level start_level, MR_Word *base_sp, MR_Word *base_curfr,
- const char *filename, int linenumber, const char *goal_path,
- MR_bool context_mismatch)
-{
- fprintf(fp, "%4" MR_INTEGER_LENGTH_MODIFIER "d ", start_level);
-
- if (count > 1) {
- fprintf(fp, " %3d* ", count);
- } else if (! trace_data_enabled) {
- fprintf(fp, "%5s ", "");
- } else {
+MR_dump_stack_record_print(FILE *fp, MR_bool include_trace_data,
+ const MR_StackDumpInfo dump_info)
+{
+ MR_Level num_levels;
+
+ num_levels = dump_info.MR_sdi_max_level + 1 - dump_info.MR_sdi_min_level;
+ fprintf(fp, "%4" MR_INTEGER_LENGTH_MODIFIER "d ",
+ dump_info.MR_sdi_min_level);
+
/*
- ** If we are printing trace data, we need all the horizonal
- ** room we can get, and there will not be any repeated lines,
- ** so we don't reserve space for the repeat counts.
+ ** If we are printing trace data, we need all the horizonal room
+ ** we can get, and there will not be any repeated lines, so we do not
+ ** reserve space for the repeat counts.
*/
+ if (! include_trace_data) {
+ if (num_levels > 1) {
+ if (num_levels != dump_info.MR_sdi_num_frames) {
+ fprintf(fp, " %3dx ", num_levels);
+ } else {
+ fprintf(fp, " %3d* ", num_levels);
+ }
+ } else {
+ fprintf(fp, "%5s ", "");
+ }
}
- MR_maybe_print_call_trace_info(fp, trace_data_enabled, proc_layout,
- base_sp, base_curfr);
- MR_print_proc_id(fp, proc_layout);
- if (MR_strdiff(filename, "") && linenumber > 0) {
- fprintf(fp, " (%s:%d%s)", filename, linenumber,
- context_mismatch ? " and others" : "");
+ 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)
+ {
+ fprintf(fp, " (%s:%d%s)",
+ dump_info.MR_sdi_filename, dump_info.MR_sdi_linenumber,
+ dump_info.MR_sdi_context_mismatch ? " and others" : "");
}
if (trace_data_enabled) {
- if (MR_strdiff(goal_path, "")) {
- fprintf(fp, " %s", goal_path);
+ if (MR_strdiff(dump_info.MR_sdi_goal_path, "")) {
+ fprintf(fp, " %s", dump_info.MR_sdi_goal_path);
} else {
fprintf(fp, " (empty)");
}
@@ -1564,9 +1595,8 @@
MR_Integer maybe_from_full = proc_layout->MR_sle_maybe_from_full;
if (maybe_from_full > 0) {
/*
- ** For procedures compiled with shallow
- ** tracing, the details will be valid only
- ** if the value of MR_from_full saved in
+ ** For procedures compiled with shallow tracing, the details
+ ** will be valid only if the value of MR_from_full saved in
** the appropriate stack slot was MR_TRUE.
*/
if (MR_DETISM_DET_STACK(proc_layout->MR_sle_detism)) {
@@ -1631,6 +1661,7 @@
MR_Word *stack_trace_sp;
MR_Word *stack_trace_curfr;
int ancestor_level;
+ MR_Unsigned reused_frames;
MR_do_init_modules();
@@ -1641,22 +1672,22 @@
ancestor_level = 0;
while (cur_label_layout != NULL) {
-
if (MR_call_is_before_event_or_seq(seq_or_event, seq_no_or_event_no,
cur_label_layout->MR_sll_entry, stack_trace_sp,
- stack_trace_curfr)) {
+ stack_trace_curfr))
+ {
return ancestor_level;
}
result = MR_stack_walk_step(cur_label_layout->MR_sll_entry,
- &cur_label_layout, &stack_trace_sp, &stack_trace_curfr, problem);
+ &cur_label_layout, &stack_trace_sp, &stack_trace_curfr,
+ &reused_frames, problem);
if (result != MR_STEP_OK) {
return -1;
}
- ancestor_level++;
-
+ ancestor_level += 1 + reused_frames;
} while (cur_label_layout != NULL);
*problem = "no more stack";
Index: runtime/mercury_stack_trace.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_stack_trace.h,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_stack_trace.h
--- runtime/mercury_stack_trace.h 2 Oct 2007 17:04:36 -0000 1.41
+++ runtime/mercury_stack_trace.h 19 Nov 2008 00:47:15 -0000
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1998-2001, 2003-2006 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.
@@ -12,7 +15,8 @@
#include <stdio.h>
/*
-** mercury_stack_trace.h -
+** mercury_stack_trace.h:
+**
** Definitions for use by the stack tracing.
*/
@@ -20,7 +24,6 @@
typedef MR_Unsigned MR_SpecLineLimit;
typedef MR_Unsigned MR_Level;
-
/*---------------------------------------------------------------------------*/
/*
@@ -48,8 +51,8 @@
*/
extern void MR_dump_stack(MR_Code *success_pointer,
- MR_Word *det_stack_pointer,
- MR_Word *current_frame, MR_bool include_trace_data);
+ MR_Word *det_stack_pointer, MR_Word *current_frame,
+ MR_bool include_trace_data);
/*
** MR_dump_stack_from_layout
@@ -66,13 +69,38 @@
** why the dump was cut short.
*/
+typedef struct {
+ /*
+ ** The min_level and max_level fields give the range of call levels
+ ** covered by this dump record. The frame_count field gives the number
+ ** of stack frames covered by this dump record.
+ **
+ ** Normally, each call has its own frame, which translates into
+ ** max_level+1-min_level being equal to frame_count. However,
+ ** frame_count can be less than this if the procedure has tail
+ ** recursion events. However, frame_count does not have to be one
+ ** for such procedures, since not all recursive calls are tail
+ ** recursive calls.
+ **
+ ** If include_trace_data is TRUE, frame_count should be 1.
+ */
+ const MR_ProcLayout *MR_sdi_proc_layout;
+ MR_Level MR_sdi_min_level;
+ MR_Level MR_sdi_max_level;
+ MR_Unsigned MR_sdi_num_frames;
+ const char *MR_sdi_filename;
+ int MR_sdi_linenumber;
+ MR_bool MR_sdi_context_mismatch;
+
+ /* These fields are meaningful only if include_trace_data is TRUE. */
+ MR_Word *MR_sdi_base_sp;
+ MR_Word *MR_sdi_base_curfr;
+ const char *MR_sdi_goal_path;
+} MR_StackDumpInfo;
+
typedef void (*MR_PrintStackRecord)(FILE *fp,
- const MR_ProcLayout *proc_layout,
- int count, MR_Level level,
- MR_Word *base_sp, MR_Word * base_curfr,
- const char *filename, int linenumber,
- const char *goal_path,
- MR_bool context_mismatch);
+ MR_bool include_trace_data,
+ MR_StackDumpInfo dump_info);
extern const char *MR_dump_stack_from_layout(FILE *fp,
const MR_LabelLayout *label_layout,
@@ -94,8 +122,8 @@
*/
extern void MR_dump_nondet_stack(FILE *fp, MR_Word *limit_addr,
- MR_FrameLimit frame_limit,
- MR_SpecLineLimit line_limit, MR_Word *maxfr);
+ MR_FrameLimit frame_limit, MR_SpecLineLimit line_limit,
+ MR_Word *maxfr);
/*
** MR_dump_nondet_stack_from_layout
@@ -148,7 +176,8 @@
extern const MR_LabelLayout *MR_find_nth_ancestor(
const MR_LabelLayout *label_layout,
MR_Level ancestor_level, MR_Word **stack_trace_sp,
- MR_Word **stack_trace_curfr, const char **problem);
+ MR_Word **stack_trace_curfr,
+ MR_Level *actual_level_ptr, const char **problem);
/*
** MR_stack_walk_step
@@ -157,8 +186,10 @@
** frame (which is the topmost stack frame from the two stack
** pointers given), and moves down one stack frame, i.e. to the
** caller's frame, setting the stack pointers to their new levels.
+** The number of times that the topmost stack has been reused
+** is returned in *reused_frames_ptr.
**
-** return_label_layout will be set to the stack_layout of the
+** *return_label_layout_ptr will be set to the stack_layout of the
** continuation label, or NULL if the bottom of the stack has
** been reached.
**
@@ -190,6 +221,7 @@
const MR_LabelLayout **return_label_layout,
MR_Word **stack_trace_sp_ptr,
MR_Word **stack_trace_curfr_ptr,
+ MR_Unsigned *reused_frames_ptr,
const char **problem_ptr);
/*
@@ -269,7 +301,8 @@
** procedure to the debugger.
*/
-extern void MR_print_proc_spec(FILE *fp, const MR_ProcLayout *entry);
+extern void MR_print_proc_spec(FILE *fp,
+ const MR_ProcLayout *entry);
/*
** MR_print_proc_separate prints a string that uniquely specifies the given
@@ -277,7 +310,8 @@
** to allow the output to be processed by tools (e.g. awk scripts).
*/
-extern void MR_print_proc_separate(FILE *fp, const MR_ProcLayout *entry);
+extern void MR_print_proc_separate(FILE *fp,
+ const MR_ProcLayout *entry);
/*
** MR_print_proc_id_trace_and_context prints an identification of the given
@@ -311,18 +345,16 @@
MR_Word *base_sp, MR_Word *base_curfr,
const char *path, const char *filename, int lineno,
MR_bool print_parent,
- const char *parent_filename,
- int parent_lineno, int indent);
+ const char *parent_filename, int parent_lineno,
+ int indent);
/*
** MR_dump_stack_record_print() prints one line of a stack dump.
*/
extern void MR_dump_stack_record_print(FILE *fp,
- const MR_ProcLayout *proc_layout, int count,
- MR_Level start_level, MR_Word *base_sp, MR_Word *base_curfr,
- const char *filename, int linenumber,
- const char *goal_path, MR_bool context_mismatch);
+ MR_bool include_trace_data,
+ MR_StackDumpInfo dump_info);
/*
** Find the first call event on the stack whose event number or sequence number
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.86
diff -u -b -r1.86 mercury_trace_base.c
--- runtime/mercury_trace_base.c 30 Oct 2007 00:46:22 -0000 1.86
+++ runtime/mercury_trace_base.c 21 Nov 2008 01:41:31 -0000
@@ -74,6 +74,9 @@
MR_bool MR_trace_unhide_events = MR_FALSE;
MR_bool MR_trace_have_unhid_events = MR_FALSE;
+MR_bool MR_trace_tailrec_have_reused_frames = MR_FALSE;
+MR_Unsigned MR_trace_tailrec_num_reused_frames = 0;
+
/*
** I/O tabling is documented in library/table_builtin.m
*/
Index: runtime/mercury_trace_base.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_trace_base.h,v
retrieving revision 1.63
diff -u -b -r1.63 mercury_trace_base.h
--- runtime/mercury_trace_base.h 2 Oct 2007 03:37:26 -0000 1.63
+++ runtime/mercury_trace_base.h 21 Nov 2008 01:46:03 -0000
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1997-2007 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.
@@ -36,6 +39,7 @@
MR_PORT_EXIT,
MR_PORT_REDO,
MR_PORT_FAIL,
+ MR_PORT_TAILREC_CALL,
MR_PORT_EXCEPTION,
MR_PORT_COND,
MR_PORT_THEN,
@@ -59,6 +63,7 @@
"EXIT", \
"REDO", \
"FAIL", \
+ "TAIL", \
"EXCP", \
"COND", \
"THEN", \
@@ -79,6 +84,7 @@
"EXIT", \
"REDO", \
"FAIL", \
+ "TAIL", \
"EXCP", \
"COND", \
"THEN", \
@@ -117,7 +123,12 @@
#define MR_trace_fill_std_slots(s1, s2, s3) \
(((s1) = MR_trace_event_number), \
((s2) = MR_trace_incr_seq()), \
- ((s3) = MR_trace_incr_depth())) \
+ ((s3) = MR_trace_incr_depth()))
+
+#define MR_trace_tailrec_std_slots(s1, s2, s3) \
+ (((s1) = MR_trace_event_number), \
+ ((s2) = MR_trace_incr_seq()), \
+ ((s3) = (s3) + 1))
#define MR_trace_reset_depth(d) \
(MR_trace_call_depth = (MR_Unsigned) (d))
@@ -179,7 +190,8 @@
#define MR_TRACE_COUNT_FILE_ID "Mercury trace counts file\n"
extern unsigned int MR_trace_write_label_exec_counts(FILE *fp,
- const char *progname, MR_bool coverage_test);
+ const char *progname,
+ MR_bool coverage_test);
/*
** Figure out where (to which file) to write out the label execution counts,
@@ -428,6 +440,30 @@
extern MR_bool MR_trace_have_unhid_events;
/*
+** When executing a retry on a call that has reused the stack frame of some
+** of its ancestors, we start executing the code of the procedure from the very
+** beginning. This code sets the stack slot that contains the count of
+** how many times that stack frame was reused to zero. This is the right thing
+** to do for normal execution, but doing it after a retry screws up the
+** debugger's picture of the stack.
+**
+** These two variables are part of the fix for this problem. The boolean
+** MR_trace_tailrec_have_reused_frames is almost always false. However,
+** when we are executing a retry of a procedure with TAIL events, we set it
+** momentarily to true, and set MR_trace_tailrec_num_reused_frames to the
+** original value of the frame reuse counter. We make the procedure prologue
+** for procedures with TAIL events check MR_trace_tailrec_have_reused_frames,
+** and it is set, we initialize the slot not to zero but to the value in
+** MR_trace_tailrec_num_reused_frames (we also reset the boolean to false).
+**
+** Note that the contents of MR_trace_tailrec_num_reused_frames are valid
+** only when MR_trace_tailrec_have_reused_frames is true.
+*/
+
+MR_bool MR_trace_tailrec_have_reused_frames;
+MR_Unsigned MR_trace_tailrec_num_reused_frames;
+
+/*
** The details of I/O tabling are documented in library/table_builtin.m.
*/
@@ -545,7 +581,8 @@
extern void MR_turn_off_debug(MR_SavedDebugState *saved_state,
MR_bool include_counter_vars);
-extern void MR_turn_debug_back_on(const MR_SavedDebugState *saved_state);
+extern void MR_turn_debug_back_on(
+ const MR_SavedDebugState *saved_state);
/*
** These functions allow library/exceptions.m to tell the debuggers
@@ -654,7 +691,8 @@
** transient.
*/
-#define MR_TRACE_USE_HP(STATEMENTS) do { \
+#define MR_TRACE_USE_HP(STATEMENTS) \
+ do { \
MR_restore_transient_registers(); \
STATEMENTS; \
MR_save_transient_registers(); \
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
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/diff
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/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mercury.options,v
retrieving revision 1.26
diff -u -b -r1.26 Mercury.options
--- tests/debugger/Mercury.options 14 Nov 2007 03:45:11 -0000 1.26
+++ tests/debugger/Mercury.options 21 Nov 2008 02:01:43 -0000
@@ -57,6 +57,8 @@
# The -O2 is to prevent spurious inconsistencies.
MCFLAGS-solver_test = -O2 --no-optimize-dead-procs --solver-type-auto-init
+MCFLAGS-tailrec1 = --trace deep --exec-trace-tail-rec --trace-table-io-all
+
# We need to use shared libraries for interactive queries to work.
# The following is necessary for shared libraries to work on Linux.
GRADEFLAGS-interactive = --pic-reg
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.141
diff -u -b -r1.141 Mmakefile
--- tests/debugger/Mmakefile 20 Feb 2008 03:01:48 -0000 1.141
+++ tests/debugger/Mmakefile 21 Nov 2008 02:56:10 -0000
@@ -15,7 +15,8 @@
scripts \
tabled_read \
tabled_read_unitize \
- tabled_read_decl
+ tabled_read_decl \
+ tailrec1
NONRETRY_PROGS = \
ambiguity \
@@ -551,6 +552,9 @@
sed 's/c_pointer(0x[0-9A-Fa-f]*)/c_pointer(0xXXXX)/g' \
> tabled_read_decl.out 2>&1
+tailrec1.out: tailrec1 tailrec1.inp tailrec1.data
+ $(MDB_STD) ./tailrec1 < tailrec1.inp > tailrec1.out 2>&1
+
term_size_cells.out: term_size_cells term_size_cells.inp
$(MDB_STD) ./term_size_cells < term_size_cells.inp \
> term_size_cells.out 2>&1
Index: tests/debugger/tailrec1.data
===================================================================
RCS file: tests/debugger/tailrec1.data
diff -N tests/debugger/tailrec1.data
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/tailrec1.data 21 Nov 2008 02:02:17 -0000
@@ -0,0 +1,6 @@
+This
+is
+a
+list
+of
+words
Index: tests/debugger/tailrec1.exp
===================================================================
RCS file: tests/debugger/tailrec1.exp
diff -N tests/debugger/tailrec1.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/tailrec1.exp 21 Nov 2008 03:02:04 -0000
@@ -0,0 +1,126 @@
+ E1: C1 CALL pred tailrec1.main/2-0 (det) tailrec1.m:17
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> context none
+Contexts will not be printed.
+mdb> break tailrec1_read_line
+ 0: + stop interface pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> continue
+ E2: C2 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E3: C2 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
+ Line (arg 2) "This"
+mdb> stack
+ 0 pred tailrec1.tailrec1_read_line/4-0 (det)
+ 1 pred tailrec1.tailrec1_read_strings/5-0 (det)
+ 2 pred tailrec1.main/2-0 (det)
+mdb> stack -d
+ 0 E2 C2 3 pred tailrec1.tailrec1_read_line/4-0 (det) (empty)
+ 1 E4 C3 2 pred tailrec1.tailrec1_read_strings/5-0 (det) c1;
+ 2 E1 C1 1 pred tailrec1.main/2-0 (det) c3;s2-2;c3;
+mdb> continue
+ E5: C4 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E6: C4 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> stack
+ 0 pred tailrec1.tailrec1_read_line/4-0 (det)
+ 1 2x pred tailrec1.tailrec1_read_strings/5-0 (det)
+ 3 pred tailrec1.main/2-0 (det)
+mdb> stack -d
+ 0 E5 C4 4 pred tailrec1.tailrec1_read_line/4-0 (det) (empty)
+ 1 E7 C5 3 pred tailrec1.tailrec1_read_strings/5-0 (det) c1;
+ 3 E1 C1 1 pred tailrec1.main/2-0 (det) c3;s2-2;c3;
+mdb> continue
+ E8: C6 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E9: C6 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> continue
+ E10: C7 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E11: C7 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> step
+ E12: C8 COND pred tailrec1.tailrec1_read_strings/5-0 (det) c2;?;
+mdb> step
+ E13: C8 ELSE pred tailrec1.tailrec1_read_strings/5-0 (det) c2;e;
+mdb> step
+ E14: C9 TAIL pred tailrec1.tailrec1_read_strings/5-0 (det) c2;e;c2;
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
+ STATE_VARIABLE_Words_0 (arg 2) ["a", "is", "This"]
+ STATE_VARIABLE_Words_1 ["list", "a", "is", "This"]
+ Word "list"
+mdb> continue
+ E15: C10 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E16: C10 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> continue
+ E17: C11 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E18: C11 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
+ Line (arg 2) "words"
+mdb> retry -f
+ E17: C11 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> stack
+ 0 pred tailrec1.tailrec1_read_line/4-0 (det)
+ 1 6x pred tailrec1.tailrec1_read_strings/5-0 (det)
+ 7 pred tailrec1.main/2-0 (det)
+mdb> stack -d
+ 0 E17 C11 8 pred tailrec1.tailrec1_read_line/4-0 (det) (empty)
+ 1 E19 C12 7 pred tailrec1.tailrec1_read_strings/5-0 (det) c1;
+ 7 E1 C1 1 pred tailrec1.main/2-0 (det) c3;s2-2;c3;
+mdb> finish
+ E18: C11 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
+ Line (arg 2) "words"
+mdb> level 1
+Ancestor level set to 1:
+ 1 pred tailrec1.tailrec1_read_strings/5-0 (det)
+mdb> print *
+ Stream (arg 1) stream(0, input, text, file("tailrec1.data"))
+ STATE_VARIABLE_Words_0 (arg 2) ["of", "list", "a", "is", "This"]
+mdb> level 2
+The stack frame of that call has been reused.
+mdb> retry -f 3
+cannot retry a call whose stack frame has been reused
+mdb> retry -f 1
+ E19: C12 CALL pred tailrec1.tailrec1_read_strings/5-0 (det)
+mdb> stack
+ 0 6x pred tailrec1.tailrec1_read_strings/5-0 (det)
+ 6 pred tailrec1.main/2-0 (det)
+mdb> stack -d
+ 0 E19 C12 7 pred tailrec1.tailrec1_read_strings/5-0 (det) (empty)
+ 6 E1 C1 1 pred tailrec1.main/2-0 (det) c3;s2-2;c3;
+mdb> continue
+ E17: C11 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E18: C11 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> continue
+ E20: C13 CALL pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> finish
+ E21: C13 EXIT pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> step
+ E22: C14 COND pred tailrec1.tailrec1_read_strings/5-0 (det) c2;?;
+mdb> next
+ E23: C14 THEN pred tailrec1.tailrec1_read_strings/5-0 (det) c2;t;
+mdb> next 3
+Due to the reuse of stack frames by tail recursive procedures,
+this command is a no-op from this port.
+mdb> delete *
+ 0: E stop interface pred tailrec1.tailrec1_read_line/4-0 (det)
+mdb> continue
+words
+of
+list
+a
+is
+This
+6
Index: tests/debugger/tailrec1.inp
===================================================================
RCS file: tests/debugger/tailrec1.inp
diff -N tests/debugger/tailrec1.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/tailrec1.inp 21 Nov 2008 03:02:02 -0000
@@ -0,0 +1,49 @@
+echo on
+register --quiet
+table_io allow
+table_io start
+context none
+break tailrec1_read_line
+continue
+finish
+print *
+stack
+stack -d
+continue
+finish
+stack
+stack -d
+continue
+finish
+continue
+finish
+step
+step
+step
+print *
+continue
+finish
+continue
+finish
+print *
+retry -f
+stack
+stack -d
+finish
+print *
+level 1
+print *
+level 2
+retry -f 3
+retry -f 1
+stack
+stack -d
+continue
+finish
+continue
+finish
+step
+next
+next 3
+delete *
+continue
Index: tests/debugger/tailrec1.m
===================================================================
RCS file: tests/debugger/tailrec1.m
diff -N tests/debugger/tailrec1.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/tailrec1.m 21 Nov 2008 01:58:56 -0000
@@ -0,0 +1,89 @@
+% vim: ts=4 sw=4 et ft=mercury
+
+:- module tailrec1.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module int.
+:- import_module string.
+
+main(!IO) :-
+ io.open_input("tailrec1.data", Result, !IO),
+ (
+ Result = ok(Stream),
+ tailrec1_read_strings(Stream, [], Words, !IO),
+ tailrec1_length(Words, Length),
+ tailrec1_write_strings(Words, !IO),
+ io.write_int(Length, !IO),
+ io.nl(!IO)
+ ;
+ Result = error(Error),
+ io.error_message(Error, Msg),
+ io.write_string(Msg, !IO),
+ io.nl(!IO)
+ ).
+
+:- pred tailrec1_read_strings(input_stream::in,
+ list(string)::in, list(string)::out, io::di, io::uo) is det.
+
+tailrec1_read_strings(Stream, !Words, !IO) :-
+ tailrec1_read_line(Stream, Word, !IO),
+ ( Word = "" ->
+ true
+ ;
+ !:Words = [Word | !.Words],
+ tailrec1_read_strings(Stream, !Words, !IO)
+ ).
+
+:- pred tailrec1_read_line(io.input_stream::in, string::out, io::di, io::uo)
+ is det.
+
+:- pragma foreign_proc("C",
+ tailrec1_read_line(Stream::in, Line::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+ /* this needs to be big enough only for the lines in tailrec1.data. */
+ char buf[100];
+ int c;
+ int i;
+
+ i = 0;
+ while ((c = mercury_getc((MercuryFilePtr) Stream)) != EOF && c != '\\n') {
+ if (i < 100) {
+ buf[i] = c;
+ }
+
+ i++;
+ }
+
+ buf[i] = '\\0';
+ MR_make_aligned_string_copy(Line, buf);
+ IO = IO0;
+").
+
+:- pred tailrec1_length(list(T)::in, int::out) is det.
+
+tailrec1_length(List, Length) :-
+ tailrec1_length_2(List, 0, Length).
+
+:- pred tailrec1_length_2(list(T)::in, int::in, int::out) is det.
+
+tailrec1_length_2([], !Length).
+tailrec1_length_2([_X | Xs], !Length) :-
+ !:Length = !.Length + 1,
+ tailrec1_length_2(Xs, !Length).
+
+:- pred tailrec1_write_strings(list(string)::in, io::di, io::uo) is det.
+
+tailrec1_write_strings([], !IO).
+tailrec1_write_strings([Word | Words], !IO) :-
+ io.write_string(Word, !IO),
+ io.nl(!IO),
+ tailrec1_write_strings(Words, !IO).
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
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/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.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.107
diff -u -b -r1.107 mercury_trace.c
--- trace/mercury_trace.c 2 Oct 2007 17:04:36 -0000 1.107
+++ trace/mercury_trace.c 21 Nov 2008 02:40:40 -0000
@@ -74,7 +74,7 @@
static MR_Code *MR_trace_event(MR_TraceCmdInfo *cmd,
MR_bool interactive, const MR_LabelLayout *layout,
MR_TracePort port, MR_Unsigned seqno,
- MR_Unsigned depth);
+ MR_Unsigned depth, const char *msg);
static MR_bool MR_in_traced_region(const MR_ProcLayout *proc_layout,
MR_Word *base_sp, MR_Word *base_curfr);
static MR_bool MR_is_io_state(MR_TypeInfoParams type_params,
@@ -210,18 +210,20 @@
MR_compute_max_mr_num(event_info.MR_max_mr_num, layout);
port = (MR_TracePort) layout->MR_sll_port;
path = MR_label_goal_path(layout);
- MR_copy_regs_to_saved_regs(event_info.MR_max_mr_num, saved_regs);
+ MR_copy_regs_to_saved_regs(event_info.MR_max_mr_num,
+ saved_regs);
MR_trace_init_point_vars(layout, saved_regs, port, MR_FALSE);
lineno = MR_get_line_number(saved_regs, layout, port);
- MR_COLLECT_filter(MR_trace_ctrl.MR_filter_ptr, seqno, depth, port,
- layout, path, lineno, &stop_collecting);
- MR_copy_saved_regs_to_regs(event_info.MR_max_mr_num, saved_regs);
+ MR_COLLECT_filter(MR_trace_ctrl.MR_filter_ptr, seqno, depth,
+ port, layout, path, lineno, &stop_collecting);
+ MR_copy_saved_regs_to_regs(event_info.MR_max_mr_num,
+ saved_regs);
if (stop_collecting) {
MR_trace_ctrl.MR_trace_cmd = MR_CMD_STEP;
- return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout,
+ port, seqno, depth, NULL);
}
#else
MR_fatal_error("attempt to use external debugger");
@@ -233,7 +235,7 @@
case MR_CMD_STEP:
port = (MR_TracePort) layout->MR_sll_port;
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
case MR_CMD_GOTO:
#if 0
@@ -251,32 +253,67 @@
{
port = (MR_TracePort) layout->MR_sll_port;
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
case MR_CMD_NEXT:
- if (MR_trace_ctrl.MR_trace_stop_depth != depth) {
- goto check_stop_print;
+ {
+ const MR_ProcLayout *proc_layout;
+ MR_Unsigned stop_depth;
+ MR_Unsigned reused_frames;
+ const char *msg;
+
+ stop_depth = MR_trace_ctrl.MR_trace_stop_depth;
+ proc_layout = layout->MR_sll_entry;
+ MR_trace_find_reused_frames(proc_layout, MR_sp, reused_frames);
+
+ if (depth - reused_frames <= stop_depth && stop_depth <= depth)
+ {
+ if (depth != stop_depth) {
+ msg = "This is the next event of a call"
+ " that reused the selected stack frame.\n";
} else {
+ msg = NULL;
+ }
+
port = (MR_TracePort) layout->MR_sll_port;
- return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout,
+ port, seqno, depth, msg);
+ } else {
+ goto check_stop_print;
+ }
}
case MR_CMD_FINISH:
- if (MR_trace_ctrl.MR_trace_stop_depth != depth) {
- goto check_stop_print;
- } else {
port = (MR_TracePort) layout->MR_sll_port;
+ if (MR_port_is_final(port)) {
+ const MR_ProcLayout *proc_layout;
+ MR_Unsigned stop_depth;
+ MR_Unsigned reused_frames;
+ const char *msg;
+
+ stop_depth = MR_trace_ctrl.MR_trace_stop_depth;
+ proc_layout = layout->MR_sll_entry;
+ MR_trace_find_reused_frames(proc_layout, MR_sp, reused_frames);
- if (! MR_port_is_final(port)) {
- goto check_stop_print;
+ if (depth - reused_frames <= stop_depth && stop_depth <= depth)
+ {
+ if (depth != stop_depth) {
+ msg = "This is the finish of a call"
+ " that reused the selected stack frame.\n";
} else {
+ msg = NULL;
+ }
+
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout,
- port, seqno, depth);
+ port, seqno, depth, msg);
+ } else {
+ goto check_stop_print;
}
+ } else {
+ goto check_stop_print;
}
case MR_CMD_FAIL:
@@ -287,7 +324,7 @@
if (port == MR_PORT_FAIL || port == MR_PORT_EXCEPTION) {
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout,
- port, seqno, depth);
+ port, seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -300,7 +337,7 @@
port != MR_PORT_EXCEPTION)
{
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -309,7 +346,7 @@
port = (MR_TracePort) layout->MR_sll_port;
if (port == MR_PORT_EXCEPTION) {
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -318,7 +355,7 @@
port = (MR_TracePort) layout->MR_sll_port;
if (port != MR_PORT_EXIT) {
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -327,7 +364,7 @@
port = (MR_TracePort) layout->MR_sll_port;
if (port == MR_PORT_USER) {
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -336,7 +373,7 @@
if (MR_trace_ctrl.MR_trace_stop_depth <= depth) {
port = (MR_TracePort) layout->MR_sll_port;
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -345,7 +382,7 @@
if (MR_trace_ctrl.MR_trace_stop_depth >= depth) {
port = (MR_TracePort) layout->MR_sll_port;
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
} else {
goto check_stop_print;
}
@@ -405,7 +442,7 @@
if (! match) {
if (MR_trace_ctrl.MR_trace_print_level == MR_PRINT_LEVEL_ALL) {
return MR_trace_event(&MR_trace_ctrl, MR_FALSE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
}
return NULL;
@@ -413,7 +450,7 @@
if ((! MR_trace_ctrl.MR_trace_strict) && action == MR_SPY_STOP) {
return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
}
if (MR_trace_ctrl.MR_trace_print_level != MR_PRINT_LEVEL_NONE) {
@@ -424,7 +461,7 @@
*/
return MR_trace_event(&MR_trace_ctrl, MR_FALSE, layout, port,
- seqno, depth);
+ seqno, depth, NULL);
}
}
@@ -467,7 +504,8 @@
port = (MR_TracePort) layout->MR_sll_port;
MR_trace_event_number++;
- return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port, seqno, depth);
+ return MR_trace_event(&MR_trace_ctrl, MR_TRUE, layout, port, seqno, depth,
+ NULL);
}
void
@@ -535,7 +573,7 @@
static MR_Code *
MR_trace_event(MR_TraceCmdInfo *cmd, MR_bool interactive,
const MR_LabelLayout *layout, MR_TracePort port,
- MR_Unsigned seqno, MR_Unsigned depth)
+ MR_Unsigned seqno, MR_Unsigned depth, const char *msg)
{
MR_TRACE_EVENT_DECL_AND_SETUP
@@ -563,7 +601,7 @@
(void) MR_event_matches_spy_point(layout, port, &action,
&print_list);
jumpaddr = MR_trace_event_internal(cmd, interactive,
- print_list, &event_info);
+ print_list, &event_info, msg);
}
#ifdef MR_USE_EXTERNAL_DEBUGGER
break;
@@ -662,6 +700,7 @@
int i;
MR_bool succeeded;
MR_Word *saved_regs;
+ MR_Unsigned reused_frames;
MR_bool has_io_state;
MR_bool io_actions_were_performed;
MR_bool is_io_state;
@@ -934,6 +973,12 @@
MR_saved_curfr_word(saved_regs) = (MR_Word) base_curfr;
MR_saved_maxfr_word(saved_regs) = (MR_Word) base_maxfr;
+ MR_trace_find_reused_frames(level_layout, base_sp, reused_frames);
+ if (reused_frames != 0) {
+ MR_trace_tailrec_have_reused_frames = MR_TRUE;
+ MR_trace_tailrec_num_reused_frames = reused_frames;
+ }
+
/*
** If the retried call is shallow traced, it must have been called from
** a deep traced region, since otherwise we wouldn't have had
@@ -1184,7 +1229,8 @@
MR_StackWalkStepResult result;
const MR_ProcLayout *level_layout;
const MR_LabelLayout *return_label_layout;
- int i;
+ MR_Level level;
+ MR_Unsigned reused_frames;
if (ancestor_level < 0) {
*problem = "no such stack frame";
@@ -1220,9 +1266,10 @@
fprintf(MR_mdb_out, "\n");
#endif
- for (i = 0; i < ancestor_level; i++) {
+ level = 0;
+ while (level < ancestor_level) {
result = MR_stack_walk_step(level_layout, &return_label_layout,
- base_sp_ptr, base_curfr_ptr, problem);
+ base_sp_ptr, base_curfr_ptr, &reused_frames, problem);
if (result != MR_STEP_OK || return_label_layout == NULL) {
if (*problem == NULL) {
*problem = "not that many ancestors";
@@ -1240,6 +1287,7 @@
fprintf(MR_mdb_out, "\n");
MR_print_nondetstackptr(MR_mdb_out, *maxfr_ptr);
fprintf(MR_mdb_out, "\n");
+ fprintf(MR_mdb_out, "reused_frames: %ld\n", (long) reused_frames);
#endif
level_layout = return_label_layout->MR_sll_entry;
@@ -1248,10 +1296,11 @@
** Don't unwind to builtin_catch, because builtin_catch has
** no CALL event, even though it has a stack frame.
*/
- if ((i == ancestor_level - 1) &&
+ if ((level == ancestor_level - 1) &&
MR_trace_proc_layout_is_builtin_catch(level_layout))
{
- i--;
+ /* XXX This seems like it will induce an infinite loop. */
+ level--;
}
*problem = MR_undo_updates_of_maxfr(level_layout,
@@ -1263,6 +1312,13 @@
MR_maybe_record_call_table(level_layout,
*base_sp_ptr, *base_curfr_ptr);
+
+ level += 1 + reused_frames;
+ }
+
+ if (level != ancestor_level) {
+ *problem = "cannot retry a call whose stack frame has been reused";
+ return NULL;
}
#ifdef MR_DEBUG_RETRY_STACKS
@@ -1272,6 +1328,7 @@
fprintf(MR_mdb_out, "\n");
MR_print_nondetstackptr(MR_mdb_out, *maxfr_ptr);
fprintf(MR_mdb_out, "\n");
+ fprintf(MR_mdb_out, "final level: %ld\n", (long) level);
#endif
return return_label_layout;
Index: trace/mercury_trace_cmd_browsing.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_browsing.c,v
retrieving revision 1.10
diff -u -b -r1.10 mercury_trace_cmd_browsing.c
--- trace/mercury_trace_cmd_browsing.c 2 Oct 2007 03:37:27 -0000 1.10
+++ trace/mercury_trace_cmd_browsing.c 19 Nov 2008 06:05:29 -0000
@@ -1021,8 +1021,10 @@
const char *parent_filename;
int parent_lineno;
const char *problem; /* not used */
- MR_Word *base_sp, *base_curfr;
+ MR_Word *base_sp;
+ MR_Word *base_curfr;
const char *msg;
+ MR_Level actual_level;
if (MR_trace_source_server.server_name != NULL) {
lineno = 0;
@@ -1030,27 +1032,29 @@
parent_lineno = 0;
parent_filename = "";
+ if (filename[0] == '\0') {
+ (void) MR_find_context(event_info->MR_event_sll,
+ &filename, &lineno);
+ }
+
/*
- ** At interface ports we send both the parent context and
- ** the current context. Otherwise, we just send the current
- ** context.
+ ** At interface ports we send both the parent context and the
+ ** current context. Otherwise, we just send the current context.
*/
if (MR_port_is_interface(event_info->MR_trace_port)) {
base_sp = MR_saved_sp(event_info->MR_saved_regs);
base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
parent = MR_find_nth_ancestor(event_info->MR_event_sll, 1,
- &base_sp, &base_curfr, &problem);
- if (parent != NULL) {
+ &base_sp, &base_curfr, &actual_level, &problem);
+ if (actual_level != 1) {
+ parent_filename = filename;
+ parent_lineno = lineno;
+ } else if (parent != NULL) {
(void) MR_find_context(parent, &parent_filename,
&parent_lineno);
}
}
- if (filename[0] == '\0') {
- (void) MR_find_context(event_info->MR_event_sll,
- &filename, &lineno);
- }
-
msg = MR_trace_source_sync(&MR_trace_source_server, filename, lineno,
parent_filename, parent_lineno, verbose);
if (msg != NULL) {
Index: trace/mercury_trace_cmd_forward.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_cmd_forward.c,v
retrieving revision 1.5
diff -u -b -r1.5 mercury_trace_cmd_forward.c
--- trace/mercury_trace_cmd_forward.c 2 Oct 2007 03:37:27 -0000 1.5
+++ trace/mercury_trace_cmd_forward.c 19 Nov 2008 14:44:00 -0000
@@ -118,9 +118,17 @@
MR_trace_cmd_next(char **words, int word_count, MR_TraceCmdInfo *cmd,
MR_EventInfo *event_info, MR_Code **jumpaddr)
{
+ const MR_ProcLayout *proc_layout;
+ const MR_LabelLayout *ancestor_layout;
MR_Unsigned depth;
MR_Unsigned stop_depth;
MR_Unsigned n;
+ MR_TracePort port;
+ MR_Word *base_sp;
+ MR_Word *base_curfr;
+ MR_Unsigned reused_frames;
+ MR_Level actual_level;
+ const char *problem; /* not used */
depth = event_info->MR_call_depth;
cmd->MR_trace_strict = MR_TRUE;
@@ -132,19 +140,47 @@
} else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
stop_depth = depth - n;
} else if (word_count == 1) {
+ n = 0;
stop_depth = depth;
} else {
MR_trace_usage_cur_cmd();
return KEEP_INTERACTING;
}
- if (depth == stop_depth && MR_port_is_final(event_info->MR_trace_port)) {
+ base_sp = MR_saved_sp(event_info->MR_saved_regs);
+ base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
+ proc_layout = event_info->MR_event_sll->MR_sll_entry;
+ MR_trace_find_reused_frames(proc_layout, base_sp, reused_frames);
+ port = event_info->MR_trace_port;
+
+ if (depth == stop_depth &&
+ (MR_port_is_final(port) || port == MR_PORT_TAILREC_CALL))
+ {
MR_trace_do_noop();
+ } else if (depth - reused_frames <= stop_depth && stop_depth < depth) {
+ 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);
+ if (ancestor_layout == NULL) {
+ fflush(MR_mdb_out);
+ if (problem != NULL) {
+ fprintf(MR_mdb_err, "mdb: %s\n", problem);
+ } else {
+ fprintf(MR_mdb_err, "mdb: not that many ancestors.\n");
+ }
+ return KEEP_INTERACTING;
+ } else if (actual_level != n) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "mdb: that stack frame has been reused, "
+ "will stop in reusing call.\n");
} else {
cmd->MR_trace_cmd = MR_CMD_NEXT;
cmd->MR_trace_stop_depth = stop_depth;
return STOP_INTERACTING;
}
+ }
return KEEP_INTERACTING;
}
@@ -153,9 +189,17 @@
MR_trace_cmd_finish(char **words, int word_count, MR_TraceCmdInfo *cmd,
MR_EventInfo *event_info, MR_Code **jumpaddr)
{
+ const MR_ProcLayout *proc_layout;
+ const MR_LabelLayout *ancestor_layout;
MR_Unsigned depth;
MR_Unsigned stop_depth;
MR_Unsigned n;
+ MR_TracePort port;
+ MR_Word *base_sp;
+ MR_Word *base_curfr;
+ MR_Unsigned reused_frames;
+ MR_Level actual_level;
+ const char *problem; /* not used */
depth = event_info->MR_call_depth;
cmd->MR_trace_strict = MR_TRUE;
@@ -167,19 +211,48 @@
} else if (word_count == 2 && MR_trace_is_natural_number(words[1], &n)) {
stop_depth = depth - n;
} else if (word_count == 1) {
+ n = 0;
stop_depth = depth;
} else {
MR_trace_usage_cur_cmd();
return KEEP_INTERACTING;
}
- if (depth == stop_depth && MR_port_is_final(event_info->MR_trace_port)) {
+ base_sp = MR_saved_sp(event_info->MR_saved_regs);
+ base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
+ proc_layout = event_info->MR_event_sll->MR_sll_entry;
+ MR_trace_find_reused_frames(proc_layout, base_sp, reused_frames);
+ port = event_info->MR_trace_port;
+
+ if (MR_port_is_final(port) && depth == stop_depth) {
MR_trace_do_noop();
+ } else if (MR_port_is_final(port) &&
+ depth - reused_frames <= stop_depth && stop_depth < depth)
+ {
+ 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);
+ if (ancestor_layout == NULL) {
+ fflush(MR_mdb_out);
+ if (problem != NULL) {
+ fprintf(MR_mdb_err, "mdb: %s\n", problem);
+ } else {
+ fprintf(MR_mdb_err, "mdb: not that many ancestors.\n");
+ }
+ return KEEP_INTERACTING;
+ } else if (actual_level != n) {
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err, "%d %d\n", (int) n, (int) actual_level);
+ fprintf(MR_mdb_err,
+ "mdb: that stack frame has been reused, "
+ "will stop at finish of reusing call.\n");
} else {
cmd->MR_trace_cmd = MR_CMD_FINISH;
cmd->MR_trace_stop_depth = stop_depth;
return STOP_INTERACTING;
}
+ }
return KEEP_INTERACTING;
}
@@ -219,6 +292,12 @@
return KEEP_INTERACTING;
}
+ /*
+ ** A procedure that lives on the nondet stack cannot have its stack frame
+ ** reused by tail recursive calls (at least not when any kind of debugging
+ ** is enabled).
+ */
+
if (depth == stop_depth && event_info->MR_trace_port == MR_PORT_FAIL) {
MR_trace_do_noop();
} else if (depth == stop_depth &&
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.113
diff -u -b -r1.113 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 27 Sep 2007 07:28:28 -0000 1.113
+++ trace/mercury_trace_declarative.c 19 Nov 2008 02:35:09 -0000
@@ -795,6 +795,7 @@
/* do nothing */
break;
+ case MR_PORT_TAILREC_CALL:
default:
MR_fatal_error("MR_trace_construct_node: unknown port");
}
@@ -878,6 +879,7 @@
MR_Word *base_sp;
MR_Word *base_curfr;
MR_Word maybe_return_label;
+ MR_Unsigned reused_frames;
if (MR_edt_depth == MR_edt_max_depth) {
at_depth_limit = MR_TRUE;
@@ -892,7 +894,8 @@
base_sp = MR_saved_sp(event_info->MR_saved_regs);
base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
result = MR_stack_walk_step(event_proc_layout, &return_label_layout,
- &base_sp, &base_curfr, &problem);
+ &base_sp, &base_curfr, &reused_frames, &problem);
+ assert(reused_frames == 0);
/*
** return_label_layout may be NULL even if result is MR_STEP_OK, if
@@ -934,9 +937,9 @@
MR_TRACE_CALL_MERCURY(
/*
- ** We need to add 1 to MR_edt_depth since this is an EXIT
- ** event, so 1 should already have been subtracted from
- ** MR_edt_depth in MR_trace_calculate_event_depth.
+ ** We need to add 1 to MR_edt_depth since this is an EXIT event,
+ ** so 1 should already have been subtracted from MR_edt_depth
+ ** in MR_trace_calculate_event_depth.
*/
MR_trace_maybe_update_implicit_tree_ideal_depth(
MR_edt_depth + 1, call);
@@ -1757,7 +1760,7 @@
MR_selected_trace_func_ptr = MR_trace_real;
MR_debug_enabled = MR_TRUE;
MR_update_trace_func_enabled();
- return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info);
+ return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info, NULL);
}
return jumpaddr;
@@ -1904,7 +1907,7 @@
MR_debug_enabled = MR_TRUE;
MR_update_trace_func_enabled();
- return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info);
+ return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info, NULL);
}
if (MR_trace_decl_debug_debugger_mode) {
@@ -2072,7 +2075,8 @@
MR_selected_trace_func_ptr = MR_trace_real;
MR_debug_enabled = MR_TRUE;
MR_update_trace_func_enabled();
- return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info);
+ return MR_trace_event_internal(cmd, MR_TRUE, NULL, event_info,
+ NULL);
}
} else {
/*
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.85
diff -u -b -r1.85 mercury_trace_external.c
--- trace/mercury_trace_external.c 2 Oct 2007 17:04:37 -0000 1.85
+++ trace/mercury_trace_external.c 19 Nov 2008 02:36:55 -0000
@@ -230,10 +230,7 @@
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,
- const MR_ProcLayout *entry_layout, int count,
- MR_Level start_level, MR_Word *base_sp, MR_Word *base_curfr,
- const char *filename, int linenumber,
- const char *goal_path, MR_bool context_mismatch);
+ MR_bool include_trace_data, MR_StackDumpInfo 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);
@@ -645,11 +642,13 @@
if (MR_debug_socket) {
fprintf(stderr, "\nMercury runtime: REQUEST_STACK\n");
}
+
MR_trace_init_modules();
message = MR_dump_stack_from_layout(stdout, layout,
MR_saved_sp(saved_regs), MR_saved_curfr(saved_regs),
include_trace_data, MR_FALSE, 0, 0,
&MR_dump_stack_record_print_to_socket);
+
MR_send_message_to_socket("end_stack");
if (message != NULL) {
MR_send_message_to_socket_format("error(\"%s\").\n",
@@ -1264,15 +1263,25 @@
*/
static void
-MR_dump_stack_record_print_to_socket(FILE *fp,
- const MR_ProcLayout *entry_layout, int count, MR_Level start_level,
- MR_Word *base_sp, MR_Word *base_curfr,
- const char *filename, int linenumber,
- const char *goal_path, MR_bool context_mismatch)
+MR_dump_stack_record_print_to_socket(FILE *fp, MR_bool include_trace_data,
+ MR_StackDumpInfo dump_info)
{
+ /*
+ ** XXX If the external debugger is ever needed again, it should be updated
+ ** to send information across the socket about about any reuse of a stack
+ ** frame by tail recursion events.
+ */
+
+ if (dump_info.MR_sdi_min_level != 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", start_level);
- MR_print_proc_id_to_socket(entry_layout, NULL, base_sp, base_curfr);
+ "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);
}
static void
@@ -1491,6 +1500,7 @@
int lineno = 0;
MR_Word *base_sp;
MR_Word *base_curfr;
+ MR_Unsigned reused_frames;
if MR_port_is_interface(port) {
/*
@@ -1501,7 +1511,9 @@
base_sp = MR_saved_sp(saved_regs);
base_curfr = MR_saved_curfr(saved_regs);
parent_layout = MR_find_nth_ancestor(layout, 1, &base_sp, &base_curfr,
- &problem);
+ &reused_frames, &problem);
+ /* The external debugger does not (yet) know about reused frames. */
+ assert(reused_frames == 0);
if (parent_layout != NULL) {
(void) MR_find_context(parent_layout, &filename, &lineno);
}
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.243
diff -u -b -r1.243 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 10 Jun 2008 04:05:01 -0000 1.243
+++ trace/mercury_trace_internal.c 19 Nov 2008 02:42:05 -0000
@@ -198,7 +198,7 @@
MR_Code *
MR_trace_event_internal(MR_TraceCmdInfo *cmd, MR_bool interactive,
- MR_SpyPrintList print_list, MR_EventInfo *event_info)
+ MR_SpyPrintList print_list, MR_EventInfo *event_info, const char *msg)
{
MR_Code *jumpaddr;
char *line;
@@ -230,6 +230,10 @@
MR_spy_point_cond_problem = NULL;
}
+ if (msg != NULL) {
+ fprintf(MR_mdb_out, "%s", msg);
+ }
+
MR_trace_event_print_internal_report(event_info);
MR_trace_maybe_sync_source_window(event_info, MR_FALSE);
@@ -746,6 +750,15 @@
fprintf(MR_mdb_err, "This command is a no-op from this port.\n");
}
+void
+MR_trace_do_noop_tail_rec(void)
+{
+ fflush(MR_mdb_out);
+ fprintf(MR_mdb_err,
+ "Due to the reuse of stack frames by tail recursive procedures,\n"
+ "this command is a no-op from this port.\n");
+}
+
/*
** This function is just a wrapper for MR_print_proc_id_and_nl,
** with the first argument type being `void *' rather than `FILE *',
@@ -1345,7 +1358,7 @@
case 'q':
MR_free(buf);
return MR_trace_event_internal(cmd, MR_TRUE, NULL,
- event_info);
+ event_info, NULL);
default:
fflush(MR_mdb_out);
@@ -1388,6 +1401,7 @@
MR_Word *base_curfr;
int indent;
const char *maybe_user_event_name;
+ MR_Level actual_level;
lineno = 0;
parent_lineno = 0;
@@ -1447,8 +1461,8 @@
base_sp = MR_saved_sp(event_info->MR_saved_regs);
base_curfr = MR_saved_curfr(event_info->MR_saved_regs);
parent = MR_find_nth_ancestor(label_layout, 1, &base_sp, &base_curfr,
- &problem);
- if (parent != NULL) {
+ &actual_level, &problem);
+ if (actual_level == 1 && parent != NULL) {
(void) MR_find_context(parent, &parent_filename, &parent_lineno);
}
}
Index: trace/mercury_trace_internal.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_internal.h,v
retrieving revision 1.25
diff -u -b -r1.25 mercury_trace_internal.h
--- trace/mercury_trace_internal.h 20 Feb 2008 02:59:38 -0000 1.25
+++ trace/mercury_trace_internal.h 18 Nov 2008 13:19:18 -0000
@@ -24,7 +24,7 @@
extern MR_Code *MR_trace_event_internal(MR_TraceCmdInfo *cmd,
MR_bool interactive, MR_SpyPrintList print_list,
- MR_EventInfo *event_info);
+ MR_EventInfo *event_info, const char *msg);
extern void MR_trace_event_print_internal_report(
MR_EventInfo *event_info);
@@ -85,9 +85,12 @@
/*
** Print a message about this command being a no-op from this port.
+** The second variant is when the command is a no-op only because of
+** the reuse of stack frames by tail recursive procedures.
*/
extern void MR_trace_do_noop(void);
+extern void MR_trace_do_noop_tail_rec(void);
/*
** If the given word is the name of a valid command, return its info.
Index: trace/mercury_trace_spy.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_spy.c,v
retrieving revision 1.35
diff -u -b -r1.35 mercury_trace_spy.c
--- trace/mercury_trace_spy.c 6 Jun 2008 09:48:58 -0000 1.35
+++ trace/mercury_trace_spy.c 19 Nov 2008 02:38:38 -0000
@@ -302,6 +302,7 @@
const char *problem;
MR_Word *base_sp;
MR_Word *base_curfr;
+ MR_Level actual_level;
enabled = MR_FALSE;
action = MR_SPY_PRINT;
@@ -324,9 +325,9 @@
base_sp = MR_sp;
base_curfr = MR_curfr;
parent = MR_find_nth_ancestor(layout, 1, &base_sp, &base_curfr,
- &problem);
- if (parent != NULL && 0 <=
- (slot = MR_search_spy_table_for_label(parent)))
+ &actual_level, &problem);
+ if (parent != NULL && actual_level == 1 &&
+ 0 <= (slot = MR_search_spy_table_for_label(parent)))
{
point = MR_spy_points[MR_spied_labels[slot].MR_sl_point_num];
if (point->MR_spy_when != MR_SPY_LINENO) {
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.80
diff -u -b -r1.80 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 20 Feb 2008 03:01:52 -0000 1.80
+++ trace/mercury_trace_vars.c 21 Nov 2008 02:05:23 -0000
@@ -349,15 +349,18 @@
MR_Word *base_curfr;
const MR_LabelLayout *top_layout;
const MR_LabelLayout *level_layout;
+ MR_Level actual_level;
problem = NULL;
top_layout = MR_point.MR_point_top_layout;
base_sp = MR_saved_sp(MR_point.MR_point_top_saved_regs);
base_curfr = MR_saved_curfr(MR_point.MR_point_top_saved_regs);
level_layout = MR_find_nth_ancestor(top_layout, ancestor_level,
- &base_sp, &base_curfr, &problem);
+ &base_sp, &base_curfr, &actual_level, &problem);
- if (level_layout != NULL) {
+ if (actual_level != ancestor_level) {
+ return "The stack frame of that call has been reused";
+ } else if (level_layout != NULL) {
return MR_trace_set_level_from_layout(level_layout,
base_sp, base_curfr, ancestor_level, print_optionals);
} else {
cvs diff: Diffing util
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