for review: a big step towards the trace-based debugger (part 2 of 3)
Zoltan Somogyi
zs at cs.mu.OZ.AU
Fri Mar 20 19:56:41 AEDT 1998
Index: compiler/dense_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dense_switch.m,v
retrieving revision 1.32
diff -u -r1.32 dense_switch.m
--- dense_switch.m 1998/03/03 17:33:59 1.32
+++ dense_switch.m 1998/03/18 05:41:23
@@ -242,8 +242,9 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(switch(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
Index: compiler/disj_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/disj_gen.m,v
retrieving revision 1.62
diff -u -r1.62 disj_gen.m
--- disj_gen.m 1998/03/03 17:34:07 1.62
+++ disj_gen.m 1998/03/18 05:59:46
@@ -170,8 +170,9 @@
code_info__get_maybe_trace_info(MaybeTraceInfo),
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(disj(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(disj(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
@@ -216,9 +217,10 @@
% Generate the goal
code_info__get_maybe_trace_info(MaybeTraceInfo),
( { MaybeTraceInfo = yes(TraceInfo) } ->
- { goal_info_get_goal_path(GoalInfo0, Path) },
- trace__generate_event_code(disj(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_goal_path(GoalInfo0, Path0) },
+ { goal_info_get_pre_deaths(GoalInfo0, PreDeaths0) },
+ trace__generate_event_code(disj(Path0, PreDeaths0),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
@@ -332,8 +334,9 @@
code_info__get_maybe_trace_info(MaybeTraceInfo),
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(disj(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(disj(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
@@ -391,9 +394,10 @@
code_info__get_maybe_trace_info(MaybeTraceInfo),
( { MaybeTraceInfo = yes(TraceInfo) } ->
- { goal_info_get_goal_path(GoalInfo0, Path) },
- trace__generate_event_code(disj(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_goal_path(GoalInfo0, Path0) },
+ { goal_info_get_pre_deaths(GoalInfo0, PreDeaths0) },
+ trace__generate_event_code(disj(Path0, PreDeaths0),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.43
diff -u -r1.43 goal_util.m
--- goal_util.m 1998/03/03 17:34:19 1.43
+++ goal_util.m 1998/03/18 07:11:03
@@ -61,6 +61,21 @@
:- pred goal_util__goal_vars(hlds_goal, set(var)).
:- mode goal_util__goal_vars(in, out) is det.
+ %
+ % A type-info variable may be non-local to a goal if any of
+ % the ordinary non-local variables for that goal are
+ % polymorphically typed with a type that depends on that
+ % type-info variable.
+ %
+ % In addition, a typeclass-info may be non-local to a goal if
+ % any of the non-local variables for that goal are
+ % polymorphically typed and are constrained by the typeclass
+ % constraints for that typeclass-info variable
+ %
+:- pred goal_util__extra_nonlocal_typeinfos(map(var, type_info_locn),
+ map(var, type), hlds_goal, set(var)).
+:- mode goal_util__extra_nonlocal_typeinfos(in, in, in, out) is det.
+
% See whether the goal is a branched structure.
:- pred goal_util__goal_is_branched(hlds_goal_expr).
:- mode goal_util__goal_is_branched(in) is semidet.
@@ -485,6 +500,23 @@
set__insert_list(Set0, NonLocals, Set1),
set__insert_list(Set1, LambdaVars, Set2),
goal_util__goal_vars_2(Goal, Set2, Set).
+
+%-----------------------------------------------------------------------------%
+
+goal_util__extra_nonlocal_typeinfos(TypeVarMap, VarTypes,
+ Goal0, NonLocalTypeInfos) :-
+ Goal0 = _ - GoalInfo0,
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ set__to_sorted_list(NonLocals, NonLocalsList),
+ map__apply_to_list(NonLocalsList, VarTypes, NonLocalsTypes),
+ term__vars_list(NonLocalsTypes, NonLocalTypeVars),
+ % Find all the type-infos and typeclass-infos that are
+ % non-local
+ solutions_set(lambda([Var::out] is nondet, (
+ list__member(TheVar, NonLocalTypeVars),
+ map__search(TypeVarMap, TheVar, Location),
+ type_info_locn_var(Location, Var)
+ )), NonLocalTypeInfos).
%-----------------------------------------------------------------------------%
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.45
diff -u -r1.45 handle_options.m
--- handle_options.m 1998/03/03 17:34:21 1.45
+++ handle_options.m 1998/03/20 07:45:43
@@ -268,6 +268,10 @@
% - enabling typeinfo liveness
globals__io_lookup_bool_option(generate_trace, Trace),
( { Trace = yes } ->
+ % The following options modify the structure
+ % of the program, which makes it difficult to
+ % relate the trace to the source code (although
+ % it can be easily related to the transformed HLDS).
globals__io_set_option(inline_simple, bool(no)),
globals__io_set_option(inline_single_use, bool(no)),
globals__io_set_option(inline_compound_threshold, int(0)),
@@ -276,7 +280,22 @@
globals__io_set_option(optimize_duplicate_calls, bool(no)),
globals__io_set_option(optimize_constructor_last_call,
bool(no)),
+
+ % The following option prevents useless variables
+ % from cluttering the trace. Its explicit setting
+ % removes a source of variability in the goal paths
+ % reported by tracing.
globals__io_set_option(excess_assign, bool(yes)),
+ % The following option selects a special-case
+ % code generator that cannot (yet) implement tracing.
+ globals__io_set_option(middle_rec, bool(no)),
+ % Tracing inserts C code into the generated LLDS.
+ % Value numbering cannot optimize such LLDS code.
+ % We turn value numbering off now so that we don't
+ % have to discover this fact anew for each procedure.
+ globals__io_set_option(optimize_value_number, bool(no)),
+ % The following options cause the info required
+ % by tracing to be generated.
globals__io_set_option(trace_stack_layout, bool(yes)),
globals__io_set_option(typeinfo_liveness, bool(yes))
;
Index: compiler/ite_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ite_gen.m,v
retrieving revision 1.53
diff -u -r1.53 ite_gen.m
--- ite_gen.m 1998/01/23 12:56:38 1.53
+++ ite_gen.m 1998/03/18 06:00:37
@@ -119,8 +119,9 @@
( { MaybeTraceInfo = yes(TraceInfoThen) } ->
{ ThenGoal = _ - ThenGoalInfo },
{ goal_info_get_goal_path(ThenGoalInfo, ThenPath) },
- trace__generate_event_code(ite_then(ThenPath), TraceInfoThen,
- ThenTraceCode)
+ { goal_info_get_pre_deaths(ThenGoalInfo, ThenPreDeaths) },
+ trace__generate_event_code(ite_then(ThenPath, ThenPreDeaths),
+ TraceInfoThen, ThenTraceCode)
;
{ ThenTraceCode = empty }
),
@@ -138,8 +139,9 @@
( { MaybeTraceInfo = yes(TraceInfoElse) } ->
{ ElseGoal = _ - ElseGoalInfo },
{ goal_info_get_goal_path(ElseGoalInfo, ElsePath) },
- trace__generate_event_code(ite_else(ElsePath), TraceInfoElse,
- ElseTraceCode)
+ { goal_info_get_pre_deaths(ElseGoalInfo, ElsePreDeaths) },
+ trace__generate_event_code(ite_else(ElsePath, ElsePreDeaths),
+ TraceInfoElse, ElseTraceCode)
;
{ ElseTraceCode = empty }
),
@@ -276,8 +278,9 @@
( { MaybeTraceInfo = yes(TraceInfoThen) } ->
{ ThenGoal = _ - ThenGoalInfo },
{ goal_info_get_goal_path(ThenGoalInfo, ThenPath) },
- trace__generate_event_code(ite_then(ThenPath), TraceInfoThen,
- ThenTraceCode)
+ { goal_info_get_pre_deaths(ThenGoalInfo, ThenPreDeaths) },
+ trace__generate_event_code(ite_then(ThenPath, ThenPreDeaths),
+ TraceInfoThen, ThenTraceCode)
;
{ ThenTraceCode = empty }
),
@@ -295,8 +298,9 @@
( { MaybeTraceInfo = yes(TraceInfoElse) } ->
{ ElseGoal = _ - ElseGoalInfo },
{ goal_info_get_goal_path(ElseGoalInfo, ElsePath) },
- trace__generate_event_code(ite_else(ElsePath), TraceInfoElse,
- ElseTraceCode)
+ { goal_info_get_pre_deaths(ElseGoalInfo, ElsePreDeaths) },
+ trace__generate_event_code(ite_else(ElsePath, ElsePreDeaths),
+ TraceInfoElse, ElseTraceCode)
;
{ ElseTraceCode = empty }
),
Index: compiler/lambda.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/lambda.m,v
retrieving revision 1.40
diff -u -r1.40 lambda.m
--- lambda.m 1998/03/03 17:34:45 1.40
+++ lambda.m 1998/03/18 07:12:16
@@ -41,28 +41,28 @@
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data.
-:- import_module list, map, term, varset.
+:- import_module list, map, set, term, varset.
:- pred lambda__process_pred(pred_id, module_info, module_info).
:- mode lambda__process_pred(in, in, out) is det.
:- pred lambda__transform_lambda(pred_or_func, string, list(var), list(mode),
- determinism, list(var), hlds_goal, unification,
+ determinism, list(var), set(var), hlds_goal, unification,
varset, map(var, type), list(class_constraint), tvarset,
map(tvar, type_info_locn), map(class_constraint, var),
module_info, unify_rhs, unification, module_info).
-:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in, in,
- in, in, in, out, out, out) is det.
+:- mode lambda__transform_lambda(in, in, in, in, in, in, in, in, in, in, in,
+ in, in, in, in, in, out, out, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module make_hlds.
-:- import_module prog_util, mode_util, inst_match, llds, arg_info.
+:- import_module make_hlds, globals, options.
+:- import_module goal_util, prog_util, mode_util, inst_match, llds, arg_info.
-:- import_module bool, set, string, std_util, require.
+:- import_module bool, string, std_util, require.
:- type lambda_info --->
lambda_info(
@@ -238,17 +238,19 @@
Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :-
LambdaInfo0 = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo0),
+ goal_util__extra_nonlocal_typeinfos(TVarMap, VarTypes,
+ LambdaGoal, ExtraTypeInfos),
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
- OrigNonLocals0, LambdaGoal, Unification0, VarSet, VarTypes,
- Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
- Unification, ModuleInfo),
+ OrigNonLocals0, ExtraTypeInfos, LambdaGoal, Unification0,
+ VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+ ModuleInfo0, Functor, Unification, ModuleInfo),
LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet,
TVarMap, TCVarMap, POF, PredName, ModuleInfo).
lambda__transform_lambda(PredOrFunc, OrigPredName, Vars, Modes, Detism,
- OrigVars, LambdaGoal, Unification0, VarSet, VarTypes,
- Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
- Unification, ModuleInfo) :-
+ OrigVars, ExtraTypeInfos, LambdaGoal, Unification0,
+ VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+ ModuleInfo0, Functor, Unification, ModuleInfo) :-
(
Unification0 = construct(Var0, _, _, UniModes0)
->
@@ -270,7 +272,20 @@
LambdaGoal = _ - LambdaGoalInfo,
goal_info_get_nonlocals(LambdaGoalInfo, NonLocals0),
- set__delete_list(NonLocals0, Vars, NonLocals),
+ set__delete_list(NonLocals0, Vars, NonLocals1),
+ module_info_globals(ModuleInfo0, Globals),
+
+ % If typeinfo_liveness is set, all type_infos for the
+ % arguments should be included, not just the ones
+ % that are used.
+ globals__lookup_bool_option(Globals,
+ typeinfo_liveness, TypeInfoLiveness),
+ ( TypeInfoLiveness = yes ->
+ set__union(NonLocals1, ExtraTypeInfos, NonLocals)
+ ;
+ NonLocals = NonLocals1
+ ),
+
set__to_sorted_list(NonLocals, ArgVars1),
(
LambdaGoal = call(PredId0, ProcId0, CallVars,
@@ -376,7 +391,6 @@
% inputs came before outputs, but that resulted in the
% HLDS not being type or mode correct which caused problems
% for some transformations and for rerunning mode analysis.
- module_info_globals(ModuleInfo1, Globals),
arg_info__ho_call_args_method(Globals, ArgsMethod),
% Now construct the proc_info and pred_info for the new
Index: compiler/live_vars.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/live_vars.m,v
retrieving revision 1.72
diff -u -r1.72 live_vars.m
--- live_vars.m 1998/02/03 08:18:22 1.72
+++ live_vars.m 1998/03/16 07:58:03
@@ -36,6 +36,7 @@
:- import_module llds, arg_info, prog_data, hlds_goal, hlds_data, mode_util.
:- import_module liveness, code_aux, globals, graph_colour, instmap, options.
+:- import_module trace.
:- import_module list, map, set, std_util, assoc_list, bool.
:- import_module int, term, require.
@@ -47,8 +48,16 @@
initial_liveness(ProcInfo0, ModuleInfo, Liveness0),
set__init(LiveSets0),
- set__init(ResumeVars0),
- build_live_sets_in_goal(Goal0, Liveness0, ResumeVars0, LiveSets0,
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, generate_trace, Trace),
+ ( Trace = yes ->
+ trace__fail_vars(ProcInfo0, ResumeVars0),
+ set__insert(LiveSets0, ResumeVars0, LiveSets1)
+ ;
+ set__init(ResumeVars0),
+ LiveSets1 = LiveSets0
+ ),
+ build_live_sets_in_goal(Goal0, Liveness0, ResumeVars0, LiveSets1,
ModuleInfo, ProcInfo0, _Liveness, _ResumeVars, LiveSets),
graph_colour__group_elements(LiveSets, ColourSets),
set__to_sorted_list(ColourSets, ColourList),
Index: compiler/liveness.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/liveness.m,v
retrieving revision 1.91
diff -u -r1.91 liveness.m
--- liveness.m 1998/03/03 17:34:49 1.91
+++ liveness.m 1998/03/11 07:36:18
@@ -145,7 +145,7 @@
:- import_module hlds_goal, hlds_data, llds, quantification, (inst), instmap.
:- import_module hlds_out, mode_util, code_util, quantification, options.
-:- import_module prog_data, globals, passes_aux.
+:- import_module prog_data, trace, globals, passes_aux.
:- import_module bool, map, std_util, list, assoc_list, require.
:- import_module varset, string.
@@ -164,7 +164,13 @@
initial_deadness(ProcInfo1, ModuleInfo, Deadness0),
detect_deadness_in_goal(Goal1, Deadness0, LiveInfo, _, Goal2),
- set__init(ResumeVars0),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, generate_trace, Trace),
+ ( Trace = yes ->
+ trace__fail_vars(ProcInfo0, ResumeVars0)
+ ;
+ set__init(ResumeVars0)
+ ),
detect_resume_points_in_goal(Goal2, Liveness0, LiveInfo,
ResumeVars0, Goal, _),
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.79
diff -u -r1.79 mercury_compile.m
--- mercury_compile.m 1998/03/20 02:58:08 1.79
+++ mercury_compile.m 1998/03/20 08:19:01
@@ -996,13 +996,13 @@
;
{ Proc = Proc0 }
),
- { globals__lookup_bool_option(Globals, basic_stack_layout,
- BasicStackLayout) },
- ( { BasicStackLayout = yes } ->
+ { globals__lookup_bool_option(Globals, agc_stack_layout,
+ AgcStackLayout) },
+ ( { AgcStackLayout = yes } ->
{ Proc = c_procedure(_, _, PredProcId, Instructions) },
{ module_info_get_continuation_info(ModuleInfo5, ContInfo2) },
write_proc_progress_message(
- "% Generating stack layout continuation information for ",
+ "% Generating call continuation information for ",
PredId, ProcId, ModuleInfo5),
{ continuation_info__process_instructions(PredProcId,
Instructions, ContInfo2, ContInfo3) },
@@ -1630,14 +1630,14 @@
mercury_compile__maybe_generate_stack_layouts(ModuleInfo0, LLDS0, Verbose,
Stats, ModuleInfo) -->
- globals__io_lookup_bool_option(agc_stack_layout, StackLayout),
- ( { StackLayout = yes } ->
+ globals__io_lookup_bool_option(agc_stack_layout, AgcStackLayout),
+ ( { AgcStackLayout = yes } ->
maybe_write_string(Verbose,
- "% Generating stack layout continuation information..."),
+ "% Generating call continuation information..."),
maybe_flush_output(Verbose),
{ module_info_get_continuation_info(ModuleInfo0, ContInfo0) },
- { continuation_info__process_llds(LLDS0, ContInfo0,
- ContInfo) },
+ { continuation_info__process_llds(LLDS0,
+ ContInfo0, ContInfo) },
{ module_info_set_continuation_info(ModuleInfo0, ContInfo,
ModuleInfo) },
maybe_write_string(Verbose, " done.\n"),
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.90
diff -u -r1.90 opt_util.m
--- opt_util.m 1998/03/03 17:35:30 1.90
+++ opt_util.m 1998/03/16 04:26:50
@@ -282,16 +282,6 @@
:- pred opt_util__rvals_free_of_lval(list(rval), lval).
:- mode opt_util__rvals_free_of_lval(in, in) is semidet.
- % Return the set of lvals referenced in an rval.
-
-:- pred opt_util__lvals_in_rval(rval, list(lval)).
-:- mode opt_util__lvals_in_rval(in, out) is det.
-
- % Return the set of lvals referenced in an lval.
-
-:- pred opt_util__lvals_in_lval(lval, list(lval)).
-:- mode opt_util__lvals_in_lval(in, out) is det.
-
% Count the number of hp increments in a block of code.
:- pred opt_util__count_incr_hp(list(instruction), int).
@@ -1544,59 +1534,6 @@
opt_util__rval_free_of_lval(binop(_, Rval1, Rval2), Forbidden) :-
opt_util__rval_free_of_lval(Rval1, Forbidden),
opt_util__rval_free_of_lval(Rval2, Forbidden).
-
-%-----------------------------------------------------------------------------%
-
-opt_util__lvals_in_lval(reg(_, _), []).
-opt_util__lvals_in_lval(stackvar(_), []).
-opt_util__lvals_in_lval(framevar(_), []).
-opt_util__lvals_in_lval(succip, []).
-opt_util__lvals_in_lval(maxfr, []).
-opt_util__lvals_in_lval(curfr, []).
-opt_util__lvals_in_lval(succip(Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_lval(redoip(Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_lval(succfr(Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_lval(prevfr(Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_lval(hp, []).
-opt_util__lvals_in_lval(sp, []).
-opt_util__lvals_in_lval(field(_, Rval1, Rval2), Lvals) :-
- opt_util__lvals_in_rval(Rval1, Lvals1),
- opt_util__lvals_in_rval(Rval2, Lvals2),
- list__append(Lvals1, Lvals2, Lvals).
-opt_util__lvals_in_lval(lvar(_), []).
-opt_util__lvals_in_lval(temp(_, _), []).
-opt_util__lvals_in_lval(mem_ref(Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-
-opt_util__lvals_in_rval(lval(Lval), [Lval | Lvals]) :-
- opt_util__lvals_in_lval(Lval, Lvals).
-opt_util__lvals_in_rval(var(_), _) :-
- error("found var in opt_util__lvals_in_rval").
-opt_util__lvals_in_rval(create(_, _, _, _, _), []).
-opt_util__lvals_in_rval(mkword(_, Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_rval(const(_), []).
-opt_util__lvals_in_rval(unop(_, Rval), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
-opt_util__lvals_in_rval(binop(_, Rval1, Rval2), Lvals) :-
- opt_util__lvals_in_rval(Rval1, Lvals1),
- opt_util__lvals_in_rval(Rval2, Lvals2),
- list__append(Lvals1, Lvals2, Lvals).
-opt_util__lvals_in_rval(mem_addr(MemRef), Lvals) :-
- opt_util__lvals_in_mem_ref(MemRef, Lvals).
-
- % XXX
-:- pred opt_util__lvals_in_mem_ref(mem_ref, list(lval)).
-:- mode opt_util__lvals_in_mem_ref(in, out) is det.
-
-opt_util__lvals_in_mem_ref(stackvar_ref(_), []).
-opt_util__lvals_in_mem_ref(framevar_ref(_), []).
-opt_util__lvals_in_mem_ref(heap_ref(Rval, _, _), Lvals) :-
- opt_util__lvals_in_rval(Rval, Lvals).
%-----------------------------------------------------------------------------%
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.130
diff -u -r1.130 polymorphism.m
--- polymorphism.m 1998/03/03 17:35:37 1.130
+++ polymorphism.m 1998/03/18 07:14:12
@@ -293,7 +293,7 @@
:- import_module hlds_pred, hlds_goal, hlds_data, llds, (lambda).
:- import_module prog_data, type_util, mode_util, quantification, instmap.
:- import_module code_util, unify_proc, special_pred, prog_util, make_hlds.
-:- import_module (inst), hlds_out, base_typeclass_info.
+:- import_module (inst), hlds_out, base_typeclass_info, goal_util.
:- import_module bool, int, string, list, set, map.
:- import_module term, varset, std_util, require, assoc_list.
@@ -543,7 +543,7 @@
% process any polymorphic calls inside the goal
polymorphism__process_goal(Goal0, Goal1, Info0, Info1),
- polymorphism__fixup_quantification(Goal1, Goal, Info1, Info),
+ polymorphism__fixup_quantification(Goal1, Goal, _, Info1, Info),
Info = poly_info(VarSet, VarTypes, TypeVarSet,
TypeInfoMap, TypeclassInfoLocations,
_Proofs, _PredName, ModuleInfo),
@@ -741,10 +741,11 @@
% lambda goal and then convert the lambda expression
% into a new predicate
polymorphism__process_goal(LambdaGoal0, LambdaGoal1),
- polymorphism__fixup_quantification(LambdaGoal1, LambdaGoal),
+ polymorphism__fixup_quantification(LambdaGoal1,
+ LambdaGoal, NonLocalTypeInfos),
polymorphism__process_lambda(PredOrFunc, Vars, Modes,
- Det, ArgVars, LambdaGoal, Unification,
- Y1, Unification1),
+ Det, ArgVars, NonLocalTypeInfos, LambdaGoal,
+ Unification, Y1, Unification1),
{ Goal = unify(XVar, Y1, Mode, Unification1, Context)
- GoalInfo }
;
@@ -950,8 +951,8 @@
).
:- pred polymorphism__fixup_quantification(hlds_goal, hlds_goal,
- poly_info, poly_info).
-:- mode polymorphism__fixup_quantification(in, out, in, out) is det.
+ set(var), poly_info, poly_info).
+:- mode polymorphism__fixup_quantification(in, out, out, in, out) is det.
%
% If the predicate we are processing is a polymorphic predicate,
@@ -960,36 +961,18 @@
% so that it includes the type-info variables in the non-locals set.
%
-polymorphism__fixup_quantification(Goal0, Goal, Info0, Info) :-
+polymorphism__fixup_quantification(Goal0, Goal, NewOutsideVars, Info0, Info) :-
Info0 = poly_info(VarSet0, VarTypes0, TypeVarSet, TypeVarMap,
TypeClassVarMap, Proofs, PredName, ModuleInfo),
( map__is_empty(TypeVarMap) ->
+ set__init(NewOutsideVars),
Info = Info0,
Goal = Goal0
;
- %
- % A type-info variable may be non-local to a goal if any of
- % the ordinary non-local variables for that goal are
- % polymorphically typed with a type that depends on that
- % type-info variable.
- %
- % In addition, a typeclass-info may be non-local to a goal if
- % any of the non-local variables for that goal are
- % polymorphically typed and are constrained by the typeclass
- % constraints for that typeclass-info variable
- %
+ goal_util__extra_nonlocal_typeinfos(TypeVarMap,
+ VarTypes0, Goal0, NewOutsideVars),
Goal0 = _ - GoalInfo0,
goal_info_get_nonlocals(GoalInfo0, NonLocals),
- set__to_sorted_list(NonLocals, NonLocalsList),
- map__apply_to_list(NonLocalsList, VarTypes0, NonLocalsTypes),
- term__vars_list(NonLocalsTypes, NonLocalTypeVars),
- % Find all the type-infos and typeclass-infos that are
- % non-local
- solutions_set(lambda([Var::out] is nondet, (
- list__member(TheVar, NonLocalTypeVars),
- map__search(TypeVarMap, TheVar, Location),
- type_info_locn_var(Location, Var)
- )), NewOutsideVars),
set__union(NewOutsideVars, NonLocals, OutsideVars),
implicitly_quantify_goal(Goal0, VarSet0, VarTypes0,
OutsideVars, Goal, VarSet, VarTypes, _Warnings),
@@ -998,14 +981,15 @@
).
:- pred polymorphism__process_lambda(pred_or_func, list(var),
- list(mode), determinism, list(var), hlds_goal, unification,
- unify_rhs, unification, poly_info, poly_info).
-:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, out, out,
+ list(mode), determinism, list(var), set(var),
+ hlds_goal, unification, unify_rhs, unification,
+ poly_info, poly_info).
+:- mode polymorphism__process_lambda(in, in, in, in, in, in, in, in, out, out,
in, out) is det.
polymorphism__process_lambda(PredOrFunc, Vars, Modes, Det, OrigNonLocals,
- LambdaGoal, Unification0, Functor, Unification,
- PolyInfo0, PolyInfo) :-
+ NonLocalTypeInfos, LambdaGoal, Unification0, Functor,
+ Unification, PolyInfo0, PolyInfo) :-
PolyInfo0 = poly_info(VarSet, VarTypes, TVarSet, TVarMap,
TCVarMap, Proofs, PredName, ModuleInfo0),
@@ -1019,9 +1003,9 @@
AllConstraints, Constraints),
lambda__transform_lambda(PredOrFunc, PredName, Vars, Modes, Det,
- OrigNonLocals, LambdaGoal, Unification0, VarSet, VarTypes,
- Constraints, TVarSet, TVarMap, TCVarMap, ModuleInfo0, Functor,
- Unification, ModuleInfo),
+ OrigNonLocals, NonLocalTypeInfos, LambdaGoal, Unification0,
+ VarSet, VarTypes, Constraints, TVarSet, TVarMap, TCVarMap,
+ ModuleInfo0, Functor, Unification, ModuleInfo),
PolyInfo = poly_info(VarSet, VarTypes, TVarSet, TVarMap,
TCVarMap, Proofs, PredName, ModuleInfo).
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.14
diff -u -r1.14 pragma_c_gen.m
--- pragma_c_gen.m 1998/03/03 17:35:38 1.14
+++ pragma_c_gen.m 1998/03/18 06:01:10
@@ -534,9 +534,10 @@
code_info__get_maybe_trace_info(MaybeTraceInfo),
( { MaybeTraceInfo = yes(TraceInfo) } ->
- trace__generate_event_code(disj([disj(1)]), TraceInfo,
+ { set__init(Empty) },
+ trace__generate_event_code(disj([disj(1)], Empty), TraceInfo,
FirstTraceCode),
- trace__generate_event_code(disj([disj(2)]), TraceInfo,
+ trace__generate_event_code(disj([disj(2)], Empty), TraceInfo,
LaterTraceCode)
;
{ FirstTraceCode = empty },
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.9
diff -u -r1.9 stack_layout.m
--- stack_layout.m 1998/03/11 05:10:05 1.9
+++ stack_layout.m 1998/03/18 00:56:23
@@ -34,7 +34,7 @@
% (the location will be set to -1
% if there is no succip available).
%
-% if the option procid_stack_layout is set, i.e. if we are doing stack
+% If the option procid_stack_layout is set, i.e. if we are doing stack
% tracing, execution tracing or profiling, the table will also include
% information on the identity of the procedure. This information will take
% one of two forms. Almost all procedures use the first form:
@@ -63,36 +63,18 @@
% The meanings of the fields in both forms are the same as in procedure labels.
%
% If the option trace_stack_layout is set, i.e. if we are doing execution
-% tracing, the table will also include information on the variables that are
-% live at entry to and exit from the procedure:
+% tracing, the table will also include one extra field:
%
-% # of live vars at entry (Integer)
-% live data pairs (Word *) - pointer to vector of pairs
-% containing MR_Live_Lval and MR_Live_Type
-% live data names (Word *) - pointer to vector of String
-% type parameters (Word *) - pointer to vector of MR_Live_Lval
-%
-% # of live vars at exit (Integer)
-% live data pairs (Word *) - pointer to vector of pairs
-% containing MR_Live_Lval and MR_Live_Type
-% live data names (Word *) - pointer to vector of String
-% type parameters (Word *) - pointer to vector of MR_Live_Lval
-%
-% The live data pair vector will have an entry for each live variable.
-% The entry will give the location of the variable and its type (it also
-% has room for its instantiation state, but this is not filled in yet).
-%
-% The live data name vector pointer may be NULL. If it is not, the vector
-% will have an entry for each live variable, with each entry being either
-% NULL or giving the name of the variable.
+% call trace info (Word *) - pointer to label stack layout
%
-% The number of type parameters is never stored as it is not needed --
-% the type parameter vector will simply be indexed by the type parameter
-% number stored within pseudo-typeinfos inside the elements of the live
-% data pairs vectors.
+% This will point to the per-label layout info for the label associated
+% with the call event at the entry to the procedure. The purpose of this
+% information is to allow the runtime debugger to find out which variables
+% are where on entry, so it can reexecute the procedure if asked to do so
+% and if the values of the required variables are still available.
%
% If the option basic_stack_layout is set, we generate stack layout tables
-% for all labels internal to the procedure. This table will be stored in the
+% for some labels internal to the procedure. This table will be stored in the
% global variable whose name is
% mercury_data__stack_layout__mercury__<proc_label>_i<label_number>.
% This table has the following format:
@@ -103,29 +85,42 @@
% live data pairs (Word *) - pointer to vector of pairs
% containing MR_Live_Lval and MR_Live_Type
% live data names (Word *) - pointer to vector of String
-% live data names (Word *) - pointer to vector of String
% type parameters (Word *) - pointer to vector of MR_Live_Lval
%
-% We need detailed information about the variables that are live at an internal
-% label in two kinds of circumstances:
+% The live data pair vector will have an entry for each live variable.
+% The entry will give the location of the variable and its type. (It also
+% has room for its instantiation state, but this is not filled in yet.)
+%
+% The live data name vector pointer may be NULL. If it is not, the vector
+% will have an entry for each live variable, with each entry being either
+% NULL or giving the name of the variable.
%
-% - the option trace_stack_layout is set, and the label represents
-% a traced event (with the current set of events, this means the
-% the entrance to one branch of a branched control structure)
+% The number of type parameters is never stored as it is not needed --
+% the type parameter vector will simply be indexed by the type variable's
+% variable number stored within pseudo-typeinfos inside the elements
+% of the live data pairs vectors. Since we allocate type variable numbers
+% sequentially, the type parameter vector will usually be dense. However,
+% in some cases, XXX
+%
+% We need detailed information about the variables that are live at an
+% internal label in two kinds of circumstances. Stack layout information
+% will be present only for labels that fall into one or both of these
+% circumstances.
+%
+% - The option trace_stack_layout is set, and the label represents
+% a traced event at which variable info is needed (call, exit,
+% or entrance to one branch of a branched control structure;
+% fail events have no variable information).
%
-% - the option agc_stack_layout is set, and the label represents
+% - The option agc_stack_layout is set, and the label represents
% a point where execution can resume after a procedure call or
% after backtracking.
%
-% If either of these conditions holds for a given label at which there are some
-% live variables, all the fields above will be present in the stack layout
-% table for that label. However, the pointer to the live data names vector
-% will be NULL unless the first condition holds for the label (i.e. the label
-% is used in execution tracing).
-%
-% If neither condition holds for a given label, or if the number of live
-% variables at that label is zero, then the "# of live vars" field will be zero
-% and the last four fields will not be present.
+% If there are no number of live variables at a label, the "# of live vars"
+% field will be zero and the last four fields will not be present.
+% Even if there are some live variables at a label, however, the pointer
+% to the live data names vector will be NULL unless the first condition
+% holds for the label (i.e. the label is used in execution tracing).
%
% XXX: Presently, type parameter vectors are not created, and
% inst information is ignored. We also do not yet enable procid stack
@@ -137,7 +132,8 @@
:- interface.
-:- import_module hlds_module, list, llds.
+:- import_module hlds_module, llds.
+:- import_module list.
:- pred stack_layout__generate_llds(module_info, module_info, list(c_module)).
:- mode stack_layout__generate_llds(in, out, out) is det.
@@ -147,7 +143,7 @@
:- import_module globals, options, continuation_info, llds_out.
:- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
:- import_module assoc_list, bool, string, int, map, std_util, require.
-:- import_module set.
+:- import_module term, set.
:- type stack_layout_info --->
stack_layout_info(
@@ -161,11 +157,13 @@
%---------------------------------------------------------------------------%
- % Initialize the StackLayoutInfo, and begin processing.
+ % Process all the continuation information stored in the HLDS,
+ % converting it into LLDS data structures.
+
stack_layout__generate_llds(ModuleInfo0, ModuleInfo, CModules) :-
module_info_get_continuation_info(ModuleInfo0, ContinuationInfo),
- continuation_info__get_all_proc_layouts(ProcLayoutList,
- ContinuationInfo, _),
+ continuation_info__get_all_proc_layouts(ContinuationInfo,
+ ProcLayoutList),
module_info_name(ModuleInfo0, ModuleName),
module_info_get_cell_count(ModuleInfo0, CellCount),
@@ -186,42 +184,34 @@
%---------------------------------------------------------------------------%
- % Construct the layouts for a single procedure.
+ % Construct the layouts that concern a single procedure:
+ % the procedure-specific layout and the layouts of the labels
+ % inside that procedure.
:- pred stack_layout__construct_layouts(proc_layout_info::in,
- stack_layout_info::in, stack_layout_info::out) is det.
+ stack_layout_info::in, stack_layout_info::out) is det.
stack_layout__construct_layouts(ProcLayoutInfo) -->
-
- { ProcLayoutInfo = proc_layout_info(MaybeGeneralInfo, InternalMap,
- EntryInfo, ExitInfo) },
-
- ( { MaybeGeneralInfo = yes(GeneralInfo) } ->
- stack_layout__construct_proc_layout(GeneralInfo, EntryInfo,
- ExitInfo),
- { GeneralInfo = proc_layout_general_info(ProcLabel, _, _, _) },
- { map__to_assoc_list(InternalMap, Internals) },
- list__foldl(stack_layout__construct_internal_layout(ProcLabel),
- Internals)
- ;
- { error("stack_layout__construct_layouts: uninitialized proc layout") }
- ).
+ { ProcLayoutInfo = proc_layout_info(ProcLabel, Detism,
+ StackSlots, SuccipLoc, CallLabel, InternalMap) },
+ stack_layout__construct_proc_layout(ProcLabel, Detism,
+ StackSlots, SuccipLoc, CallLabel),
+ { map__to_assoc_list(InternalMap, Internals) },
+ list__foldl(stack_layout__construct_internal_layout(ProcLabel),
+ Internals).
%---------------------------------------------------------------------------%
- % Construct the layout describing a single procedure.
+ % Construct a procedure-specific layout.
+
+:- pred stack_layout__construct_proc_layout(proc_label::in,
+ determinism::in, int::in, maybe(int)::in, maybe(label)::in,
+ stack_layout_info::in, stack_layout_info::out) is det.
-:- pred stack_layout__construct_proc_layout(proc_layout_general_info::in,
- maybe(continuation_label_info)::in,
- maybe(continuation_label_info)::in,
- stack_layout_info::in, stack_layout_info::out) is det.
-
-stack_layout__construct_proc_layout(GeneralInfo, MaybeEntryInfo,
- MaybeExitInfo) -->
- { GeneralInfo = proc_layout_general_info(ProcLabel, Detism,
- StackSlots, SuccipLoc) },
+stack_layout__construct_proc_layout(ProcLabel, Detism, StackSlots,
+ MaybeSuccipLoc, MaybeCallLabel) -->
{
- SuccipLoc = yes(Location0)
+ MaybeSuccipLoc = yes(Location0)
->
Location = Location0
;
@@ -244,27 +234,32 @@
{ stack_layout__represent_determinism(Detism, DetismRval) },
{ MaybeRvals0 = [yes(CodeAddrRval), yes(DetismRval),
yes(StackSlotsRval), yes(SuccipRval)] },
- stack_layout__get_module_name(ModuleName),
stack_layout__get_procid_stack_layout(ProcIdLayout),
(
{ ProcIdLayout = yes }
->
{ stack_layout__construct_procid_rvals(ProcLabel, IdRvals) },
- { list__append(MaybeRvals0, IdRvals, MaybeRvals1) },
+ { list__append(MaybeRvals0, IdRvals, MaybeRvals1) }
+ ;
+ { MaybeRvals1 = MaybeRvals0 }
+ ),
- stack_layout__get_trace_stack_layout(TraceLayout),
- (
- { TraceLayout = yes }
- ->
- stack_layout__construct_trace_rvals(MaybeEntryInfo,
- MaybeExitInfo, TraceRvals),
- { list__append(MaybeRvals1, TraceRvals, MaybeRvals) }
+ stack_layout__get_module_name(ModuleName),
+ stack_layout__get_trace_stack_layout(TraceLayout),
+ (
+ { TraceLayout = yes }
+ ->
+ ( { MaybeCallLabel = yes(CallLabel) } ->
+ { CallRval = yes(const(data_addr_const(
+ data_addr(ModuleName,
+ stack_layout(CallLabel))))) },
+ { list__append(MaybeRvals1, [CallRval], MaybeRvals) }
;
- { MaybeRvals = MaybeRvals1 }
+ { error("stack_layout__construct_proc_layout: call label not present") }
)
;
- { MaybeRvals = MaybeRvals0 }
+ { MaybeRvals = MaybeRvals1 }
),
{ CModule = c_data(ModuleName, stack_layout(Label), yes,
@@ -315,7 +310,7 @@
%---------------------------------------------------------------------------%
- % Construct the layout describing a single continuation label.
+ % Construct the layout describing a single internal label.
:- pred stack_layout__construct_internal_layout(proc_label::in,
pair(label, internal_layout_info)::in,
@@ -326,74 +321,40 @@
stack_layout__get_module_name(ModuleName),
{ EntryAddrRval = const(data_addr_const(data_addr(ModuleName,
stack_layout(local(ProcLabel))))) },
-
- stack_layout__construct_agc_rvals(Internal, AgcRvals),
-
- { LayoutRvals = [yes(EntryAddrRval) | AgcRvals] },
-
+ { Label = local(_, LabelNum0) ->
+ LabelNum = LabelNum0
+ ;
+ LabelNum = -1
+ },
+ { LabelNumRval = const(int_const(LabelNum)) },
+ stack_layout__construct_internal_rvals(Internal, AgcRvals),
+ { LayoutRvals = [yes(EntryAddrRval), yes(LabelNumRval) | AgcRvals] },
{ CModule = c_data(ModuleName, stack_layout(Label), yes,
LayoutRvals, []) },
stack_layout__add_cmodule(CModule).
- % Construct the rvals required for tracing.
-
-:- pred stack_layout__construct_trace_rvals(maybe(continuation_label_info)::in,
- maybe(continuation_label_info)::in, list(maybe(rval))::out,
- stack_layout_info::in, stack_layout_info::out) is det.
-
-stack_layout__construct_trace_rvals(MaybeEntryInfo, MaybeExitInfo,
- RvalList) -->
- (
- { MaybeEntryInfo = yes(EntryInfo) },
- { MaybeExitInfo = yes(ExitInfo) }
- ->
- { EntryInfo = continuation_label_info(EntryLvals, EntryTVars) },
- { ExitInfo = continuation_label_info(ExitLvals, ExitTVars) },
- stack_layout__construct_livelval_rvals(EntryLvals, EntryTVars,
- EntryRvals),
- stack_layout__construct_livelval_rvals(ExitLvals, ExitTVars,
- ExitRvals),
- { list__append(EntryRvals, ExitRvals, RvalList) }
- ;
- { error("stack_layout__construct_trace_rvals: entry or exit information not available.") }
- ).
+ % Construct the rvals required for accurate GC or for tracing.
- % Construct the rvals required for accurate GC.
-
-:- pred stack_layout__construct_agc_rvals(internal_layout_info::in,
+:- pred stack_layout__construct_internal_rvals(internal_layout_info::in,
list(maybe(rval))::out,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_agc_rvals(Internal, RvalList) -->
- stack_layout__get_agc_stack_layout(AgcStackLayout),
+stack_layout__construct_internal_rvals(Internal, RvalList) -->
(
- { AgcStackLayout = yes }
+ { Internal = yes(layout_label_info(LiveLvalSet, TVars)) }
->
- { Internal = internal_layout_info(ContinuationLabelInfo) },
- {
- ContinuationLabelInfo = yes(continuation_label_info(
- LiveLvalSet0, TVars0))
- ->
- LiveLvalSet = LiveLvalSet0,
- TVars = TVars0
- ;
- % This label is not being used as a continuation,
- % or we are not doing accurate GC, so we record
- % no live values here.
- % This might not be a true reflection of the
- % liveness at this point, so the values cannot
- % be relied upon by the runtime system unless
- % you know you are at a continuation (and doing
- % accurate GC).
-
- set__init(LiveLvalSet),
- set__init(TVars)
- },
stack_layout__construct_livelval_rvals(LiveLvalSet, TVars,
RvalList)
;
- { RvalList = [yes(const(int_const(0))),
- yes(const(int_const(0)))] }
+ % This label is not being used as a continuation,
+ % or we are not doing accurate GC, so we record
+ % no live values here.
+ % This might not be a true reflection of the
+ % liveness at this point, so the values cannot
+ % be relied upon by the runtime system unless
+ % you know you are at a continuation (and doing
+ % accurate GC).
+ { RvalList = [yes(const(int_const(0)))] }
).
%---------------------------------------------------------------------------%
@@ -403,34 +364,60 @@
stack_layout_info, stack_layout_info).
:- mode stack_layout__construct_livelval_rvals(in, in, out, in, out) is det.
-stack_layout__construct_livelval_rvals(LiveLvalSet, TVarSet, RvalList) -->
+stack_layout__construct_livelval_rvals(LiveLvalSet, TVarLocnSet, RvalList) -->
{ set__to_sorted_list(LiveLvalSet, LiveLvals) },
{ list__length(LiveLvals, Length) },
- { LengthRval = const(int_const(Length)) },
- stack_layout__construct_liveval_pairs(LiveLvals, LiveValRval,
- NamesRval),
-
- { set__to_sorted_list(TVarSet, TVars) },
- { assoc_list__values(TVars, TypeParamLvals) },
- stack_layout__construct_type_parameter_locn_vector(TypeParamLvals,
- TypeParamRval),
-
- { RvalList = [yes(LengthRval), yes(LiveValRval),
- yes(NamesRval), yes(TypeParamRval)] }.
+ { VarLengthRval = const(int_const(Length)) },
+ ( { Length > 0 } ->
+ stack_layout__construct_liveval_pairs(LiveLvals, LiveValRval,
+ NamesRval),
+
+ { set__to_sorted_list(TVarLocnSet, TVarLocns) },
+ stack_layout__construct_type_param_locn_vector(TVarLocns, 1,
+ TypeParamLocs),
+ stack_layout__get_next_cell_number(CNum1),
+ { TypeParamRval = create(0, TypeParamLocs, no, CNum1,
+ "stack_layout_type_param_locn_vector") },
+ { list__length(TypeParamLocs, TypeParamsLength) },
+ { TypeParamLengthRval = const(int_const(TypeParamsLength)) },
+
+ { RvalList = [yes(VarLengthRval), yes(LiveValRval),
+ yes(NamesRval), yes(TypeParamLengthRval),
+ yes(TypeParamRval)] }
+ ;
+ { RvalList = [yes(VarLengthRval)] }
+ ).
%---------------------------------------------------------------------------%
-:- pred stack_layout__construct_type_parameter_locn_vector(list(lval)::in,
- rval::out, stack_layout_info::in, stack_layout_info::out) is det.
+ % Given a association list of type variables and their locations
+ % sorted on the type variables, represent them in an array of
+ % location descriptions indexed by the type variable. The next
+ % slot to fill is given by the second argument.
-stack_layout__construct_type_parameter_locn_vector(TypeParamLvals,
- TypeParamVector) -->
- { MakeLval = lambda([Lval::in, yes(Rval)::out] is det, (
- stack_layout__represent_lval(Lval, Rval))) },
- { list__map(MakeLval, TypeParamLvals, TypeParamLocs) },
- stack_layout__get_next_cell_number(CNum1),
- { TypeParamVector = create(0, TypeParamLocs, no, CNum1,
- "stack_layout_type_parameter_locn_vector") }.
+:- pred stack_layout__construct_type_param_locn_vector(
+ assoc_list(tvar, lval)::in, int::in, list(maybe(rval))::out,
+ stack_layout_info::in, stack_layout_info::out) is det.
+
+stack_layout__construct_type_param_locn_vector([], _, []) --> [].
+stack_layout__construct_type_param_locn_vector([TVar - Locn | TVarLocns],
+ CurSlot, Vector) -->
+ { term__var_to_int(TVar, TVarNum) },
+ { NextSlot is CurSlot + 1 },
+ ( { TVarNum = CurSlot } ->
+ { stack_layout__represent_lval(Locn, Rval) },
+ stack_layout__construct_type_param_locn_vector(TVarLocns,
+ NextSlot, VectorTail),
+ { Vector = [yes(Rval) | VectorTail] }
+ ; { TVarNum > CurSlot } ->
+ stack_layout__construct_type_param_locn_vector(TVarLocns,
+ NextSlot, VectorTail),
+ % This slot will never be referred to.
+ { Vector = [yes(const(int_const(0))) | VectorTail] }
+ ;
+
+ { error("unsorted tvars in construct_type_param_locn_vector") }
+ ).
% Construct a vector of (lval, live_value_type) pairs,
% and a corresponding vector of variable names.
@@ -488,7 +475,7 @@
%
% Low integers for special values, a pointer for other values.
% (Remember to keep the low integers below the max varint value in
- % runtime/type_info.h).
+ % runtime/mercury_type_info.h).
:- pred stack_layout__represent_live_value_type(live_value_type, rval,
stack_layout_info, stack_layout_info).
@@ -509,8 +496,8 @@
stack_layout__represent_live_value_type(var(Type, _Inst), Rval) -->
stack_layout__get_cell_number(CNum0),
{ base_type_layout__construct_pseudo_type_info(Type, Rval0,
- CNum0, CNum) },
- stack_layout__set_cell_number(CNum),
+ CNum0, CNum1) },
+ stack_layout__set_cell_number(CNum1),
% XXX hack - don't yet write out insts
{ Rval1 = const(int_const(-1)) },
stack_layout__get_next_cell_number(CNum2),
Index: compiler/store_alloc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/store_alloc.m,v
retrieving revision 1.59
diff -u -r1.59 store_alloc.m
--- store_alloc.m 1998/02/12 01:17:46 1.59
+++ store_alloc.m 1998/03/11 06:58:15
@@ -37,7 +37,7 @@
:- implementation.
:- import_module follow_vars, liveness, hlds_goal, llds.
-:- import_module options, globals, goal_util, mode_util, instmap.
+:- import_module options, globals, goal_util, mode_util, instmap, trace.
:- import_module list, map, set, std_util, assoc_list.
:- import_module bool, int, require, term.
@@ -60,7 +60,12 @@
proc_info_goal(ProcInfo0, Goal2)
),
initial_liveness(ProcInfo0, ModuleInfo, Liveness0),
- set__init(ResumeVars0),
+ globals__lookup_bool_option(Globals, generate_trace, Trace),
+ ( Trace = yes ->
+ trace__fail_vars(ProcInfo0, ResumeVars0)
+ ;
+ set__init(ResumeVars0)
+ ),
store_alloc_in_goal(Goal2, Liveness0, ResumeVars0, ModuleInfo, Goal, _),
proc_info_set_goal(ProcInfo0, Goal, ProcInfo).
Index: compiler/string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/string_switch.m,v
retrieving revision 1.28
diff -u -r1.28 string_switch.m
--- string_switch.m 1998/03/03 17:36:05 1.28
+++ string_switch.m 1998/03/18 05:43:15
@@ -307,8 +307,9 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(switch(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
Index: compiler/switch_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_gen.m,v
retrieving revision 1.64
diff -u -r1.64 switch_gen.m
--- switch_gen.m 1998/03/03 17:36:06 1.64
+++ switch_gen.m 1998/03/18 05:43:36
@@ -311,7 +311,8 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path), TraceInfo,
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(switch(Path, PreDeaths), TraceInfo,
TraceCode)
;
{ TraceCode = empty }
Index: compiler/tag_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/tag_switch.m,v
retrieving revision 1.43
diff -u -r1.43 tag_switch.m
--- tag_switch.m 1998/03/03 17:36:08 1.43
+++ tag_switch.m 1998/03/18 05:45:10
@@ -663,7 +663,10 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path),
+ { goal_info_get_pre_deaths(GoalInfo,
+ PreDeaths) },
+ trace__generate_event_code(
+ switch(Path, PreDeaths),
TraceInfo, TraceCode)
;
{ TraceCode = empty }
@@ -807,8 +810,9 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(switch(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
@@ -884,8 +888,9 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path), TraceInfo,
- TraceCode)
+ { goal_info_get_pre_deaths(GoalInfo, PreDeaths) },
+ trace__generate_event_code(switch(Path, PreDeaths),
+ TraceInfo, TraceCode)
;
{ TraceCode = empty }
),
@@ -980,7 +985,10 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path),
+ { goal_info_get_pre_deaths(GoalInfo,
+ PreDeaths) },
+ trace__generate_event_code(
+ switch(Path, PreDeaths),
TraceInfo, TraceCode)
;
{ TraceCode = empty }
@@ -1063,7 +1071,10 @@
( { MaybeTraceInfo = yes(TraceInfo) } ->
{ Goal = _ - GoalInfo },
{ goal_info_get_goal_path(GoalInfo, Path) },
- trace__generate_event_code(switch(Path),
+ { goal_info_get_pre_deaths(GoalInfo,
+ PreDeaths) },
+ trace__generate_event_code(
+ switch(Path, PreDeaths),
TraceInfo, TraceCode)
;
{ TraceCode = empty }
Index: compiler/termination.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/termination.m,v
retrieving revision 1.11
diff -u -r1.11 termination.m
--- termination.m 1998/03/18 08:07:47 1.11
+++ termination.m 1998/03/19 06:27:21
@@ -47,8 +47,8 @@
:- interface.
-:- import_module io, bool, std_util, list.
:- import_module prog_data, hlds_module, hlds_pred, term_util.
+:- import_module list, io, bool, std_util.
% Perform termination analysis on the module.
@@ -84,7 +84,7 @@
:- import_module mercury_to_mercury, varset, type_util, special_pred.
:- import_module modules.
-:- import_module map, int, char, string, relation.
+:- import_module list, map, int, char, string, relation.
:- import_module require, bag, set, term.
%----------------------------------------------------------------------------%
Index: compiler/trace.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/trace.m,v
retrieving revision 1.7
diff -u -r1.7 trace.m
--- trace.m 1998/02/03 08:18:35 1.7
+++ trace.m 1998/03/18 06:01:46
@@ -25,35 +25,53 @@
:- interface.
-:- import_module hlds_goal, llds, code_info.
+:- import_module prog_data, hlds_goal, hlds_pred, llds, code_info.
+:- import_module list, assoc_list, set, term.
:- type trace_port ---> call
; exit
; fail
- ; ite_then(goal_path)
- ; ite_else(goal_path)
- ; switch(goal_path)
- ; disj(goal_path).
+ ; ite_then(goal_path, set(var))
+ ; ite_else(goal_path, set(var))
+ ; switch(goal_path, set(var))
+ ; disj(goal_path, set(var)).
:- type trace_info.
+ % Return the set of input variables whose values should be preserved
+ % until the exit and fail ports. This should be all input variables,
+ % except those that may be clobbered during the evaluation of the
+ % procedure.
+:- pred trace__fail_vars(proc_info::in, set(var)::out) is det.
+
+ % Set up the code generator state for tracing, by reserving
+ % slots for the call number and call depth.
:- pred trace__setup(code_info::in, code_info::out) is det.
+ % Generate code to fill in the slots for the call number and depth.
:- pred trace__generate_slot_fill_code(trace_info::in, code_tree::out) is det.
+ % Generate code to reset the call depth before a call.
:- pred trace__generate_depth_reset_code(trace_info::in, code_tree::out) is det.
+ % Generate code for a trace event.
:- pred trace__generate_event_code(trace_port::in, trace_info::in,
code_tree::out, code_info::in, code_info::out) is det.
+ % Generate code for a trace event, returning the
+:- pred trace__generate_event_code(trace_port::in, trace_info::in,
+ label::out, assoc_list(tvar, lval)::out, code_tree::out,
+ code_info::in, code_info::out) is det.
+
:- pred trace__path_to_string(goal_path::in, string::out) is det.
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module hlds_module, hlds_pred, llds_out, code_util, tree.
-:- import_module bool, int, list, std_util, string, require.
+:- import_module hlds_module, llds_out, code_util, type_util.
+:- import_module arg_info, continuation_info, instmap, tree.
+:- import_module bool, int, string, map, std_util, varset, require.
:- type trace_info
---> trace_info(
@@ -61,6 +79,18 @@
lval % stack slot of call depth
).
+trace__fail_vars(ProcInfo, FailVars) :-
+ proc_info_headvars(ProcInfo, HeadVars),
+ proc_info_arg_info(ProcInfo, ArgInfos),
+ assoc_list__from_corresponding_lists(HeadVars, ArgInfos, Args),
+ arg_info__build_input_arg_list(Args, ArgList),
+ assoc_list__keys(ArgList, InputArgs),
+ % We do not yet delete input vars that have any components
+ % that could be clobbered, because the modules of the mode
+ % system do not have any utility predicates for testing for
+ % this.
+ set__list_to_set(InputArgs, FailVars).
+
trace__setup -->
code_info__get_trace_slot(CallNumSlot),
code_info__get_trace_slot(CallDepthSlot),
@@ -89,13 +119,30 @@
c_code(Stmt) - ""
]).
-trace__generate_event_code(Port, TraceInfo, TraceCode) -->
- code_info__get_pred_id(PredId),
- code_info__get_proc_id(ProcId),
- code_info__get_module_info(ModuleInfo),
+trace__generate_event_code(Port, TraceInfo, Code) -->
+ trace__generate_event_code(Port, TraceInfo, _, _, Code).
+
+trace__generate_event_code(Port, TraceInfo, Label, TvarDataList, Code) -->
+ code_info__get_next_label(Label),
+ code_info__get_known_variables(LiveVars0),
+ { trace__apply_pre_deaths(Port, LiveVars0, LiveVars) },
+ code_info__get_varset(VarSet),
+ code_info__get_instmap(InstMap),
+ { set__init(TvarSet0) },
+ trace__produce_vars(LiveVars, VarSet, InstMap, TvarSet0, TvarSet,
+ VarInfoList, ProduceCode),
+ { set__to_sorted_list(TvarSet, TvarList) },
+ code_info__variable_locations(VarLocs),
+ code_info__get_proc_info(ProcInfo),
+ { proc_info_typeinfo_varmap(ProcInfo, TypeInfoMap) },
+ { trace__find_typeinfos_for_tvars(TvarList, VarLocs, TypeInfoMap,
+ TvarDataList) },
+ code_info__max_reg_in_use(MaxReg),
{
- code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel),
- llds_out__get_label(local(ProcLabel), yes, LabelStr),
+ set__list_to_set(VarInfoList, VarInfoSet),
+ set__list_to_set(TvarDataList, TvarDataSet),
+ LayoutLabelInfo = layout_label_info(VarInfoSet, TvarDataSet),
+ llds_out__get_label(Label, yes, LabelStr),
TraceInfo = trace_info(CallNumLval, CallDepthLval),
trace__stackref_to_string(CallNumLval, CallNumStr),
trace__stackref_to_string(CallDepthLval, CallDepthStr),
@@ -107,35 +154,136 @@
;
PathStr = ""
),
+ IfStmt = "\tif (MR_trace_enabled) {\n",
+ EndStmt = "\t}\n",
+ SaveStmt = "\t\tsave_transient_registers();\n",
+ RestoreStmt = "\t\trestore_transient_registers();\n",
+ string__int_to_string(MaxReg, MaxRegStr),
string__append_list([
- "MR_trace(",
- "(const Word *) &mercury_data__stack_layout__", LabelStr, Comma,
- PortStr, Comma,
+ "\t\tMR_trace((const MR_Stack_Layout_Label *)\n",
+ "\t\t\t&mercury_data__stack_layout__", LabelStr, Comma, "\n",
+ "\t\t\t", PortStr, Comma,
CallNumStr, Comma,
CallDepthStr, Comma,
- Quote, PathStr, Quote, ");\n"],
+ Quote, PathStr, Quote, Comma,
+ MaxRegStr, ");\n"],
+ CallStmt),
+ string__append_list([IfStmt, SaveStmt, CallStmt, RestoreStmt, EndStmt],
TraceStmt),
- TraceCode = node([c_code(TraceStmt) - ""])
- }.
+ TraceCode =
+ node([
+ pragma_c([], [pragma_c_raw_code(TraceStmt)],
+ may_call_mercury, yes(Label))
+ - "",
+ label(Label)
+ - "A label to hang trace liveness on"
+ % Referring to the label from the pragma_c
+ % prevents the label from being renamed
+ % or optimized away.
+ ]),
+ Code = tree(ProduceCode, TraceCode)
+ },
+ code_info__add_layout_for_label(Label, yes(LayoutLabelInfo)).
+
+:- pred trace__produce_vars(list(var)::in, varset::in, instmap::in,
+ set(tvar)::in, set(tvar)::out, list(var_info)::out, code_tree::out,
+ code_info::in, code_info::out) is det.
+
+trace__produce_vars([], _, _, Tvars, Tvars, [], empty) --> [].
+trace__produce_vars([Var | Vars], VarSet, InstMap, Tvars0, Tvars,
+ [VarInfo | VarInfos], tree(VarCode, VarsCode)) -->
+ code_info__produce_variable_in_reg_or_stack(Var, VarCode, Rval),
+ code_info__variable_type(Var, Type),
+ {
+ ( Rval = lval(LvalPrime) ->
+ Lval = LvalPrime
+ ;
+ error("var not an lval in trace__produce_vars")
+ % If the value of the variable is known,
+ % we record it as living in a nonexistent location, r0.
+ % The code that interprets layout information must know this.
+ % Lval = reg(r, 0)
+ ),
+ varset__lookup_name(VarSet, Var, "V_", Name),
+ instmap__lookup_var(InstMap, Var, Inst),
+ LiveType = var(Type, Inst),
+ VarInfo = var_info(Lval, LiveType, Name),
+ type_util__vars(Type, TypeVars),
+ set__insert_list(Tvars0, TypeVars, Tvars1)
+ },
+ trace__produce_vars(Vars, VarSet, InstMap, Tvars1, Tvars,
+ VarInfos, VarsCode).
+
+ % For each type variable in the given list, find out where the
+ % typeinfo var for that type variable is.
+
+:- pred trace__find_typeinfos_for_tvars(list(tvar)::in,
+ map(var, set(rval))::in, map(tvar, type_info_locn)::in,
+ assoc_list(tvar, lval)::out) is det.
+
+trace__find_typeinfos_for_tvars(TypeVars, VarLocs, TypeInfoMap, TypeInfoDatas)
+ :-
+ map__apply_to_list(TypeVars, TypeInfoMap, TypeInfoLocns),
+ list__map(type_info_locn_var, TypeInfoLocns, TypeInfoVars),
+
+ map__apply_to_list(TypeInfoVars, VarLocs, TypeInfoLvalSets),
+ FindSingleLval = lambda([Set::in, Lval::out] is det, (
+ (
+ set__remove_least(Set, Value, _),
+ Value = lval(Lval0)
+ ->
+ Lval = Lval0
+ ;
+ error("trace__find_typeinfos_for_tvars: typeinfo var not available")
+ ))
+ ),
+ list__map(FindSingleLval, TypeInfoLvalSets, TypeInfoLvals),
+ assoc_list__from_corresponding_lists(TypeVars, TypeInfoLvals,
+ TypeInfoDatas).
+
+%-----------------------------------------------------------------------------%
+
+:- pred trace__apply_pre_deaths(trace_port::in, list(var)::in, list(var)::out)
+ is det.
+
+trace__apply_pre_deaths(call, LiveVars, LiveVars).
+trace__apply_pre_deaths(exit, LiveVars, LiveVars).
+trace__apply_pre_deaths(fail, LiveVars, LiveVars).
+trace__apply_pre_deaths(ite_then(_, PreDeaths), LiveVars0, LiveVars) :-
+ set__list_to_set(LiveVars0, LiveVars0Set),
+ set__difference(LiveVars0Set, PreDeaths, LiveVarsSet),
+ set__to_sorted_list(LiveVarsSet, LiveVars).
+trace__apply_pre_deaths(ite_else(_, PreDeaths), LiveVars0, LiveVars) :-
+ set__list_to_set(LiveVars0, LiveVars0Set),
+ set__difference(LiveVars0Set, PreDeaths, LiveVarsSet),
+ set__to_sorted_list(LiveVarsSet, LiveVars).
+trace__apply_pre_deaths(switch(_, PreDeaths), LiveVars0, LiveVars) :-
+ set__list_to_set(LiveVars0, LiveVars0Set),
+ set__difference(LiveVars0Set, PreDeaths, LiveVarsSet),
+ set__to_sorted_list(LiveVarsSet, LiveVars).
+trace__apply_pre_deaths(disj(_, PreDeaths), LiveVars0, LiveVars) :-
+ set__list_to_set(LiveVars0, LiveVars0Set),
+ set__difference(LiveVars0Set, PreDeaths, LiveVarsSet),
+ set__to_sorted_list(LiveVarsSet, LiveVars).
%-----------------------------------------------------------------------------%
:- pred trace__port_path(trace_port::in, goal_path::out) is semidet.
-trace__port_path(ite_then(Path), Path).
-trace__port_path(ite_else(Path), Path).
-trace__port_path(switch(Path), Path).
-trace__port_path(disj(Path), Path).
+trace__port_path(ite_then(Path, _), Path).
+trace__port_path(ite_else(Path, _), Path).
+trace__port_path(switch(Path, _), Path).
+trace__port_path(disj(Path, _), Path).
:- pred trace__port_to_string(trace_port::in, string::out) is det.
trace__port_to_string(call, "MR_PORT_CALL").
trace__port_to_string(exit, "MR_PORT_EXIT").
trace__port_to_string(fail, "MR_PORT_FAIL").
-trace__port_to_string(ite_then(_), "MR_PORT_THEN").
-trace__port_to_string(ite_else(_), "MR_PORT_ELSE").
-trace__port_to_string(switch(_), "MR_PORT_SWITCH").
-trace__port_to_string(disj(_), "MR_PORT_DISJ").
+trace__port_to_string(ite_then(_, _), "MR_PORT_THEN").
+trace__port_to_string(ite_else(_, _), "MR_PORT_ELSE").
+trace__port_to_string(switch(_, _), "MR_PORT_SWITCH").
+trace__port_to_string(disj(_, _), "MR_PORT_DISJ").
:- pred trace__code_model_to_string(code_model::in, string::out) is det.
Index: compiler/vn_filter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_filter.m,v
retrieving revision 1.15
diff -u -r1.15 vn_filter.m
--- vn_filter.m 1998/01/13 10:14:09 1.15
+++ vn_filter.m 1998/03/16 04:30:41
@@ -25,7 +25,7 @@
:- implementation.
-:- import_module opt_util.
+:- import_module code_util, opt_util.
:- import_module require, std_util.
% Look for assignments to temp variables. If possible and profitable,
@@ -38,7 +38,7 @@
Instr0 = Uinstr0 - _,
Uinstr0 = assign(Temp, Defn),
Temp = temp(_, _),
- opt_util__lvals_in_rval(Defn, Deps),
+ code_util__lvals_in_rval(Defn, Deps),
vn_filter__can_substitute(Instrs0, Temp, Defn, Deps,
Instrs1)
->
@@ -73,7 +73,7 @@
Instr0 = Uinstr0 - Comment,
(
vn_filter__user_instr(Uinstr0, yes(Rval)),
- opt_util__lvals_in_rval(Rval, Lvals),
+ code_util__lvals_in_rval(Rval, Lvals),
list__delete_first(Lvals, Temp, OtherLvals)
->
% We don't want to perform the subsitution
@@ -81,7 +81,7 @@
\+ list__member(Temp, OtherLvals),
\+ (
vn_filter__defining_instr(Uinstr0, yes(Lval)),
- opt_util__lvals_in_lval(Lval, AccessLvals),
+ code_util__lvals_in_lval(Lval, AccessLvals),
list__member(Temp, AccessLvals)
),
vn_filter__replace_in_user_instr(Uinstr0, Temp, Defn, Uinstr1),
@@ -99,7 +99,7 @@
->
fail
;
- opt_util__lvals_in_lval(Lval, AccessLvals),
+ code_util__lvals_in_lval(Lval, AccessLvals),
list__delete_first(AccessLvals, Temp, OtherAccessLvals)
->
\+ list__member(Temp, OtherAccessLvals),
Index: library/require.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/require.m,v
retrieving revision 1.18
diff -u -r1.18 require.m
--- require.m 1998/03/11 05:57:41 1.18
+++ require.m 1998/03/20 08:06:15
@@ -58,6 +58,7 @@
:- pragma c_code(error(Message::in), "
fflush(stdout);
fprintf(stderr, ""Software error: %s\\n"", Message);
+ MR_trace_report();
MR_dump_stack(MR_succip, MR_sp);
exit(1);
#ifndef USE_GCC_NONLOCAL_GOTOS
Index: runtime/mercury_misc.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_misc.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_misc.c
--- mercury_misc.c 1998/03/16 12:23:33 1.4
+++ mercury_misc.c 1998/03/20 08:06:01
@@ -468,6 +468,7 @@
void
fatal_error(const char *message) {
fprintf(stderr, "Mercury runtime: %s\n", message);
+ MR_trace_report();
exit(1);
}
Index: runtime/mercury_regorder.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_regorder.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_regorder.h
--- mercury_regorder.h 1997/11/23 07:21:32 1.2
+++ mercury_regorder.h 1998/03/16 05:06:30
@@ -55,6 +55,11 @@
#define r31 count_usage(R_RN(31), mr35)
#define r32 count_usage(R_RN(32), mr36)
+/*
+** If you modify the following block, make sure that you update
+** the definitions of MR_NUM_SPECIAL_REG and MR_MAX_SPECIAL_REG_MR.
+*/
+
#define MR_succip LVALUE_CAST(Code *, count_usage(MR_SI_RN, mr1))
#define succip MR_succip
#define MR_hp LVALUE_CAST(Word *, count_usage(MR_HP_RN, mr5))
@@ -73,6 +78,12 @@
#define MR_trail_ptr count_usage(MR_TRAIL_PTR_RN, MR_trail_ptr_var)
#define MR_ticket_counter \
count_usage(MR_TICKET_COUNTER_RN, MR_ticket_counter_var)
+
+/* the number of special, non rN registers */
+#define MR_NUM_SPECIAL_REG 10
+
+/* the maximum mrN number of special, non rN registers */
+#define MR_MAX_SPECIAL_REG_MR 39
#define VIRTUAL_REG_MAP_BODY { \
2, \
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_stack_layout.h
--- mercury_stack_layout.h 1998/03/11 22:07:30 1.2
+++ mercury_stack_layout.h 1998/03/18 05:05:54
@@ -10,6 +10,10 @@
/*
** mercury_stack_layout.h -
** Definitions for the stack layout data structures.
+**
+** NOTE: The constants and data-structures used here need to be kept in
+** sync with the ones generated in the compiler. If you change anything here,
+** you may need to change compiler/stack_layout.m as well.
*/
/*
@@ -49,7 +53,8 @@
#define MR_DETISM_FIRST_SOLN(d) (((d) & 8) != 0)
-#define MR_DETISM_DET_CODE_MODEL(d) (((d) & 1) == 0)
+#define MR_DETISM_DET_CODE_MODEL(d) (!MR_DETISM_AT_MOST_MANY(d) \
+ || MR_DETISM_FIRST_SOLN(d))
/*
** Definitions for "MR_Live_Lval"
@@ -112,7 +117,7 @@
** The data is encoded such that low values (less than
** TYPELAYOUT_MAX_VARINT) represent succip, hp, etc. Higher values
** represent data variables, and are pointers to a 2 word cell,
-** containing a type_info and an instantiation represention.
+** containing a pseudo type_info and an instantiation represention.
**
** This data is generated in compiler/stack_layout.m, which must be kept
** in sync with the constants defined here.
@@ -130,7 +135,7 @@
} MR_Lval_NonVar;
typedef struct {
- Word type; /* contains a type_info */
+ Word *pseudo_type_info;
Word inst; /* not yet used; currently always -1 */
} MR_Var_Shape_Info;
@@ -140,10 +145,10 @@
((MR_Lval_NonVar) T)
#define MR_LIVE_TYPE_GET_VAR_TYPE(T) \
- ((Word) ((MR_Var_Shape_Info *) T)->type)
+ (((MR_Var_Shape_Info *) T)->pseudo_type_info)
#define MR_LIVE_TYPE_GET_VAR_INST(T) \
- ((Word) ((MR_Var_Shape_Info *) T)->inst)
+ (((MR_Var_Shape_Info *) T)->inst)
/*
** Macros to support hand-written C code.
@@ -151,9 +156,10 @@
/*
** Define a stack layout for a label that you know very little about.
-** It's just a generic entry label, no useful information, except
+** It is just a generic entry label, no useful information, except
** the code address for the label.
*/
+
#ifdef MR_USE_STACK_LAYOUTS
#define MR_MAKE_STACK_LAYOUT_ENTRY(l) \
const struct mercury_data__stack_layout__##l##_struct { \
@@ -178,6 +184,7 @@
** The only useful information in this structure is the code address
** and the reference to the entry for this label.
*/
+
#ifdef MR_USE_STACK_LAYOUTS
#define MR_MAKE_STACK_LAYOUT_INTERNAL_WITH_ENTRY(l, e) \
const struct mercury_data__stack_layout__##l##_struct { \
@@ -208,6 +215,7 @@
** The only useful information in this structure is the code address
** and the reference to the entry for this label.
*/
+
#ifdef MR_USE_STACK_LAYOUTS
#define MR_MAKE_STACK_LAYOUT_INTERNAL(e, x) \
const struct mercury_data__stack_layout__##e##_i##x##_struct { \
@@ -227,18 +235,25 @@
** Structs and macros to support stack layouts.
*/
-typedef struct MR_stack_layout_var_struct {
+typedef struct MR_Stack_Layout_Var_Struct {
MR_Live_Lval MR_slv_locn;
MR_Live_Type MR_slv_live_type;
-} MR_stack_layout_var;
+} MR_Stack_Layout_Var;
-typedef struct MR_stack_layout_vars_struct {
- MR_stack_layout_var *MR_slvs_pairs;
+typedef struct MR_Stack_Layout_Vars_Struct {
+ MR_Stack_Layout_Var *MR_slvs_pairs;
String *MR_slvs_names;
- Word *MR_slvs_tvars;
-} MR_stack_layout_vars;
+ Integer MR_slvs_tvar_count;
+ MR_Live_Lval *MR_slvs_tvars;
+} MR_Stack_Layout_Vars;
+
+#define MR_name_if_present(vars, i) \
+ ((vars->MR_slvs_names != NULL \
+ && vars->MR_slvs_names[(i)] != NULL) \
+ ? vars->MR_slvs_names[(i)] \
+ : "")
-typedef struct MR_stack_layout_entry_struct {
+typedef struct MR_Stack_Layout_Entry_Struct {
Code *MR_sle_code_addr;
MR_Determinism MR_sle_detism;
Integer MR_sle_stack_slots;
@@ -251,18 +266,17 @@
Integer MR_sle_arity;
Integer MR_sle_mode;
/* the fields from here onwards are present only with trace layouts */
- Integer MR_sle_in_arg_count;
- MR_stack_layout_vars MR_sle_in_arg_info;
- Integer MR_sle_out_arg_count;
- MR_stack_layout_vars MR_sle_out_arg_info;
-} MR_stack_layout_entry;
-
-typedef struct MR_stack_layout_label_struct {
- MR_stack_layout_entry *MR_sll_entry;
+ struct MR_Stack_Layout_Label_Struct
+ *MR_sle_call_label;
+} MR_Stack_Layout_Entry;
+
+typedef struct MR_Stack_Layout_Label_Struct {
+ MR_Stack_Layout_Entry *MR_sll_entry;
+ Integer MR_sll_label_num;
Integer MR_sll_var_count;
/* the last field is present only if MR_sll_var_count > 0 */
- MR_stack_layout_vars MR_sll_var_info;
-} MR_stack_layout_label;
+ MR_Stack_Layout_Vars MR_sll_var_info;
+} MR_Stack_Layout_Label;
/* The following macros support obsolete code. */
#define MR_ENTRY_STACK_LAYOUT_GET_LABEL_ADDRESS(s) \
@@ -282,4 +296,3 @@
/*---------------------------------------------------------------------------*/
#endif /* not MERCURY_STACK_LAYOUT_H */
-
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.2
diff -u -r1.2 mercury_stack_trace.c
--- mercury_stack_trace.c 1998/03/16 12:23:37 1.2
+++ mercury_stack_trace.c 1998/03/20 08:11:17
@@ -17,13 +17,12 @@
void
MR_dump_stack(Code *success_pointer, Word *det_stack_pointer)
{
- Label *label;
- MR_Live_Lval location;
- MR_stack_layout_label *layout;
- MR_stack_layout_entry *entry_layout;
- MR_Lval_Type type;
- int number, determinism;
-
+ Label *label;
+ MR_Live_Lval location;
+ MR_Stack_Layout_Label *layout;
+ MR_Stack_Layout_Entry *entry_layout;
+ MR_Lval_Type type;
+ int number, determinism;
#ifndef MR_STACK_TRACE
fprintf(stderr, "Stack dump not available in this grade.\n");
@@ -36,7 +35,7 @@
fatal_error("internal label not found");
}
- layout = (MR_stack_layout_label *) label->e_layout;
+ layout = (MR_Stack_Layout_Label *) label->e_layout;
entry_layout = layout->MR_sll_entry;
label = lookup_label_addr(
@@ -65,4 +64,3 @@
} while (MR_DETISM_DET_CODE_MODEL(determinism));
#endif /* MR_STACK_TRACE */
}
-
More information about the developers
mailing list