mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-16 22:35:41 +00:00
Code Issues Projects Releases Wiki Activity
Files
2ed239c28642fd9e22bf28b09b121cbe487ec2ef
mercury/compiler/trace_params.m
Zoltan Somogyi 53286dd4bf Implement a new compiler option, --exec-trace-tail-rec, that preserves direct 
Estimated hours taken: 30
Branches: main

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 implication 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.
2008-11-25 07:46:57 +00:00

665 lines
26 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2000-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: trace_params.m.
% Author: zs.
%
% This module defines the parameters of execution tracing at various trace
% levels and with various settings of the --suppress-trace option.
%
% In most cases the trace level we want to apply to a procedure (which is its
% effective trace level) is the same as the global trace level. However, if the
% global trace level is shallow, then we optimize the handling of procedures
% that cannot be called from deep traced contexts. If a procedure is neither
% exported nor has its address taken, then it can only be called from other
% procedures in its module. If the module is shallow traced, this guarantees
% that we will never get any events from the procedure, so there is no point
% in including any tracing code in it in the first place. We therefore make
% its effective trace level "none" for must purposes (the purposes whose
% functions test effective trace levels). Apart from avoiding the overhead
% of calls to MR_trace, this also allows the code generator to preserve tail
% recursion optimization. However, we continue to generate the data structures
% that enable the debugger to walk the stack for such procedures. We accomplish
% this by making the relevant test work on the global trace level, not
% effective trace levels. Most of the other functions defined in this module
% convert the given (global) trace level into the effective trace level of
% the relevant procedure before calculating their result.
%
%-----------------------------------------------------------------------------%
:- module libs.trace_params.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module mdbcomp.prim_data.
:- import_module bool.
:- import_module maybe.
%-----------------------------------------------------------------------------%
:- type trace_level.
:- type trace_suppress_items.
% The string should be the value of the --trace-level option;
% two bools should be the values of the `--require-tracing' and
% `--decl-debug' grade options.
%
% If the string is an acceptable trace level in the specified kinds of
% grades, return yes wrapper around the trace level.
%
% If the string is an known trace level that happens not to be
% acceptable in the specified kinds of grades, return no.
%
% If the string is not known trace level, fail.
%
:- pred convert_trace_level(string::in, bool::in, bool::in,
maybe(trace_level)::out) is semidet.
:- pred convert_trace_suppress(string::in, trace_suppress_items::out)
is semidet.
:- func default_trace_suppress = trace_suppress_items.
% These functions check for various properties of the global trace level.
%
:- 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.
%
:- func trace_level_needs_meaningful_var_names(trace_level) = bool.
% These functions check for various properties of the given procedure's
% effective trace level.
%
:- func eff_trace_level_is_none(module_info, pred_info, proc_info,
trace_level) = bool.
:- func eff_trace_level_needs_input_vars(module_info, pred_info, proc_info,
trace_level) = bool.
:- func eff_trace_level_needs_fail_vars(module_info, pred_info, proc_info,
trace_level) = bool.
:- func eff_trace_level_needs_fixed_slots(module_info, pred_info, proc_info,
trace_level) = bool.
:- func eff_trace_level_needs_from_full_slot(module_info, pred_info, proc_info,
trace_level) = bool.
:- func eff_trace_needs_all_var_names(module_info, pred_info, proc_info,
trace_level, trace_suppress_items) = bool.
:- func eff_trace_needs_proc_body_reps(module_info, pred_info, proc_info,
trace_level, trace_suppress_items) = bool.
:- func eff_trace_needs_port(module_info, pred_info, proc_info, trace_level,
trace_suppress_items, trace_port) = bool.
:- func eff_trace_level(module_info, pred_info, proc_info, trace_level)
= trace_level.
:- func trace_level_none = trace_level.
:- func at_least_at_shallow(trace_level) = bool.
:- func at_least_at_deep(trace_level) = bool.
% Given a trace level for a module, return the trace level we should use
% for compiler-generated unify, index and compare predicates.
%
:- func trace_level_for_unify_compare(trace_level) = trace_level.
% This is used to represent the trace level in the module layout
% and in proc layouts.
%
:- func trace_level_rep(trace_level) = string.
:- func encode_suppressed_events(trace_suppress_items) = int.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module mdbcomp.
:- import_module mdbcomp.prim_data.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module pair.
:- import_module set.
:- import_module string.
%-----------------------------------------------------------------------------%
% The trace levels none, shallow, deep and decl_rep correspond to the similarly
% named options. The trace levels basic and basic_user cannot be specified on
% the command line; they can only be effective trace levels.
%
% Basic_user is the effective trace level for procedures in shallow traced
% modules that contain a user defined event. This event requires, among other
% things, the preservation of variables in the procedure in which it occurs.
% It also requires the transmission of depth information through all procedures
% in the module that otherwise wouldn't be traced, which is what trace level
% basic does.
%
% In theory, in a shallow traced module, we could set the trace level of
% a procedure to none if that procedure is not the ancestor of any procedure
% containing a user event. However, that test is not one that can be
% implemented easily or at all, given that the call trees of procedures may
% cross module boundaries, and, in particular, may cross out of this module
% and then back again through a different entry point.
:- type trace_level
---> none
; basic
; basic_user
; shallow
; deep
; decl_rep.
:- type trace_suppress_item
---> suppress_port(trace_port)
; suppress_return_info
; suppress_all_var_names
; suppress_proc_body_reps.
:- type trace_suppress_items == set(trace_suppress_item).
trace_level_none = none.
trace_level_for_unify_compare(none) = none.
trace_level_for_unify_compare(basic) = none.
trace_level_for_unify_compare(basic_user) = none.
trace_level_for_unify_compare(shallow) = shallow.
trace_level_for_unify_compare(deep) = shallow.
trace_level_for_unify_compare(decl_rep) = shallow.
at_least_at_shallow(none) = no.
at_least_at_shallow(basic) = no.
at_least_at_shallow(basic_user) = no.
at_least_at_shallow(shallow) = yes.
at_least_at_shallow(deep) = yes.
at_least_at_shallow(decl_rep) = yes.
at_least_at_deep(none) = no.
at_least_at_deep(basic) = no.
at_least_at_deep(basic_user) = no.
at_least_at_deep(shallow) = no.
at_least_at_deep(deep) = yes.
at_least_at_deep(decl_rep) = yes.
convert_trace_level("minimum", no, no, yes(none)).
convert_trace_level("minimum", yes, no, yes(shallow)).
convert_trace_level("minimum", _, yes, yes(decl_rep)).
convert_trace_level("shallow", _, no, yes(shallow)).
convert_trace_level("shallow", _, yes, no).
convert_trace_level("deep", _, no, yes(deep)).
convert_trace_level("deep", _, yes, no).
convert_trace_level("decl", _, _, yes(decl_rep)).
convert_trace_level("rep", _, _, yes(decl_rep)).
convert_trace_level("default", no, no, yes(none)).
convert_trace_level("default", yes, no, yes(deep)).
convert_trace_level("default", _, yes, yes(decl_rep)).
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel) = EffTraceLevel :-
( TraceLevel = none ->
EffTraceLevel = none
;
pred_info_get_origin(PredInfo, Origin),
(
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
% taken.
%
% Index predicates can never be called from anywhere except
% the compare predicate.
%
% Initialise predicates invoke user-provided code. Whether that
% code has debugging enabled or not, there is no point in
% generating events in the initialise predicate itself.
(
SpecialPred = spec_pred_unify,
EffTraceLevel = shallow
;
SpecialPred = spec_pred_compare,
EffTraceLevel = shallow
;
SpecialPred = spec_pred_index,
EffTraceLevel = none
;
SpecialPred = spec_pred_init,
EffTraceLevel = TraceLevel
)
;
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,
status_is_exported(Status) = no,
proc_info_get_is_address_taken(ProcInfo, address_is_not_taken)
->
proc_info_get_has_user_event(ProcInfo, ProcHasUserEvent),
(
ProcHasUserEvent = yes,
EffTraceLevel = basic_user
;
ProcHasUserEvent = no,
module_info_get_contains_user_event(ModuleInfo,
ModuleHasUserEvent),
(
ModuleHasUserEvent = yes,
EffTraceLevel = basic
;
ModuleHasUserEvent = no,
EffTraceLevel = none
)
)
;
EffTraceLevel = TraceLevel
).
given_trace_level_is_none(TraceLevel) =
trace_level_is_none(TraceLevel).
eff_trace_level_is_none(ModuleInfo, PredInfo, ProcInfo, TraceLevel) =
trace_level_is_none(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)).
eff_trace_level_needs_input_vars(ModuleInfo, PredInfo, ProcInfo, TraceLevel) =
trace_level_needs_input_vars(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)).
eff_trace_level_needs_fail_vars(ModuleInfo, PredInfo, ProcInfo, TraceLevel) =
trace_level_needs_fail_vars(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)).
eff_trace_level_needs_fixed_slots(ModuleInfo, PredInfo, ProcInfo, TraceLevel) =
trace_level_needs_fixed_slots(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)).
eff_trace_level_needs_from_full_slot(ModuleInfo, PredInfo, ProcInfo,
TraceLevel) =
trace_level_needs_from_full_slot(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel)).
eff_trace_needs_all_var_names(ModuleInfo, PredInfo, ProcInfo, TraceLevel,
SuppressItems) =
trace_needs_all_var_names(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel),
SuppressItems).
eff_trace_needs_proc_body_reps(ModuleInfo, PredInfo, ProcInfo, TraceLevel,
SuppressItems) =
trace_needs_proc_body_reps(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel),
SuppressItems).
eff_trace_needs_port(ModuleInfo, PredInfo, ProcInfo, TraceLevel, SuppressItems,
Port) =
trace_needs_port(
eff_trace_level(ModuleInfo, PredInfo, ProcInfo, TraceLevel),
SuppressItems, Port).
:- func trace_level_is_none(trace_level) = bool.
:- func trace_level_needs_input_vars(trace_level) = bool.
:- func trace_level_needs_fail_vars(trace_level) = bool.
:- func trace_level_needs_fixed_slots(trace_level) = bool.
:- func trace_level_needs_from_full_slot(trace_level) = bool.
:- func trace_needs_all_var_names(trace_level, trace_suppress_items) = bool.
:- func trace_needs_proc_body_reps(trace_level, trace_suppress_items) = bool.
:- func trace_needs_port(trace_level, trace_suppress_items, trace_port) = bool.
trace_level_is_none(none) = yes.
trace_level_is_none(basic) = no.
trace_level_is_none(basic_user) = no.
trace_level_is_none(shallow) = no.
trace_level_is_none(deep) = no.
trace_level_is_none(decl_rep) = no.
trace_level_needs_input_vars(none) = no.
trace_level_needs_input_vars(basic) = no.
trace_level_needs_input_vars(basic_user) = no.
trace_level_needs_input_vars(shallow) = yes.
trace_level_needs_input_vars(deep) = yes.
trace_level_needs_input_vars(decl_rep) = yes.
trace_level_needs_fail_vars(none) = no.
trace_level_needs_fail_vars(basic) = no.
trace_level_needs_fail_vars(basic_user) = yes.
trace_level_needs_fail_vars(shallow) = yes.
trace_level_needs_fail_vars(deep) = yes.
trace_level_needs_fail_vars(decl_rep) = yes.
trace_level_needs_fixed_slots(none) = no.
trace_level_needs_fixed_slots(basic) = yes.
trace_level_needs_fixed_slots(basic_user) = yes.
trace_level_needs_fixed_slots(shallow) = yes.
trace_level_needs_fixed_slots(deep) = yes.
trace_level_needs_fixed_slots(decl_rep) = yes.
trace_level_needs_from_full_slot(none) = no.
trace_level_needs_from_full_slot(basic) = no.
trace_level_needs_from_full_slot(basic_user) = no.
trace_level_needs_from_full_slot(shallow) = yes.
trace_level_needs_from_full_slot(deep) = no.
trace_level_needs_from_full_slot(decl_rep) = no.
trace_level_allows_delay_death(none) = no.
trace_level_allows_delay_death(basic) = no.
trace_level_allows_delay_death(basic_user) = yes.
trace_level_allows_delay_death(shallow) = no.
trace_level_allows_delay_death(deep) = yes.
trace_level_allows_delay_death(decl_rep) = yes.
trace_level_needs_meaningful_var_names(none) = no.
trace_level_needs_meaningful_var_names(basic) = no.
trace_level_needs_meaningful_var_names(basic_user) = yes.
trace_level_needs_meaningful_var_names(shallow) = no.
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,
\+ set.member(suppress_return_info, TraceSuppressItems)
->
Need = yes
;
Need = no
).
trace_needs_all_var_names(TraceLevel, TraceSuppressItems) = Need :-
(
trace_level_has_all_var_names(TraceLevel) = yes,
\+ set.member(suppress_all_var_names, TraceSuppressItems)
->
Need = yes
;
Need = no
).
trace_needs_proc_body_reps(TraceLevel, TraceSuppressItems) = Need :-
(
trace_level_has_proc_body_reps(TraceLevel) = yes,
\+ set.member(suppress_proc_body_reps, TraceSuppressItems)
->
Need = yes
;
Need = no
).
:- func trace_level_has_return_info(trace_level) = bool.
:- func trace_level_has_all_var_names(trace_level) = bool.
:- func trace_level_has_proc_body_reps(trace_level) = bool.
trace_level_has_return_info(none) = no.
trace_level_has_return_info(basic) = yes.
trace_level_has_return_info(basic_user) = yes.
trace_level_has_return_info(shallow) = yes.
trace_level_has_return_info(deep) = yes.
trace_level_has_return_info(decl_rep) = yes.
trace_level_has_all_var_names(none) = no.
trace_level_has_all_var_names(basic) = no.
trace_level_has_all_var_names(basic_user) = no.
trace_level_has_all_var_names(shallow) = no.
trace_level_has_all_var_names(deep) = no.
trace_level_has_all_var_names(decl_rep) = yes.
trace_level_has_proc_body_reps(none) = no.
trace_level_has_proc_body_reps(basic) = no.
trace_level_has_proc_body_reps(basic_user) = no.
trace_level_has_proc_body_reps(shallow) = no.
trace_level_has_proc_body_reps(deep) = no.
trace_level_has_proc_body_reps(decl_rep) = yes.
convert_trace_suppress(SuppressString, SuppressItemSet) :-
SuppressWords = string.words_separator(char_is_comma, SuppressString),
list.map(convert_item_name, SuppressWords, SuppressItemLists),
list.condense(SuppressItemLists, SuppressItems),
set.list_to_set(SuppressItems, SuppressItemSet).
:- pred char_is_comma(char::in) is semidet.
char_is_comma(',').
default_trace_suppress = set.init.
:- func convert_port_name(string) = trace_port is semidet.
% The call port cannot be disabled, because its layout structure is
% referred to implicitly by the redo command in mdb.
%
% The exception port cannot be disabled, because it is never put into
% compiler-generated code in the first place; such events are created
% on the fly by library/exception.m.
% convert_port_name("call") = port_call.
convert_port_name("exit") = port_exit.
convert_port_name("fail") = port_fail.
convert_port_name("redo") = port_redo.
% convert_port_name("excp") = port_exception.
convert_port_name("exception") = port_exception.
convert_port_name("cond") = port_ite_cond.
convert_port_name("ite_cond") = port_ite_cond.
convert_port_name("then") = port_ite_then.
convert_port_name("ite_then") = port_ite_then.
convert_port_name("else") = port_ite_else.
convert_port_name("ite_else") = port_ite_else.
convert_port_name("nege") = port_neg_enter.
convert_port_name("neg_enter") = port_neg_enter.
convert_port_name("negs") = port_neg_success.
convert_port_name("neg_success") = port_neg_success.
convert_port_name("negf") = port_neg_failure.
convert_port_name("neg_failure") = port_neg_failure.
convert_port_name("swtc") = port_switch.
convert_port_name("switch") = port_switch.
convert_port_name("disj_first") = port_disj_first.
convert_port_name("disj_later") = port_disj_later.
convert_port_name("frst") = port_nondet_foreign_proc_first.
convert_port_name("nondet_foreign_proc_first") =
port_nondet_foreign_proc_first.
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.
convert_port_class_name("interface") =
[port_call, port_exit, port_redo, port_fail, port_exception].
convert_port_class_name("internal") =
[port_ite_then, port_ite_else, port_switch,
port_disj_first, port_disj_later].
convert_port_class_name("context") =
[port_ite_cond, port_neg_enter, port_neg_success, port_neg_failure].
:- func convert_other_name(string) = trace_suppress_item is semidet.
convert_other_name("return") = suppress_return_info.
convert_other_name("return_info") = suppress_return_info.
convert_other_name("names") = suppress_all_var_names.
convert_other_name("all_var_names") = suppress_all_var_names.
convert_other_name("bodies") = suppress_proc_body_reps.
convert_other_name("proc_body_reps") = suppress_proc_body_reps.
:- pred convert_item_name(string::in, list(trace_suppress_item)::out)
is semidet.
convert_item_name(String, Names) :-
( convert_port_name(String) = PortName ->
Names = [suppress_port(PortName)]
; convert_port_class_name(String) = PortNames ->
list.map(wrap_port, PortNames, Names)
; convert_other_name(String) = OtherName ->
Names = [OtherName]
;
fail
).
:- pred wrap_port(trace_port::in, trace_suppress_item::out) is det.
wrap_port(Port, suppress_port(Port)).
% If this is modified, then the corresponding code in
% runtime/mercury_stack_layout.h needs to be updated.
trace_level_rep(none) = "MR_TRACE_LEVEL_NONE".
trace_level_rep(basic) = "MR_TRACE_LEVEL_BASIC".
trace_level_rep(basic_user) = "MR_TRACE_LEVEL_BASIC_USER".
trace_level_rep(shallow) = "MR_TRACE_LEVEL_SHALLOW".
trace_level_rep(deep) = "MR_TRACE_LEVEL_DEEP".
trace_level_rep(decl_rep) = "MR_TRACE_LEVEL_DECL_REP".
%-----------------------------------------------------------------------------%
:- type port_category
---> port_cat_interface
% The events that describe the interface of a procedure
% with its callers.
; port_cat_internal
% The events inside each procedure that were present
% in the initial procedural debugger.
; port_cat_context
% The events inside each procedure that we added because
% the declarative debugger needs to know when (potentially)
% negated contexts start and end.
; port_cat_user.
% User defined events.
:- func trace_port_category(trace_port) = port_category.
trace_port_category(port_call) = port_cat_interface.
trace_port_category(port_exit) = port_cat_interface.
trace_port_category(port_fail) = port_cat_interface.
trace_port_category(port_redo) = port_cat_interface.
trace_port_category(port_exception) = port_cat_interface.
trace_port_category(port_ite_cond) = port_cat_context.
trace_port_category(port_ite_then) = port_cat_internal.
trace_port_category(port_ite_else) = port_cat_internal.
trace_port_category(port_neg_enter) = port_cat_context.
trace_port_category(port_neg_success) = port_cat_context.
trace_port_category(port_neg_failure) = port_cat_context.
trace_port_category(port_switch) = port_cat_internal.
trace_port_category(port_disj_first) = port_cat_internal.
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).
trace_level_port_categories(none) = [].
trace_level_port_categories(basic) = [].
trace_level_port_categories(basic_user) = [port_cat_user].
trace_level_port_categories(shallow) = [port_cat_interface].
trace_level_port_categories(deep) =
[port_cat_interface, port_cat_internal, port_cat_context, port_cat_user].
trace_level_port_categories(decl_rep) =
[port_cat_interface, port_cat_internal, port_cat_context, port_cat_user].
:- func trace_level_allows_port_suppression(trace_level) = bool.
trace_level_allows_port_suppression(none) = no. % no ports exist
trace_level_allows_port_suppression(basic) = yes.
trace_level_allows_port_suppression(basic_user) = yes.
trace_level_allows_port_suppression(shallow) = yes.
trace_level_allows_port_suppression(deep) = yes.
trace_level_allows_port_suppression(decl_rep) = no.
trace_needs_port(TraceLevel, TraceSuppressItems, Port) = NeedsPort :-
(
trace_port_category(Port) = Category,
list.member(Category, trace_level_port_categories(TraceLevel)),
\+ (
trace_level_allows_port_suppression(TraceLevel) = yes,
set.member(suppress_port(Port), TraceSuppressItems)
)
->
NeedsPort = yes
;
NeedsPort = no
).
encode_suppressed_events(SuppressedEvents) = SuppressedEventsInt :-
set.fold(maybe_add_suppressed_event, SuppressedEvents,
0, SuppressedEventsInt).
:- pred maybe_add_suppressed_event(trace_suppress_item::in, int::in, int::out)
is det.
maybe_add_suppressed_event(SuppressItem, SuppressedEventsInt0,
SuppressedEventsInt) :-
(
SuppressItem = suppress_port(Port),
SuppressedEventsInt = SuppressedEventsInt0 \/ (1 << port_number(Port))
;
( SuppressItem = suppress_return_info
; SuppressItem = suppress_all_var_names
; SuppressItem = suppress_proc_body_reps
),
SuppressedEventsInt = SuppressedEventsInt0
).
:- func port_number(trace_port) = int.
port_number(port_call) = 0.
port_number(port_exit) = 1.
port_number(port_redo) = 2.
port_number(port_fail) = 3.
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.
Reference in New Issue View Git Blame Copy Permalink