[m-rev.] Updated diff for deep profiling.
Fergus Henderson
fjh at cs.mu.OZ.AU
Tue May 29 16:29:18 AEST 2001
On 29-May-2001, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> On 29-May-2001, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> > If interdiff doesn't work, you can produce a relative diff by checking
> > out two fresh copies of the repository (using a tag or date which
> > matches the workspace that you used to produce the diffs, to avoid any
> > new conflicts), applying the old and new diffs that you posted, and
> > then using `diff --recursive'.
>
> This would produce a diff in which most changes are the result of
> "cvs update", i.e. changes on the trunk between the two dates. And applying
> the old diff to a current workspace would produce conflicts, as you say.
Even if you just ignore the conflicts (there weren't many, and they
weren't important), the resulting relative diff would be a lot more
useful than the full diff.
Here it is. Note that at 4000 lines of diff, this is a quite substantial
change from what was posted earlier. It ought to reviewed.
I shouldn't have to produce the relative diff like this; it should be
up to the person proposing a change to produce proper relative diffs,
not up to the reviewers.
diff -u -b --recursive -x CVS old/mercury/Mmakefile new/mercury/Mmakefile
--- old/mercury/Mmakefile Tue May 29 16:07:51 2001
+++ new/mercury/Mmakefile Tue May 29 16:13:25 2001
@@ -33,7 +33,7 @@
compiler \
doc \
profiler \
- deep
+ deep_profiler
MMAKEFLAGS =
@@ -53,7 +53,7 @@
# `mmake depend' forces them to be remade to ensure that they are up-to-date.
.PHONY: dep
-dep: dep_library dep_browser dep_compiler dep_profiler dep_deep
+dep: dep_library dep_browser dep_compiler dep_profiler dep_deep_profiler
.PHONY: dep_library
dep_library: library/$(deps_subdir)library.dep
@@ -79,14 +79,15 @@
profiler/$(deps_subdir)mercury_profile.dep: library/$(deps_subdir)library.dep
cd profiler && $(SUBDIR_MMAKE) depend
-.PHONY: dep_deep
-dep_deep: deep_profiler/$(deps_subdir)mdprof_cgi.dep deep_profiler/$(deps_subdir)mdprof_server.dep
+.PHONY: dep_deep_profiler
+dep_deep_profiler: deep_profiler/$(deps_subdir)mdprof_cgi.dep \
+ deep_profiler/$(deps_subdir)mdprof_server.dep
deep_profiler/$(deps_subdir)mdprof_cgi.dep: library/$(deps_subdir)library.dep
- cd deep && $(SUBDIR_MMAKE) mdprof_cgi.depend
+ cd deep_profiler && $(SUBDIR_MMAKE) mdprof_cgi.depend
deep_profiler/$(deps_subdir)mdprof_server.dep: library/$(deps_subdir)library.dep
- cd deep && $(SUBDIR_MMAKE) mdprof_server.depend
+ cd deep_profiler && $(SUBDIR_MMAKE) mdprof_server.depend
# depend_library MUST be done before depend_compiler and depend_profiler
@@ -96,7 +97,7 @@
cd browser && $(SUBDIR_MMAKE) depend
cd compiler && $(SUBDIR_MMAKE) depend
cd profiler && $(SUBDIR_MMAKE) depend
- cd deep && $(SUBDIR_MMAKE) depend
+ cd deep_profiler && $(SUBDIR_MMAKE) depend
.PHONY: depend_library
depend_library:
@@ -114,9 +115,9 @@
depend_profiler:
cd profiler && $(SUBDIR_MMAKE) depend
-.PHONY: depend_deep
-depend_deep:
- cd deep && $(SUBDIR_MMAKE) depend
+.PHONY: depend_deep_profiler
+depend_deep_profiler:
+ cd deep_profiler && $(SUBDIR_MMAKE) depend
#-----------------------------------------------------------------------------#
@@ -168,14 +169,15 @@
profiler: dep_profiler scripts util boehm_gc runtime library browser trace
cd profiler && $(SUBDIR_MMAKE)
-.PHONY: deep
-deep: dep_deep scripts util boehm_gc runtime library browser trace
- cd deep && $(SUBDIR_MMAKE)
+.PHONY: deep_profiler
+deep_profiler: dep_deep_profiler scripts util boehm_gc runtime library \
+ browser trace
+ cd deep_profiler && $(SUBDIR_MMAKE)
#-----------------------------------------------------------------------------#
.PHONY: tags
-tags: tags_compiler tags_library tags_browser tags_profiler tags_deep
+tags: tags_compiler tags_library tags_browser tags_profiler tags_deep_profiler
.PHONY: tags_compiler
tags_compiler:
@@ -193,16 +195,18 @@
tags_profiler:
cd profiler && $(SUBDIR_MMAKE) tags
-.PHONY: tags_deep
-tags_deep:
- cd deep && $(SUBDIR_MMAKE) tags
+.PHONY: tags_deep_profiler
+tags_deep_profiler:
+ cd deep_profiler && $(SUBDIR_MMAKE) tags
#-----------------------------------------------------------------------------#
+# Remove from each of the listed directories mmc-generated files that don't
+# belong there.
cleanint:
- for dir in browser compiler deep library profiler; do \
- echo looking for inappropriate files in the $$dir directory: ; \
- ( cd $$dir; cleanint > .cleanint ) ; \
+ for dir in browser compiler deep_profiler library profiler; do \
+ echo Looking for inappropriate files in the $$dir directory: ; \
+ ( cd $$dir && ../tools/cleanint > .cleanint ) ; \
if test -s $$dir/.cleanint ; then \
cat $$dir/.cleanint ; \
else \
@@ -254,8 +258,8 @@
cd compiler && $(SUBDIR_MMAKE) cs tags
cd profiler && $(SUBDIR_MMAKE) depend
cd profiler && $(SUBDIR_MMAKE) cs tags
- cd deep && $(SUBDIR_MMAKE) depend
- cd deep && $(SUBDIR_MMAKE) cs tags
+ cd deep_profiler && $(SUBDIR_MMAKE) depend
+ cd deep_profiler && $(SUBDIR_MMAKE) cs tags
cd doc && $(SUBDIR_MMAKE) info html dvi mdb_doc
cd bindist && $(SUBDIR_MMAKE) bindist.configure
# the following command might fail on Windows?
@@ -335,7 +339,7 @@
install_main: all \
install_scripts install_util install_runtime install_boehm_gc \
install_library install_browser install_trace \
- install_compiler install_profiler install_deep install_doc
+ install_compiler install_profiler install_deep_profiler install_doc
.PHONY: install_scripts
install_scripts: scripts
@@ -378,9 +382,9 @@
install_profiler: profiler
cd profiler && $(SUBDIR_MMAKE) install
-.PHONY: install_deep
-install_deep: deep
- cd deep && $(SUBDIR_MMAKE) install
+.PHONY: install_deep_profiler
+install_deep_profiler: deep_profiler
+ cd deep_profiler && $(SUBDIR_MMAKE) install
.PHONY: install_grades
install_grades: scripts
diff -u -b --recursive -x CVS old/mercury/compiler/call_gen.m new/mercury/compiler/call_gen.m
--- old/mercury/compiler/call_gen.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/call_gen.m Fri Apr 20 14:57:35 2001
@@ -110,7 +110,7 @@
% If the call can fail, generate code to check for and
% handle the failure.
- call_gen__handle_failure(CodeModel, GoalInfo, FailHandlingCode),
+ call_gen__handle_failure(CodeModel, FailHandlingCode),
{ Code =
tree(SetupCode,
@@ -200,7 +200,7 @@
% If the call can fail, generate code to check for and
% handle the failure.
- call_gen__handle_failure(CodeModel, GoalInfo, FailHandlingCode),
+ call_gen__handle_failure(CodeModel, FailHandlingCode),
{ Code =
tree(SetupCode,
@@ -520,15 +520,11 @@
),
trace__prepare_for_call(TraceCode).
-:- pred call_gen__handle_failure(code_model::in, hlds_goal_info::in,
- code_tree::out, code_info::in, code_info::out) is det.
+:- pred call_gen__handle_failure(code_model::in, code_tree::out,
+ code_info::in, code_info::out) is det.
-call_gen__handle_failure(CodeModel, GoalInfo, FailHandlingCode) -->
+call_gen__handle_failure(CodeModel, FailHandlingCode) -->
( { CodeModel = model_semi } ->
- { goal_info_get_determinism(GoalInfo, Detism) },
- ( { Detism = failure } ->
- code_info__generate_failure(FailHandlingCode)
- ;
code_info__get_next_label(ContLab),
{ FailTestCode = node([
if_val(lval(reg(r, 1)), label(ContLab))
@@ -544,7 +540,6 @@
tree(FailCode,
ContLabelCode))
}
- )
;
{ FailHandlingCode = empty }
).
diff -u -b --recursive -x CVS old/mercury/compiler/deep_profiling.m new/mercury/compiler/deep_profiling.m
--- old/mercury/compiler/deep_profiling.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/deep_profiling.m Tue May 29 16:13:25 2001
@@ -31,7 +31,7 @@
:- import_module quantification, dependency_graph, rtti, trace.
:- import_module options, globals.
:- import_module bool, int, list, assoc_list, map, require, set.
-:- import_module exception, std_util, string, term, varset.
+:- import_module exception, std_util, string, term, varset, counter.
apply_deep_profiling_transformation(ModuleInfo0, ModuleInfo, ProcStatics) -->
{ module_info_globals(ModuleInfo0, Globals) },
@@ -529,7 +529,7 @@
module_info :: module_info,
pred_proc_id :: pred_proc_id,
current_csd :: prog_var,
- next_site_num :: int,
+ site_num_counter :: counter,
call_sites :: list(call_site_static_data),
vars :: prog_varset,
var_types :: vartypes,
@@ -571,9 +571,9 @@
FileName = term__context_file(Context),
proc_info_get_maybe_deep_profile_info(Proc0, MaybeRecInfo),
-
- DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD, 0,
- [], Vars5, VarTypes5, FileName, MaybeRecInfo),
+ DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD,
+ counter__init(0), [], Vars5, VarTypes5,
+ FileName, MaybeRecInfo),
transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
@@ -655,9 +655,9 @@
FileName = term__context_file(Context),
proc_info_get_maybe_deep_profile_info(Proc0, MaybeRecInfo),
-
- DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD, 0,
- [], Vars5, VarTypes5, FileName, MaybeRecInfo),
+ DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD,
+ counter__init(0), [], Vars5, VarTypes5,
+ FileName, MaybeRecInfo),
transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
@@ -761,9 +761,9 @@
FileName = term__context_file(Context),
proc_info_get_maybe_deep_profile_info(Proc0, MaybeRecInfo),
-
- DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD, 0,
- [], Vars5, VarTypes5, FileName, MaybeRecInfo),
+ DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD,
+ counter__init(0), [], Vars5, VarTypes5,
+ FileName, MaybeRecInfo),
transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
@@ -869,9 +869,9 @@
FileName = term__context_file(Context),
proc_info_get_maybe_deep_profile_info(Proc0, MaybeRecInfo),
-
- DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD, 0,
- [], Vars3, VarTypes3, FileName, MaybeRecInfo),
+ DeepInfo0 = deep_info(ModuleInfo, PredProcId, MiddleCSD,
+ counter__init(0), [], Vars3, VarTypes3,
+ FileName, MaybeRecInfo),
transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
@@ -1016,30 +1016,32 @@
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
goal_info_remove_feature(GoalInfo1, tailcall, GoalInfo),
- SiteNum = DeepInfo0 ^ next_site_num,
+ SiteNumCounter0 = DeepInfo0 ^ site_num_counter,
+ counter__allocate(SiteNum, SiteNumCounter0, SiteNumCounter),
varset__new_named_var(DeepInfo0 ^ vars, "SiteNum", SiteNumVar, Vars),
IntType = int_type,
map__set(DeepInfo0 ^ var_types, SiteNumVar, IntType, VarTypes),
generate_unify(int_const(SiteNum), SiteNumVar, SiteNumVarGoal),
- DeepInfo1 = DeepInfo0 ^ vars := Vars,
- DeepInfo2 = DeepInfo1 ^ var_types := VarTypes,
+ DeepInfo1 = (((DeepInfo0 ^ vars := Vars)
+ ^ var_types := VarTypes)
+ ^ site_num_counter := SiteNumCounter),
goal_info_get_context(GoalInfo0, Context),
FileName0 = term__context_file(Context),
LineNumber = term__context_line(Context),
- compress_filename(DeepInfo2, FileName0, FileName),
+ compress_filename(DeepInfo1, FileName0, FileName),
classify_call(ModuleInfo, GoalExpr, CallKind),
(
CallKind = normal(PredProcId),
generate_call(ModuleInfo, "prepare_for_normal_call", 2,
[MiddleCSD, SiteNumVar], [], PrepareGoal),
PredProcId = proc(PredId, ProcId),
- TypeSubst = compute_type_subst(GoalExpr, DeepInfo2),
- MaybeRecInfo = DeepInfo2 ^ maybe_rec_info,
+ TypeSubst = compute_type_subst(GoalExpr, DeepInfo1),
+ MaybeRecInfo = DeepInfo1 ^ maybe_rec_info,
(
MaybeRecInfo = yes(RecInfo1),
RecInfo1 ^ role = inner_proc(OuterPredProcId),
- PredProcId = DeepInfo2 ^ pred_proc_id
+ PredProcId = DeepInfo1 ^ pred_proc_id
->
OuterPredProcId = proc(OuterPredId, OuterProcId),
RttiProcLabel = rtti__make_proc_label(ModuleInfo,
@@ -1049,7 +1051,7 @@
RecInfo2 ^ role = outer_proc(InnerPredProcId),
PredProcId = InnerPredProcId
->
- OuterPredProcId = DeepInfo2 ^ pred_proc_id,
+ OuterPredProcId = DeepInfo1 ^ pred_proc_id,
OuterPredProcId = proc(OuterPredId, OuterProcId),
RttiProcLabel = rtti__make_proc_label(ModuleInfo,
OuterPredId, OuterProcId)
@@ -1060,14 +1062,14 @@
CallSite = normal_call(RttiProcLabel, TypeSubst,
FileName, LineNumber, GoalPath),
Goal1 = Goal0,
- DeepInfo3 = DeepInfo2
+ DeepInfo2 = DeepInfo1
;
CallKind = special(_PredProcId, TypeInfoVar),
generate_call(ModuleInfo, "prepare_for_special_call", 3,
[MiddleCSD, SiteNumVar, TypeInfoVar], [], PrepareGoal),
CallSite = special_call(FileName, LineNumber, GoalPath),
Goal1 = Goal0,
- DeepInfo3 = DeepInfo2
+ DeepInfo2 = DeepInfo1
;
CallKind = generic(Generic),
generate_call(ModuleInfo, "prepare_for_ho_call", 3,
@@ -1089,31 +1091,45 @@
use_zeroing_for_ho_cycles, UseZeroing),
( UseZeroing = yes ->
transform_higher_order_call(Globals, GoalCodeModel,
- Goal0, Goal1, DeepInfo2, DeepInfo3)
+ Goal0, Goal1, DeepInfo1, DeepInfo2)
;
Goal1 = Goal0,
- DeepInfo3 = DeepInfo2
+ DeepInfo2 = DeepInfo1
)
),
- DeepInfo4 = DeepInfo3 ^ next_site_num := SiteNum + 1,
- DeepInfo5 = DeepInfo4 ^ call_sites :=
- DeepInfo4 ^ call_sites ++ [CallSite],
+ DeepInfo3 = DeepInfo2 ^ call_sites :=
+ (DeepInfo2 ^ call_sites ++ [CallSite]),
(
member(tailcall, GoalFeatures),
- DeepInfo5 ^ maybe_rec_info = yes(RecInfo),
+ DeepInfo3 ^ maybe_rec_info = yes(RecInfo),
RecInfo ^ role = outer_proc(_)
->
+ VisSCC = RecInfo ^ visible_scc,
+ (
+ VisSCC = [],
+ CallGoals = [],
+ ExitGoals = [],
+ FailGoals = [],
+ ExtraVarList = [],
+ DeepInfo = DeepInfo3
+ ;
+ VisSCC = [SCCmember],
generate_recursion_counter_saves_and_restores(
- MiddleCSD, RecInfo ^ visible_scc,
- BeforeGoals, ExitGoals, FailGoals, ExtraVarList,
- DeepInfo5, DeepInfo),
+ SCCmember ^ rec_call_sites, MiddleCSD,
+ CallGoals, ExitGoals, FailGoals, ExtraVarList,
+ DeepInfo3, DeepInfo)
+ ;
+ VisSCC = [_, _ | _],
+ error("wrap_call: multi-procedure SCCs not yet implemented")
+ ),
+
generate_call(ModuleInfo, "set_current_csd", 1,
[MiddleCSD], [], ReturnGoal),
goal_info_get_code_model(GoalInfo, CodeModel),
( CodeModel = model_det ->
condense([
- BeforeGoals,
+ CallGoals,
[SiteNumVarGoal, PrepareGoal, Goal1,
ReturnGoal],
ExitGoals
@@ -1136,7 +1152,7 @@
append(FailGoals, [FailGoal], FailGoalsAndFail),
condense([
- BeforeGoals,
+ CallGoals,
[disj([
conj([
SiteNumVarGoal,
@@ -1159,7 +1175,7 @@
PrepareGoal,
Goal1
]) - GoalInfo,
- DeepInfo = DeepInfo5
+ DeepInfo = DeepInfo3
).
:- pred transform_higher_order_call(globals::in, code_model::in,
@@ -1299,7 +1315,8 @@
NonLocals = union(NonLocals0, NewNonlocals),
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
- SiteNum = DeepInfo0 ^ next_site_num,
+ SiteNumCounter0 = DeepInfo0 ^ site_num_counter,
+ counter__allocate(SiteNum, SiteNumCounter0, SiteNumCounter),
varset__new_named_var(DeepInfo0 ^ vars, "SiteNum", SiteNumVar, Vars),
IntType = int_type,
map__set(DeepInfo0 ^ var_types, SiteNumVar, IntType, VarTypes),
@@ -1319,11 +1336,10 @@
PrepareGoal,
Goal0
]) - GoalInfo,
- DeepInfo1 = DeepInfo0 ^ next_site_num := SiteNum + 1,
- DeepInfo2 = DeepInfo1 ^ call_sites
- := DeepInfo1 ^ call_sites ++ [CallSite],
- DeepInfo3 = DeepInfo2 ^ vars := Vars,
- DeepInfo = DeepInfo3 ^ var_types := VarTypes.
+ DeepInfo = ((((DeepInfo0 ^ site_num_counter := SiteNumCounter)
+ ^ vars := Vars)
+ ^ var_types := VarTypes)
+ ^ call_sites := DeepInfo0 ^ call_sites ++ [CallSite]).
:- pred compress_filename(deep_info::in, string::in, string::out) is det.
@@ -1375,88 +1391,140 @@
% XXX we don't compute type substitution strings yet.
compute_type_subst(_, _) = "".
-:- pred generate_recursion_counter_saves_and_restores(
- prog_var, list(visible_scc_data), list(hlds_goal),
- list(hlds_goal), list(hlds_goal), list(prog_var),
- deep_info, deep_info).
-:- mode generate_recursion_counter_saves_and_restores(in, in, out, out, out,
- out, in, out) is det.
-
-generate_recursion_counter_saves_and_restores(_, [], [], [], [], [],
- DInfo, DInfo).
-generate_recursion_counter_saves_and_restores(CSDVar, [Vis|Viss],
- Befores, Exits, Fails, Vars, DeepInfo0, DeepInfo) :-
- generate_recursion_counter_saves_and_restores_2(Vis ^ rec_call_sites,
- CSDVar, Befores0, Exits0, Fails0, Vars0, DeepInfo0, DeepInfo1),
- (
- Viss = [],
- Befores = Befores0,
- Exits = Exits0,
- Fails = Fails0,
- Vars = Vars0,
- DeepInfo = DeepInfo1
- ;
- Viss = [_|_],
- error("generate_recursion_counter_saves_and_restores: not implemented")
- % generate a call to get the outermost csd for the next
- % procedure in the clique, then make the recursive call
- ).
+ % The maximum value of N for which save_recursion_depth_N,
+ % restore_recursion_depth_exit_N and restore_recursion_depth_fail_N
+ % exist in library/profiling_builtin.m.
+:- func max_save_restore_vector_size = int.
+
+max_save_restore_vector_size = 9.
+
+:- pred generate_recursion_counter_saves_and_restores(list(int)::in,
+ prog_var::in, list(hlds_goal)::out, list(hlds_goal)::out,
+ list(hlds_goal)::out, list(prog_var)::out,
+ deep_info::in, deep_info::out) is det.
-:- pred generate_recursion_counter_saves_and_restores_2(
- list(int), prog_var, list(hlds_goal), list(hlds_goal),
- list(hlds_goal), list(prog_var), deep_info, deep_info).
-:- mode generate_recursion_counter_saves_and_restores_2(in, in, out, out,
- out, out, in, out) is det.
+generate_recursion_counter_saves_and_restores(CSNs, CSDVar, CallGoals,
+ ExitGoals, FailGoals, ExtraVars, DeepInfo0, DeepInfo) :-
+ list__chunk(CSNs, max_save_restore_vector_size, CSNChunks),
+ generate_recursion_counter_saves_and_restores_2(CSNChunks, CSDVar,
+ CallGoals, ExitGoals, FailGoals, ExtraVars,
+ DeepInfo0, DeepInfo).
+
+:- pred generate_recursion_counter_saves_and_restores_2(list(list(int))::in,
+ prog_var::in, list(hlds_goal)::out, list(hlds_goal)::out,
+ list(hlds_goal)::out, list(prog_var)::out,
+ deep_info::in, deep_info::out) is det.
generate_recursion_counter_saves_and_restores_2([], _, [], [], [], [],
- DInfo, DInfo).
-generate_recursion_counter_saves_and_restores_2([CSN | CSNs], CSDVar,
- [Unify, Before | Befores], [Exit | Exits], [Fail | Fails],
- [CSNVar, DepthVar | ExtraVars], DeepInfo0, DeepInfo) :-
- varset__new_named_var(DeepInfo0 ^ vars, "CSN", CSNVar, Vars1),
- IntType = functor(atom("int"), [], context_init),
- map__set(DeepInfo0 ^ var_types, CSNVar, IntType, VarTypes1),
- varset__new_named_var(Vars1, "Depth", DepthVar, Vars),
- map__set(VarTypes1, DepthVar, IntType, VarTypes),
- DeepInfo1 = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes,
- generate_unify(int_const(CSN), CSNVar, Unify),
- ModuleInfo = DeepInfo1 ^ module_info,
- generate_call(ModuleInfo, "save_recursion_depth_count", 3,
- [CSDVar, CSNVar, DepthVar], [DepthVar], Before),
- generate_call(ModuleInfo, "restore_recursion_depth_count_exit", 3,
- [CSDVar, CSNVar, DepthVar], [], Exit),
- generate_call(ModuleInfo, "restore_recursion_depth_count_fail", 3,
- [CSDVar, CSNVar, DepthVar], [], Fail),
- generate_recursion_counter_saves_and_restores_2(CSNs, CSDVar,
- Befores, Exits, Fails, ExtraVars, DeepInfo1, DeepInfo).
-
-% :- pred generate_ho_save_goal(ho_call_info, module_info, hlds_goal).
-% :- mode generate_ho_save_goal(in, in, out) is det.
-%
-% generate_ho_save_goal(ho_call_info(MiddleCSD, CountVar, PtrVar), ModuleInfo,
-% Goal) :-
-% generate_call(ModuleInfo, "save_and_zero_activation_info", 3,
-% [MiddleCSD, CountVar, PtrVar], [CountVar, PtrVar], Goal).
-%
-% generate_ho_save_goal(ho_call_info(MiddleCSD, PtrVar), ModuleInfo, Goal) :-
-% generate_call(ModuleInfo, "save_and_zero_activation_info", 2,
-% [MiddleCSD, PtrVar], [PtrVar], Goal).
-%
-% :- pred generate_ho_restore_goal(ho_call_info, module_info,
-% set(prog_var), hlds_goal).
-% :- mode generate_ho_restore_goal(in, in, out, out) is det.
-%
-% generate_ho_restore_goal(ho_call_info(MiddleCSD, CountVar, PtrVar),
-% ModuleInfo, RestoreVars, Goal) :-
-% RestoreVars = list_to_set([MiddleCSD, CountVar, PtrVar]),
-% generate_call(ModuleInfo, "reset_activation_info", 3,
-% [MiddleCSD, CountVar, PtrVar], [], Goal).
-%
-% generate_ho_restore_goal(ho_call_info(MiddleCSD, PtrVar), ModuleInfo,
-% RestoreVars, Goal) :-
-% RestoreVars = list_to_set([MiddleCSD, PtrVar]),
-% generate_call(ModuleInfo, "reset_activation_info", 2,
-% [MiddleCSD, PtrVar], [], Goal).
+ DeepInfo, DeepInfo).
+generate_recursion_counter_saves_and_restores_2([Chunk | Chunks], CSDVar,
+ CallGoals, ExitGoals, FailGoals, ExtraVars,
+ DeepInfo0, DeepInfo) :-
+
+ list__map_foldl(generate_depth_var, Chunk, DepthVars,
+ DeepInfo0, DeepInfo1),
+
+ % We generate three separate variables to hold the constant CSN vector.
+ % If we used only one, the code generator would have to save its value
+ % on the stack when we enter the disjunction that wraps the goal.
+ list__length(Chunk, Length),
+ generate_csn_vector(Length, Chunk, CallVars1, CallGoals1, CallCellVar,
+ DeepInfo1, DeepInfo2),
+ generate_csn_vector(Length, Chunk, ExitVars1, ExitGoals1, ExitCellVar,
+ DeepInfo2, DeepInfo3),
+ generate_csn_vector(Length, Chunk, FailVars1, FailGoals1, FailCellVar,
+ DeepInfo3, DeepInfo4),
+ list__condense([CallVars1, ExitVars1, FailVars1], ExtraVars1),
+
+ CallPredName = string__format("save_recursion_depth_%d",
+ [i(Length)]),
+ ExitPredName = string__format("restore_recursion_depth_exit_%d",
+ [i(Length)]),
+ FailPredName = string__format("restore_recursion_depth_fail_%d",
+ [i(Length)]),
+ ModuleInfo = DeepInfo4 ^ module_info,
+ generate_call(ModuleInfo, CallPredName, Length + 2,
+ [CSDVar, CallCellVar | DepthVars], DepthVars, CallCellGoal),
+ generate_call(ModuleInfo, ExitPredName, Length + 2,
+ [CSDVar, ExitCellVar | DepthVars], [], ExitCellGoal),
+ generate_call(ModuleInfo, FailPredName, Length + 2,
+ [CSDVar, FailCellVar | DepthVars], [], FailCellGoal),
+
+ generate_recursion_counter_saves_and_restores_2(Chunks, CSDVar,
+ CallGoals2, ExitGoals2, FailGoals2, ExtraVars2,
+ DeepInfo4, DeepInfo),
+
+ list__append(CallGoals1, [CallCellGoal | CallGoals2], CallGoals),
+ list__append(ExitGoals1, [ExitCellGoal | ExitGoals2], ExitGoals),
+ list__append(FailGoals1, [FailCellGoal | FailGoals2], FailGoals),
+ list__append(ExtraVars1, ExtraVars2, ExtraVars).
+
+:- pred generate_depth_var(int::in, prog_var::out,
+ deep_info::in, deep_info::out) is det.
+
+generate_depth_var(CSN, DepthVar, DeepInfo0, DeepInfo) :-
+ Vars0 = DeepInfo0 ^ vars,
+ VarTypes0 = DeepInfo0 ^ var_types,
+ IntType = int_type,
+ VarName = string__format("Depth%d", [i(CSN)]),
+ varset__new_named_var(Vars0, VarName, DepthVar, Vars),
+ map__set(VarTypes0, DepthVar, IntType, VarTypes),
+ DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes.
+
+:- pred generate_csn_vector(int::in, list(int)::in, list(prog_var)::out,
+ list(hlds_goal)::out, prog_var::out,
+ deep_info::in, deep_info::out) is det.
+
+generate_csn_vector(Length, CSNs, CSNVars, UnifyGoals, CellVar,
+ DeepInfo0, DeepInfo) :-
+ ( CSNs = [CSN] ->
+ generate_single_csn_unify(CSN, CSNVar - UnifyGoal,
+ DeepInfo0, DeepInfo),
+ CSNVars = [CSNVar],
+ UnifyGoals = [UnifyGoal],
+ CellVar = CSNVar
+ ;
+ require(Length =< max_save_restore_vector_size,
+ "generate_csn_vector_unifies: too long"),
+ list__map_foldl(generate_single_csn_unify, CSNs, CSNVarsGoals,
+ DeepInfo0, DeepInfo1),
+ InnerVars = assoc_list__keys(CSNVarsGoals),
+ InnerGoals = assoc_list__values(CSNVarsGoals),
+ generate_csn_vector_cell(Length, InnerVars, CellVar, CellGoal,
+ DeepInfo1, DeepInfo),
+ CSNVars = [CellVar | InnerVars],
+ UnifyGoals = list__append(InnerGoals, [CellGoal])
+ ).
+
+:- pred generate_csn_vector_cell(int::in, list(prog_var)::in,
+ prog_var::out, hlds_goal::out, deep_info::in, deep_info::out) is det.
+
+generate_csn_vector_cell(Length, CSNVars, CellVar, CellGoal,
+ DeepInfo0, DeepInfo) :-
+ Vars0 = DeepInfo0 ^ vars,
+ VarTypes0 = DeepInfo0 ^ var_types,
+ varset__new_named_var(Vars0, "CSNCell", CellVar, Vars),
+ mercury_profiling_builtin_module(ProfilingBuiltin),
+ CellTypeName = string__format("call_site_nums_%d", [i(Length)]),
+ CellTypeId = qualified(ProfilingBuiltin, CellTypeName) - Length,
+ construct_type(CellTypeId, [], CellType),
+ map__set(VarTypes0, CellVar, CellType, VarTypes),
+ DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes,
+ ConsId = cons(qualified(ProfilingBuiltin, CellTypeName), Length),
+ generate_cell_unify(Length, ConsId, CSNVars, CellVar, CellGoal).
+
+:- pred generate_single_csn_unify(int::in,
+ pair(prog_var, hlds_goal)::out, deep_info::in, deep_info::out) is det.
+
+generate_single_csn_unify(CSN, CSNVar - UnifyGoal, DeepInfo0, DeepInfo) :-
+ Vars0 = DeepInfo0 ^ vars,
+ VarTypes0 = DeepInfo0 ^ var_types,
+ VarName = string__format("CSN%d", [i(CSN)]),
+ varset__new_named_var(Vars0, VarName, CSNVar, Vars),
+ IntType = int_type,
+ map__set(VarTypes0, CSNVar, IntType, VarTypes),
+ DeepInfo = (DeepInfo0 ^ vars := Vars) ^ var_types := VarTypes,
+ generate_unify(int_const(CSN), CSNVar, UnifyGoal).
:- pred generate_call(module_info::in, string::in, int::in,
list(prog_var)::in, list(prog_var)::in, hlds_goal::out) is det.
@@ -1500,6 +1568,24 @@
(free -> Ground) - (Ground -> Ground),
construct(Var, ConsId, [], [], construct_statically([]),
cell_is_shared, no),
+ unify_context(explicit, [])) - GoalInfo.
+
+:- pred generate_cell_unify(int::in, cons_id::in, list(prog_var)::in,
+ prog_var::in, hlds_goal::out) is det.
+
+generate_cell_unify(Length, ConsId, Args, Var, Goal) :-
+ Ground = ground(shared, none),
+ NonLocals = set__list_to_set([Var | Args]),
+ instmap_delta_from_assoc_list([Var - ground(shared, none)],
+ InstMapDelta),
+ Determinism = det,
+ goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo),
+ ArgMode = ((free - Ground) -> (Ground - Ground)),
+ list__duplicate(Length, ArgMode, ArgModes),
+ Goal = unify(Var, functor(ConsId, Args),
+ (free -> Ground) - (Ground -> Ground),
+ construct(Var, ConsId, Args, ArgModes,
+ construct_statically([]), cell_is_shared, no),
unify_context(explicit, [])) - GoalInfo.
%-----------------------------------------------------------------------------%
diff -u -b --recursive -x CVS old/mercury/compiler/handle_options.m new/mercury/compiler/handle_options.m
--- old/mercury/compiler/handle_options.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/handle_options.m Tue May 29 16:13:25 2001
@@ -504,8 +504,7 @@
->
[]
;
- usage_error(
- "deep profiling is supported only LLDS grades")
+ usage_error("deep profiling is incompatible with high level code")
),
globals__io_lookup_bool_option(
use_lots_of_ho_specialization, LotsOfHOSpec),
@@ -523,8 +522,9 @@
% The tail recursion optimization for deep profiling is implemented
% only with --use-activation-counts.
- option_neg_implies(use_activation_counts,
- deep_profile_tail_recursion, bool(no)),
+ % XXX
+ % option_neg_implies(use_activation_counts,
+ % deep_profile_tail_recursion, bool(no)),
% --no-reorder-conj implies --no-deforestation.
option_neg_implies(reorder_conj, deforestation, bool(no)),
diff -u -b --recursive -x CVS old/mercury/compiler/jumpopt.m new/mercury/compiler/jumpopt.m
--- old/mercury/compiler/jumpopt.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/jumpopt.m Tue May 29 16:13:25 2001
@@ -26,12 +26,14 @@
% labels. The third argument gives the trace level, which we also
% use to avoid optimizations that may interfere with RTTI.
%
- % The three bool inputs should be
+ % The four bool inputs should be
%
% - the value of the --optimize-fulljumps option,
%
% - an indication of whether this is the final application of this
- % optimization, and
+ % optimization,
+ %
+ % - the value of the --pessimize-tailcalls option, and
%
% - the value of the --checked-nondet-tailcalls option respectively.
%
diff -u -b --recursive -x CVS old/mercury/compiler/layout.m new/mercury/compiler/layout.m
--- old/mercury/compiler/layout.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/layout.m Tue May 29 16:13:25 2001
@@ -9,14 +9,17 @@
% used by the parts of the runtime system that need to look at the stacks
% (and sometimes the registers) and make sense of their contents. The parts
% of the runtime system that need to do this include exception handling,
-% the debugger, and (eventually) the accurate garbage collector.
+% the debugger, the deep profiler and (eventually) the accurate garbage
+% collector.
%
-% When output by layout_out.m, values of most these types will correspond to
-% the C types defined in runtime/mercury_stack_layout.h; the documentation of
-% those types can be found there. The names of the C types are listed next to
-% the function symbol whose arguments represent their contents.
+% When output by layout_out.m, values of most these types will correspond
+% to the C types defined in runtime/mercury_stack_layout.h or
+% runtime/mercury_deep_profiling.h; the documentation of those types
+% can be found there. The names of the C types are listed next to the
+% function symbol whose arguments represent their contents.
%
-% The code to generate values of these types is in stack_layout.m.
+% The code to generate values of these types is in stack_layout.m and
+% deep_profiling.m.
%
% This module should be, but as yet isn't, independent of whether we are
% compiling to LLDS or MLDS.
@@ -62,13 +65,13 @@
closure_line_number :: int,
closure_goal_path :: string
)
- ; proc_static_data(
+ ; proc_static_data( % defines MR_ProcStatic
proc_static_id :: rtti_proc_label,
proc_static_file_name :: string,
call_site_statics :: list(call_site_static_data)
).
-:- type call_site_static_data
+:- type call_site_static_data % defines MR_CallSiteStatic
---> normal_call(
normal_callee :: rtti_proc_label,
normal_type_subst :: string,
diff -u -b --recursive -x CVS old/mercury/compiler/layout_out.m new/mercury/compiler/layout_out.m
--- old/mercury/compiler/layout_out.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/layout_out.m Tue May 29 16:13:25 2001
@@ -243,9 +243,6 @@
io__write_string("_proc_static__"),
{ ProcLabel = code_util__make_proc_label_from_rtti(RttiProcLabel) },
output_proc_label(ProcLabel).
- % io__write_string("_id").
- % { pred_id_to_int(RttiProcLabel ^ pred_id, PredId) },
- % io__write_int(PredId).
output_layout_name(proc_static_call_sites(RttiProcLabel)) -->
io__write_string(mercury_data_prefix),
io__write_string("_proc_static_call_sites__"),
diff -u -b --recursive -x CVS old/mercury/compiler/mercury_compile.m new/mercury/compiler/mercury_compile.m
--- old/mercury/compiler/mercury_compile.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/mercury_compile.m Tue May 29 16:13:25 2001
@@ -70,8 +70,8 @@
% miscellaneous compiler modules
:- import_module prog_data, hlds_module, hlds_pred, hlds_out, llds, rl.
-:- import_module mercury_to_mercury, mercury_to_goedel, hlds_data.
-:- import_module layout, dependency_graph, prog_util, rl_dump, rl_file.
+:- import_module mercury_to_mercury, mercury_to_goedel.
+:- import_module dependency_graph, prog_util, rl_dump, rl_file.
:- import_module options, globals, trace_params, passes_aux.
% library modules
diff -u -b --recursive -x CVS old/mercury/compiler/options.m new/mercury/compiler/options.m
--- old/mercury/compiler/options.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/options.m Tue May 29 16:13:25 2001
@@ -2095,7 +2095,8 @@
"\tThis option is not supported for the IL or Java back-ends.",
"--deep-profiling\t\t(grade modifier: `.profdeep')",
"\tEnable deep profiling.",
- "\tThis option is not supported for the HLC, IL or Java back-ends.",
+ "\tThis option is not supported for the high-level C, IL",
+ "\tor Java back-ends.",
/*****************
XXX The following options are not documented,
because they are currently not useful.
diff -u -b --recursive -x CVS old/mercury/compiler/unify_gen.m new/mercury/compiler/unify_gen.m
--- old/mercury/compiler/unify_gen.m Tue May 29 16:07:51 2001
+++ new/mercury/compiler/unify_gen.m Tue May 29 16:13:25 2001
@@ -370,10 +370,6 @@
;
{ error("unify_gen: deep_profiling_proc_static has args") }
),
- % code_info__get_module_info(ModuleInfo),
- % { PPId = proc(PredId, ProcId) },
- % { code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel) },
- % { module_info_name(ModuleInfo, ModuleName) },
{ DataAddr = layout_addr(proc_static(RttiProcLabel)) },
code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
unify_gen__generate_construction_2(code_addr_constant(PredId, ProcId),
diff -u -b --recursive -x CVS old/mercury/configure.in new/mercury/configure.in
--- old/mercury/configure.in Tue May 29 16:07:51 2001
+++ new/mercury/configure.in Tue May 29 16:13:25 2001
@@ -1969,11 +1969,11 @@
LIBGRADES="$GC_LIBGRADES"
fi
-if test "$enable_prof_grades" = yes; then
+if test "$enable_nogc_grades" = yes; then
# add `.prof' (--profiling) grades, if time profiling is supported,
# and a `.memprof' (--memory-profiling) grade.
if test $mercury_cv_profiling = yes; then
- if test "$enable_nogc_grades" = yes; then
+ if test "$enable_prof_grades" = yes; then
DEFAULT_GRADE_NOGC="`echo $DEFAULT_GRADE | sed 's/\.gc$//'`"
LIBGRADES="$LIBGRADES $DEFAULT_GRADE.prof $DEFAULT_GRADE_NOGC.prof"
else
@@ -2855,7 +2855,7 @@
#-----------------------------------------------------------------------------#
AC_OUTPUT(Mmake.common scripts/Mmake.vars scripts/mmc scripts/mprof
scripts/mercury_update_interface scripts/mgnuc scripts/ml
-scripts/mmake scripts/c2init scripts/mdb scripts/mdbrc scripts/mdprof
+scripts/mmake scripts/c2init scripts/mdb scripts/mdbrc
scripts/sicstus_conv scripts/mkfifo_using_mknod bindist/bindist.build_vars
,
for header in $CONFIG_HEADERS ; do
diff -u -b --recursive -x CVS old/mercury/deep_profiler/Mmakefile new/mercury/deep_profiler/Mmakefile
--- old/mercury/deep_profiler/Mmakefile Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/Mmakefile Tue May 29 16:13:25 2001
@@ -81,7 +81,7 @@
# so just leave it out.
$(cs_subdir)mdprof_cgi_init.c: $(UTIL_DIR)/mkinit
-$(cs_subdir)mdprof_server.c: $(UTIL_DIR)/mkinit
+$(cs_subdir)mdprof_server_init.c: $(UTIL_DIR)/mkinit
#-----------------------------------------------------------------------------#
@@ -115,9 +115,9 @@
.PHONY: os cs
os: $(mdprof_cgi.os) $(os_subdir)mdprof_cgi_init.o
-os: $(mdprof_server.os) $(os_subdir)mdprof_server.o
+os: $(mdprof_server.os) $(os_subdir)mdprof_server_init.o
cs: $(mdprof_cgi.cs) $(cs_subdir)mdprof_cgi_init.c
-cs: $(mdprof_server.cs) $(cs_subdir)mdprof_server.c
+cs: $(mdprof_server.cs) $(cs_subdir)mdprof_server_init.c
#-----------------------------------------------------------------------------#
diff -u -b --recursive -x CVS old/mercury/deep_profiler/cliques.m new/mercury/deep_profiler/cliques.m
--- old/mercury/deep_profiler/cliques.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/cliques.m Tue May 29 16:13:25 2001
@@ -7,8 +7,8 @@
% Authors: conway, zs.
%
% This module allows you build a description of a directed graph (represented
-% as a set of arcs between nodes identified by integers) and then find the
-% strongly connected components (cliques) of that graph.
+% as a set of arcs between nodes identified by dense small integers) and then
+% find the strongly connected components (cliques) of that graph.
:- module cliques.
diff -u -b --recursive -x CVS old/mercury/deep_profiler/conf.m new/mercury/deep_profiler/conf.m
--- old/mercury/deep_profiler/conf.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/conf.m Tue May 29 16:13:25 2001
@@ -29,14 +29,10 @@
make_pipe_cmd(PipeName) = Cmd :-
mkfifo_cmd(CmdName),
- (
- ( string__remove_suffix(CmdName, "mkfifo", _)
- ; string__remove_suffix(CmdName, "mkfifo_using_mknod", _)
- )
- ->
- string__format("%s %s", [s(CmdName), s(PipeName)], Cmd)
- ;
+ ( CmdName = "" ->
error("make_pipe_cmd: do not know what command to use")
+ ;
+ string__format("%s %s", [s(CmdName), s(PipeName)], Cmd)
).
server_name(ServerName) -->
diff -u -b --recursive -x CVS old/mercury/deep_profiler/dense_bitset.m new/mercury/deep_profiler/dense_bitset.m
--- old/mercury/deep_profiler/dense_bitset.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/dense_bitset.m Tue May 29 16:13:25 2001
@@ -9,6 +9,8 @@
% This module provides an ADT for storing dense sets of small integers.
% The sets are represented as bit vectors, which are implemented as arrays
% of integers.
+%
+% We should think about replacing this module with library/bitmap.m.
:- module dense_bitset.
diff -u -b --recursive -x CVS old/mercury/deep_profiler/mdprof_cgi.m new/mercury/deep_profiler/mdprof_cgi.m
--- old/mercury/deep_profiler/mdprof_cgi.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/mdprof_cgi.m Tue May 29 16:13:25 2001
@@ -10,7 +10,8 @@
% to handle web page requests implemented by the Mercury deep profiler server.
%
% A shell script installed as /usr/lib/cgi-bin/mdprof should invoke this
-% program after setting up
+% program after setting up the executable search path in the environment
+% to include the directory that contains the server program, mdprof_server.
:- module mdprof_cgi.
@@ -27,6 +28,8 @@
:- import_module char, string, int, list, set, require, std_util.
main -->
+ io__command_line_arguments(Args),
+ ( { Args = [] } ->
io__get_environment_var("QUERY_STRING", MaybeQueryString),
(
{ MaybeQueryString = yes(QueryString0) },
@@ -41,6 +44,9 @@
)
;
{ MaybeQueryString = no }
+ )
+ ;
+ io__write_string("Usage: mdprof_cgi")
).
:- pred process_query(string::in, string::in,
@@ -77,10 +83,11 @@
io__state::di, io__state::uo) is det.
create_server(DataFileName, MaybeError) -->
+ { StartupFileName = server_startup_name(DataFileName) },
{ ServerCmd = string__format(
- "%s -f %s < /dev/null > /dev/null 2> %s",
+ "%s %s < /dev/null > /dev/null 2> %s",
[s(server_path_name), s(DataFileName),
- s(server_startup_name(DataFileName))]) },
+ s(StartupFileName)]) },
io__call_system(ServerCmd, Res),
(
{ Res = ok(ExitStatus) },
@@ -94,10 +101,13 @@
"rm -f %s", [s(ToServer)]) },
{ RemoveFromServerCmd = string__format(
"rm -f %s", [s(FromServer)]) },
+ { RemoveStartupFileCmd = string__format(
+ "rm -f %s", [s(StartupFileName)]) },
% We ignore any errors since we can't do anything
% about them anyway.
io__call_system(RemoveToServerCmd, _),
- io__call_system(RemoveFromServerCmd, _)
+ io__call_system(RemoveFromServerCmd, _),
+ io__call_system(RemoveStartupFileCmd, _)
)
;
{ Res = error(Err) },
@@ -108,11 +118,6 @@
:- func server_path_name = string.
server_path_name = "mdprof_server".
-
-:- func machine_name = string.
-
-% Eventually, this should call the hostname library function.
-machine_name = "miles".
:- pred handle_query(string::in, string::in, string::in,
io__state::di, io__state::uo) is det.
diff -u -b --recursive -x CVS old/mercury/deep_profiler/mdprof_server.m new/mercury/deep_profiler/mdprof_server.m
--- old/mercury/deep_profiler/mdprof_server.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/mdprof_server.m Tue May 29 16:13:25 2001
@@ -25,7 +25,6 @@
:- type option
---> canonical_clique
- ; data_file
; debug
; test
; test_dir
@@ -45,11 +44,11 @@
(
{ MaybeOptions = ok(Options) },
( { Args = [] } ->
- main2(Options)
- ;
io__set_exit_status(1),
io__write_string(StdErr,
- "unexpected non-option argument\n")
+ "no data file name specified\n")
+ ;
+ main2(Args, Options)
)
;
{ MaybeOptions = error(Msg) },
@@ -57,25 +56,17 @@
io__format(StdErr, "error parsing options: %s\n", [s(Msg)])
).
-:- pred main2(option_table::in, io__state::di, io__state::uo) is cc_multi.
+:- pred main2(list(string)::in, option_table::in,
+ io__state::di, io__state::uo) is cc_multi.
-main2(Options) -->
+main2(FileNames, Options) -->
io__stderr_stream(StdErr),
server_name(Machine),
- { lookup_maybe_string_option(Options, data_file,
- MaybeFileName) },
- {
- MaybeFileName = yes(FileName0),
- FileName = FileName0
- ;
- MaybeFileName = no,
- FileName = "Deep.data"
- },
{ lookup_bool_option(Options, test, Test) },
{ lookup_bool_option(Options, canonical_clique, CanonicalClique) },
(
{ Test = yes },
- read_and_startup(Machine, FileName, CanonicalClique, Res),
+ read_and_startup(Machine, FileNames, CanonicalClique, Res),
(
{ Res = ok(Deep) },
{ lookup_string_option(Options, test_dir, TestDir) },
@@ -91,10 +82,10 @@
)
;
{ Test = no },
- make_pipes(FileName, IsOK),
+ make_pipes(FileNames, IsOK),
(
{ IsOK = yes },
- read_and_startup(Machine, FileName, CanonicalClique,
+ read_and_startup(Machine, FileNames, CanonicalClique,
Res),
(
{ Res = ok(Deep) },
@@ -117,11 +108,13 @@
)
).
-:- pred make_pipes(string::in, bool::out, io__state::di, io__state::uo) is det.
+:- pred make_pipes(list(string)::in, bool::out, io__state::di, io__state::uo)
+ is det.
-make_pipes(DataFileName, OK) -->
- { InputPipe = to_server_pipe_name(DataFileName) },
- { OutputPipe = from_server_pipe_name(DataFileName) },
+make_pipes(FileNames, OK) -->
+ ( { FileNames = [FileName] } ->
+ { InputPipe = to_server_pipe_name(FileName) },
+ { OutputPipe = from_server_pipe_name(FileName) },
{ MakeInputPipeCmd = make_pipe_cmd(InputPipe) },
{ MakeOutputPipeCmd = make_pipe_cmd(OutputPipe) },
io__call_system(MakeInputPipeCmd, InputRes),
@@ -133,7 +126,10 @@
OK = yes
;
OK = no
- }.
+ }
+ ;
+ { error("make_pipes: multiple filenames not yet implemented") }
+ ).
%-----------------------------------------------------------------------------%
@@ -141,7 +137,6 @@
short('c', canonical_clique).
short('D', test_dir).
-short('f', data_file).
short('F', test_fields).
short('t', timeout).
short('T', test).
@@ -149,7 +144,6 @@
:- pred long(string::in, option::out) is semidet.
long("canonical-clique",canonical_clique).
-long("data-file", data_file).
long("debug", debug).
long("test", test).
long("test-dir", test_dir).
@@ -166,48 +160,7 @@
defaults0(canonical_clique, bool(no)).
defaults0(debug, bool(no)).
-defaults0(data_file, maybe_string(no)).
defaults0(test, bool(no)).
defaults0(test_dir, string("deep_test")).
defaults0(test_fields, string("pqw")).
defaults0(timeout, int(30)).
-
-:- func lookup_bool_option(option_table, option) = bool.
-
-lookup_bool_option(OptionTable, Option) = Value :-
- map__lookup(OptionTable, Option, TypedValue),
- ( TypedValue = bool(ValuePrime) ->
- Value = ValuePrime
- ;
- error("lookup_bool_option: option is not boolean")
- ).
-
-:- func lookup_int_option(option_table, option) = int.
-
-lookup_int_option(OptionTable, Option) = Value :-
- map__lookup(OptionTable, Option, TypedValue),
- ( TypedValue = int(ValuePrime) ->
- Value = ValuePrime
- ;
- error("lookup_int_option: option is not int")
- ).
-
-:- func lookup_string_option(option_table, option) = string.
-
-lookup_string_option(OptionTable, Option) = Value :-
- map__lookup(OptionTable, Option, TypedValue),
- ( TypedValue = string(ValuePrime) ->
- Value = ValuePrime
- ;
- error("lookup_string_option: option is not string")
- ).
-
-:- func lookup_maybe_string_option(option_table, option) = maybe(string).
-
-lookup_maybe_string_option(OptionTable, Option) = Value :-
- map__lookup(OptionTable, Option, TypedValue),
- ( TypedValue = maybe_string(ValuePrime) ->
- Value = ValuePrime
- ;
- error("lookup_string_option: option is not string")
- ).
diff -u -b --recursive -x CVS old/mercury/deep_profiler/profile.m new/mercury/deep_profiler/profile.m
--- old/mercury/deep_profiler/profile.m Tue May 29 16:07:51 2001
+++ new/mercury/deep_profiler/profile.m Tue May 29 16:13:25 2001
@@ -30,7 +30,8 @@
num_csds :: int,
num_pds :: int,
num_csss :: int,
- num_pss :: int
+ num_pss :: int,
+ ticks_per_sec :: int
).
:- type initial_deep --->
diff -u -b --recursive -x CVS old/mercury/deep_profiler/read_profile.m new/mercury/deep_profiler/read_profile.m
--- old/mercury/deep_profiler/read_profile.m Tue May 29 16:07:52 2001
+++ new/mercury/deep_profiler/read_profile.m Tue May 29 16:13:25 2001
@@ -52,20 +52,23 @@
read_id_string(Res1),
(
{ Res1 = ok(_) },
- read_sequence6(
+ read_sequence7(
read_fixed_size_int,
read_fixed_size_int,
read_fixed_size_int,
read_fixed_size_int,
read_num,
read_num,
+ read_num,
(pred(NumCSDs::in, NumCSSs::in,
NumPDs::in, NumPSs::in,
+ TicksPerSec::in,
InstrumentQuanta::in,
UserQuanta::in,
ResInitDeep::out) is det :-
init_deep(NumCSDs, NumCSSs,
NumPDs, NumPSs,
+ TicksPerSec,
InstrumentQuanta, UserQuanta,
InitDeep0),
ResInitDeep = ok(InitDeep0)
@@ -113,14 +116,15 @@
id_string = "Mercury deep profiler data".
:- pred init_deep(int::in, int::in, int::in, int::in, int::in, int::in,
- initial_deep::out) is det.
+ int::in, initial_deep::out) is det.
init_deep(NumCSDs, NumCSSs, NumPDs, NumPSs, InstrumentQuanta, UserQuanta,
- InitDeep) :-
+ TicksPerSec, InitDeep) :-
InitStats = profile_stats(
InstrumentQuanta,
UserQuanta,
- -1, -1, -1, -1),
+ -1, -1, -1, -1,
+ TicksPerSec),
InitDeep = initial_deep(
InitStats,
proc_dynamic_ptr(-1),
@@ -1088,6 +1092,80 @@
{ Res = error(Err) }
).
+:- pred read_sequence7(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(deep_result(T3), io__state, io__state),
+ pred(deep_result(T4), io__state, io__state),
+ pred(deep_result(T5), io__state, io__state),
+ pred(deep_result(T6), io__state, io__state),
+ pred(deep_result(T7), io__state, io__state),
+ pred(T1, T2, T3, T4, T5, T6, T7, deep_result(T8)),
+ deep_result(T8), io__state, io__state).
+:- mode read_sequence7(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, in, in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence7(P1, P2, P3, P4, P5, P6, P7, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ call(P4, Res4),
+ (
+ { Res4 = ok(T4) },
+ call(P5, Res5),
+ (
+ { Res5 = ok(T5) },
+ call(P6, Res6),
+ (
+ { Res6 = ok(T6) },
+ call(P7, Res7),
+ (
+ { Res7 = ok(T7) },
+ { call(Combine, T1, T2, T3, T4, T5, T6, T7,
+ Res) }
+ ;
+ { Res7 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res6 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res5 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res4 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
%-----------------------------------------------------------------------------%
:- pred read_string(deep_result(string)::out,
@@ -1373,9 +1451,9 @@
ProfileStats0 = InitDeep4 ^ init_profile_stats,
ProfileStats0 = profile_stats(InstrumentQuanta, UserQuanta,
- _, _, _, _),
+ _, _, _, _, TicksPerSec),
ProfileStats = profile_stats(InstrumentQuanta, UserQuanta,
- CSDMax, PDMax, CSSMax, PSMax),
+ CSDMax, PDMax, CSSMax, PSMax, TicksPerSec),
InitDeep = InitDeep4 ^ init_profile_stats := ProfileStats.
%-----------------------------------------------------------------------------%
diff -u -b --recursive -x CVS old/mercury/deep_profiler/server.m new/mercury/deep_profiler/server.m
--- old/mercury/deep_profiler/server.m Tue May 29 16:07:52 2001
+++ new/mercury/deep_profiler/server.m Tue May 29 16:13:25 2001
@@ -39,7 +39,8 @@
%-----------------------------------------------------------------------------%
test_server(DirName, Deep, Fields) -->
- { string__format("mkdir -p %s", [s(DirName)], Cmd) },
+ { string__format("test -d %s || mkdir -p %s",
+ [s(DirName), s(DirName)], Cmd) },
io__call_system(Cmd, _),
{ array__max(Deep ^ clique_members, NumCliques) },
test_cliques(1, NumCliques, DirName, Deep, Fields),
@@ -79,16 +80,17 @@
% each batch of pages in a different subdirectory, thus limiting the
% number of files/subdirs in each directory.
{ Bunch = (Num - 1) // 1000 },
+ { string__format("%s/%s_%04d",
+ [s(DirName), s(BaseName), i(Bunch)], BunchName) },
( { (Num - 1) rem 1000 = 0 } ->
- { string__format("mkdir -p %s/%s_%04d",
- [s(DirName), s(BaseName), i(Bunch)], Cmd) },
+ { string__format("test -p %s || mkdir -p %s",
+ [s(BunchName), s(BunchName)], Cmd) },
io__call_system(Cmd, _)
;
[]
),
- { string__format("%s/%s_%04d/%s_%06d.html",
- [s(DirName), s(BaseName), i(Bunch), s(BaseName), i(Num)],
- FileName) },
+ { string__format("%s/%s_%06d.html",
+ [s(BunchName), s(BaseName), i(Num)], FileName) },
io__tell(FileName, _),
io__write_string(HTML),
io__told.
@@ -99,8 +101,10 @@
{ DataFileName = Deep ^ data_file_name },
{ InputPipe = to_server_pipe_name(DataFileName) },
{ OutputPipe = from_server_pipe_name(DataFileName) },
+ { StartupFile = server_startup_name(DataFileName) },
detach_server_loop,
- server_loop(InputPipe, OutputPipe, TimeOut, Debug, 0, Deep).
+ server_loop(InputPipe, OutputPipe, StartupFile, TimeOut,
+ Debug, 0, Deep).
:- pragma foreign_decl("C", "
#include <unistd.h>
@@ -140,11 +144,12 @@
*/
}").
-:- pred server_loop(string::in, string::in, int::in, bool::in, int::in,
- deep::in, io__state::di, io__state::uo) is cc_multi.
+:- pred server_loop(string::in, string::in, string::in, int::in,
+ bool::in, int::in, deep::in, io__state::di, io__state::uo) is cc_multi.
-server_loop(InputPipe, OutputPipe, TimeOut, Debug, QueryNum, Deep) -->
- setup_timeout(InputPipe, OutputPipe, TimeOut),
+server_loop(InputPipe, OutputPipe, StartupFile, TimeOut,
+ Debug, QueryNum, Deep) -->
+ setup_timeout(InputPipe, OutputPipe, StartupFile, TimeOut),
io__see(InputPipe, SeeRes),
(
{ SeeRes = ok },
@@ -165,7 +170,7 @@
;
{ Debug = no }
),
- server_loop(InputPipe, OutputPipe,
+ server_loop(InputPipe, OutputPipe, StartupFile,
TimeOut, Debug, QueryNum + 1, Deep)
;
{ ReadRes = error(Msg, Line) },
@@ -177,7 +182,7 @@
;
{ Debug = no }
),
- server_loop(InputPipe, OutputPipe,
+ server_loop(InputPipe, OutputPipe, StartupFile,
TimeOut, Debug, QueryNum + 1, Deep)
;
{ ReadRes = ok(Cmd) },
@@ -197,17 +202,15 @@
io__write_string(".\n"),
io__told,
( { Cmd = quit } ->
- { format("rm -f %s %s",
- [s(InputPipe), s(OutputPipe)],
- RemovePipesCmd) },
- % If we can't open remove the pipes, then
- % we have no way to report our failure anyway.
- io__call_system(RemovePipesCmd, _)
+ % This cleans up after the server.
+ execute_timeout_action
+ % The lack of a recursive call here shuts down
+ % the server process.
; { Cmd = timeout(NewTimeOut) } ->
- server_loop(InputPipe, OutputPipe,
+ server_loop(InputPipe, OutputPipe, StartupFile,
NewTimeOut, Debug, QueryNum + 1, Deep)
;
- server_loop(InputPipe, OutputPipe,
+ server_loop(InputPipe, OutputPipe, StartupFile,
TimeOut, Debug, QueryNum + 1, Deep)
)
)
@@ -1090,11 +1093,13 @@
%-----------------------------------------------------------------------------%
-:- func quantum_time(int) = string.
+:- func quantum_time(deep, int) = string.
-quantum_time(Quanta) = TimeStr :-
- Time = Quanta * 10, % a quantum is 10 milliseconds on our machines
- format("%d", [i(Time)], Str0),
+quantum_time(Deep, Quanta) = TimeStr :-
+ % Time is in units of milliseconds.
+ TicksPerSec = Deep ^ profile_stats ^ ticks_per_sec,
+ Time = float(Quanta) * 1000.0 / float(TicksPerSec),
+ format("%5.2f", [f(Time)], Str0),
string__to_char_list(Str0, Chars0),
reverse(Chars0, RevChars0),
string__from_char_list(reverse(
@@ -1684,20 +1689,20 @@
OwnQuanta = quanta(Own),
TotalQuanta = inherit_quanta(OwnPlusDesc),
RootQuanta = inherit_quanta(Root),
- OwnQuantaProp = 100.0 * float(OwnQuanta) / float(RootQuanta),
- TotalQuantaProp = 100.0 * float(TotalQuanta) / float(RootQuanta),
+ OwnQuantaProp = percentage(OwnQuanta, RootQuanta),
+ TotalQuantaProp = percentage(TotalQuanta, RootQuanta),
OwnAllocs = mallocs(Own),
TotalAllocs = inherit_mallocs(OwnPlusDesc),
RootAllocs = inherit_mallocs(Root),
- OwnAllocProp = 100.0 * float(OwnAllocs) / float(RootAllocs),
- TotalAllocProp = 100.0 * float(TotalAllocs) / float(RootAllocs),
+ OwnAllocProp = percentage(OwnAllocs, RootAllocs),
+ TotalAllocProp = percentage(TotalAllocs, RootAllocs),
OwnWords = words(Own),
TotalWords = inherit_words(OwnPlusDesc),
RootWords = inherit_words(Root),
- OwnWordProp = 100.0 * float(OwnWords) / float(RootWords),
- TotalWordProp = 100.0 * float(TotalWords) / float(RootWords),
+ OwnWordProp = percentage(OwnWords, RootWords),
+ TotalWordProp = percentage(TotalWords, RootWords),
HTML =
( show_port_counts(Fields) ->
@@ -1720,13 +1725,13 @@
) ++
( show_times(Fields) ->
format("<TD ALIGN=RIGHT>%s</TD>\n",
- [s(quantum_time(OwnQuanta))])
+ [s(quantum_time(Deep, OwnQuanta))])
;
""
) ++
( (show_quanta(Fields) ; show_times(Fields)) ->
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(OwnQuantaProp)])
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(OwnQuantaProp)])
;
""
) ++
@@ -1738,40 +1743,50 @@
) ++
( show_times(Fields) ->
format("<TD ALIGN=RIGHT>%s</TD>\n",
- [s(quantum_time(TotalQuanta))])
+ [s(quantum_time(Deep, TotalQuanta))])
;
""
) ++
( (show_quanta(Fields) ; show_times(Fields)) ->
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(TotalQuantaProp)])
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(TotalQuantaProp)])
;
""
) ++
( show_allocs(Fields) ->
format("<TD ALIGN=RIGHT>%s</TD>\n",
[s(commas(OwnAllocs))]) ++
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(OwnAllocProp)]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(OwnAllocProp)]) ++
format("<TD ALIGN=RIGHT>%s</TD>\n",
[s(commas(TotalAllocs))]) ++
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(TotalAllocProp)])
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(TotalAllocProp)])
;
""
) ++
( show_words(Fields) ->
format("<TD ALIGN=RIGHT>%s</TD>\n",
[s(commas(OwnWords))]) ++
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(OwnWordProp)]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(OwnWordProp)]) ++
format("<TD ALIGN=RIGHT>%s</TD>\n",
[s(commas(TotalWords))]) ++
- format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
- [f(TotalWordProp)])
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(TotalWordProp)])
;
""
).
+
+:- func percentage(int, int) = string.
+
+percentage(Fraction, Whole) = PercentageStr :-
+ ( Whole = 0 ->
+ PercentageStr = "N/A"
+ ;
+ Percentage = 100.0 * float(Fraction) / float(Whole),
+ PercentageStr = string__format("%4.2f", [f(Percentage)])
+ ).
:- func deep_cmd_to_url(deep, cmd) = string.
diff -u -b --recursive -x CVS old/mercury/deep_profiler/startup.m new/mercury/deep_profiler/startup.m
--- old/mercury/deep_profiler/startup.m Tue May 29 16:07:52 2001
+++ new/mercury/deep_profiler/startup.m Tue May 29 16:13:25 2001
@@ -16,9 +16,9 @@
:- interface.
:- import_module profile.
-:- import_module io, bool, std_util.
+:- import_module io, bool, list, std_util.
-:- pred read_and_startup(string::in, string::in, bool::in,
+:- pred read_and_startup(string::in, list(string)::in, bool::in,
maybe_error(deep)::out, io__state::di, io__state::uo) is det.
%-----------------------------------------------------------------------------%
@@ -27,9 +27,15 @@
:- import_module unsafe.
:- import_module profile, read_profile, cliques, measurements, array_util.
-:- import_module std_util, int, array, list, assoc_list, set, map, require.
+:- import_module std_util, int, array, assoc_list, set, map, require.
-read_and_startup(Machine, DataFileName, CanonicalClique, Res) -->
+read_and_startup(Machine, DataFileNames, CanonicalClique, Res) -->
+ (
+ { DataFileNames = [] },
+ % This should have been caught and reported by main.
+ { error("read_and_startup: no data files") }
+ ;
+ { DataFileNames = [DataFileName] },
io__stderr_stream(StdErr),
io__report_stats,
io__write_string(StdErr, " Reading graph data...\n"),
@@ -44,6 +50,10 @@
;
{ Res0 = error(Error) },
{ Res = error(Error) }
+ )
+ ;
+ { DataFileNames = [_, _ | _] },
+ { error("mdprof_server: merging of data files is not yet implemented") }
).
:- pred startup(string::in, string::in, bool::in, initial_deep::in, deep::out,
diff -u -b --recursive -x CVS old/mercury/deep_profiler/timeout.m new/mercury/deep_profiler/timeout.m
--- old/mercury/deep_profiler/timeout.m Tue May 29 16:07:52 2001
+++ new/mercury/deep_profiler/timeout.m Tue May 29 16:13:25 2001
@@ -19,6 +19,10 @@
% is not an atomic action, there is a potential race condition. However,
% there is no simple, portable way to eliminate the race condition, and the
% window of vulnerability is quite small.
+%
+% This module also provides a predicate for executing the timeout action
+% explicitly, for use when the user explicitly shuts down the server.
+% This avoids double maintenance of the shutdown actions.
:- module timeout.
@@ -26,9 +30,11 @@
:- import_module io.
-:- pred setup_timeout(string::in, string::in, int::in,
+:- pred setup_timeout(string::in, string::in, string::in, int::in,
io__state::di, io__state::uo) is det.
+:- pred execute_timeout_action(io__state::di, io__state::uo) is det.
+
:- implementation.
:- import_module int.
@@ -43,6 +49,7 @@
extern char *MP_timeout_file1;
extern char *MP_timeout_file2;
+extern char *MP_timeout_file3;
extern void delete_timeout_files_and_exit(void);
").
@@ -51,10 +58,17 @@
"
char *MP_timeout_file1;
char *MP_timeout_file2;
+char *MP_timeout_file3;
void
delete_timeout_files_and_exit(void)
{
+ char buf[1000];
+
+ sprintf(buf, ""echo %s %s %s > /tmp/timeout"",
+ MP_timeout_file1, MP_timeout_file2, MP_timeout_file3);
+ system(buf);
+
if (unlink(MP_timeout_file1) != 0) {
perror(MP_timeout_file1);
}
@@ -63,12 +77,17 @@
perror(MP_timeout_file2);
}
+ if (unlink(MP_timeout_file3) != 0) {
+ perror(MP_timeout_file3);
+ }
+
exit(0);
}
").
:- pragma foreign_proc("C",
- setup_timeout(File1::in, File2::in, Minutes::in, IO0::di, IO::uo),
+ setup_timeout(File1::in, File2::in, File3::in, Minutes::in,
+ IO0::di, IO::uo),
[will_not_call_mercury],
"
int seconds;
@@ -76,8 +95,17 @@
seconds = Minutes * 60;
MP_timeout_file1 = File1;
MP_timeout_file2 = File2;
+ MP_timeout_file3 = File3;
MR_setup_signal(SIGALRM, delete_timeout_files_and_exit, FALSE,
""Mercury deep profiler: cannot setup timeout"");
(void) alarm(seconds);
+ IO = IO0;
+").
+
+:- pragma foreign_proc("C",
+ execute_timeout_action(IO0::di, IO::uo),
+ [will_not_call_mercury],
+"
+ delete_timeout_files_and_exit();
IO = IO0;
").
diff -u -b --recursive -x CVS old/mercury/deep_profiler/util.m new/mercury/deep_profiler/util.m
--- old/mercury/deep_profiler/util.m Tue May 29 16:07:52 2001
+++ new/mercury/deep_profiler/util.m Tue May 29 16:13:25 2001
@@ -15,6 +15,9 @@
:- import_module char, list.
+% split(Str, Char, Pieces): splits Str into pieces at every occurrence of Char,
+% and returns the pieces in order. No piece will contain Char.
+
:- pred split(string::in, char::in, list(string)::out) is det.
:- implementation.
@@ -34,23 +37,23 @@
Chars0 = [],
Strs = Strs0
;
- Chars0 = [_|_],
+ Chars0 = [_ | _],
list__reverse(Chars0, Chars),
string__from_char_list(Chars, Str),
- Strs = [Str|Strs0]
+ Strs = [Str | Strs0]
).
-split([C|Cs], SChar, Chars0, Strs0, Strs) :-
+split([C | Cs], SChar, Chars0, Strs0, Strs) :-
( C = SChar ->
(
Chars0 = [],
Strs1 = Strs0
;
- Chars0 = [_|_],
+ Chars0 = [_ | _],
list__reverse(Chars0, Chars),
string__from_char_list(Chars, Str),
- Strs1 = [Str|Strs0]
+ Strs1 = [Str | Strs0]
),
split(Cs, SChar, [], Strs1, Strs)
;
- split(Cs, SChar, [C|Chars0], Strs0, Strs)
+ split(Cs, SChar, [C | Chars0], Strs0, Strs)
).
diff -u -b --recursive -x CVS old/mercury/doc/Mmakefile new/mercury/doc/Mmakefile
--- old/mercury/doc/Mmakefile Tue May 29 16:07:52 2001
+++ new/mercury/doc/Mmakefile Tue May 29 16:13:25 2001
@@ -166,10 +166,10 @@
# Note that the private_builtin.m module is just an implementation
# detail of the library, so it is not documented.
-library-menu.texi: $(LIBRARY_DIR)/[a-z]*.m
+library-menu.texi: $(LIBRARY_DIR)/*.m
{ \
echo ""; \
- for filename in $(LIBRARY_DIR)/[a-z]*.m; do \
+ for filename in $(LIBRARY_DIR)/*.m; do \
case $$filename in \
$(LIBRARY_DIR)/private_builtin.m) \
;; \
diff -u -b --recursive -x CVS old/mercury/doc/user_guide.texi new/mercury/doc/user_guide.texi
--- old/mercury/doc/user_guide.texi Tue May 29 16:07:52 2001
+++ new/mercury/doc/user_guide.texi Tue May 29 16:13:25 2001
@@ -2545,8 +2545,8 @@
that should be part of every software engineer's toolkit.
Mercury programs can be analyzed using two distinct profilers.
-The Mercury profiler @samp{mprof} is a conventional graph profiler
-in the style of gprof.
+The Mercury profiler @samp{mprof} is a conventional call-graph profiler
+(or graph profiler for short) in the style of @samp{gprof}.
The Mercury deep profiler @samp{mdprof} is a new kind of profiler
that associates a lot more context with each measurement.
@samp{mprof} can be used to profile either time or space,
@@ -2592,7 +2592,7 @@
(self-tail-recursive predicates stay tail-recursive).
Second, your program will be linked with versions of the library and runtime
that were compiled with the same kind of profiling enabled.
-Third, if enable graph profiling,
+Third, if you enable graph profiling,
the compiler will generate for each source file
the static call graph for that file in @samp{@var{module}.prof}.
@@ -3716,7 +3716,7 @@
@sp 1
@item @code{--deep-profiling} (grades: any grade containing @samp{.profdeep})
Enable deep profiling by inserting the appropriate hooks in the generated code.
-This option is not supported for the HLC, IL and Java back-ends.
+This option is not supported for the high-level C, IL and Java back-ends.
@ignore
The following are basically useless, hence undocumented.
diff -u -b --recursive -x CVS old/mercury/library/Mmakefile new/mercury/library/Mmakefile
--- old/mercury/library/Mmakefile Tue May 29 16:07:52 2001
+++ new/mercury/library/Mmakefile Tue May 15 00:38:11 2001
@@ -80,8 +80,7 @@
$(ENABLE_TERM_OPTS)
MCTOI = $(M_ENV) $(MC) --make-trans-opt $(INTERMODULE_OPTS) \
$(ENABLE_TERM_OPTS)
-# MCG = $(M_ENV) $(MC) --compile-to-c --trace minimum \
-MCG = $(M_ENV) $(MC) --compile-to-c \
+MCG = $(M_ENV) $(MC) --compile-to-c --trace minimum \
$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
MCS = $(M_ENV) $(MC) --split-c-files -c --cflags "$(ALL_CFLAGS)" \
$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
@@ -320,11 +319,6 @@
$(os_subdir)std_util.$O \
$(os_subdir)std_util.pic_o \
: ../runtime/mercury_stack_layout.h
-
-# array.m contains C code that #includes exception.h. This requires us
-# to force exception.h to be made before array.c is compiled.
-$(os_subdir)array.$O: $(cs_subdir)exception.c
-$(os_subdir)array.pic_o: $(cs_subdir)exception.c
#-----------------------------------------------------------------------------#
diff -u -b --recursive -x CVS old/mercury/library/array.m new/mercury/library/array.m
--- old/mercury/library/array.m Tue May 29 16:07:52 2001
+++ new/mercury/library/array.m Tue May 29 16:13:25 2001
@@ -505,8 +505,6 @@
#ifdef MR_DEEP_PROFILING
-/* XXX missing prepare_for_normal_call */
-
#define proc_label mercury____Unify___array__array_1_0
#define proc_static MR_proc_static_compiler_name(array, __Unify__, \
array, 1, 0)
diff -u -b --recursive -x CVS old/mercury/library/list.m new/mercury/library/list.m
--- old/mercury/library/list.m Wed Jan 17 15:35:19 2001
+++ new/mercury/library/list.m Tue May 29 16:13:26 2001
@@ -484,6 +484,21 @@
:- mode list__foldl2(pred(in, di, uo, di, uo) is det,
in, di, uo, di, uo) is det.
+ % list__foldl3(Pred, List, Start1, End1, Start2, End2, Start3, End3)
+ % calls Pred with each element of List (working left-to-right),
+ % 3 accumulators (with the initial values of Start1, Start2 and Start3),
+ % and returns the final values in End1, End2 and End3.
+ % (Although no more expressive than list__foldl, this is often
+ % a more convenient format, and a little more efficient).
+:- pred list__foldl3(pred(L, A1, A1, A2, A2, A3, A3), list(L),
+ A1, A1, A2, A2, A3, A3).
+:- mode list__foldl3(pred(in, in, out, in, out, in, out) is det,
+ in, in, out, in, out, in, out) is det.
+:- mode list__foldl3(pred(in, in, out, in, out, in, out) is semidet,
+ in, in, out, in, out, in, out) is semidet.
+:- mode list__foldl3(pred(in, in, out, in, out, in, out) is nondet,
+ in, in, out, in, out, in, out) is nondet.
+
% list__map_foldl(Pred, InList, OutList, Start, End) calls Pred
% with an accumulator (with the initial value of Start) on
% each element of InList (working left-to-right) to transform
@@ -1148,6 +1163,14 @@
list__foldl2(P, [H|T], FirstAcc0, FirstAcc, SecAcc0, SecAcc) :-
call(P, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1),
list__foldl2(P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc).
+
+list__foldl3(_, [], FirstAcc, FirstAcc, SecAcc, SecAcc, ThirdAcc, ThirdAcc).
+list__foldl3(P, [H | T], FirstAcc0, FirstAcc, SecAcc0, SecAcc,
+ ThirdAcc0, ThirdAcc) :-
+ call(P, H, FirstAcc0, FirstAcc1, SecAcc0, SecAcc1,
+ ThirdAcc0, ThirdAcc1),
+ list__foldl3(P, T, FirstAcc1, FirstAcc, SecAcc1, SecAcc,
+ ThirdAcc1, ThirdAcc).
list__map_foldl(_, [], []) -->
[].
diff -u -b --recursive -x CVS old/mercury/library/profiling_builtin.m new/mercury/library/profiling_builtin.m
--- old/mercury/library/profiling_builtin.m Tue May 29 16:07:52 2001
+++ new/mercury/library/profiling_builtin.m Tue May 29 16:13:26 2001
@@ -112,15 +112,130 @@
:- impure pred set_current_csd(call_site_dynamic::in) is det.
-:- impure pred save_recursion_depth_count(call_site_dynamic::in,
+:- type call_site_nums_2
+ ---> call_site_nums_2(int, int).
+
+:- type call_site_nums_3
+ ---> call_site_nums_3(int, int, int).
+
+:- type call_site_nums_4
+ ---> call_site_nums_4(int, int, int, int).
+
+:- type call_site_nums_5
+ ---> call_site_nums_5(int, int, int, int, int).
+
+:- type call_site_nums_6
+ ---> call_site_nums_6(int, int, int, int, int, int).
+
+:- type call_site_nums_7
+ ---> call_site_nums_7(int, int, int, int, int, int, int).
+
+:- type call_site_nums_8
+ ---> call_site_nums_8(int, int, int, int, int, int, int, int).
+
+:- type call_site_nums_9
+ ---> call_site_nums_9(int, int, int, int, int, int, int, int, int).
+
+:- impure pred save_recursion_depth_1(call_site_dynamic::in,
int::in, int::out) is det.
-:- impure pred restore_recursion_depth_count_exit(
+:- impure pred save_recursion_depth_2(call_site_dynamic::in,
+ call_site_nums_2::in, int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_3(call_site_dynamic::in,
+ call_site_nums_3::in, int::out, int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_4(call_site_dynamic::in,
+ call_site_nums_4::in, int::out, int::out, int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_5(call_site_dynamic::in,
+ call_site_nums_5::in, int::out, int::out, int::out, int::out,
+ int::out) is det.
+
+:- impure pred save_recursion_depth_6(call_site_dynamic::in,
+ call_site_nums_6::in, int::out, int::out, int::out, int::out,
+ int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_7(call_site_dynamic::in,
+ call_site_nums_7::in, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_8(call_site_dynamic::in,
+ call_site_nums_8::in, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out) is det.
+
+:- impure pred save_recursion_depth_9(call_site_dynamic::in,
+ call_site_nums_9::in, int::out, int::out, int::out, int::out,
+ int::out, int::out, int::out, int::out, int::out) is det.
+
+:- impure pred restore_recursion_depth_exit_1(
call_site_dynamic::in, int::in, int::in) is det.
-:- impure pred restore_recursion_depth_count_fail(
+:- impure pred restore_recursion_depth_exit_2(
+ call_site_dynamic::in, call_site_nums_2::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_3(
+ call_site_dynamic::in, call_site_nums_3::in, int::in, int::in,
+ int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_4(
+ call_site_dynamic::in, call_site_nums_4::in, int::in, int::in,
+ int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_5(
+ call_site_dynamic::in, call_site_nums_5::in, int::in, int::in,
+ int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_6(
+ call_site_dynamic::in, call_site_nums_6::in, int::in, int::in,
+ int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_7(
+ call_site_dynamic::in, call_site_nums_7::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_8(
+ call_site_dynamic::in, call_site_nums_8::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_exit_9(
+ call_site_dynamic::in, call_site_nums_9::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_1(
call_site_dynamic::in, int::in, int::in) is det.
+:- impure pred restore_recursion_depth_fail_2(
+ call_site_dynamic::in, call_site_nums_2::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_3(
+ call_site_dynamic::in, call_site_nums_3::in, int::in, int::in,
+ int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_4(
+ call_site_dynamic::in, call_site_nums_4::in, int::in, int::in,
+ int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_5(
+ call_site_dynamic::in, call_site_nums_5::in, int::in, int::in,
+ int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_6(
+ call_site_dynamic::in, call_site_nums_6::in, int::in, int::in,
+ int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_7(
+ call_site_dynamic::in, call_site_nums_7::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_8(
+ call_site_dynamic::in, call_site_nums_8::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_fail_9(
+ call_site_dynamic::in, call_site_nums_9::in, int::in, int::in,
+ int::in, int::in, int::in, int::in, int::in, int::in, int::in) is det.
+
%---------------------------------------------------------------------------%
:- implementation.
@@ -136,6 +251,7 @@
#ifdef MR_DEEP_PROFILING
#include ""mercury_deep_profiling.h""
+ #include ""mercury_deep_rec_depth_actions.h""
#include ""mercury_ho_call.h""
#include <stdio.h>
@@ -148,7 +264,7 @@
% Call port procedures
%---------------------------------------------------------------------------%
-:- pragma c_code(det_call_port_code_ac(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", det_call_port_code_ac(ProcStatic::in, TopCSD::out,
MiddleCSD::out),
[thread_safe, will_not_call_mercury],
"{
@@ -161,7 +277,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(semi_call_port_code_ac(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", semi_call_port_code_ac(ProcStatic::in, TopCSD::out,
MiddleCSD::out),
[thread_safe, will_not_call_mercury],
"{
@@ -174,7 +290,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(non_call_port_code_ac(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", non_call_port_code_ac(ProcStatic::in, TopCSD::out,
MiddleCSD::out, NewOutermostActivationPtr::out),
[thread_safe, will_not_call_mercury],
"{
@@ -189,7 +305,7 @@
#undef MR_NEED_NEW_OUTERMOST
}").
-:- pragma c_code(det_call_port_code_sr(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", det_call_port_code_sr(ProcStatic::in, TopCSD::out,
MiddleCSD::out, OldOutermostActivationPtr::out),
[thread_safe, will_not_call_mercury],
"{
@@ -203,7 +319,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(semi_call_port_code_sr(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", semi_call_port_code_sr(ProcStatic::in, TopCSD::out,
MiddleCSD::out, OldOutermostActivationPtr::out),
[thread_safe, will_not_call_mercury],
"{
@@ -217,7 +333,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(non_call_port_code_sr(ProcStatic::in, TopCSD::out,
+:- pragma foreign_proc("C", non_call_port_code_sr(ProcStatic::in, TopCSD::out,
MiddleCSD::out, OldOutermostActivationPtr::out,
NewOutermostActivationPtr::out),
[thread_safe, will_not_call_mercury],
@@ -237,7 +353,7 @@
% Exit/Fail port procedures
%---------------------------------------------------------------------------%
-:- pragma c_code(det_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+:- pragma foreign_proc("C", det_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
[thread_safe, will_not_call_mercury],
"{
/* shut up warning: TopCSD, MiddleCSD */
@@ -250,7 +366,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(det_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+:- pragma foreign_proc("C", det_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
OldOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -264,7 +380,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(semi_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+:- pragma foreign_proc("C", semi_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
[thread_safe, will_not_call_mercury],
"{
/* shut up warning: TopCSD, MiddleCSD */
@@ -277,7 +393,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(semi_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+:- pragma foreign_proc("C", semi_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
OldOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -291,7 +407,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(semi_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
+:- pragma foreign_proc("C", semi_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
[thread_safe, will_not_call_mercury],
"{
/* shut up warning: TopCSD, MiddleCSD */
@@ -304,7 +420,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(semi_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
+:- pragma foreign_proc("C", semi_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
OldOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -318,7 +434,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(non_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+:- pragma foreign_proc("C", non_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
[thread_safe, will_not_call_mercury],
"{
/* shut up warning: TopCSD, MiddleCSD */
@@ -331,7 +447,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(non_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+:- pragma foreign_proc("C", non_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
OldOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -345,7 +461,7 @@
#undef MR_VERSION_SR
}").
-:- pragma c_code(non_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
+:- pragma foreign_proc("C", non_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
[thread_safe, will_not_call_mercury],
"{
/* shut up warning: TopCSD, MiddleCSD */
@@ -358,7 +474,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(non_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
+:- pragma foreign_proc("C", non_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
OldOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -376,7 +492,7 @@
% Redo port procedures
%---------------------------------------------------------------------------%
-:- pragma c_code(non_redo_port_code_ac(MiddleCSD::in,
+:- pragma foreign_proc("C", non_redo_port_code_ac(MiddleCSD::in,
NewOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -388,7 +504,7 @@
#undef MR_VERSION_AC
}").
-:- pragma c_code(non_redo_port_code_sr(MiddleCSD::in,
+:- pragma foreign_proc("C", non_redo_port_code_sr(MiddleCSD::in,
NewOutermostActivationPtr::in),
[thread_safe, will_not_call_mercury],
"{
@@ -404,7 +520,7 @@
% Procedures that prepare for calls
%---------------------------------------------------------------------------%
-:- pragma c_code(prepare_for_normal_call(CSD::in, N::in),
+:- pragma foreign_proc("C", prepare_for_normal_call(CSD::in, N::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
@@ -422,7 +538,6 @@
#ifdef MR_DEEP_PROFILING_STATISTICS
if (child_csd == NULL) {
MR_deep_prof_prep_normal_new++;
- MR_deep_prof_prep_normal_new_array_size += N;
} else {
MR_deep_prof_prep_normal_old++;
}
@@ -440,7 +555,8 @@
#endif
}").
-:- pragma c_code(prepare_for_special_call(CSD::in, CSN::in, TInfo::in),
+:- pragma foreign_proc("C",
+ prepare_for_special_call(CSD::in, CSN::in, TypeInfo::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
@@ -459,7 +575,7 @@
pd = csd->MR_csd_callee_ptr;
MR_deep_assert(pd != NULL);
- type_info = (MR_TypeInfo) TInfo;
+ type_info = (MR_TypeInfo) TypeInfo;
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
void_key = (void *) type_ctor_info;
@@ -490,7 +606,7 @@
#endif
}").
-:- pragma c_code(prepare_for_ho_call(CSD::in, CSN::in, Closure::in),
+:- pragma foreign_proc("C", prepare_for_ho_call(CSD::in, CSN::in, Closure::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
@@ -542,7 +658,7 @@
#endif
}").
-:- pragma c_code(prepare_for_callback(CSD::in, N::in),
+:- pragma foreign_proc("C", prepare_for_callback(CSD::in, N::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
@@ -564,12 +680,13 @@
% Procedures needed for handling directly recursive procedures
%---------------------------------------------------------------------------%
-:- pragma c_code(inner_call_port_code(ProcStatic::in, MiddleCSD::out),
+:- pragma foreign_proc("C",
+ inner_call_port_code(ProcStatic::in, MiddleCSD::out),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
- #ifndef MR_USE_ACTIVATION_COUNTS
- MR_fatal_error(""create_proc_dynamic_inner called when not using activation counts!"");
- #else
+ /* #ifndef MR_USE_ACTIVATION_COUNTS */
+ /* MR_fatal_error(""inner_call_port_code called when not using activation counts!""); */
+ /* #else */
MR_CallSiteDynamic *csd;
MR_ProcStatic *ps;
@@ -592,13 +709,13 @@
}
MR_leave_instrumentation();
- #endif
+ /* #endif */
#else
- MR_fatal_error(""create_proc_dynamic_inner: deep profiling not enabled"");
+ MR_fatal_error(""inner_call_port_code: deep profiling not enabled"");
#endif
}").
-:- pragma c_code(set_current_csd(CSD::in),
+:- pragma foreign_proc("C", set_current_csd(CSD::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_current_call_site_dynamic = (MR_CallSiteDynamic *) CSD;
@@ -610,7 +727,7 @@
:- impure pred increment_activation_count(call_site_dynamic::in,
proc_dynamic::in) is det.
-:- pragma c_code(increment_activation_count(CSD::in, PD::in),
+:- pragma foreign_proc("C", increment_activation_count(CSD::in, PD::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifdef MR_USE_ACTIVATION_COUNTS
@@ -637,7 +754,7 @@
#endif
}").
-:- pragma c_code(set_outermost_activation_ptr(CSD::in, Ptr::in),
+:- pragma foreign_proc("C", set_outermost_activation_ptr(CSD::in, Ptr::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
MR_CallSiteDynamic *csd;
@@ -657,7 +774,7 @@
#endif
}").
-:- pragma c_code(
+:- pragma foreign_proc("C",
save_and_zero_activation_info_ac(CSD::in, Count::out, Ptr::out),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
@@ -686,7 +803,8 @@
#endif
}").
-:- pragma c_code(save_and_zero_activation_info_sr(CSD::in, Ptr::out),
+:- pragma foreign_proc("C",
+ save_and_zero_activation_info_sr(CSD::in, Ptr::out),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifndef MR_USE_ACTIVATION_COUNTS
@@ -712,7 +830,7 @@
#endif
}").
-:- pragma c_code(rezero_activation_info_ac(CSD::in),
+:- pragma foreign_proc("C", rezero_activation_info_ac(CSD::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifdef MR_USE_ACTIVATION_COUNTS
@@ -738,7 +856,7 @@
#endif
}").
-:- pragma c_code(rezero_activation_info_sr(CSD::in),
+:- pragma foreign_proc("C", rezero_activation_info_sr(CSD::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifndef MR_USE_ACTIVATION_COUNTS
@@ -763,7 +881,8 @@
#endif
}").
-:- pragma c_code(reset_activation_info_ac(CSD::in, Count::in, Ptr::in),
+:- pragma foreign_proc("C",
+ reset_activation_info_ac(CSD::in, Count::in, Ptr::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifdef MR_USE_ACTIVATION_COUNTS
@@ -789,7 +908,7 @@
#endif
}").
-:- pragma c_code(reset_activation_info_sr(CSD::in, Ptr::in),
+:- pragma foreign_proc("C", reset_activation_info_sr(CSD::in, Ptr::in),
[thread_safe, will_not_call_mercury], "{
#ifdef MR_DEEP_PROFILING
#ifndef MR_USE_ACTIVATION_COUNTS
@@ -814,105 +933,703 @@
#endif
}").
-:- pragma c_code(save_recursion_depth_count(CSD::in, CSN::in, Count::out),
- [thread_safe, will_not_call_mercury], "{
-#ifdef MR_DEEP_PROFILING
- #ifdef MR_DEEP_PROFILING_TAIL_RECURSION
- MR_CallSiteDynamic *csd;
- MR_CallSiteDynamic *inner_csd;
+%---------------------------------------------------------------------------%
+% instances of save_recursion_depth_N
+%---------------------------------------------------------------------------%
- MR_enter_instrumentation();
- csd = (MR_CallSiteDynamic *) CSD;
- MR_deep_assert(csd->MR_csd_callee_ptr != NULL);
- MR_deep_assert(csd->MR_csd_callee_ptr->MR_pd_proc_static != NULL);
- MR_deep_assert(CSN <= csd->MR_csd_callee_ptr->MR_pd_proc_static
- ->MR_ps_num_call_sites);
- inner_csd = csd->MR_csd_callee_ptr->MR_pd_call_site_ptr_ptrs[CSN];
+:- pragma foreign_proc("C", save_recursion_depth_1(CSD::in, CSN::in,
+ OuterCount1::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSN, OuterCount1 */
+#define MR_PROCNAME ""save_recursion_depth_1""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ CSN); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
- if (inner_csd != NULL) {
- Count = inner_csd->MR_csd_depth_count;
- } else {
- Count = 0;
+:- pragma foreign_proc("C", save_recursion_depth_2(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2 */
+#define MR_PROCNAME ""save_recursion_depth_2""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
}
- MR_leave_instrumentation();
- #else
- MR_fatal_error(""save_recursion_depth_count: no depth counts"");
- #endif
-#else
- MR_fatal_error(""save_recursion_depth_count: deep profiling not enabled"");
-#endif
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
}").
-:- pragma c_code(restore_recursion_depth_count_exit(
- CSD::in, CSN::in, OuterCount::in),
- [thread_safe, will_not_call_mercury], "{
-#ifdef MR_DEEP_PROFILING
- #ifdef MR_DEEP_PROFILING_TAIL_RECURSION
- MR_CallSiteDynamic *csd;
- MR_CallSiteDynamic *inner_csd;
- int inner_count;
+:- pragma foreign_proc("C", save_recursion_depth_3(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+#define MR_PROCNAME ""save_recursion_depth_3""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
- MR_enter_instrumentation();
- csd = (MR_CallSiteDynamic *) CSD;
- MR_deep_assert(csd->MR_csd_callee_ptr != NULL);
- MR_deep_assert(csd->MR_csd_callee_ptr->MR_pd_proc_static != NULL);
- MR_deep_assert(CSN <= csd->MR_csd_callee_ptr->MR_pd_proc_static
- ->MR_ps_num_call_sites);
- inner_csd = csd->MR_csd_callee_ptr->MR_pd_call_site_ptr_ptrs[CSN];
-
- if (inner_csd != NULL) {
- inner_count = inner_csd->MR_csd_depth_count;
-
- /* calls are computed from the other counts */
- /* inner_csd->MR_csd_own.MR_own_calls += inner_count; */
- inner_csd->MR_csd_own.MR_own_exits += inner_count;
+:- pragma foreign_proc("C", save_recursion_depth_4(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4 */
+#define MR_PROCNAME ""save_recursion_depth_4""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
- inner_csd->MR_csd_depth_count = OuterCount;
- } else {
- MR_deep_assert(OuterCount == 0);
+:- pragma foreign_proc("C", save_recursion_depth_5(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out, OuterCount5::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5 */
+#define MR_PROCNAME ""save_recursion_depth_5""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
}
- MR_leave_instrumentation();
- #else
- MR_fatal_error(""restore_recursion_depth_count_exit: no depth counts"");
- #endif
-#else
- MR_fatal_error(""restore_recursion_depth_count_exit: deep profiling not enabled"");
-#endif
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
}").
-:- pragma c_code(restore_recursion_depth_count_fail(
- CSD::in, CSN::in, OuterCount::in),
- [thread_safe, will_not_call_mercury], "{
-#ifdef MR_DEEP_PROFILING
- #ifdef MR_DEEP_PROFILING_TAIL_RECURSION
- MR_CallSiteDynamic *csd;
- MR_CallSiteDynamic *inner_csd;
- int inner_count;
+:- pragma foreign_proc("C", save_recursion_depth_6(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out, OuterCount5::out, OuterCount6::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6 */
+#define MR_PROCNAME ""save_recursion_depth_6""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
- MR_enter_instrumentation();
- csd = (MR_CallSiteDynamic *) CSD;
- MR_deep_assert(csd->MR_csd_callee_ptr != NULL);
- MR_deep_assert(csd->MR_csd_callee_ptr->MR_pd_proc_static != NULL);
- MR_deep_assert(CSN <= csd->MR_csd_callee_ptr->MR_pd_proc_static
- ->MR_ps_num_call_sites);
- inner_csd = csd->MR_csd_callee_ptr->MR_pd_call_site_ptr_ptrs[CSN];
-
- if (inner_csd != NULL) {
- inner_count = inner_csd->MR_csd_depth_count;
-
- /* calls are computed from the other counts */
- /* inner_csd->MR_csd_own.MR_own_calls += inner_count; */
- inner_csd->MR_csd_own.MR_own_fails += inner_count;
+:- pragma foreign_proc("C", save_recursion_depth_7(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out, OuterCount5::out, OuterCount6::out,
+ OuterCount7::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+#define MR_PROCNAME ""save_recursion_depth_7""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
- inner_csd->MR_csd_depth_count = OuterCount;
- } else {
- MR_deep_assert(OuterCount == 0);
+:- pragma foreign_proc("C", save_recursion_depth_8(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out, OuterCount5::out, OuterCount6::out,
+ OuterCount7::out, OuterCount8::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8 */
+#define MR_PROCNAME ""save_recursion_depth_8""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
}
- MR_leave_instrumentation();
- #else
- MR_fatal_error(""restore_recursion_depth_count_fail: no depth counts"");
- #endif
-#else
- MR_fatal_error(""restore_recursion_depth_count_fail: deep profiling not enabled"");
-#endif
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C", save_recursion_depth_9(CSD::in, CSNsVector::in,
+ OuterCount1::out, OuterCount2::out, OuterCount3::out,
+ OuterCount4::out, OuterCount5::out, OuterCount6::out,
+ OuterCount7::out, OuterCount8::out, OuterCount9::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8, OuterCount9 */
+#define MR_PROCNAME ""save_recursion_depth_9""
+#define MR_REC_DEPTH_BODY { \
+ MR_SAVE_DEPTH_ACTION(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
+ MR_SAVE_DEPTH_ACTION(OuterCount9, \
+ MR_csn_vector_field(CSNsVector, 8)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+%---------------------------------------------------------------------------%
+% instances of restore_recursion_depth_exit_N
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C", restore_recursion_depth_exit_1(CSD::in, CSN::in,
+ OuterCount1::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSN, OuterCount1 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_1""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ CSN); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_2(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_2""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_3(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_3""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_4(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_4""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_5(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_5""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_6(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_6""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_7(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_7""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_8(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in, OuterCount8::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_8""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_exit_9(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in, OuterCount8::in, OuterCount9::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8, OuterCount9 */
+#define MR_PROCNAME ""restore_recursion_depth_exit_9""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_EXIT(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
+ MR_RESTORE_DEPTH_EXIT(OuterCount9, \
+ MR_csn_vector_field(CSNsVector, 8)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+%---------------------------------------------------------------------------%
+% instances of restore_recursion_depth_fail_N
+%---------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_1(CSD::in, CSN::in,
+ OuterCount1::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSN, OuterCount1 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_1""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ CSN); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_2(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_2""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_3(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_3""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_4(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_4""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_5(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_5""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_6(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_6""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_7(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_7""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_8(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in, OuterCount8::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_8""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
+}").
+
+:- pragma foreign_proc("C",
+ restore_recursion_depth_fail_9(CSD::in, CSNsVector::in,
+ OuterCount1::in, OuterCount2::in, OuterCount3::in,
+ OuterCount4::in, OuterCount5::in, OuterCount6::in,
+ OuterCount7::in, OuterCount8::in, OuterCount9::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: CSD, CSNsVector, OuterCount1, OuterCount2, OuterCount3 */
+/* shut up warning: OuterCount4, OuterCount5, OuterCount6, OuterCount7 */
+/* shut up warning: OuterCount8, OuterCount9 */
+#define MR_PROCNAME ""restore_recursion_depth_fail_9""
+#define MR_REC_DEPTH_BODY { \
+ MR_RESTORE_DEPTH_FAIL(OuterCount1, \
+ MR_csn_vector_field(CSNsVector, 0)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount2, \
+ MR_csn_vector_field(CSNsVector, 1)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount3, \
+ MR_csn_vector_field(CSNsVector, 2)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount4, \
+ MR_csn_vector_field(CSNsVector, 3)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount5, \
+ MR_csn_vector_field(CSNsVector, 4)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount6, \
+ MR_csn_vector_field(CSNsVector, 5)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount7, \
+ MR_csn_vector_field(CSNsVector, 6)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount8, \
+ MR_csn_vector_field(CSNsVector, 7)); \
+ MR_RESTORE_DEPTH_FAIL(OuterCount9, \
+ MR_csn_vector_field(CSNsVector, 8)); \
+ }
+#include ""mercury_deep_rec_depth_body.h""
+#undef MR_PROCNAME
+#undef MR_REC_DEPTH_BODY
}").
diff -u -b --recursive -x CVS old/mercury/runtime/Mmakefile new/mercury/runtime/Mmakefile
--- old/mercury/runtime/Mmakefile Tue May 29 16:07:52 2001
+++ new/mercury/runtime/Mmakefile Tue May 29 16:13:26 2001
@@ -102,6 +102,8 @@
mercury_deep_copy_body.h \
mercury_deep_leave_port_body.h \
mercury_deep_redo_port_body.h \
+ mercury_deep_rec_depth_actions.h \
+ mercury_deep_rec_depth_body.h \
mercury_exception_catch_body.h \
mercury_hand_compare_body.h \
mercury_hand_unify_body.h \
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_conf_param.h new/mercury/runtime/mercury_conf_param.h
--- old/mercury/runtime/mercury_conf_param.h Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_conf_param.h Tue May 29 16:13:26 2001
@@ -200,37 +200,27 @@
** count you should not also enable low-level debugging.)
**
** MR_MPROF_PROFILE_CALLS
-** Enables call count profiling.
+** Enables call count profiling for mprof.
**
** MR_MPROF_PROFILE_TIME
-** Enables time profiling.
+** Enables time profiling for mprof.
**
** MR_MPROF_PROFILE_MEMORY
-** Enables profiling of memory usage.
+** Enables profiling of memory usage for mprof.
**
-** MR_DEEP_PROFILING_PORT_COUNTS.
-** Enables deep profiling of port counts.
-**
-** MR_DEEP_PROFILING_TIMING.
-** Enables deep profiling of time.
+** MR_DEEP_PROFILING
+** Enables deep profiling.
**
-** MR_DEEP_PROFILING_MEMORY.
-** Enables deep profiling of memory usage.
+** MR_DEEP_PROFILING_PERF_TEST
+** Allows the selective performance testing of various aspects of deep
+** profiling. For implementors only.
+**
+** MR_USE_ACTIVATION_COUNTS
+** Selects the activation counter approach to deep profiling over the
+** save/restore approach (the two approaches are documented in the deep
+** profiling paper). For implementors only.
*/
-#ifdef MR_DEEP_PROFILING
- /* this is the default set of measurements in deep profiling grades */
- #define MR_DEEP_PROFILING_PORT_COUNTS
- #ifndef MR_DEEP_PROFILING_PERF_TEST
- #define MR_DEEP_PROFILING_TIMING
- #define MR_DEEP_PROFILING_MEMORY
- #endif
-#else
- #undef MR_DEEP_PROFILING_PORT_COUNTS
- #undef MR_DEEP_PROFILING_TIMING
- #undef MR_DEEP_PROFILING_MEMORY
-#endif
-
/*
** Experimental options:
**
@@ -270,6 +260,30 @@
#define MR_CHECK_FOR_OVERFLOW
#endif
+/*
+** MR_DEEP_PROFILING_PORT_COUNTS.
+** Enables deep profiling of port counts.
+**
+** MR_DEEP_PROFILING_TIMING.
+** Enables deep profiling of time.
+**
+** MR_DEEP_PROFILING_MEMORY.
+** Enables deep profiling of memory usage.
+*/
+
+#ifdef MR_DEEP_PROFILING
+ /* this is the default set of measurements in deep profiling grades */
+ #define MR_DEEP_PROFILING_PORT_COUNTS
+ #ifndef MR_DEEP_PROFILING_PERF_TEST
+ #define MR_DEEP_PROFILING_TIMING
+ #define MR_DEEP_PROFILING_MEMORY
+ #endif
+#else
+ #undef MR_DEEP_PROFILING_PORT_COUNTS
+ #undef MR_DEEP_PROFILING_TIMING
+ #undef MR_DEEP_PROFILING_MEMORY
+#endif
+
/*---------------------------------------------------------------------------*/
/*
** Configuration parameters whose values are determined by the settings
@@ -292,8 +306,7 @@
#define MR_STATIC_CODE_ADDRESSES
#endif
-/* XXX documetn MR_BYTECODE_CALLABLE */
-
+/* XXX document MR_BYTECODE_CALLABLE */
/*
** MR_INSERT_LABELS -- labels need to be inserted into the label table.
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_debug.c new/mercury/runtime/mercury_debug.c
--- old/mercury/runtime/mercury_debug.c Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_debug.c Tue May 29 16:13:26 2001
@@ -299,7 +299,7 @@
MR_print_ordinary_regs();
if (MR_watch_addr != NULL) {
- printf("watch addr %p: %lx %ld\n", MR_watch_addr,
+ printf("watch addr %p: 0x%lx %ld\n", MR_watch_addr,
(long) *MR_watch_addr, (long) *MR_watch_addr);
}
@@ -334,14 +334,6 @@
printf("%ld %lx\n", (long) value, (long) value);
}
-
-#if 0
- if (MR_sp >= &MR_CONTEXT(MR_ctxt_detstack_zone)->min[300]) {
- for (i = 321; i < 335; i++) {
- MR_printdetslot_as_label(i);
- }
- }
-#endif
}
#endif /* defined(MR_DEBUG_GOTOS) */
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_deep_call_port_body.h new/mercury/runtime/mercury_deep_call_port_body.h
--- old/mercury/runtime/mercury_deep_call_port_body.h Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_deep_call_port_body.h Tue May 29 16:13:26 2001
@@ -88,7 +88,6 @@
csd->MR_csd_callee_ptr;
}
} else if (ps->MR_ps_activation_count > 0) {
- MR_incr_activation_loads();
csd->MR_csd_callee_ptr = ps->MR_ps_outermost_activation_ptr;
} else {
MR_ProcDynamic *pd;
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_deep_profiling.c new/mercury/runtime/mercury_deep_profiling.c
--- old/mercury/runtime/mercury_deep_profiling.c Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_deep_profiling.c Tue May 29 16:13:26 2001
@@ -13,12 +13,14 @@
#include "mercury_imp.h"
#include "mercury_ho_call.h"
#include "mercury_stack_layout.h"
+#include "mercury_timing.h"
#include "mercury_prof_time.h"
#include "mercury_deep_profiling.h"
#ifdef MR_DEEP_PROFILING
#include <stdio.h>
+#include <unistd.h>
MR_CallSiteStatic MR_main_parent_call_site_statics[1] =
{
@@ -78,19 +80,19 @@
(MR_CallSiteDynList **)
&MR_main_parent_call_site_dynamics[0];
bool MR_inside_deep_profiling_code = FALSE;
-unsigned long MR_quanta_inside_deep_profiling_code = 0L;
-unsigned long MR_quanta_outside_deep_profiling_code = 0L;
+volatile unsigned MR_quanta_inside_deep_profiling_code = 0L;
+volatile unsigned MR_quanta_outside_deep_profiling_code = 0L;
#ifdef MR_DEEP_PROFILING_STATISTICS
-int MR_number_of_profiling_entries = 0;
-int MR_number_of_activation_loads = 0;
-int MR_amount_of_memory = 0;
-int MR_profiling_tree_memory = 0;
+int MR_deep_num_csd_nodes = 0;
+int MR_deep_num_pd_nodes = 0;
+int MR_deep_num_pd_array_slots = 0;
+int MR_deep_num_dynlist_nodes = 0;
+
int MR_dictionary_search_lengths[MR_MAX_CLOSURE_LIST_LENGTH];
int MR_closure_search_lengths[MR_MAX_CLOSURE_LIST_LENGTH];
-long MR_deep_prof_prep_normal_new_array_size = 0;
int MR_deep_prof_prep_normal_new = 0;
int MR_deep_prof_prep_normal_old = 0;
int MR_deep_prof_prep_special_new = 0;
@@ -174,6 +176,8 @@
** Functions for writing out the data at the end of the execution.
*/
+static void MR_deep_data_output_error(const char *msg);
+
static void MR_write_out_id_string(FILE *fp);
static void MR_write_out_call_site_static(FILE *fp,
@@ -192,7 +196,7 @@
kind_csd, kind_pd, kind_css, kind_ps
} MR_NodeKind;
-/* must correspond to fixed_size_int_bytes in deep_profiler/deep.io.m */
+/* must correspond to fixed_size_int_bytes in deep/read_profile.m */
#define MR_FIXED_SIZE_INT_BYTES 4
static void MR_write_csd_ptr(FILE *fp, const MR_CallSiteDynamic *ptr);
@@ -204,10 +208,11 @@
static void MR_write_string(FILE *fp, const char *ptr);
/*----------------------------------------------------------------------------*/
+
/*
-** We need a couple of hash tables, so here are some structures for handling
-** them....
+** We need some hash tables, so here are the structures for handling them....
*/
+
typedef struct MR_Profiling_Hash_Node_Struct {
const void *item;
int id;
@@ -256,6 +261,8 @@
static FILE *debug_fp;
#endif
+#define MR_MDPROF_DATAFILENAME "Deep.data"
+
void
MR_write_out_profiling_tree(void)
{
@@ -264,10 +271,12 @@
MR_Proc_Id *pid;
int root_pd_id;
FILE *fp;
+ int ticks_per_sec;
- fp = fopen("Deep.data", "w+");
+ fp = fopen(MR_MDPROF_DATAFILENAME, "wb+");
if (fp == NULL) {
- MR_fatal_error("Cannot open Deep.data");
+ perror(MR_MDPROF_DATAFILENAME);
+ exit(1);
}
#ifdef MR_DEEP_PROFILING_DEBUG
@@ -283,6 +292,13 @@
MR_write_fixed_size_int(fp, 0);
MR_write_fixed_size_int(fp, 0);
+#ifdef MR_CLOCK_TICKS_PER_SECOND
+ ticks_per_sec = MR_CLOCK_TICKS_PER_SECOND;
+#else
+ ticks_per_sec = 0;
+#endif
+
+ MR_write_num(fp, ticks_per_sec);
MR_write_num(fp, MR_quanta_inside_deep_profiling_code);
MR_write_num(fp, MR_quanta_outside_deep_profiling_code);
@@ -313,67 +329,125 @@
MR_deep_assert(MR_address_of_write_out_proc_statics != NULL);
(*MR_address_of_write_out_proc_statics)(fp);
- rewind(fp);
+ if (fseek(fp, 0L, SEEK_SET) != 0) {
+ MR_deep_data_output_error("cannot seek to start of");
+ }
+
MR_write_out_id_string(fp);
MR_write_fixed_size_int(fp, MR_call_site_dynamic_table->last_id);
MR_write_fixed_size_int(fp, MR_call_site_static_table->last_id);
MR_write_fixed_size_int(fp, MR_proc_dynamic_table->last_id);
MR_write_fixed_size_int(fp, MR_proc_static_table->last_id);
- (void) fclose(fp);
+
+ if (fclose(fp) != 0) {
+ MR_deep_data_output_error("cannot close");
+ }
#ifdef MR_DEEP_PROFILING_STATISTICS
if (! MR_print_deep_profiling_statistics) {
return;
}
- fprintf(stderr, "Amount of memory accounted for: %d\n",
- MR_amount_of_memory);
- fprintf(stderr, "There were %d activation increments\n",
- MR_number_of_profiling_entries);
- fprintf(stderr, "There were %d outermost_activation_ptr uses\n",
- MR_number_of_activation_loads);
- fprintf(stderr, "Closure/TypeInfo search length histogram:\n");
-
- for (i = 0; i < MR_MAX_CLOSURE_LIST_LENGTH; i++) {
- fprintf(stderr, "\t%3d : %12d %12d\n", i,
- MR_closure_search_lengths[i],
- MR_dictionary_search_lengths[i]);
- }
-
- fprintf(stderr, "MR_deep_prof_prep_normal_new_array_size: %ld\n",
- MR_deep_prof_prep_normal_new_array_size);
- fprintf(stderr, "MR_deep_prof_prep_normal_new: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_normal_new:",
MR_deep_prof_prep_normal_new);
- fprintf(stderr, "MR_deep_prof_prep_normal_old: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_normal_old:",
MR_deep_prof_prep_normal_old);
- fprintf(stderr, "MR_deep_prof_prep_special_new: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_special_new:",
MR_deep_prof_prep_special_new);
- fprintf(stderr, "MR_deep_prof_prep_special_old: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_special_old:",
MR_deep_prof_prep_special_old);
- fprintf(stderr, "MR_deep_prof_prep_ho_new: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_ho_new:",
MR_deep_prof_prep_ho_new);
- fprintf(stderr, "MR_deep_prof_prep_ho_old: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_prep_ho_old:",
MR_deep_prof_prep_ho_old);
- fprintf(stderr, "MR_deep_prof_call_old: %d\n",
- MR_deep_prof_call_old);
- fprintf(stderr, "MR_deep_prof_call_rec: %d\n",
- MR_deep_prof_call_rec);
- fprintf(stderr, "MR_deep_prof_call_new: %d\n",
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_call_new:",
MR_deep_prof_call_new);
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_call_rec:",
+ MR_deep_prof_call_rec);
+ fprintf(stderr, "%-40s %10d\n",
+ "MR_deep_prof_call_old:",
+ MR_deep_prof_call_old);
+
+ fprintf(stderr, "\ntotal size of profiling tree: %10d bytes\n",
+ MR_deep_num_csd_nodes * sizeof(MR_CallSiteDynamic) +
+ MR_deep_num_pd_nodes * sizeof(MR_ProcDynamic) +
+ MR_deep_num_pd_array_slots * sizeof(MR_CallSiteDynamic *) +
+ MR_deep_num_dynlist_nodes * sizeof(MR_CallSiteDynList));
+ fprintf(stderr, "%10d CSD nodes at %4d bytes per node: %10d bytes\n",
+ MR_deep_num_csd_nodes,
+ sizeof(MR_CallSiteDynamic),
+ MR_deep_num_csd_nodes * sizeof(MR_CallSiteDynamic));
+ fprintf(stderr, "%10d PD nodes at %4d bytes per node: %10d bytes\n",
+ MR_deep_num_pd_nodes,
+ sizeof(MR_ProcDynamic),
+ MR_deep_num_pd_nodes * sizeof(MR_ProcDynamic));
+ fprintf(stderr, "%10d array slots at %4d bytes per node: %10d bytes\n",
+ MR_deep_num_pd_array_slots,
+ sizeof(MR_CallSiteDynamic *),
+ MR_deep_num_pd_array_slots * sizeof(MR_CallSiteDynamic *));
+ fprintf(stderr, "%10d list nodes at %4d bytes per node: %10d bytes\n",
+ MR_deep_num_dynlist_nodes,
+ sizeof(MR_CallSiteDynList),
+ MR_deep_num_dynlist_nodes * sizeof(MR_CallSiteDynList));
+
+ fprintf(stderr, "\nClosure search length histogram:\n");
+ for (i = 0; i < MR_MAX_CLOSURE_LIST_LENGTH; i++) {
+ if (MR_closure_search_lengths[i] > 0) {
+ fprintf(stderr, "\t%3d: %12d\n", i,
+ MR_closure_search_lengths[i]);
+ }
+ }
+
+ fprintf(stderr, "\nTypeInfo search length histogram:\n");
+ for (i = 0; i < MR_MAX_CLOSURE_LIST_LENGTH; i++) {
+ if (MR_dictionary_search_lengths[i] > 0) {
+ fprintf(stderr, "\t%3d: %12d\n", i,
+ MR_dictionary_search_lengths[i]);
+ }
+ }
#endif
}
static void
+MR_deep_data_output_error(const char *op)
+{
+ /* The op name and data file name are both fixed in length and short */
+ char buf[1000];
+
+ sprintf(buf, "%s: %s", op, MR_MDPROF_DATAFILENAME);
+ perror(buf);
+
+ /*
+ ** An incomplete profiling data file is useless. Removing it
+ ** prevents misunderstandings about that, and may also cure a
+ ** disk-full condition, if the close failure was caused by
+ ** that.
+ */
+
+ if (unlink(MR_MDPROF_DATAFILENAME) != 0) {
+ sprintf(buf, "%s: %s", "unlink", MR_MDPROF_DATAFILENAME);
+ perror(buf);
+ }
+
+ exit(1);
+}
+
+static void
MR_write_out_id_string(FILE *fp)
{
- /* This string must match id_string deep_profiler/deep.io.m */
+ /* This string must match id_string deep/read_profile.m */
const char *id_string = "Mercury deep profiler data";
- int i;
- for (i = 0; id_string[i] != '\0'; i++) {
- putc(id_string[i], fp);
- }
+ fputs(id_string, fp);
}
void
@@ -550,7 +624,7 @@
}
#ifdef MR_DEEP_PROFILING_STATISTICS
- MR_amount_of_memory += sizeof(MR_CallSiteDynamic);
+ MR_deep_num_csd_nodes++;
#endif
#ifdef MR_DEEP_PROFILING_DEBUG
@@ -637,12 +711,12 @@
int ps_id;
bool already_written;
+ if (ptr == NULL) {
/*
- ** This shouldn't really happen except that we don't have correct
- ** handling of nondet pragma_foreign_code yet.
+ ** This shouldn't really happen except that we don't have
+ ** correct handling of nondet pragma_foreign_code yet.
*/
- if (ptr == NULL) {
return;
}
@@ -661,8 +735,8 @@
ptr->MR_pd_proc_static, &ps_id, NULL, FALSE);
#ifdef MR_DEEP_PROFILING_STATISTICS
- MR_amount_of_memory += sizeof(MR_ProcDynamic);
- MR_amount_of_memory += sizeof(MR_CallSiteDynamic*) *
+ MR_deep_num_pd_nodes++;
+ MR_deep_num_pd_array_slots +=
ptr->MR_pd_proc_static->MR_ps_num_call_sites;
#endif
@@ -729,7 +803,7 @@
{
while (dynlist != NULL) {
#ifdef MR_DEEP_PROFILING_STATISTICS
- MR_amount_of_memory += sizeof(MR_CallSiteDynList);
+ MR_deep_num_dynlist_nodes++;
#endif
#ifdef MR_DEEP_PROFILING_DEBUG
fprintf(debug_fp, " multi call from pd %p to pd %p\n",
@@ -807,6 +881,13 @@
putc(byte, fp);
}
+/*
+** Write out a (non-negative) integer. The format we use is a multibyte format
+** which uses the least significant 7 bits as data bits and the most
+** significant bit to indicate whether there are more bytes following.
+** Numbers are written most significant byte first.
+*/
+
static void
MR_write_num(FILE *fp, unsigned long num)
{
@@ -869,6 +950,18 @@
/*----------------------------------------------------------------------------*/
+/*
+** This section of the file implements the hash tables that turn the addresses
+** of ProcDynamic, ProcDynamic, and CallSiteDynamic nodes into node ids.
+** We use our own routines instead of reusing the hash table routines in
+** mercury_hash_table.c for efficiency. By writing our own code, we avoid
+** several sources of overhead: higher order calls, separate calls to lookup
+** a pointer and insert it if it isn't there, and the use of doubly-linked
+** lists. Efficiency is reasonably important, since the tables can have
+** millions of entries. Eventually, they should be implemented using
+** dynamically sized hash tables (extendible hashing or linear hashing).
+*/
+
static MR_ProfilingHashTable *
MR_create_hash_table(int size)
{
@@ -881,6 +974,8 @@
return ptr;
}
+#define MR_hash_ptr(ptr, table) (((unsigned int) (ptr) >> 2) % (table)->length)
+
static bool
MR_hash_table_insert(MR_ProfilingHashTable *table, const void *ptr,
int *id, bool *already_written, bool init_written)
@@ -892,8 +987,7 @@
MR_fatal_error("NULL ptr in MR_hash_table_insert");
}
- hash = ((unsigned int) ptr >> 2) % table->length;
-
+ hash = MR_hash_ptr(ptr, table);
node = table->nodes[hash];
while (node != NULL) {
if (node->item == ptr) {
@@ -931,8 +1025,7 @@
MR_fatal_error("NULL ptr in MR_hash_table_flag_written");
}
- hash = ((unsigned int) ptr >> 2) % table->length;
-
+ hash = MR_hash_ptr(ptr, table);
node = table->nodes[hash];
while (node != NULL) {
if (node->item == ptr) {
@@ -944,6 +1037,8 @@
MR_fatal_error("MR_hash_table_flag_written: did not find node");
}
+
+/*----------------------------------------------------------------------------*/
void
MR_deep_prof_init(void)
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_deep_profiling.h new/mercury/runtime/mercury_deep_profiling.h
--- old/mercury/runtime/mercury_deep_profiling.h Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_deep_profiling.h Tue May 29 16:13:26 2001
@@ -45,7 +45,7 @@
unsigned MR_own_redos;
#endif
#ifdef MR_DEEP_PROFILING_TIMING
- unsigned MR_own_quanta;
+ volatile unsigned MR_own_quanta;
#endif
#ifdef MR_DEEP_PROFILING_MEMORY
unsigned MR_own_allocs;
@@ -98,7 +98,9 @@
struct MR_CallSiteDynamic_Struct {
MR_ProcDynamic *MR_csd_callee_ptr;
MR_ProfilingMetrics MR_csd_own;
- unsigned long MR_csd_depth_count;
+#ifdef MR_DEEP_PROFILING_TAIL_RECURSION
+ unsigned MR_csd_depth_count;
+#endif
};
struct MR_ProcDynamic_Struct {
@@ -203,7 +205,6 @@
do { \
int i; \
\
- MR_incr_profiling_entries(); \
(pd) = MR_PROFILING_MALLOC(MR_ProcDynamic); \
(pd)->MR_pd_proc_static = (ps); \
(pd)->MR_pd_call_site_ptr_ptrs = \
@@ -228,11 +229,6 @@
MR_deep_profile_update_special_history(typectorinfo)
#define MR_maybe_deep_profile_update_closure_history(closure) \
MR_deep_profile_update_closure_history(closure)
-
- #define MR_incr_profiling_entries() \
- do { MR_number_of_profiling_entries++; } while (0)
- #define MR_incr_activation_loads() \
- do { MR_number_of_activation_loads++; } while (0)
#else
#define MR_maybe_init_search_len() \
((void) 0)
@@ -242,24 +238,21 @@
((void) 0)
#define MR_maybe_deep_profile_update_closure_history(closure) \
((void) 0)
-
- #define MR_incr_profiling_entries() \
- ((void) 0)
- #define MR_incr_activation_loads() \
- ((void) 0)
#endif
#ifdef MR_DEEP_PROFILING_MOVE_TO_FRONT_LISTS
#define MR_maybe_update_prev(csdlist, prev) \
do { (prev) = (csdlist); } while (0)
#define MR_maybe_move_to_front(csdlist, prev, pd, csn) \
+ do { \
if (prev != NULL) { \
- prev->MR_csdlist_next = csdlist->MR_csdlist_next; \
- csdlist->MR_csdlist_next = (MR_CallSiteDynList *) \
+ prev->MR_csdlist_next = csdlist->MR_csdlist_next;\
+ csdlist->MR_csdlist_next = (MR_CallSiteDynList *)\
pd->MR_pd_call_site_ptr_ptrs[(csn)]; \
pd->MR_pd_call_site_ptr_ptrs[(csn)] = \
(MR_CallSiteDynamic *) csdlist; \
- }
+ } \
+ } while (0)
#else
#define MR_maybe_update_prev(csdlist, prev) \
((void) 0)
@@ -317,29 +310,22 @@
((void) 0)
#endif
-/* If these are volatile, a lot of other things must be too */
extern MR_CallSiteDynamic *MR_current_call_site_dynamic;
extern MR_CallSiteDynamic *MR_next_call_site_dynamic;
extern MR_CallSiteDynList **MR_current_callback_site;
extern MR_CallSiteDynamic *MR_root_call_sites[];
extern volatile bool MR_inside_deep_profiling_code;
-extern unsigned long MR_quanta_inside_deep_profiling_code;
-extern unsigned long MR_quanta_outside_deep_profiling_code;
+extern volatile unsigned MR_quanta_inside_deep_profiling_code;
+extern volatile unsigned MR_quanta_outside_deep_profiling_code;
#ifdef MR_DEEP_PROFILING_STATISTICS
-extern int MR_number_of_profiling_entries;
-extern int MR_number_of_activation_loads;
-extern int MR_amount_of_memory;
-extern int MR_profiling_tree_memory;
-
#define MR_MAX_CLOSURE_LIST_LENGTH 256
extern int MR_dictionary_search_lengths[MR_MAX_CLOSURE_LIST_LENGTH];
extern int MR_closure_search_lengths[MR_MAX_CLOSURE_LIST_LENGTH];
-extern long MR_deep_prof_prep_normal_new_array_size;
extern int MR_deep_prof_prep_normal_new;
extern int MR_deep_prof_prep_normal_old;
extern int MR_deep_prof_prep_special_new;
diff -u -b --recursive -x CVS old/mercury/runtime/mercury_wrapper.c new/mercury/runtime/mercury_wrapper.c
--- old/mercury/runtime/mercury_wrapper.c Tue May 29 16:07:52 2001
+++ new/mercury/runtime/mercury_wrapper.c Tue May 29 16:13:26 2001
@@ -733,7 +733,7 @@
int c;
int long_index;
- while ((c = MR_getopt_long(argc, argv, "acC:d:e:D:i:m:o:P:pr:stT:x",
+ while ((c = MR_getopt_long(argc, argv, "acC:d:D:e:i:m:o:pP:r:sStT:x",
MR_long_opts, &long_index)) != EOF)
{
switch (c)
diff -u -b --recursive -x CVS old/mercury/scripts/mdprof.in new/mercury/scripts/mdprof.in
--- old/mercury/scripts/mdprof.in Tue May 29 16:07:52 2001
+++ new/mercury/scripts/mdprof.in Tue May 29 16:13:26 2001
@@ -3,6 +3,12 @@
# mdprof_cgi and mprof_server programs. This should allow this shell script
# to find the right version of mdprof_cgi, and it should allow the mdprof_cgi
# process to find the right mdprof_server.
+#
+# We ignore the argument(s) of this script. The web server passes us the same
+# information in the environment variable QUERY_STRING, but QUERY_STRING is
+# unprocessed, which is what we want; the web servers breaks up QUERY_STRING
+# on boundaries inappropriate for us when computing the command line arguments.
+
PATH=@PREFIX@/bin:$PATH
export PATH
-exec mdprof_cgi "$@"
+exec mdprof_cgi
diff -u -b --recursive -x CVS old/mercury/scripts/mgnuc.in new/mercury/scripts/mgnuc.in
--- old/mercury/scripts/mgnuc.in Tue May 29 16:07:52 2001
+++ new/mercury/scripts/mgnuc.in Tue May 29 16:13:26 2001
@@ -86,7 +86,7 @@
assemble=false
c_debug=false
c_optimize=true
-use_activation_counts=true
+use_activation_counts=false
preserve_tail_recursion=true
# include the file `init_grade_options.sh-subr'
diff -u -b --recursive -x CVS old/mercury/tests/debugger/Mmakefile new/mercury/tests/debugger/Mmakefile
--- old/mercury/tests/debugger/Mmakefile Tue May 29 16:07:52 2001
+++ new/mercury/tests/debugger/Mmakefile Tue May 29 16:13:26 2001
@@ -69,7 +69,11 @@
PROGS=
else
ifneq "$(findstring profdeep,$(GRADE))" ""
- DEBUGGER_PROGS=$(NONRETRY_PROGS)
+ # Eventually, this should be DEBUGGER_PROGS=$(NONRETRY_PROGS).
+ # However, the code that is required to switch off the profiling
+ # primitives in Mercury code invoked by the debugger (e.g. for
+ # browsing) has not yet been implemented.
+ DEBUGGER_PROGS=
else
DEBUGGER_PROGS=$(NONRETRY_PROGS) $(RETRY_PROGS)
endif
diff -u -b --recursive -x CVS old/mercury/tests/debugger/runtests new/mercury/tests/debugger/runtests
--- old/mercury/tests/debugger/runtests Tue May 29 16:07:52 2001
+++ new/mercury/tests/debugger/runtests Tue May 15 17:10:41 2001
@@ -17,9 +17,6 @@
. ../subdir_runtests
-# Don't let any single test run for more than ten minutes.
-ulimit -t 600
-
if test "$subdir_failures" = ""
then
subdir_status=0
diff -u -b --recursive -x CVS old/mercury/tests/hard_coded/Mmakefile new/mercury/tests/hard_coded/Mmakefile
--- old/mercury/tests/hard_coded/Mmakefile Tue May 29 16:07:53 2001
+++ new/mercury/tests/hard_coded/Mmakefile Tue May 29 16:13:26 2001
@@ -118,21 +118,12 @@
type_qual \
type_spec_modes \
type_to_term_bug \
+ user_defined_equality \
user_defined_equality2 \
write \
write_reg1 \
write_reg2
-# Deep profiling cannot yet handle exceptions being caught, which the
-# user_defined_equality test case does.
-
-ifeq "$(findstring profdeep,$(GRADE))" ""
- EXCEPTION_PROGS = \
- user_defined_equality
-else
- EXCEPTION_PROGS =
-endif
-
# XXX csharp_test doesn't work yet (not even in il* grades)
#
# XXX copy_pred does not work in the hl* grades (e.g. hlc.gc),
@@ -169,9 +160,13 @@
ifeq "$(findstring hl,$(GRADE))$(findstring .tr,$(GRADE))" "hl.tr"
NONDET_C_PROGS =
else
+ ifneq "$(findstring profdeep,$(GRADE))" ""
+ NONDET_C_PROGS =
+ else
NONDET_C_PROGS = \
inline_nondet_pragma_c \
nondet_c
+ endif
endif
PROGS = $(ORDINARY_PROGS) $(EXCEPTION_PROGS) $(BACKEND_PROGS) $(NONDET_C_PROGS)
diff -u -b --recursive -x CVS old/mercury/tests/hard_coded/exceptions/Mmakefile new/mercury/tests/hard_coded/exceptions/Mmakefile
--- old/mercury/tests/hard_coded/exceptions/Mmakefile Tue May 29 16:07:53 2001
+++ new/mercury/tests/hard_coded/exceptions/Mmakefile Tue May 29 16:13:26 2001
@@ -30,12 +30,13 @@
# which should be deleted once that bug is fixed.
#
-# Deep profiling grades cannot yet handle catching exceptions.
+# Deep profiling grades cannot yet handle catching exceptions, either
+# explicitly or implicitly by the runtime system.
ifneq "$(findstring profdeep,$(GRADE))" ""
- PROGS=$(EXCEPTION_PROGS)
-else
PROGS=
+else
+ PROGS=$(EXCEPTION_PROGS)
endif
depend: $(PROGS:.m=.depend)
diff -u -b --recursive -x CVS old/mercury/tests/valid/Mmakefile new/mercury/tests/valid/Mmakefile
--- old/mercury/tests/valid/Mmakefile Tue May 29 16:07:53 2001
+++ new/mercury/tests/valid/Mmakefile Tue May 29 16:13:27 2001
@@ -209,9 +209,15 @@
SOURCES=$(SOURCES2) $(ADITI_SOURCES)
endif
-ALL_SOURCES = $(SOURCES) $(RLO_SOURCES)
+ifneq "$(findstring profdeep,$(GRADE))" ""
+ ALL_RLO_SOURCES =
+else
+ ALL_RLO_SOURCES = $(RLO_SOURCES)
+endif
+
+ALL_SOURCES = $(SOURCES) $(ALL_RLO_SOURCES)
DEPS = $(ALL_SOURCES:%.m=%.depend)
-OBJS = $(SOURCES:%.m=$(os_subdir)%.$O) $(RLO_SOURCES:%.m=$(rlos_subdir)%.rlo)
+OBJS = $(SOURCES:%.m=$(os_subdir)%.$O) $(ALL_RLO_SOURCES:%.m=$(rlos_subdir)%.rlo)
PROGS = $(SOURCES:%.m=%)
all: objs
diff -u -b --recursive -x CVS old/mercury/tools/bootcheck new/mercury/tools/bootcheck
--- old/mercury/tools/bootcheck Tue May 29 16:07:53 2001
+++ new/mercury/tools/bootcheck Tue May 29 16:13:27 2001
@@ -487,14 +487,14 @@
$LN_S $root/profiler/*.m .
cp $root/profiler/Mmake* .
cd $root/stage2
- mkdir deep
- cd deep
+ mkdir deep_profiler
+ cd deep_profiler
$LN_S $root/deep_profiler/*.m .
cp $root/deep_profiler/Mmake* .
cd $root/stage2
else
$LN_S $root/profiler .
- $LN_S $root/deep .
+ $LN_S $root/deep_profiler .
fi
$LN_S $root/conf* .
$LN_S $root/aclocal.m4 .
@@ -534,7 +534,7 @@
fi
if (cd stage2 && $MMAKE $mmake_opts dep_library dep_browser \
- dep_compiler dep_profiler dep_deep)
+ dep_compiler dep_profiler dep_deep_profiler)
then
echo "building of stage 2 dependencies successful"
else
@@ -666,7 +666,7 @@
$LN_S $root/scripts .
$LN_S $root/util .
$LN_S $root/profiler .
- $LN_S $root/deep .
+ $LN_S $root/deep_profiler .
$LN_S $root/conf* .
$LN_S $root/aclocal.m4 .
$LN_S $root/VERSION .
diff -u -b --recursive -x CVS old/mercury/tools/cvspatch new/mercury/tools/cvspatch
--- old/mercury/tools/cvspatch Tue May 29 16:07:40 2001
+++ new/mercury/tools/cvspatch Sat Nov 20 10:20:38 1999
@@ -18,8 +18,6 @@
if (startline != NR) {
printf "%s %d %d\n", dirname, startline, NR - 1;
}
- dirname = $4;
- startline = NR + 1;
usecvsdiff = 1;
}
usecvsdiff != 1 && $1 == "Index:" {
@@ -46,12 +44,7 @@
do
echo patching files in $dirname
awk "{ if ($start <= NR && NR <= $end) print}" < $inputfile > $dirname/.cvspatch
- (if cd $dirname; then
- patch < .cvspatch
- /bin/rm .cvspatch
- else
- echo "Can't find directory '$dirname'"
- fi)
+ ( cd $dirname ; patch < .cvspatch ; /bin/rm .cvspatch )
done
exit 0
diff -u -b --recursive -x CVS old/mercury/tools/speedtest new/mercury/tools/speedtest
--- old/mercury/tools/speedtest Fri Feb 16 15:55:47 2001
+++ new/mercury/tools/speedtest Tue May 29 16:13:27 2001
@@ -92,6 +92,12 @@
else
$root/tools/dotime $cmd
fi
+
+ if test -s Deep.data
+ then
+ mv Deep.data ../batch/`basename $file .gz`.run$count
+ fi
+
count=`expr $count + 1`
done
cd $root
diff -u -b --recursive -x CVS old/mercury/trace/mercury_trace_declarative.h new/mercury/trace/mercury_trace_declarative.h
--- old/mercury/trace/mercury_trace_declarative.h Tue May 29 16:07:53 2001
+++ new/mercury/trace/mercury_trace_declarative.h Mon Apr 30 22:44:53 2001
@@ -11,6 +11,8 @@
#include "mercury_trace.h"
#include "mercury_trace_internal.h"
+#ifdef MR_USE_DECLARATIVE_DEBUGGER
+
/*
** When in declarative debugging mode, the internal debugger calls
** MR_trace_decl_debug for each event.
@@ -43,4 +45,5 @@
#define MR_TRACE_STATUS_FAILED (MR_Word) 1
#define MR_TRACE_STATUS_UNDECIDED (MR_Word) 2
+#endif /* MR_USE_DECLARATIVE_DEBUGGER */
#endif /* MERCURY_TRACE_DECLARATIVE_H */
diff -u -b --recursive -x CVS old/mercury/util/Mmakefile new/mercury/util/Mmakefile
--- old/mercury/util/Mmakefile Tue May 29 16:07:53 2001
+++ new/mercury/util/Mmakefile Sun Apr 8 18:59:32 2001
@@ -24,8 +24,6 @@
PROGFILENAMES=$(PROGS:%=%$(EXT_FOR_EXE))
SRC=$(PROGS:%=%.c)
-# GETOPT_FLAGS suppresses warnings about the prototype of getopt
-GETOPT_FLAGS=-D__GNU_LIBRARY__
GETOPT_SRC=$(RUNTIME_DIR)/GETOPT/getopt.c $(RUNTIME_DIR)/GETOPT/getopt1.c
# mkinit.c needs `struct stat'
@@ -36,7 +34,7 @@
all: $(PROGS)
.c:
- $(MGNUC) $(GRADEFLAGS) $(ALL_MGNUCFLAGS) $(GETOPT_FLAGS) -o $@ $< $(GETOPT_SRC)
+ $(MGNUC) $(GRADEFLAGS) $(ALL_MGNUCFLAGS) -o $@ $< $(GETOPT_SRC)
tags:
ctags $(SRC)
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
| of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh> | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list