[m-rev.] Updated diff for deep profiling.
Zoltan Somogyi
zs at cs.mu.OZ.AU
Thu May 17 18:01:40 AEST 2001
It should address all the comments made on the previous diff except for
comments in array_util.m; since Tom write almost all of that module, he is in a
better position to document it than I am :-(
It also has a bunch of improvements, mainly optimizations and simplification
of the usage of mdprof.
Zoltan.
Implement deep profiling; merge the changes on the deep2 branch back
onto the trunk.
The main documentation on the general architecture of the deep profiler
is the deep profiling paper.
doc/user_guide.texi:
Document how to use the deep profiler.
deep:
deep/Mmakefile:
A new directory holding the deep profiler and its mmakefile.
Mmakefile:
Add targets for the new directory.
Add support for removing inappropriate files from directories.
deep/interface.m:
The deep profiler consists of two programs: mdprof_cgi.m, which acts
as a CGI "script", and mdprof_server.m, which implements the server
process that the CGI script talks to. Interface.m defines the
interface between them.
script/mdprof.in:
A shell script template. ../configure uses it to generate mdprof,
which is a wrapper around mdprof_cgi that tells it how to find
mdprof_server.
deep/mdprof_cgi.m:
The CGI "script" program.
deep/mdprof_server.m:
The top level predicates of the server.
deep/profile.m:
The main data structures of the server and their operations.
deep/read_profile.m:
Code for reading in profiling data files.
deep/startup.m:
Code for post-processing the information in profiling data files,
propagating costs from procedures to their ancestors and performing
various kinds of summaries.
deep/server.m:
Code for responding to requests from the CGI script.
deep/cliques.m:
Code to find cliques in graphs.
deep/array_util.m:
deep/util.m:
Utility predicates.
deep/dense_bitset.m:
An implementation of (part of) the set ADT with dense bit vectors.
deep/measurements.m:
Operations on profiling measurements.
deep/timeout.m:
An implementation of a timeout facility.
deep/conf.m:
Functions that depend on autoconfigured settings.
configure.in:
Find out what command to use to find the name of the local host.
Install deep profiling versions of the standard library along with the
other profiling versions.
runtime/mercury_conf.h.in:
Add some macros for deep/conf.m to use.
library/profiling_builtin.m:
runtime/mercury_deep_call_port_body.h:
runtime/mercury_deep_leave_port_body.h:
runtime/mercury_deep_redo_port_body.h:
A new library module that implements deep profiling primitives.
Some of these primitives have many versions, whose common code is
factor is factored out in three new include files in the runtime.
compiler/deep_profiling.m:
New module to perform the program transformations described in the
paper.
compiler/notes/compiler_design.html:
Document the new compiler module.
compiler/mercury_compiler.m:
Invoke the new module in deep profiling grades. Allow global static
data to be generated by deep_profiling.m.
compiler/options.m:
Add options to turn on deep profiling and (for benchmarking purposes)
control its implementation.
Add an optimize to disable tailcall optimization in the LLDS backend,
to help benchmarking deep profiling.
compiler/jumpopt.m:
compiler/optimize.m:
Obey the option to disable tailcalls.
compiler/handle_options.m:
Handle the implications of deep profiling.
compiler/modules.m:
In deep profiling grades, automatically import profiling_builtin.m.
compiler/prog_util.m:
doc/Makefile:
library/library.m:
Handle the new builtin module.
compiler/export.m:
In deep profiling grades, wrap deep profiling code around exported
procedures to handle the "unscheduled call" aspects of callbacks to
Mercury from the foreign language.
compiler/higher_order.m:
profiler/demangle.m:
util/demangle.c:
When creating a name for a higher-order-specialized predicate, include
the mode number in the name.
compiler/add_trail_ops.m:
compiler/type_util.m:
Move c_pointer_type from add_trail_ops to type_util, so it can also be
used by deep_profiling.m.
compiler/hlds_goal.m:
Add a new goal feature that marks a tail call, for use by
deep_profiling.m.
compiler/hlds_pred.m:
Add a new field to proc_info structures for use by deep_profiling.m.
Add a mechanism for getting proc_ids for procedure clones.
Remove next_proc_id, an obsolete and unused predicate.
compiler/hlds_data.m:
Add a new cons_id to refer to the proc_static structure of a procedure.
compiler/bytecode_gen.m:
compiler/code_util.m:
compiler/dependency_graph.m:
compiler/hlds_out.m:
compiler/mercury_to_mercury.m:
compiler/ml_unify_gen.m:
compiler/opt_debug.m:
compiler/prog_rep.m:
compiler/rl_exprn.m:
compiler/switch_util.m:
compiler/unify_gen.m:
Trivial changes to handle the new cons_id, goal feature and/or
proc_info argument.
compiler/rtti.m:
Add a utility predicate for extracting pred_id and proc_id from an
rtti_proc_label, for use by hlds_out.m
compiler/layout.m:
compiler/layout_out.m:
compiler/llds.m:
compiler/llds_common.m:
Add support for proc_static and call_site_static structures.
compiler/layout_out.m:
compiler/llds_out.m:
compiler/code_util.m:
Make code_util__make_proc_label_from_rtti a function, and export it.
util/mkinit.c:
compiler/llds_out.m:
compiler/layout.m:
compiler/modules.m:
Add support for a fourth per-module C function, for writing out
proc_static structures (and the call_site_static structures they
contains).
Since proc_static structures can be referred to from LLDS code (and not
just from other static structures and compiler-generated C code),
reorganize the declarations of static structures slightly.
Change the schema for the name of the first per-module C function
slightly, to make it the addition of the fourth function easier.
The scheme now is:
mercury__<modulename>__init
mercury__<modulename>__init_type_tables
mercury__<modulename>__init_debugger
mercury__<modulename>__write_out_proc_statics
Improve formatting of the generated C code.
library/*.m:
runtime/mercury.c:
runtime/mercury_context.c:
runtime/mercury_engine.c:
runtime/mercury_ho_call.c:
runtime/mercury_tabling.c:
runtime/mercury_trace_base.c:
runtime/mercury_wrapper.c:
trace/mercrury_trace.[ch]:
trace/mercrury_trace_declarative.c:
trace/mercrury_trace_external.c:
trace/mercrury_trace_internal.c:
Conform to the new scheme for initialization functions for hand-written
modules.
compiler/mercury_compile.m:
library/benchmarking.m:
runtime/mercury_conf_param.h:
runtime/mercury.h:
runtime/mercury_engine.c:
runtime/mercury_goto.c:
runtime/mercury_grade.h:
runtime/mercury_ho_call.c:
runtime/mercury_label.[ch]:
runtime/mercury_prof.[ch]:
Add an MR_MPROF_ prefix in front of the C macros used to control the
old profiler.
compiler/handle_options.m:
runtime/mercury_grade.h:
scripts/canonical_grade.sh-subr:
scripts/init_grade_options.sh-subr:
scripts/parse_grade_options.sh-subr:
Make deep profiling completely separate from the old profiling system,
by making the deep profiling grade independent of MR_MPROF_PROFILE_TIME
and the compiler option --profile-time.
library/array.m:
library/builtin.m:
library/std_util.m:
runtime/mercury_hand_unify_body.h:
runtime/mercury_hand_compare_body.h:
In deep profiling grades, wrap the deep profiling call, exit, fail
and redo codes around the bodies of hand-written unification
and comparison procedures.
Make the reporting of array bounds violations switchable between
making them fatal errors, as we currently, and reporting them by
throwing an exception. Throwing an exception makes debugging code
using arrays easier, but since exceptions aren't (yet) propagated
across engine boundaries, we keep the old behaviour as the default;
the new behaviour is for implementors.
runtime/mercury_deep_profiling_hand.h:
New file that defines macros for use in Mercury predicates whose
definition is in hand-written C code.
library/exception.m:
runtime/mercury_exception_catch_body.h:
runtime/mercury_stacks.h:
In deep profiling grades, wrap the deep profiling call, exit, fail
and redo codes around the bodies of the various modes of builtin_catch.
Provide a function that C code can use to throw exceptions.
library/benchmarking.m:
library/exception.m:
library/gc.m:
library/std_util.m:
runtime/mercury_context.[ch]:
runtime/mercury_engine.[ch]:
runtime/mercury_debug.c:
runtime/mercury_deep_copy.c:
runtime/mercury_overflow.h:
runtime/mercury_regs.h:
runtime/mercury_stacks.h:
runtime/mercury_thread.c:
runtime/mercury_wrapper.c:
Add prefixes to the names of the fields in the engine and context
structures, to make code using them easier to understand and modify.
runtime/mercury_deep_profiling.[ch]:
New module containing support functions for deep profiling and
functions for writing out a deep profiling data file at the end of
execution.
runtime/mercury_debug.[ch]:
Add support for debugging deep profiling.
Add support for watching the value at a given address.
Make the buffered/unbuffered nature of debugging output controllable
via the -du option.
Print register contents only if -dr is specified.
runtime/mercury_goto.h:
runtime/mercury_std.h:
Use the macros in mercury_std.h instead of defining local variants.
runtime/mercury_goto.h:
runtime/mercury_stack_layout.h:
runtime/mercury_stack_trace.c:
runtime/mercury_tabling.c:
trace/mercury_trace.c:
trace/mercury_trace_declarative.c:
trace/mercury_trace_external.c:
trace/mercury_trace_vars.c:
Standardize some of the macro names with those used in the debugger
paper.
runtime/mercury_heap.h:
Add support for memory profiling with the deep profiler.
runtime/mercury_prof.[ch]:
runtime/mercury_prof_time.[ch]:
Move the functionality that both the old profiler and the deep profiler
need into the new module mercury_prof_time. Leave mercury_prof
containing stuff that is only relevant to the old profiler.
runtime/mercury_prof.[ch]:
runtime/mercury_strerror.[ch]:
Move the definition of strerror from mercury_prof to its own file.
runtime/mercury_wrapper.[ch]:
Add support for deep profiling.
Add suppory for controlling whether debugging output is buffered or
not.
Add support for watching the value at a given address.
runtime/Mmakefile:
Mention all the added files.
scripts/mgnuc.in:
Add an option for turning on deep profiling.
Add options for controlling the details of deep profiling. These
are not documented because they are intended only for benchmarking
the deep profiler itself, for the paper; they are not for general use.
tools/bootcheck:
Compile the deep directory as well as the other directories containing
Mercury code.
Turn off the creation of deep profiling data files during bootcheck,
since all but one of these in each directory will be overwritten
anyway.
Add support for turning on --keep-objs by default in a workspace.
trace/mercury_trace.c:
Trap attempts to perform retries in deep profiling grades, since they
would lead to core dumps otherwise.
util/Mmakefile:
Avoid compile-time warnings when compiling getopt.
tests/*/Mmakefile:
tests/*/*/Mmakefile:
In deep profiling grades, switch off the tests that test features
that don't work with deep profiling, either by design or because
the combination hasn't been implemented yet.
cvs diff: Diffing .
Index: Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/Mmakefile,v
retrieving revision 1.65
diff -u -b -r1.65 Mmakefile
--- Mmakefile 2001/01/13 05:30:47 1.65
+++ Mmakefile 2001/05/16 17:37:39
@@ -32,7 +32,8 @@
browser \
compiler \
doc \
- profiler
+ profiler \
+ deep
MMAKEFLAGS =
@@ -52,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: dep_library dep_browser dep_compiler dep_profiler dep_deep
.PHONY: dep_library
dep_library: library/$(deps_subdir)library.dep
@@ -78,6 +79,15 @@
profiler/$(deps_subdir)mercury_profile.dep: library/$(deps_subdir)library.dep
cd profiler && $(SUBDIR_MMAKE) depend
+.PHONY: dep_deep
+dep_deep: deep/$(deps_subdir)mdprof_cgi.dep deep/$(deps_subdir)mdprof_server.dep
+
+deep/$(deps_subdir)mdprof_cgi.dep: library/$(deps_subdir)library.dep
+ cd deep && $(SUBDIR_MMAKE) mdprof_cgi.depend
+
+deep/$(deps_subdir)mdprof_server.dep: library/$(deps_subdir)library.dep
+ cd deep && $(SUBDIR_MMAKE) mdprof_server.depend
+
# depend_library MUST be done before depend_compiler and depend_profiler
.PHONY: depend
@@ -86,6 +96,7 @@
cd browser && $(SUBDIR_MMAKE) depend
cd compiler && $(SUBDIR_MMAKE) depend
cd profiler && $(SUBDIR_MMAKE) depend
+ cd deep && $(SUBDIR_MMAKE) depend
.PHONY: depend_library
depend_library:
@@ -103,6 +114,10 @@
depend_profiler:
cd profiler && $(SUBDIR_MMAKE) depend
+.PHONY: depend_deep
+depend_deep:
+ cd deep && $(SUBDIR_MMAKE) depend
+
#-----------------------------------------------------------------------------#
.PHONY: all
@@ -153,10 +168,14 @@
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: tags
-tags: tags_compiler tags_library tags_browser tags_profiler
+tags: tags_compiler tags_library tags_browser tags_profiler tags_deep
.PHONY: tags_compiler
tags_compiler:
@@ -174,8 +193,25 @@
tags_profiler:
cd profiler && $(SUBDIR_MMAKE) tags
+.PHONY: tags_deep
+tags_deep:
+ cd deep && $(SUBDIR_MMAKE) tags
+
#-----------------------------------------------------------------------------#
+cleanint:
+ for dir in browser compiler deep library profiler; do \
+ echo looking for inappropriate files in the $$dir directory: ; \
+ ( cd $$dir; cleanint > .cleanint ) ; \
+ if test -s $$dir/.cleanint ; then \
+ cat $$dir/.cleanint ; \
+ else \
+ echo none found. ; \
+ fi \
+ done
+
+#-----------------------------------------------------------------------------#
+
configure: configure.in aclocal.m4
autoconf
@@ -218,6 +254,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 doc && $(SUBDIR_MMAKE) info html dvi mdb_doc
cd bindist && $(SUBDIR_MMAKE) bindist.configure
# the following command might fail on Windows?
@@ -297,7 +335,7 @@
install_main: all \
install_scripts install_util install_runtime install_boehm_gc \
install_library install_browser install_trace \
- install_compiler install_profiler install_doc
+ install_compiler install_profiler install_deep install_doc
.PHONY: install_scripts
install_scripts: scripts
@@ -340,6 +378,10 @@
install_profiler: profiler
cd profiler && $(SUBDIR_MMAKE) install
+.PHONY: install_deep
+install_deep: deep
+ cd deep && $(SUBDIR_MMAKE) install
+
.PHONY: install_grades
install_grades: scripts
cd boehm_gc && rm -rf tmp_dir && mkdir tmp_dir && \
@@ -454,6 +496,9 @@
touch profiler/*.date*
chmod +w profiler/*.dep
touch profiler/*.dep
+ touch deep/*.date*
+ chmod +w deep/*.dep
+ touch deep/*.dep
touch doc/*.texi configure
sleep 1
touch boehm_gc/*.c
@@ -463,6 +508,7 @@
touch trace/*.c
touch compiler/*.c
touch profiler/*.c
+ touch deep/*.c
touch doc/*.info doc/*.dvi doc/*.html config.status
#-----------------------------------------------------------------------------#
Index: configure.in
===================================================================
RCS file: /home/mercury1/repository/mercury/configure.in,v
retrieving revision 1.253
diff -u -b -r1.253 configure.in
--- configure.in 2001/04/10 15:37:35 1.253
+++ configure.in 2001/05/15 14:48:25
@@ -289,6 +289,9 @@
if test "$MKFIFO" = ""; then
AC_MSG_WARN(cannot find a working \`mkfifo' or \`mknod')
MKFIFO=none
+ AC_DEFINE_UNQUOTED(MR_MKFIFO, "")
+else
+ AC_DEFINE_UNQUOTED(MR_MKFIFO, "$MKFIFO")
fi
AC_SUBST(MKFIFO)
test "$MKNOD" = "" && MKNOD=mknod
@@ -331,6 +334,12 @@
AC_PATH_PROG(PERL,perl)
AC_SUBST(PERL)
#-----------------------------------------------------------------------------#
+AC_PATH_PROG(HOSTNAMECMD,hostname uname)
+case "$HOSTNAMECMD" in
+ *hostname) HOSTNAMECMD="$HOSTNAMECMD -f" ;;
+esac
+AC_DEFINE_UNQUOTED(MR_HOSTNAMECMD, "$HOSTNAMECMD")
+#-----------------------------------------------------------------------------#
AC_PROG_CC
AC_SUBST(CC)
@@ -1960,11 +1969,11 @@
LIBGRADES="$GC_LIBGRADES"
fi
-if test "$enable_nogc_grades" = yes; then
+if test "$enable_prof_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_prof_grades" = yes; then
+ if test "$enable_nogc_grades" = yes; then
DEFAULT_GRADE_NOGC="`echo $DEFAULT_GRADE | sed 's/\.gc$//'`"
LIBGRADES="$LIBGRADES $DEFAULT_GRADE.prof $DEFAULT_GRADE_NOGC.prof"
else
@@ -1979,7 +1988,7 @@
fi
fi
fi
- LIBGRADES="$LIBGRADES $DEFAULT_GRADE.memprof"
+ LIBGRADES="$LIBGRADES $DEFAULT_GRADE.memprof $DEFAULT_GRADE.profdeep"
fi
if test "$enable_trail_grades" = yes; then
@@ -2794,9 +2803,10 @@
to_delete=""
if test "$BOOTSTRAP_MC" != "" ; then
MERCURY_MSG("checking whether any C files need to be rebuilt...")
- for c_file in library/*.c compiler/*.c browser/*.c profiler/*.c \
+ for c_file in library/*.c compiler/*.c browser/*.c profiler/*.c deep/*.c \
library/Mercury/cs/*.c compiler/Mercury/cs/*.c \
- browser/Mercury/cs/*.c profiler/Mercury/cs/*.c
+ browser/Mercury/cs/*.c profiler/Mercury/cs/*.c \
+ deep/Mercury/cs/*.c
do
case $c_file in
*/'*.c')
@@ -2845,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/mmake scripts/c2init scripts/mdb scripts/mdbrc scripts/mdprof
scripts/sicstus_conv scripts/mkfifo_using_mknod bindist/bindist.build_vars
,
for header in $CONFIG_HEADERS ; do
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.4
diff -u -b -r1.4 add_trail_ops.m
--- compiler/add_trail_ops.m 2001/05/02 17:34:31 1.4
+++ compiler/add_trail_ops.m 2001/05/03 06:44:11
@@ -453,11 +453,6 @@
:- func ticket_counter_type = (type).
ticket_counter_type = c_pointer_type.
-:- func c_pointer_type = (type).
-c_pointer_type = Type :-
- mercury_public_builtin_module(BuiltinModule),
- construct_type(qualified(BuiltinModule, "c_pointer") - 0, [], Type).
-
%-----------------------------------------------------------------------------%
% XXX copied from table_gen.m
Index: compiler/bytecode_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/bytecode_gen.m,v
retrieving revision 1.61
diff -u -b -r1.61 bytecode_gen.m
--- compiler/bytecode_gen.m 2001/04/07 14:04:31 1.61
+++ compiler/bytecode_gen.m 2001/05/03 06:41:03
@@ -740,6 +740,9 @@
;
ConsId = tabling_pointer_const(_, _),
error("bytecode cannot implement tabling")
+ ;
+ ConsId = deep_profiling_proc_static(_),
+ error("bytecode cannot implement deep profiling")
).
:- pred bytecode_gen__map_cons_tag(cons_tag::in, byte_cons_tag::out) is det.
@@ -765,6 +768,8 @@
error("base_typeclass_info_constant cons tag for non-base_typeclass_info_constant cons id").
bytecode_gen__map_cons_tag(tabling_pointer_constant(_, _), _) :-
error("tabling_pointer_constant cons tag for non-tabling_pointer_constant cons id").
+bytecode_gen__map_cons_tag(deep_profiling_proc_static_tag(_), _) :-
+ error("deep_profiling_proc_static_tag cons tag for non-deep_profiling_proc_static cons id").
%---------------------------------------------------------------------------%
Index: compiler/call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/call_gen.m,v
retrieving revision 1.148
diff -u -b -r1.148 call_gen.m
--- compiler/call_gen.m 2001/04/20 04:57:35 1.148
+++ compiler/call_gen.m 2001/05/13 03:12:51
@@ -110,7 +110,7 @@
% If the call can fail, generate code to check for and
% handle the failure.
- call_gen__handle_failure(CodeModel, FailHandlingCode),
+ call_gen__handle_failure(CodeModel, GoalInfo, 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, FailHandlingCode),
+ call_gen__handle_failure(CodeModel, GoalInfo, FailHandlingCode),
{ Code =
tree(SetupCode,
@@ -520,11 +520,15 @@
),
trace__prepare_for_call(TraceCode).
-:- pred call_gen__handle_failure(code_model::in, code_tree::out,
- code_info::in, code_info::out) is det.
+:- pred call_gen__handle_failure(code_model::in, hlds_goal_info::in,
+ code_tree::out, code_info::in, code_info::out) is det.
-call_gen__handle_failure(CodeModel, FailHandlingCode) -->
+call_gen__handle_failure(CodeModel, GoalInfo, 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))
@@ -540,6 +544,7 @@
tree(FailCode,
ContLabelCode))
}
+ )
;
{ FailHandlingCode = empty }
).
Index: compiler/code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.131
diff -u -b -r1.131 code_util.m
--- compiler/code_util.m 2001/04/07 14:04:32 1.131
+++ compiler/code_util.m 2001/05/03 06:41:03
@@ -62,6 +62,8 @@
:- pred code_util__make_proc_label(module_info, pred_id, proc_id, proc_label).
:- mode code_util__make_proc_label(in, in, in, out) is det.
+:- func code_util__make_proc_label_from_rtti(rtti_proc_label) = proc_label.
+
% code_util__make_user_proc_label(ModuleName, PredIsImported,
% PredOrFunc, ModuleName, PredName, Arity, ProcId, Label):
% Make a proc_label for a user-defined procedure.
@@ -208,7 +210,8 @@
RttiProcLabel^proc_id)
)
->
- code_util__make_proc_label_from_rtti(RttiProcLabel, ProcLabel),
+ code_util__make_proc_label_from_rtti(RttiProcLabel)
+ = ProcLabel,
ProcAddr = imported(ProcLabel)
;
code_util__make_local_entry_label_from_rtti(RttiProcLabel,
@@ -226,7 +229,7 @@
:- mode code_util__make_local_entry_label_from_rtti(in, in, out) is det.
code_util__make_local_entry_label_from_rtti(RttiProcLabel, Immed, Label) :-
- code_util__make_proc_label_from_rtti(RttiProcLabel, ProcLabel),
+ code_util__make_proc_label_from_rtti(RttiProcLabel) = ProcLabel,
(
Immed = no,
% If we want to define the label or use it to put it
@@ -276,12 +279,9 @@
code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel) :-
RttiProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId),
- code_util__make_proc_label_from_rtti(RttiProcLabel, ProcLabel).
-
-:- pred code_util__make_proc_label_from_rtti(rtti_proc_label, proc_label).
-:- mode code_util__make_proc_label_from_rtti(in, out) is det.
+ code_util__make_proc_label_from_rtti(RttiProcLabel) = ProcLabel.
-code_util__make_proc_label_from_rtti(RttiProcLabel, ProcLabel) :-
+code_util__make_proc_label_from_rtti(RttiProcLabel) = ProcLabel :-
RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule,
PredModule, PredName, PredArity, ArgTypes, _PredId, ProcId,
_VarSet, _HeadVars, _ArgModes, _CodeModel,
@@ -692,6 +692,8 @@
base_typeclass_info_constant(M,C,N)).
code_util__cons_id_to_tag(tabling_pointer_const(PredId,ProcId), _, _,
tabling_pointer_constant(PredId,ProcId)).
+code_util__cons_id_to_tag(deep_profiling_proc_static(PPId), _, _,
+ deep_profiling_proc_static_tag(PPId)).
code_util__cons_id_to_tag(cons(Name, Arity), Type, ModuleInfo, Tag) :-
(
% handle the `character' type specially
Index: compiler/deep_profiling.m
===================================================================
RCS file: deep_profiling.m
diff -N deep_profiling.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ deep_profiling.m Fri May 11 04:10:05 2001
@@ -0,0 +1,1585 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Main author: conway.
+%
+% This module applies the deep profiling transformation described in the paper
+% ``Engineering a profiler for a logic programming language'' by Thomas Conway
+% and Zoltan Somogyi.
+%
+%-----------------------------------------------------------------------------%
+
+:- module deep_profiling.
+
+:- interface.
+
+:- import_module hlds_module, layout.
+:- import_module io, list.
+
+:- pred apply_deep_profiling_transformation(module_info::in, module_info::out,
+ list(layout_data)::out, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module (inst), instmap, hlds_data, hlds_pred, hlds_goal, prog_data.
+:- import_module code_model, code_util, prog_util, type_util, mode_util.
+:- 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.
+
+apply_deep_profiling_transformation(ModuleInfo0, ModuleInfo, ProcStatics) -->
+ { module_info_globals(ModuleInfo0, Globals) },
+ { globals__lookup_bool_option(Globals, deep_profile_tail_recursion,
+ TailRecursion) },
+ (
+ { TailRecursion = yes },
+ { apply_tail_recursion_transformation(ModuleInfo0,
+ ModuleInfo1) }
+ ;
+ { TailRecursion = no },
+ { ModuleInfo1 = ModuleInfo0 }
+ ),
+ { module_info_predids(ModuleInfo1, PredIds) },
+ { module_info_get_predicate_table(ModuleInfo1, PredTable0) },
+ { predicate_table_get_preds(PredTable0, PredMap0) },
+ { list__foldl2(transform_predicate(ModuleInfo1),
+ PredIds, PredMap0, PredMap, [], MaybeProcStatics) },
+ % Remove any duplicates that resulted from
+ % references in inner tail recursive procedures
+ { list__filter_map(
+ (pred(MaybeProcStatic::in, ProcStatic::out) is semidet :-
+ MaybeProcStatic = yes(ProcStatic)
+ ), MaybeProcStatics, ProcStatics) },
+ { predicate_table_set_preds(PredTable0, PredMap, PredTable) },
+ { module_info_set_predicate_table(ModuleInfo1, PredTable, ModuleInfo) }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred apply_tail_recursion_transformation(module_info::in, module_info::out)
+ is det.
+
+apply_tail_recursion_transformation(ModuleInfo0, ModuleInfo) :-
+ module_info_ensure_dependency_info(ModuleInfo0, ModuleInfo1),
+ module_info_dependency_info(ModuleInfo1, DepInfo),
+ hlds_dependency_info_get_dependency_ordering(DepInfo, SCCs),
+ list__foldl(apply_tail_recursion_to_scc, SCCs,
+ ModuleInfo1, ModuleInfo).
+
+:- pred apply_tail_recursion_to_scc(list(pred_proc_id)::in,
+ module_info::in, module_info::out) is det.
+
+apply_tail_recursion_to_scc(SCC, ModuleInfo0, ModuleInfo) :-
+ % For the time being, we only look for self-tail-recursive calls.
+ list__foldl(apply_tail_recursion_to_proc, SCC,
+ ModuleInfo0, ModuleInfo).
+
+:- pred apply_tail_recursion_to_proc(pred_proc_id::in,
+ module_info::in, module_info::out) is det.
+
+apply_tail_recursion_to_proc(PredProcId, ModuleInfo0, ModuleInfo) :-
+ PredProcId = proc(PredId, ProcId),
+ module_info_preds(ModuleInfo0, PredTable0),
+ map__lookup(PredTable0, PredId, PredInfo0),
+ pred_info_arg_types(PredInfo0, Types),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ map__lookup(ProcTable0, ProcId, ProcInfo0),
+ proc_info_goal(ProcInfo0, Goal0),
+ proc_info_interface_determinism(ProcInfo0, Detism),
+ (
+ determinism_components(Detism, _CanFail, SolnCount),
+ SolnCount \= at_most_many,
+ proc_info_headvars(ProcInfo0, HeadVars),
+ proc_info_argmodes(ProcInfo0, Modes),
+ find_list_of_output_args(HeadVars, Modes, Types, ModuleInfo0,
+ Outputs),
+ clone_proc_id(ProcTable0, ProcId, CloneProcId),
+ ClonePredProcId = proc(PredId, CloneProcId),
+ ApplyInfo = apply_tail_recursion_info(ModuleInfo0,
+ [PredProcId - ClonePredProcId], Detism, Outputs),
+ apply_tail_recursion_to_goal(Goal0, ApplyInfo,
+ Goal, no, FoundTailCall, _),
+ FoundTailCall = yes
+ ->
+ proc_info_set_goal(ProcInfo0, Goal, ProcInfo1),
+ figure_out_rec_call_numbers(Goal, 0, _N, [], TailCallSites),
+ OrigDeepProfileInfo = deep_profile_proc_info(
+ outer_proc(ClonePredProcId),
+ [visible_scc_data(PredProcId, ClonePredProcId,
+ TailCallSites)]),
+ CloneDeepProfileInfo = deep_profile_proc_info(
+ inner_proc(PredProcId),
+ [visible_scc_data(PredProcId, ClonePredProcId,
+ TailCallSites)]),
+ proc_info_set_maybe_deep_profile_info(ProcInfo1,
+ yes(OrigDeepProfileInfo), ProcInfo),
+ proc_info_set_maybe_deep_profile_info(ProcInfo1,
+ yes(CloneDeepProfileInfo), CloneProcInfo),
+ map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable1),
+ map__det_insert(ProcTable1, CloneProcId, CloneProcInfo,
+ ProcTable),
+ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
+ map__det_update(PredTable0, PredId, PredInfo, PredTable),
+ module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo)
+ ;
+ ModuleInfo = ModuleInfo0
+ ).
+
+:- pred find_list_of_output_args(list(prog_var)::in, list(mode)::in,
+ list(type)::in, module_info::in, list(prog_var)::out) is det.
+
+find_list_of_output_args(Vars, Modes, Types, ModuleInfo, Outputs) :-
+ (
+ find_list_of_output_args_2(Vars, Modes, Types, ModuleInfo,
+ OutputsPrime)
+ ->
+ Outputs = OutputsPrime
+ ;
+ error("find_list_of_output_args: list length mismatch")
+ ).
+
+:- pred find_list_of_output_args_2(list(prog_var)::in, list(mode)::in,
+ list(type)::in, module_info::in, list(prog_var)::out) is semidet.
+
+find_list_of_output_args_2([], [], [], _, []).
+find_list_of_output_args_2([Var | Vars], [Mode | Modes], [Type | Types],
+ ModuleInfo, Outputs) :-
+ find_list_of_output_args_2(Vars, Modes, Types, ModuleInfo, Outputs1),
+ mode_to_arg_mode(ModuleInfo, Mode, Type, ArgMode),
+ ( ArgMode = top_in ->
+ Outputs = Outputs1
+ ;
+ Outputs = [Var | Outputs1]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type apply_tail_recursion_info
+ ---> apply_tail_recursion_info(
+ moduleinfo :: module_info,
+ scc_ppids :: assoc_list(pred_proc_id),
+ detism :: determinism,
+ outputs :: list(prog_var)
+ ).
+
+:- pred apply_tail_recursion_to_goal(hlds_goal::in,
+ apply_tail_recursion_info::in, hlds_goal::out, bool::in, bool::out,
+ maybe(list(prog_var))::out) is det.
+
+apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal,
+ FoundTailCall0, FoundTailCall, Continue) :-
+ Goal0 = GoalExpr0 - GoalInfo0,
+ (
+ GoalExpr0 = foreign_proc(_, _, _, _, _, _, _),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ Continue = no
+ ;
+ GoalExpr0 = call(PredId, ProcId, Args,
+ Builtin, UnifyContext, SymName),
+ (
+ PredProcId = proc(PredId, ProcId),
+ assoc_list__search(ApplyInfo ^ scc_ppids, PredProcId,
+ ClonePredProcId),
+ module_info_pred_proc_info(ApplyInfo ^ moduleinfo,
+ PredId, ProcId, PredInfo, ProcInfo),
+ proc_info_interface_determinism(ProcInfo, CallDetism),
+ CallDetism = ApplyInfo ^ detism,
+ pred_info_arg_types(PredInfo, Types),
+ proc_info_argmodes(ProcInfo, Modes),
+ find_list_of_output_args(Args, Modes, Types,
+ ApplyInfo ^ moduleinfo, CallOutputs),
+ CallOutputs = ApplyInfo ^ outputs,
+ Builtin = not_builtin
+ ->
+ ClonePredProcId = proc(ClonePredId, CloneProcId),
+ GoalExpr = call(ClonePredId, CloneProcId, Args,
+ Builtin, UnifyContext, SymName),
+ goal_info_add_feature(GoalInfo0, tailcall, GoalInfo),
+ Goal = GoalExpr - GoalInfo,
+ FoundTailCall = yes
+ ;
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0
+ ),
+ Continue = no
+ ;
+ GoalExpr0 = generic_call(_, _, _, _),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ Continue = no
+ ;
+ GoalExpr0 = unify(_, _, _, Unify0, _),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ (
+ Unify0 = assign(ToVar, FromVar)
+ ->
+ apply_tail_recursion_process_assign(
+ ApplyInfo ^ outputs, ToVar, FromVar, Outputs),
+ Continue = yes(Outputs)
+ ;
+ Continue = no
+ )
+ ;
+ GoalExpr0 = conj(Goals0),
+ apply_tail_recursion_to_conj(Goals0, ApplyInfo,
+ Goals, FoundTailCall0, FoundTailCall, Continue),
+ GoalExpr = conj(Goals),
+ Goal = GoalExpr - GoalInfo0
+ ;
+ GoalExpr0 = disj(Goals0, SM),
+ apply_tail_recursion_to_disj(Goals0, ApplyInfo,
+ Goals, FoundTailCall0, FoundTailCall),
+ GoalExpr = disj(Goals, SM),
+ Goal = GoalExpr - GoalInfo0,
+ Continue = no
+ ;
+ GoalExpr0 = switch(Var, CanFail, Cases0, SM),
+ apply_tail_recursion_to_cases(Cases0, ApplyInfo,
+ Cases, FoundTailCall0, FoundTailCall),
+ GoalExpr = switch(Var, CanFail, Cases, SM),
+ Goal = GoalExpr - GoalInfo0,
+ Continue = no
+ ;
+ GoalExpr0 = if_then_else(Vars, Cond, Then0, Else0, SM),
+ apply_tail_recursion_to_goal(Then0, ApplyInfo,
+ Then, FoundTailCall0, FoundTailCall1, _),
+ apply_tail_recursion_to_goal(Else0, ApplyInfo,
+ Else, FoundTailCall1, FoundTailCall, _),
+ GoalExpr = if_then_else(Vars, Cond, Then, Else, SM),
+ Goal = GoalExpr - GoalInfo0,
+ Continue = no
+ ;
+ GoalExpr0 = par_conj(_, _),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ Continue = no
+ ;
+ GoalExpr0 = some(_, _, _),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ Continue = no
+ ;
+ GoalExpr0 = not(_),
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall0,
+ Continue = no
+ ;
+ GoalExpr0 = shorthand(_),
+ error("shorthand in apply_tail_recursion_to_goal")
+ ).
+
+:- pred apply_tail_recursion_process_assign(list(prog_var)::in,
+ prog_var::in, prog_var::in, list(prog_var)::out) is det.
+
+apply_tail_recursion_process_assign([], _, _, []).
+apply_tail_recursion_process_assign([Output0 | Outputs0], ToVar, FromVar,
+ [Output | Outputs]) :-
+ ( ToVar = Output0 ->
+ Output = FromVar
+ ;
+ Output = Output0
+ ),
+ apply_tail_recursion_process_assign(Outputs0, ToVar, FromVar, Outputs).
+
+:- pred apply_tail_recursion_to_conj(list(hlds_goal)::in,
+ apply_tail_recursion_info::in, list(hlds_goal)::out,
+ bool::in, bool::out, maybe(list(prog_var))::out) is det.
+
+apply_tail_recursion_to_conj([], ApplyInfo, [],
+ FoundTailCall, FoundTailCall, yes(ApplyInfo ^ outputs)).
+apply_tail_recursion_to_conj([Goal0 | Goals0], ApplyInfo0, [Goal | Goals],
+ FoundTailCall0, FoundTailCall, Continue) :-
+ apply_tail_recursion_to_conj(Goals0, ApplyInfo0, Goals,
+ FoundTailCall0, FoundTailCall1, Continue1),
+ (
+ Continue1 = yes(Outputs),
+ apply_tail_recursion_to_goal(Goal0,
+ ApplyInfo0 ^ outputs := Outputs, Goal,
+ FoundTailCall1, FoundTailCall, Continue)
+ ;
+ Continue1 = no,
+ Goal = Goal0,
+ FoundTailCall = FoundTailCall1,
+ Continue = no
+ ).
+
+:- pred apply_tail_recursion_to_disj(list(hlds_goal)::in,
+ apply_tail_recursion_info::in, list(hlds_goal)::out,
+ bool::in, bool::out) is det.
+
+apply_tail_recursion_to_disj([], _, [], FoundTailCall, FoundTailCall).
+apply_tail_recursion_to_disj([Goal0], ApplyInfo, [Goal],
+ FoundTailCall0, FoundTailCall) :-
+ apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal,
+ FoundTailCall0, FoundTailCall, _).
+apply_tail_recursion_to_disj([Goal0 | Goals0], ApplyInfo, [Goal0 | Goals],
+ FoundTailCall0, FoundTailCall) :-
+ Goals0 = [_ | _],
+ apply_tail_recursion_to_disj(Goals0, ApplyInfo, Goals,
+ FoundTailCall0, FoundTailCall).
+
+:- pred apply_tail_recursion_to_cases(list(case)::in,
+ apply_tail_recursion_info::in, list(case)::out,
+ bool::in, bool::out) is det.
+
+apply_tail_recursion_to_cases([], _,
+ [], FoundTailCall, FoundTailCall).
+apply_tail_recursion_to_cases([case(ConsId, Goal0) | Cases0], ApplyInfo,
+ [case(ConsId, Goal) | Cases], FoundTailCall0, FoundTailCall) :-
+ apply_tail_recursion_to_goal(Goal0, ApplyInfo, Goal,
+ FoundTailCall0, FoundTailCall1, _),
+ apply_tail_recursion_to_cases(Cases0, ApplyInfo, Cases,
+ FoundTailCall1, FoundTailCall).
+
+%-----------------------------------------------------------------------------%
+
+:- pred figure_out_rec_call_numbers(hlds_goal, int, int, list(int), list(int)).
+:- mode figure_out_rec_call_numbers(in, in, out, in, out) is det.
+
+figure_out_rec_call_numbers(Goal, N0, N, TailCallSites0, TailCallSites) :-
+ Goal = GoalExpr - GoalInfo,
+ (
+ GoalExpr = foreign_proc(Attrs, _, _, _, _, _, _),
+ ( may_call_mercury(Attrs, may_call_mercury) ->
+ N = N0 + 1
+ ;
+ N = N0
+ ),
+ TailCallSites = TailCallSites0
+ ;
+ GoalExpr = call(_, _, _, BuiltinState, _, _),
+ goal_info_get_features(GoalInfo, Features),
+ ( BuiltinState \= inline_builtin ->
+ N = N0 + 1
+ ;
+ N = N0
+ ),
+ ( member(tailcall, Features) ->
+ TailCallSites = [N0|TailCallSites0]
+ ;
+ TailCallSites = TailCallSites0
+ )
+ ;
+ GoalExpr = generic_call(_, _, _, _),
+ N = N0 + 1,
+ TailCallSites = TailCallSites0
+ ;
+ GoalExpr = unify(_, _, _, _, _),
+ N = N0,
+ TailCallSites = TailCallSites0
+ ;
+ GoalExpr = conj(Goals),
+ figure_out_rec_call_numbers_in_goal_list(Goals, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = disj(Goals, _),
+ figure_out_rec_call_numbers_in_goal_list(Goals, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = switch(_, _, Cases, _),
+ figure_out_rec_call_numbers_in_case_list(Cases, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = if_then_else(_, Cond, Then, Else, _),
+ figure_out_rec_call_numbers(Cond, N0, N1,
+ TailCallSites0, TailCallSites1),
+ figure_out_rec_call_numbers(Then, N1, N2,
+ TailCallSites1, TailCallSites2),
+ figure_out_rec_call_numbers(Else, N2, N,
+ TailCallSites2, TailCallSites)
+ ;
+ GoalExpr = par_conj(Goals, _),
+ figure_out_rec_call_numbers_in_goal_list(Goals, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = some(_, _, Goal1),
+ figure_out_rec_call_numbers(Goal1, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = not(Goal1),
+ figure_out_rec_call_numbers(Goal1, N0, N,
+ TailCallSites0, TailCallSites)
+ ;
+ GoalExpr = shorthand(_),
+ error("shorthand in apply_tail_recursion_to_goal")
+ ).
+
+:- pred figure_out_rec_call_numbers_in_goal_list(list(hlds_goal), int, int,
+ list(int), list(int)).
+:- mode figure_out_rec_call_numbers_in_goal_list(in, in, out, in, out) is det.
+
+figure_out_rec_call_numbers_in_goal_list([], N, N,
+ TailCallSites, TailCallSites).
+figure_out_rec_call_numbers_in_goal_list([Goal|Goals], N0, N,
+ TailCallSites0, TailCallSites) :-
+ figure_out_rec_call_numbers(Goal, N0, N1,
+ TailCallSites0, TailCallSites1),
+ figure_out_rec_call_numbers_in_goal_list(Goals, N1, N,
+ TailCallSites1, TailCallSites).
+
+:- pred figure_out_rec_call_numbers_in_case_list(list(case), int, int,
+ list(int), list(int)).
+:- mode figure_out_rec_call_numbers_in_case_list(in, in, out, in, out) is det.
+
+figure_out_rec_call_numbers_in_case_list([], N, N,
+ TailCallSites, TailCallSites).
+figure_out_rec_call_numbers_in_case_list([Case|Cases], N0, N,
+ TailCallSites0, TailCallSites) :-
+ Case = case(_, Goal),
+ figure_out_rec_call_numbers(Goal, N0, N1,
+ TailCallSites0, TailCallSites1),
+ figure_out_rec_call_numbers_in_case_list(Cases, N1, N,
+ TailCallSites1, TailCallSites).
+
+%-----------------------------------------------------------------------------%
+
+:- pred transform_predicate(module_info::in, pred_id::in,
+ pred_table::in, pred_table::out,
+ list(maybe(layout_data))::in, list(maybe(layout_data))::out) is det.
+
+transform_predicate(ModuleInfo, PredId, PredMap0, PredMap,
+ ProcStatics0, ProcStatics) :-
+ map__lookup(PredMap0, PredId, PredInfo0),
+ pred_info_non_imported_procids(PredInfo0, ProcIds),
+ pred_info_procedures(PredInfo0, ProcTable0),
+ list__foldl2(maybe_transform_procedure(ModuleInfo, PredId),
+ ProcIds, ProcTable0, ProcTable, ProcStatics0, ProcStatics),
+ pred_info_set_procedures(PredInfo0, ProcTable, PredInfo),
+ map__det_update(PredMap0, PredId, PredInfo, PredMap).
+
+:- pred maybe_transform_procedure(module_info::in, pred_id::in, proc_id::in,
+ proc_table::in, proc_table::out,
+ list(maybe(layout_data))::in, list(maybe(layout_data))::out) is det.
+
+maybe_transform_procedure(ModuleInfo, PredId, ProcId, ProcTable0, ProcTable,
+ ProcStatics0, ProcStatics) :-
+ map__lookup(ProcTable0, ProcId, ProcInfo0),
+ proc_info_goal(ProcInfo0, Goal0),
+ predicate_module(ModuleInfo, PredId, PredModuleName),
+ (
+ % XXX We need to eliminate nondet C code...
+ Goal0 = foreign_proc(_,_,_,_,_,_, Impl) - _,
+ Impl = nondet(_, _, _, _, _, _, _, _, _)
+ ->
+ error("deep profiling is incompatible with nondet foreign code")
+ ;
+ % We don't want to transform the procedures for
+ % managing the deep profiling call graph, or we'd get
+ % infinite recursion.
+ mercury_profiling_builtin_module(PredModuleName)
+ ->
+ ProcTable = ProcTable0,
+ ProcStatics = ProcStatics0
+ ;
+ transform_procedure2(ModuleInfo, proc(PredId, ProcId),
+ ProcInfo0, ProcInfo, ProcStatics0, ProcStatics),
+ map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable)
+ ).
+
+:- pred transform_procedure2(module_info::in, pred_proc_id::in,
+ proc_info::in, proc_info::out,
+ list(maybe(layout_data))::in, list(maybe(layout_data))::out) is det.
+
+transform_procedure2(ModuleInfo, PredProcId, Proc0, Proc,
+ ProcStaticList0, ProcStaticList) :-
+ proc_info_get_maybe_deep_profile_info(Proc0, MaybeRecInfo),
+ proc_info_interface_code_model(Proc0, CodeModel),
+ (
+ CodeModel = model_det,
+ (
+ MaybeRecInfo = yes(RecInfo),
+ RecInfo ^ role = inner_proc(_)
+ ->
+ transform_inner_proc(ModuleInfo, PredProcId, Proc0,
+ Proc, MaybeProcStatic)
+ ;
+ transform_det_proc(ModuleInfo, PredProcId, Proc0,
+ Proc, MaybeProcStatic)
+ )
+ ;
+ CodeModel = model_semi,
+ (
+ MaybeRecInfo = yes(RecInfo),
+ RecInfo ^ role = inner_proc(_)
+ ->
+ transform_inner_proc(ModuleInfo, PredProcId, Proc0,
+ Proc, MaybeProcStatic)
+ ;
+ transform_semi_proc(ModuleInfo, PredProcId, Proc0,
+ Proc, MaybeProcStatic)
+ )
+ ;
+ CodeModel = model_non,
+ transform_non_proc(ModuleInfo, PredProcId, Proc0,
+ Proc, MaybeProcStatic)
+ ),
+ ProcStaticList = [MaybeProcStatic | ProcStaticList0].
+
+%-----------------------------------------------------------------------------%
+
+:- type deep_info --->
+ deep_info(
+ module_info :: module_info,
+ pred_proc_id :: pred_proc_id,
+ current_csd :: prog_var,
+ next_site_num :: int,
+ call_sites :: list(call_site_static_data),
+ vars :: prog_varset,
+ var_types :: vartypes,
+ proc_filename :: string,
+ maybe_rec_info :: maybe(deep_profile_proc_info)
+ ).
+
+:- pred transform_det_proc(module_info::in, pred_proc_id::in,
+ proc_info::in, proc_info::out, maybe(layout_data)::out) is det.
+
+transform_det_proc(ModuleInfo, PredProcId, Proc0, Proc, yes(ProcStatic)) :-
+ proc_info_goal(Proc0, Goal0),
+ Goal0 = _ - GoalInfo0,
+ proc_info_varset(Proc0, Vars0),
+ proc_info_vartypes(Proc0, VarTypes0),
+ CPointerType = c_pointer_type,
+ varset__new_named_var(Vars0, "TopCSD", TopCSD, Vars1),
+ map__set(VarTypes0, TopCSD, CPointerType, VarTypes1),
+ varset__new_named_var(Vars1, "MiddleCSD", MiddleCSD, Vars2),
+ map__set(VarTypes1, MiddleCSD, CPointerType, VarTypes2),
+ varset__new_named_var(Vars2, "ProcStatic", ProcStaticVar, Vars3),
+ map__set(VarTypes2, ProcStaticVar, CPointerType, VarTypes3),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, use_activation_counts,
+ UseActivationCounts),
+ (
+ UseActivationCounts = no,
+ varset__new_named_var(Vars3, "ActivationPtr", ActivationPtr0,
+ Vars5),
+ map__set(VarTypes3, ActivationPtr0, CPointerType, VarTypes5),
+ MaybeActivationPtr = yes(ActivationPtr0)
+ ;
+ UseActivationCounts = yes,
+ Vars5 = Vars3,
+ VarTypes5 = VarTypes3,
+ MaybeActivationPtr = no
+ ),
+ goal_info_get_context(GoalInfo0, Context),
+ 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),
+
+ transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
+
+ Vars = DeepInfo ^ vars,
+ VarTypes = DeepInfo ^ var_types,
+ CallSites = DeepInfo ^ call_sites,
+
+ (
+ MaybeRecInfo = yes(RecInfo),
+ RecInfo ^ role = inner_proc(OuterPredProcId)
+ ->
+ OuterPredProcId = proc(PredId, ProcId)
+ ;
+ PredProcId = proc(PredId, ProcId)
+ ),
+
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId),
+ ProcStatic = proc_static_data(RttiProcLabel, FileName, CallSites),
+ ProcStaticConsId = deep_profiling_proc_static(RttiProcLabel),
+ generate_unify(ProcStaticConsId, ProcStaticVar, BindProcStaticVarGoal),
+
+ (
+ MaybeActivationPtr = yes(ActivationPtr1),
+ generate_call(ModuleInfo, "det_call_port_code_sr", 4,
+ [ProcStaticVar, TopCSD, MiddleCSD, ActivationPtr1],
+ [TopCSD, MiddleCSD, ActivationPtr1], CallPortCode),
+ generate_call(ModuleInfo, "det_exit_port_code_sr", 3,
+ [TopCSD, MiddleCSD, ActivationPtr1], [], ExitPortCode)
+ ;
+ MaybeActivationPtr = no,
+ generate_call(ModuleInfo, "det_call_port_code_ac", 3,
+ [ProcStaticVar, TopCSD, MiddleCSD],
+ [TopCSD, MiddleCSD], CallPortCode),
+ generate_call(ModuleInfo, "det_exit_port_code_ac", 2,
+ [TopCSD, MiddleCSD], [], ExitPortCode)
+ ),
+
+ Goal = conj([
+ BindProcStaticVarGoal,
+ CallPortCode,
+ TransformedGoal,
+ ExitPortCode
+ ]) - GoalInfo0,
+ proc_info_set_varset(Proc0, Vars, Proc1),
+ proc_info_set_vartypes(Proc1, VarTypes, Proc2),
+ proc_info_set_goal(Proc2, Goal, Proc).
+
+:- pred transform_semi_proc(module_info::in, pred_proc_id::in,
+ proc_info::in, proc_info::out, maybe(layout_data)::out) is det.
+
+transform_semi_proc(ModuleInfo, PredProcId, Proc0, Proc, yes(ProcStatic)) :-
+ proc_info_goal(Proc0, Goal0),
+ Goal0 = _ - GoalInfo0,
+ proc_info_varset(Proc0, Vars0),
+ proc_info_vartypes(Proc0, VarTypes0),
+ CPointerType = c_pointer_type,
+ varset__new_named_var(Vars0, "TopCSD", TopCSD, Vars1),
+ map__set(VarTypes0, TopCSD, CPointerType, VarTypes1),
+ varset__new_named_var(Vars1, "MiddleCSD", MiddleCSD, Vars2),
+ map__set(VarTypes1, MiddleCSD, CPointerType, VarTypes2),
+ varset__new_named_var(Vars2, "ProcStatic", ProcStaticVar, Vars3),
+ map__set(VarTypes2, ProcStaticVar, CPointerType, VarTypes3),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, use_activation_counts,
+ UseActivationCounts),
+ (
+ UseActivationCounts = no,
+ varset__new_named_var(Vars3, "ActivationPtr", ActivationPtr0,
+ Vars5),
+ map__set(VarTypes3, ActivationPtr0, CPointerType, VarTypes5),
+ MaybeActivationPtr = yes(ActivationPtr0)
+ ;
+ UseActivationCounts = yes,
+ Vars5 = Vars3,
+ VarTypes5 = VarTypes3,
+ MaybeActivationPtr = no
+ ),
+ goal_info_get_context(GoalInfo0, Context),
+ 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),
+
+ transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
+
+ Vars = DeepInfo ^ vars,
+ VarTypes = DeepInfo ^ var_types,
+ CallSites = DeepInfo ^ call_sites,
+
+ (
+ MaybeRecInfo = yes(RecInfo),
+ RecInfo ^ role = inner_proc(OuterPredProcId)
+ ->
+ OuterPredProcId = proc(PredId, ProcId)
+ ;
+ PredProcId = proc(PredId, ProcId)
+ ),
+
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId),
+ ProcStatic = proc_static_data(RttiProcLabel, FileName, CallSites),
+ ProcStaticConsId = deep_profiling_proc_static(RttiProcLabel),
+ generate_unify(ProcStaticConsId, ProcStaticVar, BindProcStaticVarGoal),
+
+ (
+ MaybeActivationPtr = yes(ActivationPtr1),
+ generate_call(ModuleInfo, "semi_call_port_code_sr", 4,
+ [ProcStaticVar, TopCSD, MiddleCSD, ActivationPtr1],
+ [TopCSD, MiddleCSD, ActivationPtr1], CallPortCode),
+ generate_call(ModuleInfo, "semi_exit_port_code_sr", 3,
+ [TopCSD, MiddleCSD, ActivationPtr1], [], ExitPortCode),
+ generate_call(ModuleInfo, "semi_fail_port_code_sr", 3,
+ [TopCSD, MiddleCSD, ActivationPtr1], no, failure,
+ FailPortCode),
+ NewNonlocals = list_to_set([MiddleCSD, ActivationPtr1])
+ ;
+ MaybeActivationPtr = no,
+ generate_call(ModuleInfo, "semi_call_port_code_ac", 3,
+ [ProcStaticVar, TopCSD, MiddleCSD],
+ [TopCSD, MiddleCSD], CallPortCode),
+ generate_call(ModuleInfo, "semi_exit_port_code_ac", 2,
+ [TopCSD, MiddleCSD], [], ExitPortCode),
+ generate_call(ModuleInfo, "semi_fail_port_code_ac", 2,
+ [TopCSD, MiddleCSD], no, failure, FailPortCode),
+ NewNonlocals = list_to_set([MiddleCSD])
+ ),
+
+ ExitConjGoalInfo = goal_info_add_nonlocals_make_impure(GoalInfo0,
+ NewNonlocals),
+
+ Goal = conj([
+ BindProcStaticVarGoal,
+ CallPortCode,
+ disj([
+ conj([
+ TransformedGoal,
+ ExitPortCode
+ ]) - ExitConjGoalInfo,
+ FailPortCode
+ ], map__init) - ExitConjGoalInfo
+ ]) - GoalInfo0,
+ proc_info_set_varset(Proc0, Vars, Proc1),
+ proc_info_set_vartypes(Proc1, VarTypes, Proc2),
+ proc_info_set_goal(Proc2, Goal, Proc).
+
+:- pred transform_non_proc(module_info::in, pred_proc_id::in,
+ proc_info::in, proc_info::out, maybe(layout_data)::out) is det.
+
+transform_non_proc(ModuleInfo, PredProcId, Proc0, Proc, yes(ProcStatic)) :-
+ proc_info_goal(Proc0, Goal0),
+ Goal0 = _ - GoalInfo0,
+ proc_info_varset(Proc0, Vars0),
+ proc_info_vartypes(Proc0, VarTypes0),
+ CPointerType = c_pointer_type,
+ varset__new_named_var(Vars0, "TopCSD", TopCSD, Vars1),
+ map__set(VarTypes0, TopCSD, CPointerType, VarTypes1),
+ varset__new_named_var(Vars1, "MiddleCSD", MiddleCSD, Vars2),
+ map__set(VarTypes1, MiddleCSD, CPointerType, VarTypes2),
+ varset__new_named_var(Vars2, "ProcStatic", ProcStaticVar, Vars3),
+ map__set(VarTypes2, ProcStaticVar, CPointerType, VarTypes3),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, use_activation_counts,
+ UseActivationCounts),
+ (
+ UseActivationCounts = no,
+ varset__new_named_var(Vars3, "OldOutermost",
+ OldOutermostProcDyn0, Vars4),
+ map__set(VarTypes3, OldOutermostProcDyn0, CPointerType,
+ VarTypes4),
+ varset__new_named_var(Vars4, "NewOutermost",
+ NewOutermostProcDyn, Vars5),
+ map__set(VarTypes4, NewOutermostProcDyn, CPointerType,
+ VarTypes5),
+ MaybeOldActivationPtr = yes(OldOutermostProcDyn0)
+ ;
+ UseActivationCounts = yes,
+ varset__new_named_var(Vars3, "NewOutermost",
+ NewOutermostProcDyn, Vars5),
+ map__set(VarTypes3, NewOutermostProcDyn, CPointerType,
+ VarTypes5),
+ MaybeOldActivationPtr = no
+ ),
+ goal_info_get_context(GoalInfo0, Context),
+ 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),
+
+ transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
+
+ Vars = DeepInfo ^ vars,
+ VarTypes = DeepInfo ^ var_types,
+ CallSites = DeepInfo ^ call_sites,
+
+ PredProcId = proc(PredId, ProcId),
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId),
+ ProcStatic = proc_static_data(RttiProcLabel, FileName, CallSites),
+ ProcStaticConsId = deep_profiling_proc_static(RttiProcLabel),
+ generate_unify(ProcStaticConsId, ProcStaticVar, BindProcStaticVarGoal),
+
+ (
+ MaybeOldActivationPtr = yes(OldOutermostProcDyn2),
+ generate_call(ModuleInfo, "non_call_port_code_sr", 5,
+ [ProcStaticVar, TopCSD, MiddleCSD,
+ OldOutermostProcDyn2, NewOutermostProcDyn],
+ [TopCSD, MiddleCSD,
+ OldOutermostProcDyn2, NewOutermostProcDyn],
+ CallPortCode),
+ generate_call(ModuleInfo, "non_exit_port_code_sr", 3,
+ [TopCSD, MiddleCSD, OldOutermostProcDyn2], [],
+ ExitPortCode),
+ generate_call(ModuleInfo, "non_fail_port_code_sr", 3,
+ [TopCSD, MiddleCSD, OldOutermostProcDyn2], no,
+ failure, FailPortCode),
+ generate_call(ModuleInfo, "non_redo_port_code_sr", 2,
+ [MiddleCSD, NewOutermostProcDyn], no,
+ failure, RedoPortCode),
+ NewNonlocals = list_to_set(
+ [TopCSD, MiddleCSD, OldOutermostProcDyn2])
+ ;
+ MaybeOldActivationPtr = no,
+ generate_call(ModuleInfo, "non_call_port_code_ac", 4,
+ [ProcStaticVar, TopCSD, MiddleCSD, NewOutermostProcDyn],
+ [TopCSD, MiddleCSD, NewOutermostProcDyn],
+ CallPortCode),
+ generate_call(ModuleInfo, "non_exit_port_code_ac", 2,
+ [TopCSD, MiddleCSD], [], ExitPortCode),
+ generate_call(ModuleInfo, "non_fail_port_code_ac", 2,
+ [TopCSD, MiddleCSD], no, failure, FailPortCode),
+ generate_call(ModuleInfo, "non_redo_port_code_ac", 2,
+ [MiddleCSD, NewOutermostProcDyn], no,
+ failure, RedoPortCode),
+ NewNonlocals = list_to_set([TopCSD, MiddleCSD])
+ ),
+
+ % Even though the procedure has a model_non interface determinism,
+ % the actual determinism of its original body goal may have been
+ % at_most once. However, the exit/redo disjunction we insert into
+ % the procedure body means that the procedure body does actually leave
+ % a nondet stack frame when it succeeds, and its determinism must be
+ % adjusted accordingly.
+ goal_info_get_determinism(GoalInfo0, Detism0),
+ determinism_components(Detism0, CanFail, _),
+ determinism_components(Detism, CanFail, at_most_many),
+ goal_info_set_determinism(GoalInfo0, Detism, GoalInfo),
+
+ ExitRedoNonLocals = set__union(NewNonlocals,
+ list_to_set([NewOutermostProcDyn])),
+ ExitRedoGoalInfo = impure_reachable_init_goal_info(ExitRedoNonLocals,
+ multidet),
+
+ CallExitRedoGoalInfo = goal_info_add_nonlocals_make_impure(GoalInfo,
+ ExitRedoNonLocals),
+
+ Goal = conj([
+ BindProcStaticVarGoal,
+ CallPortCode,
+ disj([
+ conj([
+ TransformedGoal,
+ disj([
+ ExitPortCode,
+ RedoPortCode
+ ], map__init) - ExitRedoGoalInfo
+ ]) - CallExitRedoGoalInfo,
+ FailPortCode
+ ], map__init) - CallExitRedoGoalInfo
+ ]) - GoalInfo,
+ proc_info_set_varset(Proc0, Vars, Proc1),
+ proc_info_set_vartypes(Proc1, VarTypes, Proc2),
+ proc_info_set_goal(Proc2, Goal, Proc).
+
+:- pred transform_inner_proc(module_info::in, pred_proc_id::in,
+ proc_info::in, proc_info::out, maybe(layout_data)::out) is det.
+
+transform_inner_proc(ModuleInfo, PredProcId, Proc0, Proc, no) :-
+ proc_info_goal(Proc0, Goal0),
+ Goal0 = _ - GoalInfo0,
+ proc_info_varset(Proc0, Vars0),
+ proc_info_vartypes(Proc0, VarTypes0),
+ CPointerType = c_pointer_type,
+ varset__new_named_var(Vars0, "TopCSD", TopCSD, Vars1),
+ map__set(VarTypes0, TopCSD, CPointerType, VarTypes1),
+ varset__new_named_var(Vars1, "MiddleCSD", MiddleCSD, Vars2),
+ map__set(VarTypes1, MiddleCSD, CPointerType, VarTypes2),
+ varset__new_named_var(Vars2, "ProcStatic", ProcStaticVar, Vars3),
+ map__set(VarTypes2, ProcStaticVar, CPointerType, VarTypes3),
+
+ goal_info_get_context(GoalInfo0, Context),
+ 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),
+
+ transform_goal([], Goal0, TransformedGoal, DeepInfo0, DeepInfo),
+
+ Vars = DeepInfo ^ vars,
+ VarTypes = DeepInfo ^ var_types,
+
+ (
+ MaybeRecInfo = yes(RecInfo),
+ RecInfo ^ role = inner_proc(OuterPredProcId)
+ ->
+ OuterPredProcId = proc(PredId, ProcId)
+ ;
+ error("transform_inner_proc: no rec_info")
+ ),
+
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo, PredId, ProcId),
+ ProcStaticConsId = deep_profiling_proc_static(RttiProcLabel),
+ generate_unify(ProcStaticConsId, ProcStaticVar, BindProcStaticVarGoal),
+
+ generate_call(ModuleInfo, "inner_call_port_code", 2,
+ [ProcStaticVar, MiddleCSD], [MiddleCSD], CallPortCode),
+
+ Goal = conj([
+ BindProcStaticVarGoal,
+ CallPortCode,
+ TransformedGoal
+ ]) - GoalInfo0,
+
+ proc_info_set_varset(Proc0, Vars, Proc1),
+ proc_info_set_vartypes(Proc1, VarTypes, Proc2),
+ proc_info_set_goal(Proc2, Goal, Proc).
+
+%-----------------------------------------------------------------------------%
+
+:- pred transform_goal(goal_path::in, hlds_goal::in, hlds_goal::out,
+ deep_info::in, deep_info::out) is det.
+
+transform_goal(Path, conj(Goals0) - Info, conj(Goals) - Info) -->
+ transform_conj(0, Path, Goals0, Goals).
+
+transform_goal(Path, par_conj(Goals0, SM) - Info,
+ par_conj(Goals, SM) - Info) -->
+ transform_conj(0, Path, Goals0, Goals).
+
+transform_goal(Path, switch(Var, CF, Cases0, SM) - Info,
+ switch(Var, CF, Cases, SM) - Info) -->
+ transform_switch(list__length(Cases0), 0, Path, Cases0, Cases).
+
+transform_goal(Path, disj(Goals0, SM) - Info, disj(Goals, SM) - Info) -->
+ transform_disj(0, Path, Goals0, Goals).
+
+transform_goal(Path, not(Goal0) - Info, not(Goal) - Info) -->
+ transform_goal([neg | Path], Goal0, Goal).
+
+transform_goal(Path, some(QVars, CR, Goal0) - Info,
+ some(QVars, CR, Goal) - Info) -->
+ { Goal0 = _ - InnerInfo },
+ { goal_info_get_determinism(Info, OuterDetism) },
+ { goal_info_get_determinism(InnerInfo, InnerDetism) },
+ { InnerDetism = OuterDetism ->
+ MaybeCut = no_cut
+ ;
+ MaybeCut = cut
+ },
+ transform_goal([exist(MaybeCut) | Path], Goal0, Goal).
+
+transform_goal(Path, if_then_else(IVars, Cond0, Then0, Else0, SM) - Info,
+ if_then_else(IVars, Cond, Then, Else, SM) - Info) -->
+ transform_goal([ite_cond | Path], Cond0, Cond),
+ transform_goal([ite_then | Path], Then0, Then),
+ transform_goal([ite_else | Path], Else0, Else).
+
+transform_goal(_, shorthand(_) - _, _) -->
+ { error("transform_goal/5: shorthand should have gone by now") }.
+
+transform_goal(Path0, Goal0 - Info0, GoalAndInfo) -->
+ { Goal0 = foreign_proc(Attrs, _, _, _, _, _, _) },
+ ( { may_call_mercury(Attrs, may_call_mercury) } ->
+ { reverse(Path0, Path) },
+ wrap_foreign_code(Path, Goal0 - Info0, GoalAndInfo)
+ ;
+ { GoalAndInfo = Goal0 - Info0 }
+ ).
+
+transform_goal(_Path, Goal - Info, Goal - Info) -->
+ { Goal = unify(_, _, _, _, _) }.
+
+transform_goal(Path0, Goal0 - Info0, GoalAndInfo) -->
+ { Goal0 = call(_, _, _, BuiltinState, _, _) },
+ ( { BuiltinState \= inline_builtin } ->
+ { reverse(Path0, Path) },
+ wrap_call(Path, Goal0 - Info0, GoalAndInfo)
+ ;
+ { GoalAndInfo = Goal0 - Info0 }
+ ).
+
+transform_goal(Path0, Goal0 - Info0, GoalAndInfo) -->
+ { Goal0 = generic_call(_, _, _, _) },
+ { reverse(Path0, Path) },
+ wrap_call(Path, Goal0 - Info0, GoalAndInfo).
+
+:- pred transform_conj(int::in, goal_path::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ deep_info::in, deep_info::out) is det.
+
+transform_conj(_, _, [], []) --> [].
+transform_conj(N, Path, [Goal0 | Goals0], [Goal | Goals]) -->
+ transform_goal([conj(N) | Path], Goal0, Goal),
+ transform_conj(N + 1, Path, Goals0, Goals).
+
+:- pred transform_disj(int::in, goal_path::in,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ deep_info::in, deep_info::out) is det.
+
+transform_disj(_, _, [], []) --> [].
+transform_disj(N, Path, [Goal0 | Goals0], [Goal | Goals]) -->
+ transform_goal([disj(N) | Path], Goal0, Goal),
+ transform_disj(N + 1, Path, Goals0, Goals).
+
+:- pred transform_switch(int::in, int::in, goal_path::in,
+ list(case)::in, list(case)::out,
+ deep_info::in, deep_info::out) is det.
+
+transform_switch(_, _, _, [], []) --> [].
+transform_switch(NumCases, N, Path, [case(Id, Goal0) | Goals0],
+ [case(Id, Goal) | Goals]) -->
+ transform_goal([switch(NumCases, N) | Path], Goal0, Goal),
+ transform_switch(NumCases, N + 1, Path, Goals0, Goals).
+
+:- pred wrap_call(goal_path::in, hlds_goal::in, hlds_goal::out,
+ deep_info::in, deep_info::out) is det.
+
+wrap_call(GoalPath, Goal0, Goal, DeepInfo0, DeepInfo) :-
+ Goal0 = GoalExpr - GoalInfo0,
+ ModuleInfo = DeepInfo0 ^ module_info,
+ MiddleCSD = DeepInfo0 ^ current_csd,
+
+ goal_info_get_nonlocals(GoalInfo0, NonLocals0),
+ goal_info_get_features(GoalInfo0, GoalFeatures),
+ NewNonlocals = set__make_singleton_set(MiddleCSD),
+ NonLocals = union(NonLocals0, NewNonlocals),
+ goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
+ goal_info_remove_feature(GoalInfo1, tailcall, GoalInfo),
+
+ SiteNum = DeepInfo0 ^ next_site_num,
+ 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,
+
+ goal_info_get_context(GoalInfo0, Context),
+ FileName0 = term__context_file(Context),
+ LineNumber = term__context_line(Context),
+ compress_filename(DeepInfo2, 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,
+ (
+ MaybeRecInfo = yes(RecInfo1),
+ RecInfo1 ^ role = inner_proc(OuterPredProcId),
+ PredProcId = DeepInfo2 ^ pred_proc_id
+ ->
+ OuterPredProcId = proc(OuterPredId, OuterProcId),
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo,
+ OuterPredId, OuterProcId)
+ ;
+ MaybeRecInfo = yes(RecInfo2),
+ RecInfo2 ^ role = outer_proc(InnerPredProcId),
+ PredProcId = InnerPredProcId
+ ->
+ OuterPredProcId = DeepInfo2 ^ pred_proc_id,
+ OuterPredProcId = proc(OuterPredId, OuterProcId),
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo,
+ OuterPredId, OuterProcId)
+ ;
+ RttiProcLabel = rtti__make_proc_label(ModuleInfo,
+ PredId, ProcId)
+ ),
+ CallSite = normal_call(RttiProcLabel, TypeSubst,
+ FileName, LineNumber, GoalPath),
+ Goal1 = Goal0,
+ DeepInfo3 = DeepInfo2
+ ;
+ 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
+ ;
+ CallKind = generic(Generic),
+ generate_call(ModuleInfo, "prepare_for_ho_call", 3,
+ [MiddleCSD, SiteNumVar, ClosureVar], [], PrepareGoal),
+ (
+ Generic = higher_order(ClosureVar, _, _),
+ CallSite = higher_order_call(FileName, LineNumber,
+ GoalPath)
+ ;
+ Generic = class_method(ClosureVar, _, _, _),
+ CallSite = method_call(FileName, LineNumber, GoalPath)
+ ;
+ Generic = aditi_builtin(_, _),
+ error("deep profiling and aditi do not mix")
+ ),
+ goal_info_get_code_model(GoalInfo0, GoalCodeModel),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals,
+ use_zeroing_for_ho_cycles, UseZeroing),
+ ( UseZeroing = yes ->
+ transform_higher_order_call(Globals, GoalCodeModel,
+ Goal0, Goal1, DeepInfo2, DeepInfo3)
+ ;
+ Goal1 = Goal0,
+ DeepInfo3 = DeepInfo2
+ )
+ ),
+ DeepInfo4 = DeepInfo3 ^ next_site_num := SiteNum + 1,
+ DeepInfo5 = DeepInfo4 ^ call_sites :=
+ DeepInfo4 ^ call_sites ++ [CallSite],
+ (
+ member(tailcall, GoalFeatures),
+ DeepInfo5 ^ maybe_rec_info = yes(RecInfo),
+ RecInfo ^ role = outer_proc(_)
+ ->
+ generate_recursion_counter_saves_and_restores(
+ MiddleCSD, RecInfo ^ visible_scc,
+ BeforeGoals, ExitGoals, FailGoals, ExtraVarList,
+ DeepInfo5, DeepInfo),
+ generate_call(ModuleInfo, "set_current_csd", 1,
+ [MiddleCSD], [], ReturnGoal),
+
+ goal_info_get_code_model(GoalInfo, CodeModel),
+ ( CodeModel = model_det ->
+ condense([
+ BeforeGoals,
+ [SiteNumVarGoal, PrepareGoal, Goal1,
+ ReturnGoal],
+ ExitGoals
+ ], Goals),
+ Goal = conj(Goals) - GoalInfo
+ ;
+ ExtraVars = list_to_set(ExtraVarList),
+ WrappedGoalGoalInfo =
+ goal_info_add_nonlocals_make_impure(GoalInfo,
+ ExtraVars),
+
+ insert(ExtraVars, MiddleCSD, ReturnFailsNonLocals),
+ ReturnFailsGoalInfo =
+ impure_unreachable_init_goal_info(
+ ReturnFailsNonLocals, failure),
+
+ FailGoalInfo = fail_goal_info,
+ FailGoal = disj([], init) - FailGoalInfo,
+
+ append(FailGoals, [FailGoal], FailGoalsAndFail),
+
+ condense([
+ BeforeGoals,
+ [disj([
+ conj([
+ SiteNumVarGoal,
+ PrepareGoal,
+ Goal1,
+ ReturnGoal |
+ ExitGoals
+ ]) - WrappedGoalGoalInfo,
+ conj([
+ ReturnGoal |
+ FailGoalsAndFail
+ ]) - ReturnFailsGoalInfo
+ ], init) - WrappedGoalGoalInfo]
+ ], Goals),
+ Goal = conj(Goals) - GoalInfo
+ )
+ ;
+ Goal = conj([
+ SiteNumVarGoal,
+ PrepareGoal,
+ Goal1
+ ]) - GoalInfo,
+ DeepInfo = DeepInfo5
+ ).
+
+:- pred transform_higher_order_call(globals::in, code_model::in,
+ hlds_goal::in, hlds_goal::out, deep_info::in, deep_info::out) is det.
+
+transform_higher_order_call(Globals, CodeModel, Goal0, Goal,
+ DeepInfo0, DeepInfo) :-
+ Vars0 = DeepInfo0 ^ vars,
+ VarTypes0 = DeepInfo0 ^ var_types,
+
+ CPointerType = c_pointer_type,
+ varset__new_named_var(Vars0, "SavedPtr", SavedPtrVar, Vars1),
+ map__set(VarTypes0, SavedPtrVar, CPointerType, VarTypes1),
+
+ globals__lookup_bool_option(Globals, use_activation_counts,
+ UseActivationCounts),
+ (
+ UseActivationCounts = yes,
+
+ IntType = int_type,
+ varset__new_named_var(Vars1, "SavedCounter", SavedCountVar,
+ Vars),
+ map__set(VarTypes1, SavedCountVar, IntType, VarTypes),
+
+ DeepInfo1 = DeepInfo0 ^ vars := Vars,
+ DeepInfo = DeepInfo1 ^ var_types := VarTypes,
+ MiddleCSD = DeepInfo ^ current_csd,
+ ExtraNonLocals = set__list_to_set(
+ [MiddleCSD, SavedCountVar, SavedPtrVar]),
+
+ generate_call(DeepInfo ^ module_info,
+ "save_and_zero_activation_info_ac", 3,
+ [MiddleCSD, SavedCountVar, SavedPtrVar],
+ [SavedCountVar, SavedPtrVar], SaveStuff),
+ generate_call(DeepInfo ^ module_info,
+ "reset_activation_info_ac", 3,
+ [MiddleCSD, SavedCountVar, SavedPtrVar], [],
+ RestoreStuff),
+ generate_call(DeepInfo ^ module_info,
+ "rezero_activation_info_ac", 1,
+ [MiddleCSD], [], ReZeroStuff)
+ ;
+ UseActivationCounts = no,
+
+ DeepInfo1 = DeepInfo0 ^ vars := Vars1,
+ DeepInfo = DeepInfo1 ^ var_types := VarTypes1,
+ MiddleCSD = DeepInfo ^ current_csd,
+ ExtraNonLocals = set__list_to_set([MiddleCSD, SavedPtrVar]),
+
+ generate_call(DeepInfo ^ module_info,
+ "save_and_zero_activation_info_sr", 2,
+ [MiddleCSD, SavedPtrVar],
+ [SavedPtrVar], SaveStuff),
+ generate_call(DeepInfo ^ module_info,
+ "reset_activation_info_sr", 2,
+ [MiddleCSD, SavedPtrVar], [],
+ RestoreStuff),
+ generate_call(DeepInfo ^ module_info,
+ "rezero_activation_info_sr", 1,
+ [MiddleCSD], [], ReZeroStuff)
+ ),
+
+ Goal0 = _ - GoalInfo0,
+ ExtGoalInfo = goal_info_add_nonlocals_make_impure(GoalInfo0,
+ ExtraNonLocals),
+
+ % XXX We should build up NoBindExtGoalInfo from scratch.
+ instmap_delta_init_reachable(EmptyDelta),
+ goal_info_set_instmap_delta(ExtGoalInfo, EmptyDelta,
+ NoBindExtGoalInfo),
+
+ FailGoalInfo = fail_goal_info,
+ FailGoal = disj([], init) - FailGoalInfo,
+
+ RestoreFailGoalInfo = impure_unreachable_init_goal_info(ExtraNonLocals,
+ failure),
+
+ RezeroFailGoalInfo = impure_unreachable_init_goal_info(
+ list_to_set([MiddleCSD]), failure),
+
+ goal_info_add_feature(GoalInfo0, impure, GoalInfo),
+ (
+ CodeModel = model_det,
+ Goal = conj([
+ SaveStuff,
+ Goal0,
+ RestoreStuff
+ ]) - GoalInfo
+ ;
+ CodeModel = model_semi,
+ Goal = conj([
+ SaveStuff,
+ disj([
+ conj([
+ Goal0,
+ RestoreStuff
+ ]) - ExtGoalInfo,
+ conj([
+ RestoreStuff,
+ FailGoal
+ ]) - RestoreFailGoalInfo
+ ], init) - ExtGoalInfo
+ ]) - GoalInfo
+ ;
+ CodeModel = model_non,
+ Goal = conj([
+ SaveStuff,
+ disj([
+ conj([
+ Goal0,
+ disj([
+ RestoreStuff,
+ conj([
+ ReZeroStuff,
+ FailGoal
+ ]) - RezeroFailGoalInfo
+ ], init) - NoBindExtGoalInfo
+ ]) - ExtGoalInfo,
+ conj([
+ RestoreStuff,
+ FailGoal
+ ]) - RestoreFailGoalInfo
+ ], init) - ExtGoalInfo
+ ]) - GoalInfo
+ ).
+
+:- pred wrap_foreign_code(goal_path::in, hlds_goal::in, hlds_goal::out,
+ deep_info::in, deep_info::out) is det.
+
+wrap_foreign_code(GoalPath, Goal0, Goal, DeepInfo0, DeepInfo) :-
+ Goal0 = _ - GoalInfo0,
+ ModuleInfo = DeepInfo0 ^ module_info,
+ MiddleCSD = DeepInfo0 ^ current_csd,
+
+ goal_info_get_nonlocals(GoalInfo0, NonLocals0),
+ NewNonlocals = set__make_singleton_set(MiddleCSD),
+ NonLocals = union(NonLocals0, NewNonlocals),
+ goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
+
+ SiteNum = DeepInfo0 ^ next_site_num,
+ 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),
+
+ generate_call(ModuleInfo, "prepare_for_callback", 2,
+ [MiddleCSD, SiteNumVar], [], PrepareGoal),
+
+ goal_info_get_context(GoalInfo0, Context),
+ LineNumber = term__context_line(Context),
+ FileName0 = term__context_file(Context),
+ compress_filename(DeepInfo0, FileName0, FileName),
+ CallSite = callback(FileName, LineNumber, GoalPath),
+
+ Goal = conj([
+ SiteNumVarGoal,
+ 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.
+
+:- pred compress_filename(deep_info::in, string::in, string::out) is det.
+
+compress_filename(Deep, FileName0, FileName) :-
+ ( FileName0 = Deep ^ proc_filename ->
+ FileName = ""
+ ;
+ FileName = FileName0
+ ).
+
+:- type call_class
+ % For normal first order calls
+ ---> normal(pred_proc_id)
+ % For calls to unify/2 and compare/3
+ ; special(pred_proc_id, prog_var)
+ % For higher order and typeclass method calls
+ ; generic(generic_call).
+
+:- pred classify_call(module_info::in, hlds_goal_expr::in,
+ call_class::out) is det.
+
+classify_call(ModuleInfo, Expr, Class) :-
+ ( Expr = call(PredId, ProcId, Args, _, _, _) ->
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ mercury_public_builtin_module(MercuryBuiltin),
+ (
+ predicate_table_search_pred_m_n_a(PredTable,
+ MercuryBuiltin, "unify", 2, [PredId]),
+ Args = [TypeInfoVar | _]
+ ->
+ Class = special(proc(PredId, ProcId), TypeInfoVar)
+ ;
+ predicate_table_search_pred_m_n_a(PredTable,
+ MercuryBuiltin, "compare", 3, [PredId]),
+ Args = [TypeInfoVar | _]
+ ->
+ Class = special(proc(PredId, ProcId), TypeInfoVar)
+ ;
+ Class = normal(proc(PredId, ProcId))
+ )
+ ; Expr = generic_call(Generic, _, _, _) ->
+ Class = generic(Generic)
+ ;
+ error("unexpected goal type in classify_call/2")
+ ).
+
+:- func compute_type_subst(hlds_goal_expr, deep_info) = string.
+
+% 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
+ ).
+
+:- 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_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).
+
+:- pred generate_call(module_info::in, string::in, int::in,
+ list(prog_var)::in, list(prog_var)::in, hlds_goal::out) is det.
+
+generate_call(ModuleInfo, Name, Arity, ArgVars, OutputVars, Goal) :-
+ generate_call(ModuleInfo, Name, Arity, ArgVars, yes(OutputVars),
+ det, Goal).
+
+:- pred generate_call(module_info::in, string::in, int::in, list(prog_var)::in,
+ maybe(list(prog_var))::in, determinism::in, hlds_goal::out) is det.
+
+generate_call(ModuleInfo, Name, Arity, ArgVars, MaybeOutputVars, Detism,
+ Goal) :-
+ get_deep_profile_builtin_ppid(ModuleInfo, Name, Arity, PredId, ProcId),
+ NonLocals = list_to_set(ArgVars),
+ Ground = ground(shared, none),
+ (
+ MaybeOutputVars = yes(OutputVars),
+ map((pred(V::in, P::out) is det :-
+ P = V - Ground
+ ), OutputVars, OutputInsts),
+ instmap_delta_from_assoc_list(OutputInsts, InstMapDelta)
+ ;
+ MaybeOutputVars = no,
+ instmap_delta_init_unreachable(InstMapDelta)
+ ),
+ GoalInfo = impure_init_goal_info(NonLocals, InstMapDelta, Detism),
+ Goal = call(PredId, ProcId, ArgVars, not_builtin, no,
+ unqualified(Name)) - GoalInfo.
+
+:- pred generate_unify(cons_id::in, prog_var::in, hlds_goal::out) is det.
+
+generate_unify(ConsId, Var, Goal) :-
+ Ground = ground(shared, none),
+ NonLocals = set__make_singleton_set(Var),
+ instmap_delta_from_assoc_list([Var - ground(shared, none)],
+ InstMapDelta),
+ Determinism = det,
+ goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo),
+ Goal = unify(Var, functor(ConsId, []),
+ (free -> Ground) - (Ground -> Ground),
+ construct(Var, ConsId, [], [], construct_statically([]),
+ cell_is_shared, no),
+ unify_context(explicit, [])) - GoalInfo.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred get_deep_profile_builtin_ppid(module_info::in, string::in, int::in,
+ pred_id::out, proc_id::out) is det.
+
+get_deep_profile_builtin_ppid(ModuleInfo, Name, Arity, PredId, ProcId) :-
+ mercury_profiling_builtin_module(ModuleName),
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ (
+ predicate_table_search_pred_m_n_a(PredTable,
+ ModuleName, Name, Arity, PredIds)
+ ->
+ (
+ PredIds = [],
+ error("get_deep_profile_builtin_ppid: no pred_id")
+ ;
+ PredIds = [PredId],
+ predicate_table_get_preds(PredTable, Preds),
+ lookup(Preds, PredId, PredInfo),
+ pred_info_procids(PredInfo, ProcIds),
+ (
+ ProcIds = [],
+ error("get_deep_profile_builtin_ppid: no proc_id")
+ ;
+ ProcIds = [ProcId]
+ ;
+ ProcIds = [_, _ | _],
+ error("get_deep_profile_builtin_ppid: proc_id not unique")
+ )
+ ;
+ PredIds = [_, _ | _],
+ error("get_deep_profile_builtin_ppid: pred_id not unique")
+ )
+ ;
+ format("couldn't find pred_id for `%s'/%d",
+ [s(Name), i(Arity)], Msg),
+ error(Msg)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func impure_init_goal_info(set(prog_var), instmap_delta, determinism)
+ = hlds_goal_info.
+
+impure_init_goal_info(NonLocals, InstMapDelta, Determinism) = GoalInfo :-
+ goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo0),
+ goal_info_add_feature(GoalInfo0, impure, GoalInfo).
+
+:- func impure_reachable_init_goal_info(set(prog_var), determinism)
+ = hlds_goal_info.
+
+impure_reachable_init_goal_info(NonLocals, Determinism) = GoalInfo :-
+ instmap_delta_init_reachable(InstMapDelta),
+ goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo0),
+ goal_info_add_feature(GoalInfo0, impure, GoalInfo).
+
+:- func impure_unreachable_init_goal_info(set(prog_var), determinism)
+ = hlds_goal_info.
+
+impure_unreachable_init_goal_info(NonLocals, Determinism) = GoalInfo :-
+ instmap_delta_init_unreachable(InstMapDelta),
+ goal_info_init(NonLocals, InstMapDelta, Determinism, GoalInfo0),
+ goal_info_add_feature(GoalInfo0, impure, GoalInfo).
+
+:- func goal_info_add_nonlocals_make_impure(hlds_goal_info, set(prog_var))
+ = hlds_goal_info.
+
+goal_info_add_nonlocals_make_impure(GoalInfo0, NewNonLocals) = GoalInfo :-
+ goal_info_get_nonlocals(GoalInfo0, NonLocals0),
+ NonLocals = set__union(NonLocals0, NewNonLocals),
+ goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo1),
+ goal_info_add_feature(GoalInfo1, impure, GoalInfo).
+
+:- func fail_goal_info = hlds_goal_info.
+
+fail_goal_info = GoalInfo :-
+ instmap_delta_init_unreachable(InstMapDelta),
+ goal_info_init(set__init, InstMapDelta, failure, GoalInfo).
+
+%-----------------------------------------------------------------------------%
Index: compiler/dependency_graph.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dependency_graph.m,v
retrieving revision 1.53
diff -u -b -r1.53 dependency_graph.m
--- compiler/dependency_graph.m 2001/04/07 14:04:34 1.53
+++ compiler/dependency_graph.m 2001/05/03 06:41:03
@@ -433,6 +433,8 @@
_Caller, DepGraph, DepGraph).
dependency_graph__add_arcs_in_cons(tabling_pointer_const(_, _),
_Caller, DepGraph, DepGraph).
+dependency_graph__add_arcs_in_cons(deep_profiling_proc_static(_),
+ _Caller, DepGraph, DepGraph).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.46
diff -u -b -r1.46 export.m
--- compiler/export.m 2001/02/05 08:01:40 1.46
+++ compiler/export.m 2001/05/03 06:41:03
@@ -140,6 +140,11 @@
% #if MR_THREAD_SAFE
% MR_Bool must_finalize_engine;
% #endif
+ % #if MR_DEEP_PROFILING
+ % MR_CallSiteDynamic *saved_call_site_addr
+ % = MR_current_callback_site;
+ % MR_CallSiteDynamic *saved_csd;
+ % #endif
%
% /* save the registers that our C caller may be using */
% MR_save_regs_to_mem(c_regs);
@@ -154,6 +159,10 @@
% must_finalize_engine = MR_init_thread(MR_use_now);
% #endif
%
+ % #if MR_DEEP_PROFILING
+ % saved_csd = MR_current_call_site_dynamic;
+ % MR_setup_callback(MR_ENTRY(<label of called proc>));
+ % #endif
% /*
% ** restore Mercury's registers that were saved as
% ** we entered C from Mercury. For single threaded
@@ -174,6 +183,10 @@
% /* clobbered by the return from the C function */
% /* MR_call_engine() */
% MR_restore_transient_registers();
+ % #if MR_DEEP_PROFILING
+ % MR_current_call_site_dynamic = saved_csd;
+ % MR_current_callback_site = saved_call_site_addr;
+ % #endif
% #if SEMIDET
% if (!MR_r1) {
% MR_restore_regs_from_mem(c_regs);
@@ -216,7 +229,8 @@
code_util__make_proc_label(Module, PredId, ProcId, ProcLabel),
llds_out__get_proc_label(ProcLabel, yes, ProcLabelString),
- string__append_list([ "\n",
+ string__append_list([
+ "\n",
DeclareString, "(", ProcLabelString, ");\n",
"\n",
C_RetType, "\n",
@@ -227,18 +241,31 @@
"#if MR_THREAD_SAFE\n",
"\tMR_Bool must_finalize_engine;\n",
"#endif\n",
+ "#if MR_DEEP_PROFILING\n",
+ "\tMR_CallSiteDynList **saved_cur_callback;\n",
+ "\tMR_CallSiteDynamic *saved_cur_csd;\n",
+ "#endif\n",
MaybeDeclareRetval,
"\n",
"\tMR_save_regs_to_mem(c_regs);\n",
"#if MR_THREAD_SAFE\n",
"\tmust_finalize_engine = MR_init_thread(MR_use_now);\n",
"#endif\n",
+ "#if MR_DEEP_PROFILING\n",
+ "\tsaved_cur_callback = MR_current_callback_site;\n",
+ "\tsaved_cur_csd = MR_current_call_site_dynamic;\n",
+ "\tMR_setup_callback(MR_ENTRY(", ProcLabelString, "));\n",
+ "#endif\n",
"\tMR_restore_registers();\n",
InputArgs,
"\tMR_save_transient_registers();\n",
"\t(void) MR_call_engine(MR_ENTRY(",
ProcLabelString, "), FALSE);\n",
"\tMR_restore_transient_registers();\n",
+ "#if MR_DEEP_PROFILING\n",
+ "\tMR_current_call_site_dynamic = saved_cur_csd;\n",
+ "\tMR_current_callback_site = saved_cur_callback;\n",
+ "#endif\n",
MaybeFail,
OutputArgs,
"#if MR_THREAD_SAFE\n",
@@ -551,6 +578,9 @@
"\n",
"#ifndef MERCURY_HDR_EXCLUDE_IMP_H\n",
"#include ""mercury_imp.h""\n",
+ "#endif\n",
+ "#ifdef MR_DEEP_PROFILING\n",
+ "#include ""mercury_deep_profiling.h""\n",
"#endif\n",
"\n"]),
export__produce_header_file_2(C_ExportDecls),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.109
diff -u -b -r1.109 handle_options.m
--- compiler/handle_options.m 2001/05/15 07:11:20 1.109
+++ compiler/handle_options.m 2001/05/15 07:16:59
@@ -492,8 +492,39 @@
[]
),
- % Deep profiling requires `procid' stack layouts
- option_implies(profile_deep, procid_stack_layout, bool(yes)),
+ % Deep profiling will eventually use `procid' stack layouts,
+ % but for now, we use a separate copy of each MR_Proc_Id structure.
+ % option_implies(profile_deep, procid_stack_layout, bool(yes)),
+ globals__io_lookup_bool_option(profile_deep, ProfileDeep),
+ globals__io_lookup_bool_option(highlevel_code, HighLevel),
+ ( { ProfileDeep = yes } ->
+ (
+ { HighLevel = no },
+ { Target = c }
+ ->
+ []
+ ;
+ usage_error(
+ "deep profiling is supported only LLDS grades")
+ ),
+ globals__io_lookup_bool_option(
+ use_lots_of_ho_specialization, LotsOfHOSpec),
+ ( { LotsOfHOSpec = yes } ->
+ { True = bool(yes) },
+ globals__io_set_option(optimize_higher_order, True),
+ globals__io_set_option(higher_order_size_limit,
+ int(999999))
+ ;
+ []
+ )
+ ;
+ []
+ ),
+
+ % 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)),
% --no-reorder-conj implies --no-deforestation.
option_neg_implies(reorder_conj, deforestation, bool(no)),
@@ -673,7 +704,6 @@
[s(UseForeignLanguage)]))
),
- globals__io_lookup_bool_option(highlevel_code, HighLevel),
( { HighLevel = no } ->
postprocess_options_lowlevel
;
@@ -1000,24 +1030,24 @@
grade_component_table("agc", gc, [gc - string("accurate")]).
% Profiling components
-grade_component_table("prof", prof, [profile_time - bool(yes),
- profile_deep - bool(no), profile_calls - bool(yes),
- profile_memory - bool(no)]).
-grade_component_table("profdeep", prof, [profile_time - bool(yes),
- profile_deep - bool(yes), profile_calls - bool(no),
- profile_memory - bool(no)]).
-grade_component_table("proftime", prof, [profile_time - bool(yes),
- profile_deep - bool(no), profile_calls - bool(no),
- profile_memory - bool(no)]).
-grade_component_table("profcalls", prof, [profile_time - bool(no),
- profile_deep - bool(no), profile_calls - bool(yes),
- profile_memory - bool(no)]).
-grade_component_table("memprof", prof, [profile_time - bool(no),
- profile_deep - bool(no), profile_calls - bool(yes),
- profile_memory - bool(yes)]).
-grade_component_table("profall", prof, [profile_time - bool(yes),
- profile_deep - bool(no), profile_calls - bool(yes),
- profile_memory - bool(yes)]).
+grade_component_table("prof", prof,
+ [profile_time - bool(yes), profile_calls - bool(yes),
+ profile_memory - bool(no), profile_deep - bool(no)]).
+grade_component_table("proftime", prof,
+ [profile_time - bool(yes), profile_calls - bool(no),
+ profile_memory - bool(no), profile_deep - bool(no)]).
+grade_component_table("profcalls", prof,
+ [profile_time - bool(no), profile_calls - bool(yes),
+ profile_memory - bool(no), profile_deep - bool(no)]).
+grade_component_table("memprof", prof,
+ [profile_time - bool(no), profile_calls - bool(yes),
+ profile_memory - bool(yes), profile_deep - bool(no)]).
+grade_component_table("profall", prof,
+ [profile_time - bool(yes), profile_calls - bool(yes),
+ profile_memory - bool(yes), profile_deep - bool(no)]).
+grade_component_table("profdeep", prof,
+ [profile_time - bool(no), profile_calls - bool(no),
+ profile_memory - bool(no), profile_deep - bool(yes)]).
% Trailing components
grade_component_table("tr", trail, [use_trail - bool(yes)]).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.85
diff -u -b -r1.85 higher_order.m
--- compiler/higher_order.m 2001/04/07 14:04:37 1.85
+++ compiler/higher_order.m 2001/05/03 06:41:03
@@ -2248,10 +2248,20 @@
pred_info_arg_types(PredInfo0, ArgTVarSet, ExistQVars, Types),
( IsUserTypeSpec = yes ->
- % If this is a user-guided type specialisation, the
- % new name comes from the name of the requesting predicate.
+ % If this is a user-guided type specialisation, the new name
+ % comes from the name and mode number of the requesting
+ % predicate. The mode number is included because we want to
+ % avoid the creation of more than one predicate with the same
+ % name if more than one mode of a predicate is specialized.
+ % Since the names of e.g. deep profiling proc_static structures
+ % are derived from the names of predicates, duplicate predicate
+ % names lead to duplicate global variable names and hence to
+ % link errors.
Caller = proc(CallerPredId, CallerProcId),
- predicate_name(ModuleInfo0, CallerPredId, PredName),
+ predicate_name(ModuleInfo0, CallerPredId, PredName0),
+ proc_id_to_int(CallerProcId, CallerProcInt),
+ PredName = string__append_list(
+ [PredName0, "_", int_to_string(CallerProcInt)]),
SymName = qualified(PredModule, PredName),
NextHOid = NextHOid0,
NewProcId = CallerProcId,
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.54
diff -u -b -r1.54 hlds_data.m
--- compiler/hlds_data.m 2001/05/02 17:34:32 1.54
+++ compiler/hlds_data.m 2001/05/03 06:44:11
@@ -13,8 +13,8 @@
:- interface.
-:- import_module hlds_pred, prog_data, (inst), term.
-:- import_module bool, list, map, std_util.
+:- import_module hlds_pred, prog_data, (inst), rtti.
+:- import_module bool, list, map, std_util, term.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -54,7 +54,7 @@
% that points to the table that implements
% memoization, loop checking or the minimal
% model semantics for the given procedure.
- .
+ ; deep_profiling_proc_static(rtti_proc_label).
% A cons_defn is the definition of a constructor (i.e. a constant
% or a functor) for a particular type.
@@ -187,6 +187,9 @@
error("cons_id_arity: can't get arity of base_typeclass_info_const").
cons_id_arity(tabling_pointer_const(_, _), _) :-
error("cons_id_arity: can't get arity of tabling_pointer_const").
+cons_id_arity(deep_profiling_proc_static(_), _) :-
+ error("cons_id_arity: can't get arity of deep_profiling_proc_static").
+
cons_id_maybe_arity(cons(_, Arity), yes(Arity)).
cons_id_maybe_arity(int_const(_), yes(0)).
@@ -197,6 +200,7 @@
cons_id_maybe_arity(type_ctor_info_const(_, _, _), no) .
cons_id_maybe_arity(base_typeclass_info_const(_, _, _, _), no).
cons_id_maybe_arity(tabling_pointer_const(_, _), no).
+cons_id_maybe_arity(deep_profiling_proc_static(_), no).
make_functor_cons_id(term__atom(Name), Arity,
cons(unqualified(Name), Arity)).
@@ -348,6 +352,9 @@
% represented as global data. The word just contains
% the address of the tabling pointer of the
% specified procedure.
+ ; deep_profiling_proc_static_tag(rtti_proc_label)
+ % This is for constants representing procedure
+ % descriptions for deep profiling.
; unshared_tag(tag_bits)
% This is for constants or functors which can be
% distinguished with just a primary tag.
Index: compiler/hlds_goal.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_goal.m,v
retrieving revision 1.87
diff -u -b -r1.87 hlds_goal.m
--- compiler/hlds_goal.m 2001/04/07 14:04:39 1.87
+++ compiler/hlds_goal.m 2001/05/03 06:41:03
@@ -707,12 +707,14 @@
% for the definition of this.
; (impure) % This goal is impure. See hlds_pred.m.
; (semipure) % This goal is semipure. See hlds_pred.m.
- ; call_table_gen. % This goal generates the variable that
+ ; call_table_gen % This goal generates the variable that
% represents the call table tip. If debugging
% is enabled, the code generator needs to save
% the value of this variable in its stack slot
% as soon as it is generated; this marker
% tells the code generator when this happens.
+ ; tailcall. % This goal represents a tail call. This marker
+ % is used by deep profiling.
% We can think of the goal that defines a procedure to be a tree,
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.258
diff -u -b -r1.258 hlds_out.m
--- compiler/hlds_out.m 2001/04/07 14:04:40 1.258
+++ compiler/hlds_out.m 2001/05/03 06:41:03
@@ -251,7 +251,7 @@
% HLDS modules.
:- import_module mercury_to_mercury, purity, special_pred, instmap.
-:- import_module termination, term_errors, check_typeclass.
+:- import_module termination, term_errors, check_typeclass, rtti.
% RL back-end modules (XXX should avoid using those here).
:- import_module rl.
@@ -306,6 +306,8 @@
"<base_typeclass_info>").
hlds_out__cons_id_to_string(tabling_pointer_const(_, _),
"<tabling_pointer>").
+hlds_out__cons_id_to_string(deep_profiling_proc_static(_),
+ "<deep_profiling_proc_static>").
hlds_out__write_cons_id(cons(SymName, Arity)) -->
prog_out__write_sym_name_and_arity(SymName / Arity).
@@ -325,6 +327,8 @@
io__write_string("<base_typeclass_info>").
hlds_out__write_cons_id(tabling_pointer_const(_, _)) -->
io__write_string("<tabling_pointer>").
+hlds_out__write_cons_id(deep_profiling_proc_static(_)) -->
+ io__write_string("<deep_profiling_proc_static>").
% The code of this predicate duplicates the functionality of
% error_util__describe_one_pred_name. Changes here should be made
@@ -2118,6 +2122,16 @@
{ proc_id_to_int(ProcId, ProcIdInt) },
io__write_int(ProcIdInt),
io__write_string(")")
+ ;
+ { ConsId = deep_profiling_proc_static(RttiProcLabel) },
+ { rtti__proc_label_pred_proc_id(RttiProcLabel,
+ PredId, ProcId) },
+ io__write_string("deep_profiling_proc_static("),
+ hlds_out__write_pred_id(ModuleInfo, PredId),
+ { proc_id_to_int(ProcId, ProcIdInt) },
+ io__write_string(" (mode "),
+ io__write_int(ProcIdInt),
+ io__write_string("))")
).
hlds_out__write_var_modes([], [], _, _, _) --> [].
@@ -2912,6 +2926,7 @@
{ proc_info_eval_method(Proc, EvalMethod) },
{ proc_info_is_address_taken(Proc, IsAddressTaken) },
{ proc_info_get_call_table_tip(Proc, MaybeCallTableTip) },
+ { proc_info_get_maybe_deep_profile_info(Proc, MaybeDeepProfileInfo) },
{ Indent1 is Indent + 1 },
hlds_out__write_indent(Indent1),
@@ -2969,6 +2984,27 @@
( { MaybeCallTableTip = yes(CallTableTip) } ->
io__write_string("% call table tip: "),
mercury_output_var(CallTableTip, VarSet, AppendVarnums),
+ io__write_string("\n")
+ ;
+ []
+ ),
+
+ ( { MaybeDeepProfileInfo = yes(DeepProfileInfo) } ->
+ { DeepProfileInfo = deep_profile_proc_info(Role, _SCC) },
+ io__write_string("% deep profile info: "),
+ (
+ { Role = inner_proc(DeepPredProcId) },
+ io__write_string("inner, outer is ")
+ ;
+ { Role = outer_proc(DeepPredProcId) },
+ io__write_string("outer, inner is ")
+ ),
+ { DeepPredProcId = proc(DeepPredId, DeepProcId) },
+ { pred_id_to_int(DeepPredId, DeepPredInt) },
+ { proc_id_to_int(DeepProcId, DeepProcInt) },
+ io__write_int(DeepPredInt),
+ io__write_string("/"),
+ io__write_int(DeepProcInt),
io__write_string("\n")
;
[]
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.94
diff -u -b -r1.94 hlds_pred.m
--- compiler/hlds_pred.m 2001/03/27 05:23:06 1.94
+++ compiler/hlds_pred.m 2001/05/03 06:41:03
@@ -55,9 +55,6 @@
:- pred hlds_pred__next_pred_id(pred_id, pred_id).
:- mode hlds_pred__next_pred_id(in, out) is det.
-:- pred hlds_pred__next_proc_id(proc_id, proc_id).
-:- mode hlds_pred__next_proc_id(in, out) is det.
-
:- pred pred_id_to_int(pred_id, int).
:- mode pred_id_to_int(in, out) is det.
:- mode pred_id_to_int(out, in) is det.
@@ -791,9 +788,6 @@
hlds_pred__next_pred_id(PredId, NextPredId) :-
NextPredId is PredId + 1.
-hlds_pred__next_proc_id(ProcId, NextProcId) :-
- NextProcId is ProcId + 1.
-
pred_id_to_int(PredId, PredId).
proc_id_to_int(ProcId, ProcId).
@@ -1366,6 +1360,37 @@
---> address_is_taken
; address_is_not_taken.
+:- type deep_profile_role
+ ---> inner_proc(
+ outer_proc :: pred_proc_id
+ )
+ ; outer_proc(
+ inner_proc :: pred_proc_id
+ ).
+
+:- type deep_profile_proc_info
+ ---> deep_profile_proc_info(
+ role :: deep_profile_role,
+ visible_scc :: list(visible_scc_data)
+ % If the procedure is not tail
+ % recursive, this list is empty.
+ % Otherwise, it contains outer-inner
+ % pairs of procedures in the visible
+ % SCC, including this procedure and
+ % its copy.
+ ).
+
+:- type visible_scc_data
+ ---> visible_scc_data(
+ vis_outer_proc :: pred_proc_id,
+ vis_inner_proc :: pred_proc_id,
+ rec_call_sites :: list(int)
+ % A list of all the call site numbers
+ % that correspond to tail calls.
+ % (Call sites are numbered depth-first,
+ % left-to-right, from zero.)
+ ).
+
:- pred proc_info_init(arity, list(type), list(mode), maybe(list(mode)),
maybe(list(is_live)), maybe(determinism), prog_context,
is_address_taken, proc_info).
@@ -1551,6 +1576,12 @@
:- pred proc_info_set_call_table_tip(proc_info, maybe(prog_var), proc_info).
:- mode proc_info_set_call_table_tip(in, in, out) is det.
+:- pred proc_info_get_maybe_deep_profile_info(proc_info::in,
+ maybe(deep_profile_proc_info)::out) is det.
+
+:- pred proc_info_set_maybe_deep_profile_info(proc_info::in,
+ maybe(deep_profile_proc_info)::in, proc_info::out) is det.
+
% For a set of variables V, find all the type variables in the types
% of the variables in V, and return set of typeinfo variables for
% those type variables. (find all typeinfos for variables in V).
@@ -1646,6 +1677,12 @@
:- pred proc_info_has_io_state_pair(module_info::in, proc_info::in,
int::out, int::out) is semidet.
+ % Given a procedure table and the id of a procedure in that table,
+ % return a procedure id to be attached to a clone of that procedure.
+ % (The task of creating the clone proc_info and inserting into the
+ % procedure table is the task of the caller.)
+:- pred clone_proc_id(proc_table::in, proc_id::in, proc_id::out) is det.
+
% When mode inference is enabled, we record for each inferred
% mode whether it is valid or not by keeping a list of error
% messages in the proc_info. The mode is valid iff this list
@@ -1747,7 +1784,7 @@
% backend XXX. Its value is set during
% the live_vars pass; it is invalid
% before then.
- call_table_tip :: maybe(prog_var)
+ call_table_tip :: maybe(prog_var),
% If the tracing is enabled and the
% procedure's evaluation method is
% memo, loopcheck or minimal, this
@@ -1774,6 +1811,8 @@
% relevant backend must record this
% fact in a place accessible to the
% debugger.
+ maybe_deep_profile_proc_info
+ :: maybe(deep_profile_proc_info)
).
% Some parts of the procedure aren't known yet. We initialize
@@ -1806,7 +1845,7 @@
MaybeArgLives, ClauseBody, MContext, StackSlots, MaybeDet,
InferredDet, CanProcess, ArgInfo, InitialLiveness, TVarsMap,
TCVarsMap, eval_normal, no, no, DeclaredModes, IsAddressTaken,
- RLExprn, no, no
+ RLExprn, no, no, no
).
proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes,
@@ -1821,7 +1860,7 @@
InstVarSet, HeadLives, Goal, Context,
StackSlots, DeclaredDetism, InferredDetism, CanProcess, ArgInfo,
Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes,
- Termination, no, IsAddressTaken, RLExprn, no, no).
+ Termination, no, IsAddressTaken, RLExprn, no, no, no).
proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet, Detism,
Goal, Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :-
@@ -1833,7 +1872,7 @@
ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes, ModeErrors,
InstVarSet, MaybeHeadLives, Goal, Context, StackSlots,
yes(Detism), Detism, yes, [], Liveness, TVarMap, TCVarsMap,
- eval_normal, no, no, no, IsAddressTaken, RLExprn, no, no).
+ eval_normal, no, no, no, IsAddressTaken, RLExprn, no, no, no).
proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal,
TI_VarMap, TCI_VarMap, ProcInfo) :-
@@ -1921,6 +1960,8 @@
proc_info_get_rl_exprn_id(ProcInfo, ProcInfo^maybe_aditi_rl_id).
proc_info_get_need_maxfr_slot(ProcInfo, ProcInfo^need_maxfr_slot).
proc_info_get_call_table_tip(ProcInfo, ProcInfo^call_table_tip).
+proc_info_get_maybe_deep_profile_info(ProcInfo,
+ ProcInfo^maybe_deep_profile_proc_info).
proc_info_set_varset(ProcInfo, VS, ProcInfo^prog_varset := VS).
proc_info_set_vartypes(ProcInfo, VT, ProcInfo^var_types := VT).
@@ -1949,6 +1990,8 @@
proc_info_set_rl_exprn_id(ProcInfo, ID, ProcInfo^maybe_aditi_rl_id := yes(ID)).
proc_info_set_need_maxfr_slot(ProcInfo, NMS, ProcInfo^need_maxfr_slot := NMS).
proc_info_set_call_table_tip(ProcInfo, CTT, ProcInfo^call_table_tip := CTT).
+proc_info_set_maybe_deep_profile_info(ProcInfo, CTT,
+ ProcInfo^maybe_deep_profile_proc_info := CTT).
proc_info_get_typeinfo_vars(Vars, VarTypes, TVarMap, TypeInfoVars) :-
set__to_sorted_list(Vars, VarList),
@@ -2205,6 +2248,25 @@
),
proc_info_has_io_state_pair_2(VarModes, ModuleInfo, VarTypes,
ArgNum + 1, MaybeIn1, MaybeOut1, MaybeIn, MaybeOut).
+
+clone_proc_id(ProcTable, _ProcId, CloneProcId) :-
+ find_lowest_unused_proc_id(ProcTable, CloneProcId).
+
+:- pred find_lowest_unused_proc_id(proc_table::in, proc_id::out) is det.
+
+find_lowest_unused_proc_id(ProcTable, CloneProcId) :-
+ find_lowest_unused_proc_id_2(0, ProcTable, CloneProcId).
+
+:- pred find_lowest_unused_proc_id_2(proc_id::in, proc_table::in, proc_id::out)
+ is det.
+
+find_lowest_unused_proc_id_2(TrialProcId, ProcTable, CloneProcId) :-
+ ( map__search(ProcTable, TrialProcId, _) ->
+ find_lowest_unused_proc_id_2(TrialProcId + 1, ProcTable,
+ CloneProcId)
+ ;
+ CloneProcId = TrialProcId
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/jumpopt.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/jumpopt.m,v
retrieving revision 1.57
diff -u -b -r1.57 jumpopt.m
--- compiler/jumpopt.m 2000/10/31 02:15:42 1.57
+++ compiler/jumpopt.m 2001/05/10 18:53:38
@@ -40,7 +40,7 @@
:- pred jumpopt_main(list(instruction)::in, set(label)::in, trace_level::in,
proc_label::in, counter::in, counter::out,
- bool::in, bool::in, bool::in,
+ bool::in, bool::in, bool::in, bool::in,
list(instruction)::out, bool::out) is det.
%-----------------------------------------------------------------------------%
@@ -77,7 +77,8 @@
% been applied.
jumpopt_main(Instrs0, LayoutLabels, TraceLevel, ProcLabel, C0, C,
- Blockopt, Recjump, MostlyDetTailCall, Instrs, Mod) :-
+ Blockopt, Recjump, PessimizeTailCalls, CheckedNondetTailCall,
+ Instrs, Mod) :-
map__init(Instrmap0),
map__init(Lvalmap0),
map__init(Procmap0),
@@ -86,10 +87,25 @@
map__init(Blockmap0),
jumpopt__build_maps(Instrs0, Blockopt, Recjump, Instrmap0, Instrmap,
Blockmap0, Blockmap, Lvalmap0, Lvalmap,
- Procmap0, Procmap, Sdprocmap0, Sdprocmap, Succmap0, Succmap),
+ Procmap0, Procmap1, Sdprocmap0, Sdprocmap1,
+ Succmap0, Succmap1),
map__init(Forkmap0),
- jumpopt__build_forkmap(Instrs0, Sdprocmap, Forkmap0, Forkmap),
- ( MostlyDetTailCall = yes ->
+ jumpopt__build_forkmap(Instrs0, Sdprocmap1, Forkmap0, Forkmap1),
+ (
+ PessimizeTailCalls = no,
+ Procmap = Procmap1,
+ Sdprocmap = Sdprocmap1,
+ Succmap = Succmap1,
+ Forkmap = Forkmap1
+ ;
+ PessimizeTailCalls = yes,
+ Procmap = map__init,
+ Sdprocmap = map__init,
+ Succmap = map__init,
+ Forkmap = map__init
+ ),
+ (
+ CheckedNondetTailCall = yes,
CheckedNondetTailCallInfo0 = yes(ProcLabel - C0),
jumpopt__instr_list(Instrs0, comment(""), Instrmap, Blockmap,
Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap,
@@ -101,6 +117,7 @@
error("jumpopt_main: lost the next label number")
)
;
+ CheckedNondetTailCall = no,
CheckedNondetTailCallInfo0 = no,
jumpopt__instr_list(Instrs0, comment(""), Instrmap, Blockmap,
Lvalmap, Procmap, Sdprocmap, Forkmap, Succmap,
Index: compiler/layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/layout.m,v
retrieving revision 1.1
diff -u -b -r1.1 layout.m
--- compiler/layout.m 2001/01/18 01:18:44 1.1
+++ compiler/layout.m 2001/05/03 06:41:03
@@ -18,7 +18,7 @@
%
% The code to generate values of these types is in stack_layout.m.
%
-% This module is should be, but as yet isn't, independent of whether we are
+% This module should be, but as yet isn't, independent of whether we are
% compiling to LLDS or MLDS.
%
% Author: zs.
@@ -29,7 +29,7 @@
:- interface.
-:- import_module prog_data, trace_params, llds.
+:- import_module prog_data, trace_params, llds, rtti, hlds_goal.
:- import_module std_util, list, assoc_list.
:- type layout_data
@@ -61,6 +61,40 @@
closure_file_name :: string,
closure_line_number :: int,
closure_goal_path :: string
+ )
+ ; proc_static_data(
+ proc_static_id :: rtti_proc_label,
+ proc_static_file_name :: string,
+ call_site_statics :: list(call_site_static_data)
+ ).
+
+:- type call_site_static_data
+ ---> normal_call(
+ normal_callee :: rtti_proc_label,
+ normal_type_subst :: string,
+ normal_filename :: string,
+ normal_line_number :: int,
+ normal_goal_path :: goal_path
+ )
+ ; special_call(
+ special_filename :: string,
+ special_line_number :: int,
+ special_goal_path :: goal_path
+ )
+ ; higher_order_call(
+ higher_order_filename :: string,
+ ho_line_number :: int,
+ ho_goal_path :: goal_path
+ )
+ ; method_call(
+ method_filename :: string,
+ method_line_number :: int,
+ method_goal_path :: goal_path
+ )
+ ; callback(
+ callback_filename :: string,
+ callback_line_number :: int,
+ callback_goal_path :: goal_path
).
:- type label_var_info
@@ -126,7 +160,9 @@
; module_layout_string_table(module_name)
; module_layout_file_vector(module_name)
; module_layout_proc_vector(module_name)
- ; module_layout(module_name).
+ ; module_layout(module_name)
+ ; proc_static(rtti_proc_label)
+ ; proc_static_call_sites(rtti_proc_label).
:- type label_vars
---> label_has_var_info
Index: compiler/layout_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/layout_out.m,v
retrieving revision 1.2
diff -u -b -r1.2 layout_out.m
--- compiler/layout_out.m 2001/02/06 10:10:20 1.2
+++ compiler/layout_out.m 2001/05/03 06:41:03
@@ -29,10 +29,22 @@
:- pred output_layout_data_defn(layout_data::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
+ % Given the name of a layout structure, output the declaration
+ % of the C global variable which will hold it.
+:- pred output_layout_name_decl(layout_name::in, io__state::di, io__state::uo)
+ is det.
+
+ % Given the name of a layout structure, output the declaration
+ % of the C global variable which will hold it, if it has
+ % not already been declared.
+:- pred output_maybe_layout_name_decl(layout_name::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
% Given a Mercury representation of a layout structure, output the
- % declaration of the C global variable which will hold it.
-:- pred output_layout_data_decl(layout_data::in, decl_set::in, decl_set::out,
- io__state::di, io__state::uo) is det.
+ % declaration of the C global variable which will hold it, if it has
+ % not already been declared.
+:- pred output_maybe_layout_data_decl(layout_data::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
% Given a reference to a layout structure, output the storage class
% (e.g. static), type and name of the global variable that will
@@ -66,6 +78,7 @@
:- implementation.
:- import_module prog_data, prog_out, hlds_pred, trace_params, c_util.
+:- import_module rtti, trace, code_util.
:- import_module int, char, string, require, std_util, list.
output_layout_data_defn(label_layout_data(Label, ProcLayoutAddr,
@@ -87,16 +100,33 @@
output_module_layout_data_defn(ModuleName, StringTableSize,
StringTable, ProcLayoutNames, FileLayouts, TraceLevel,
DeclSet0, DeclSet).
+output_layout_data_defn(proc_static_data(RttiProcLabel, FileName, CallSites),
+ DeclSet0, DeclSet) -->
+ output_proc_static_data_defn(RttiProcLabel, FileName, CallSites,
+ DeclSet0, DeclSet).
%-----------------------------------------------------------------------------%
-output_layout_data_decl(LayoutData, DeclSet0, DeclSet) -->
+output_layout_name_decl(LayoutName) -->
output_layout_name_storage_type_name(LayoutName, no),
- io__write_string(";\n"),
- { extract_layout_name(LayoutData, LayoutName) },
+ io__write_string(";\n").
+
+output_maybe_layout_name_decl(LayoutName, DeclSet0, DeclSet) -->
+ (
+ { decl_set_is_member(data_addr(layout_addr(LayoutName)),
+ DeclSet0) }
+ ->
+ { DeclSet = DeclSet0 }
+ ;
+ output_layout_name_decl(LayoutName),
{ decl_set_insert(DeclSet0, data_addr(layout_addr(LayoutName)),
- DeclSet) }.
+ DeclSet) }
+ ).
+output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet) -->
+ { extract_layout_name(LayoutData, LayoutName) },
+ output_maybe_layout_name_decl(LayoutName, DeclSet0, DeclSet).
+
:- pred extract_layout_name(layout_data::in, layout_name::out) is det.
extract_layout_name(label_layout_data(Label, _, _, _, yes(_)), LayoutName) :-
@@ -111,6 +141,8 @@
closure_proc_id(CallerProcLabel, SeqNo, ClosureProcLabel)).
extract_layout_name(module_layout_data(ModuleName, _,_,_,_,_), LayoutName) :-
LayoutName = module_layout(ModuleName).
+extract_layout_name(proc_static_data(RttiProcLabel, _, _), LayoutName) :-
+ LayoutName = proc_static(RttiProcLabel).
:- pred output_layout_decls(list(layout_name)::in, decl_set::in, decl_set::out,
io__state::di, io__state::uo) is det.
@@ -206,6 +238,19 @@
io__write_string("_module_layout__"),
{ llds_out__sym_name_mangle(ModuleName, ModuleNameStr) },
io__write_string(ModuleNameStr).
+output_layout_name(proc_static(RttiProcLabel)) -->
+ io__write_string(mercury_data_prefix),
+ 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__"),
+ { ProcLabel = code_util__make_proc_label_from_rtti(RttiProcLabel) },
+ output_proc_label(ProcLabel).
output_layout_name_storage_type_name(label_layout(Label, LabelVars),
_BeingDefined) -->
@@ -272,6 +317,27 @@
_BeingDefined) -->
io__write_string("static const MR_Module_Layout "),
output_layout_name(module_layout(ModuleName)).
+output_layout_name_storage_type_name(proc_static(RttiProcLabel),
+ BeingDefined) -->
+ (
+ { BeingDefined = no },
+ io__write_string("extern ")
+ ;
+ { BeingDefined = yes }
+ ),
+ (
+ { RttiProcLabel ^ is_special_pred_instance = yes },
+ io__write_string("MR_Compiler_ProcStatic ")
+ ;
+ { RttiProcLabel ^ is_special_pred_instance = no },
+ io__write_string("MR_User_ProcStatic ")
+ ),
+ output_layout_name(proc_static(RttiProcLabel)).
+output_layout_name_storage_type_name(proc_static_call_sites(RttiProcLabel),
+ _BeingDefined) -->
+ io__write_string("static const MR_CallSiteStatic "),
+ output_layout_name(proc_static_call_sites(RttiProcLabel)),
+ io__write_string("[]").
layout_name_would_include_code_addr(label_layout(_, _)) = no.
layout_name_would_include_code_addr(proc_layout(_, _)) = yes.
@@ -284,6 +350,8 @@
layout_name_would_include_code_addr(module_layout_file_vector(_)) = no.
layout_name_would_include_code_addr(module_layout_proc_vector(_)) = no.
layout_name_would_include_code_addr(module_layout(_)) = no.
+layout_name_would_include_code_addr(proc_static(_)) = no.
+layout_name_would_include_code_addr(proc_static_call_sites(_)) = no.
:- func label_vars_to_type(label_vars) = string.
@@ -984,5 +1052,115 @@
io__write_string(Prefix),
output_data_addr(DataAddr),
io__write_string(",\n").
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_proc_static_data_defn(rtti_proc_label::in, string::in,
+ list(call_site_static_data)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_proc_static_data_defn(RttiProcLabel, FileName, CallSites,
+ DeclSet0, DeclSet) -->
+ list__foldl2(output_call_site_static_decl, CallSites,
+ DeclSet0, DeclSet1),
+ output_call_site_static_array(RttiProcLabel, CallSites,
+ DeclSet1, DeclSet2),
+ { LayoutName = proc_static(RttiProcLabel) },
+ io__write_string("\n"),
+ output_layout_name_storage_type_name(LayoutName, yes),
+ io__write_string(" = {\n"),
+ { ProcLabel = code_util__make_proc_label_from_rtti(RttiProcLabel) },
+ output_layout_proc_id_group(ProcLabel),
+ io__write_string("\t"),
+ quote_and_write_string(FileName),
+ io__write_string(",\n\t"),
+ io__write_int(list__length(CallSites)),
+ io__write_string(",\n\t"),
+ { CallSitesLayoutName = proc_static_call_sites(RttiProcLabel) },
+ output_layout_name(CallSitesLayoutName),
+ io__write_string(",\n#ifdef MR_USE_ACTIVATION_COUNTS\n"),
+ io__write_string("\t0,\n"),
+ io__write_string("#endif\n"),
+ io__write_string("\tNULL\n};\n"),
+ { decl_set_insert(DeclSet2, data_addr(layout_addr(LayoutName)),
+ DeclSet) }.
+
+:- pred output_call_site_static_array(rtti_proc_label::in,
+ list(call_site_static_data)::in, decl_set::in, decl_set::out,
+ io__state::di, io__state::uo) is det.
+
+output_call_site_static_array(RttiProcLabel, CallSites, DeclSet0, DeclSet) -->
+ { LayoutName = proc_static_call_sites(RttiProcLabel) },
+ io__write_string("\n"),
+ output_layout_name_storage_type_name(LayoutName, yes),
+ io__write_string(" = {\n"),
+ list__foldl(output_call_site_static, CallSites),
+ io__write_string("};\n"),
+ { decl_set_insert(DeclSet0, data_addr(layout_addr(LayoutName)),
+ DeclSet) }.
+
+:- pred output_call_site_static(call_site_static_data::in,
+ io__state::di, io__state::uo) is det.
+
+output_call_site_static(CallSiteStatic) -->
+ io__write_string("\t{ "),
+ (
+ { CallSiteStatic = normal_call(Callee, TypeSubst,
+ FileName, LineNumber, GoalPath) },
+ io__write_string("MR_normal_call, (MR_ProcStatic *)\n\t &"),
+ output_layout_name(proc_static(Callee)),
+ ( { TypeSubst = "" } ->
+ io__write_string(",\n\t NULL, ")
+ ;
+ io__write_string(",\n\t """),
+ io__write_string(TypeSubst),
+ io__write_string(""", ")
+ )
+ ;
+ { CallSiteStatic = special_call(FileName, LineNumber,
+ GoalPath) },
+ io__write_string("MR_special_call, NULL,\n\t NULL, ")
+ ;
+ { CallSiteStatic = higher_order_call(FileName, LineNumber,
+ GoalPath) },
+ io__write_string("MR_higher_order_call, NULL,\n\t NULL, ")
+ ;
+ { CallSiteStatic = method_call(FileName, LineNumber,
+ GoalPath) },
+ io__write_string("MR_method_call, NULL,\n\t NULL, ")
+ ;
+ { CallSiteStatic = callback(FileName, LineNumber, GoalPath) },
+ io__write_string("MR_callback, NULL,\n\t NULL, ")
+ ),
+ io__write_string(""""),
+ io__write_string(FileName),
+ io__write_string(""", "),
+ io__write_int(LineNumber),
+ io__write_string(", """),
+ { trace__path_to_string(GoalPath, GoalPathStr) },
+ io__write_string(GoalPathStr),
+ io__write_string(""" },\n").
+
+:- pred output_call_site_static_decl(call_site_static_data::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_call_site_static_decl(CallSiteStatic, DeclSet0, DeclSet) -->
+ (
+ { CallSiteStatic = normal_call(Callee, _, _, _, _) },
+ output_maybe_layout_name_decl(proc_static(Callee),
+ DeclSet0, DeclSet)
+ ;
+ { CallSiteStatic = special_call(_, _, _) },
+ { DeclSet = DeclSet0 }
+ ;
+ { CallSiteStatic = higher_order_call(_, _, _) },
+ { DeclSet = DeclSet0 }
+ ;
+ { CallSiteStatic = method_call(_, _, _) },
+ { DeclSet = DeclSet0 }
+ ;
+ { CallSiteStatic = callback(_, _, _) },
+ { DeclSet = DeclSet0 }
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.276
diff -u -b -r1.276 llds.m
--- compiler/llds.m 2001/05/02 17:34:33 1.276
+++ compiler/llds.m 2001/05/03 06:44:11
@@ -69,7 +69,7 @@
:- type global_data.
-:- pred global_data_init(global_data::out) is det.
+:- pred global_data_init(list(layout_data)::in, global_data::out) is det.
:- pred global_data_add_new_proc_var(global_data::in,
pred_proc_id::in, comp_gen_c_var::in, global_data::out) is det.
@@ -928,10 +928,12 @@
; base_typeclass_info(class_id, string)
% class name & class arity, names and arities of the
% types
- ; tabling_pointer(proc_label).
+ ; tabling_pointer(proc_label)
% A variable that contains a pointer that points to
% the table used to implement memoization, loopcheck
% or minimal model semantics for the given procedure.
+ ; deep_profiling_procedure_data(proc_label)
+ .
:- type reg_type
---> r % general-purpose (integer) regs
@@ -1300,10 +1302,16 @@
% because their construction
% ensures no overlaps.
).
+
+:- func wrap_layout_data(layout_data) = comp_gen_c_data.
+
+wrap_layout_data(LayoutData) = layout_data(LayoutData).
-global_data_init(global_data(EmptyDataMap, EmptyLayoutMap, [], [])) :-
+global_data_init(LayoutData, GlobalData) :-
map__init(EmptyDataMap),
- map__init(EmptyLayoutMap).
+ map__init(EmptyLayoutMap),
+ NonCommon = map(wrap_layout_data, LayoutData),
+ GlobalData = global_data(EmptyDataMap, EmptyLayoutMap, [], NonCommon).
global_data_add_new_proc_var(GlobalData0, PredProcId, ProcVar, GlobalData) :-
ProcVarMap0 = GlobalData0 ^ proc_var_map,
Index: compiler/llds_common.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_common.m,v
retrieving revision 1.37
diff -u -b -r1.37 llds_common.m
--- compiler/llds_common.m 2001/04/24 03:58:57 1.37
+++ compiler/llds_common.m 2001/05/03 06:41:03
@@ -188,6 +188,9 @@
llds_common__process_layout_data(LayoutData0, LayoutData, Info, Info) :-
LayoutData0 = module_layout_data(_, _, _, _, _, _),
LayoutData = LayoutData0.
+llds_common__process_layout_data(LayoutData0, LayoutData, Info, Info) :-
+ LayoutData0 = proc_static_data(_, _, _),
+ LayoutData = LayoutData0.
:- pred llds_common__process_exec_trace(proc_layout_exec_trace::in,
proc_layout_exec_trace::out, common_info::in, common_info::out) is det.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.175
diff -u -b -r1.175 llds_out.m
--- compiler/llds_out.m 2001/04/24 03:58:57 1.175
+++ compiler/llds_out.m 2001/05/03 06:41:03
@@ -392,10 +392,9 @@
output_init_comment(ModuleName),
output_c_file_mercury_headers,
io__write_string("\n"),
- output_debugger_init_list_decls(Datas),
- io__write_string("\n"),
+ { decl_set_init(DeclSet0) },
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels),
+ StackLayoutLabels, DeclSet0, _DeclSet),
output_rl_file(ModuleName, MaybeRLFile),
io__told
;
@@ -419,10 +418,19 @@
;
io__write_string("#include ""mercury_imp.h""\n")
),
+ globals__io_lookup_bool_option(profile_deep, DeepProfile),
+ (
+ { DeepProfile = yes },
+ io__write_string("#include ""mercury_deep_profiling.h""\n")
+ ;
+ { DeepProfile = no }
+ ),
globals__io_lookup_bool_option(generate_bytecode, GenBytecode),
- ( { GenBytecode = yes },
+ (
+ { GenBytecode = yes },
io__write_string("#include ""mb_interface_stub.h""\n")
- ; { GenBytecode = no }
+ ;
+ { GenBytecode = no }
).
output_c_file_intro_and_grade(SourceFileName, Version) -->
@@ -491,7 +499,7 @@
output_comp_gen_c_var_list(Vars, DeclSet2, DeclSet3),
output_comp_gen_c_data_list(Datas, DeclSet3, DeclSet4),
output_comp_gen_c_module_list(Modules, StackLayoutLabels,
- DeclSet4, _DeclSet),
+ DeclSet4, DeclSet5),
output_user_foreign_code_list(UserForeignCode),
output_exported_c_functions(Exports),
@@ -500,7 +508,7 @@
;
io__write_string("\n"),
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels)
+ StackLayoutLabels, DeclSet5, _DeclSet)
),
output_rl_file(ModuleName, MaybeRLFile),
io__told
@@ -516,9 +524,10 @@
:- pred output_c_module_init_list(module_name::in, list(comp_gen_c_module)::in,
list(comp_gen_c_data)::in, map(label, data_addr)::in,
- io__state::di, io__state::uo) is det.
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_c_module_init_list(ModuleName, Modules, Datas, StackLayoutLabels) -->
+output_c_module_init_list(ModuleName, Modules, Datas, StackLayoutLabels,
+ DeclSet0, DeclSet) -->
{ MustInit = lambda([Module::in] is semidet, (
module_defines_label_with_layout(Module, StackLayoutLabels)
)) },
@@ -542,19 +551,24 @@
io__write_string("/* suppress gcc -Wmissing-decls warnings */\n"),
io__write_string("void "),
+ output_init_name(ModuleName),
+ io__write_string("init(void);\n"),
+ io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("(void);\n"),
+ io__write_string("init_type_tables(void);\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("_type_tables(void);\n"),
+ io__write_string("init_debugger(void);\n"),
+ io__write_string("#ifdef MR_DEEP_PROFILING\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("_debugger(void);\n"),
+ io__write_string("write_out_proc_statics(FILE *fp);\n"),
+ io__write_string("#endif\n"),
io__write_string("\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("(void)\n"),
+ io__write_string("init(void)\n"),
io__write_string("{\n"),
io__write_string("\tstatic bool done = FALSE;\n"),
io__write_string("\tif (done) {\n"),
@@ -582,12 +596,12 @@
% overwritten, it can be deleted.
io__write_string("\t"),
output_init_name(ModuleName),
- io__write_string("_debugger();\n"),
+ io__write_string("init_debugger();\n"),
io__write_string("}\n\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("_type_tables(void)\n"),
+ io__write_string("init_type_tables(void)\n"),
io__write_string("{\n"),
io__write_string("\tstatic bool done = FALSE;\n"),
io__write_string("\tif (done) {\n"),
@@ -597,9 +611,11 @@
output_type_tables_init_list(Datas, SplitFiles),
io__write_string("}\n\n"),
+ output_debugger_init_list_decls(Datas, DeclSet0, DeclSet1),
+ io__write_string("\n"),
io__write_string("void "),
output_init_name(ModuleName),
- io__write_string("_debugger(void)\n"),
+ io__write_string("init_debugger(void)\n"),
io__write_string("{\n"),
io__write_string("\tstatic bool done = FALSE;\n"),
io__write_string("\tif (done) {\n"),
@@ -609,6 +625,16 @@
output_debugger_init_list(Datas),
io__write_string("}\n\n"),
+ io__write_string("#ifdef MR_DEEP_PROFILING\n"),
+ output_write_proc_static_list_decls(Datas, DeclSet1, DeclSet),
+ io__write_string("\nvoid "),
+ output_init_name(ModuleName),
+ io__write_string("write_out_proc_statics(FILE *fp)\n"),
+ io__write_string("{\n"),
+ output_write_proc_static_list(Datas),
+ io__write_string("}\n"),
+ io__write_string("\n#endif\n\n"),
+
io__write_string(
"/* ensure everything is compiled with the same grade */\n"),
io__write_string(
@@ -669,7 +695,7 @@
output_init_bunch_calls([], _, _, _) --> [].
output_init_bunch_calls([_ | Bunches], ModuleName, InitStatus, Seq) -->
- io__write_string("\t\t"),
+ io__write_string("\t"),
output_bunch_name(ModuleName, InitStatus, Seq),
io__write_string("();\n"),
{ NextSeq is Seq + 1 },
@@ -709,21 +735,20 @@
% Output declarations for each module layout defined in this module
% (there should only be one, of course).
:- pred output_debugger_init_list_decls(list(comp_gen_c_data)::in,
- io__state::di, io__state::uo) is det.
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
-output_debugger_init_list_decls([]) --> [].
-output_debugger_init_list_decls([Data | Datas]) -->
+output_debugger_init_list_decls([], DeclSet, DeclSet) --> [].
+output_debugger_init_list_decls([Data | Datas], DeclSet0, DeclSet) -->
(
{ Data = layout_data(LayoutData) },
{ LayoutData = module_layout_data(ModuleName, _, _, _, _, _) }
->
- { decl_set_init(DeclSet0) },
output_data_addr_decls(layout_addr(module_layout(ModuleName)),
- "", "", 0, _, DeclSet0, _DeclSet)
+ "", "", 0, _, DeclSet0, DeclSet1)
;
- []
+ { DeclSet1 = DeclSet0 }
),
- output_debugger_init_list_decls(Datas).
+ output_debugger_init_list_decls(Datas, DeclSet1, DeclSet).
% Output calls to MR_register_module_layout()
% for each module layout defined in this module
@@ -738,16 +763,50 @@
{ Data = layout_data(LayoutData) },
{ LayoutData = module_layout_data(ModuleName, _, _, _, _, _) }
->
- io__write_string("\t\tif (MR_register_module_layout != NULL) {\n"),
- io__write_string("\t\t\t(*MR_register_module_layout)("),
- io__write_string("\n\t\t\t\t&"),
+ io__write_string("\tif (MR_register_module_layout != NULL) {\n"),
+ io__write_string("\t\t(*MR_register_module_layout)("),
+ io__write_string("\n\t\t\t&"),
output_layout_name(module_layout(ModuleName)),
- io__write_string(");\n\t\t}\n")
+ io__write_string(");\n\t}\n")
;
[]
),
output_debugger_init_list(Datas).
+:- pred output_write_proc_static_list_decls(list(comp_gen_c_data)::in,
+ decl_set::in, decl_set::out, io__state::di, io__state::uo) is det.
+
+output_write_proc_static_list_decls([], DeclSet, DeclSet) --> [].
+output_write_proc_static_list_decls([Data | Datas], DeclSet0, DeclSet) -->
+ (
+ { Data = layout_data(LayoutData) },
+ { LayoutData = proc_static_data(_, _, _) }
+ ->
+ output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet1)
+ ;
+ { DeclSet1 = DeclSet0 }
+ ),
+ output_write_proc_static_list_decls(Datas,
+ DeclSet1, DeclSet).
+
+:- pred output_write_proc_static_list(list(comp_gen_c_data)::in,
+ io__state::di, io__state::uo) is det.
+
+output_write_proc_static_list([]) --> [].
+output_write_proc_static_list([Data | Datas]) -->
+ (
+ { Data = layout_data(LayoutData) },
+ { LayoutData = proc_static_data(RttiProcLabel, _, _) }
+ ->
+ io__write_string("\tMR_write_out_proc_static(fp, "),
+ io__write_string("(MR_ProcStatic *)\n\t\t&"),
+ output_layout_name(proc_static(RttiProcLabel)),
+ io__write_string(");\n")
+ ;
+ []
+ ),
+ output_write_proc_static_list(Datas).
+
% Output a comment to tell mkinit what functions to
% call from <module>_init.c.
:- pred output_init_comment(module_name, io__state, io__state).
@@ -757,7 +816,7 @@
io__write_string("/*\n"),
io__write_string("INIT "),
output_init_name(ModuleName),
- io__write_string("\n"),
+ io__write_string("init\n"),
globals__io_lookup_bool_option(aditi, Aditi),
( { Aditi = yes } ->
{ llds_out__make_rl_data_name(ModuleName, RLName) },
@@ -779,7 +838,7 @@
llds_out__make_init_name(ModuleName, InitName) :-
llds_out__sym_name_mangle(ModuleName, MangledModuleName),
- string__append_list(["mercury__", MangledModuleName, "__init"],
+ string__append_list(["mercury__", MangledModuleName, "__"],
InitName).
llds_out__make_rl_data_name(ModuleName, RLDataConstName) :-
@@ -851,7 +910,7 @@
output_c_data_type_def(rtti_data(RttiData), DeclSet0, DeclSet) -->
output_rtti_data_decl(RttiData, DeclSet0, DeclSet).
output_c_data_type_def(layout_data(LayoutData), DeclSet0, DeclSet) -->
- output_layout_data_decl(LayoutData, DeclSet0, DeclSet).
+ output_maybe_layout_data_decl(LayoutData, DeclSet0, DeclSet).
:- pred output_comp_gen_c_module_list(list(comp_gen_c_module)::in,
map(label, data_addr)::in, decl_set::in, decl_set::out,
@@ -2381,6 +2440,8 @@
->
[]
;
+ % XXX io__write_string("const ")
+ % []
io__write_string("const ")
)
;
@@ -2439,6 +2500,7 @@
data_name_would_include_code_address(common(_)) = no.
data_name_would_include_code_address(base_typeclass_info(_, _)) = yes.
data_name_would_include_code_address(tabling_pointer(_)) = no.
+data_name_would_include_code_address(deep_profiling_procedure_data(_)) = no.
:- pred output_decl_id(decl_id, io__state, io__state).
:- mode output_decl_id(in, di, uo) is det.
@@ -3018,6 +3080,7 @@
data_name_linkage(common(_), static).
data_name_linkage(base_typeclass_info(_, _), extern).
data_name_linkage(tabling_pointer(_), static).
+data_name_linkage(deep_profiling_procedure_data(_), static).
%-----------------------------------------------------------------------------%
@@ -3360,6 +3423,11 @@
;
{ VarName = tabling_pointer(ProcLabel) },
io__write_string("mercury_var__tabling__"),
+ output_proc_label(ProcLabel)
+ ;
+ { VarName = deep_profiling_procedure_data(ProcLabel) },
+ io__write_string(mercury_data_prefix),
+ io__write_string("_deep_profiling_data__"),
output_proc_label(ProcLabel)
).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.202
diff -u -b -r1.202 mercury_compile.m
--- compiler/mercury_compile.m 2001/05/16 16:18:10 1.202
+++ compiler/mercury_compile.m 2001/05/17 05:12:33
@@ -39,6 +39,7 @@
:- import_module type_ctor_info, termination, higher_order, accumulator.
:- import_module inlining, deforest, dnf, magic, dead_proc_elim.
:- import_module delay_construct, unused_args, unneeded_code, lco.
+:- import_module deep_profiling.
% the LLDS back-end
:- import_module saved_vars, liveness.
@@ -69,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.
-:- import_module dependency_graph, prog_util, rl_dump, rl_file.
+:- import_module mercury_to_mercury, mercury_to_goedel, hlds_data.
+:- import_module layout, dependency_graph, prog_util, rl_dump, rl_file.
:- import_module options, globals, trace_params, passes_aux.
% library modules
@@ -653,7 +654,8 @@
;
mercury_compile__maybe_output_prof_call_graph(HLDS21,
Verbose, Stats, HLDS25),
- mercury_compile__middle_pass(ModuleName, HLDS25, HLDS50),
+ mercury_compile__middle_pass(ModuleName, HLDS25, HLDS50,
+ DeepProfilingStructures),
globals__io_lookup_bool_option(highlevel_code, HighLevelCode),
globals__io_lookup_bool_option(aditi_only, AditiOnly),
globals__io_get_target(Target),
@@ -740,7 +742,7 @@
)
;
mercury_compile__backend_pass(HLDS50, HLDS70,
- GlobalData, LLDS),
+ DeepProfilingStructures, GlobalData, LLDS),
mercury_compile__output_pass(HLDS70, GlobalData, LLDS,
MaybeRLFile, ModuleName, _CompileErrors)
)
@@ -1291,11 +1293,12 @@
%-----------------------------------------------------------------------------%
:- pred mercury_compile__middle_pass(module_name, module_info, module_info,
- io__state, io__state).
-% :- mode mercury_compile__middle_pass(in, di, uo, di, uo) is det.
-:- mode mercury_compile__middle_pass(in, in, out, di, uo) is det.
+ list(layout_data), io__state, io__state).
+% :- mode mercury_compile__middle_pass(in, di, uo, out, di, uo) is det.
+:- mode mercury_compile__middle_pass(in, in, out, out, di, uo) is det.
-mercury_compile__middle_pass(ModuleName, HLDS24, HLDS50) -->
+mercury_compile__middle_pass(ModuleName, HLDS24, HLDS50,
+ DeepProfilingStructures) -->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
@@ -1370,8 +1373,15 @@
mercury_compile__maybe_dead_procs(HLDS46, Verbose, Stats, HLDS48),
mercury_compile__maybe_dump_hlds(HLDS48, "48", "dead_procs"),
+
+ % Deep profiling transformation should be done late in the piece
+ % since it munges the code a fair amount and introduces strange
+ % disjunctions that might confuse other hlds->hlds transformations.
+ mercury_compile__maybe_deep_profiling(HLDS48, Verbose, Stats, HLDS49,
+ DeepProfilingStructures),
+ mercury_compile__maybe_dump_hlds(HLDS49, "49", "deep_profiling"),
- { HLDS50 = HLDS48 },
+ { HLDS49 = HLDS50 },
mercury_compile__maybe_dump_hlds(HLDS50, "50", "middle_pass").
%-----------------------------------------------------------------------------%
@@ -1436,12 +1446,16 @@
%-----------------------------------------------------------------------------%
-:- pred mercury_compile__backend_pass(module_info, module_info, global_data,
- list(c_procedure), io__state, io__state).
+:- pred mercury_compile__backend_pass(module_info, module_info,
+ list(layout_data), global_data, list(c_procedure),
+ io__state, io__state).
% :- mode mercury_compile__backend_pass(di, uo, out, out, di, uo) is det.
-:- mode mercury_compile__backend_pass(in, out, out, out, di, uo) is det.
+:- mode mercury_compile__backend_pass(in, out, in, out, out, di, uo) is det.
+
+mercury_compile__backend_pass(HLDS50, HLDS, DeepProfilingStructures,
+ GlobalData, LLDS) -->
+ { global_data_init(DeepProfilingStructures, GlobalData0) },
-mercury_compile__backend_pass(HLDS50, HLDS, GlobalData, LLDS) -->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
@@ -1455,21 +1469,23 @@
(
{ TradPasses = no },
mercury_compile__backend_pass_by_phases(HLDS51, HLDS,
- GlobalData, LLDS)
+ GlobalData0, GlobalData, LLDS)
;
{ TradPasses = yes },
mercury_compile__backend_pass_by_preds(HLDS51, HLDS,
- GlobalData, LLDS)
+ GlobalData0, GlobalData, LLDS)
).
%-----------------------------------------------------------------------------%
:- pred mercury_compile__backend_pass_by_phases(module_info, module_info,
- global_data, list(c_procedure), io__state, io__state).
-:- mode mercury_compile__backend_pass_by_phases(in, out, out, out, di, uo)
+ global_data, global_data, list(c_procedure),
+ io__state, io__state).
+:- mode mercury_compile__backend_pass_by_phases(in, out, in, out, out, di, uo)
is det.
-mercury_compile__backend_pass_by_phases(HLDS51, HLDS99, GlobalData, LLDS) -->
+mercury_compile__backend_pass_by_phases(HLDS51, HLDS99,
+ GlobalData0, GlobalData, LLDS) -->
globals__io_lookup_bool_option(verbose, Verbose),
globals__io_lookup_bool_option(statistics, Stats),
@@ -1500,8 +1516,6 @@
{ HLDS90 = HLDS72 },
mercury_compile__maybe_dump_hlds(HLDS90, "90", "precodegen"),
- { global_data_init(GlobalData0) },
-
mercury_compile__generate_code(HLDS90, GlobalData0, Verbose, Stats,
HLDS99, GlobalData1, LLDS1),
mercury_compile__maybe_dump_hlds(HLDS99, "99", "codegen"),
@@ -1514,15 +1528,16 @@
LLDS).
:- pred mercury_compile__backend_pass_by_preds(module_info, module_info,
- global_data, list(c_procedure), io__state, io__state).
-% :- mode mercury_compile__backend_pass_by_preds(di, uo, out, out, di, uo)
+ global_data, global_data, list(c_procedure),
+ io__state, io__state).
+% :- mode mercury_compile__backend_pass_by_preds(di, uo, in, out, out, di, uo)
% is det.
-:- mode mercury_compile__backend_pass_by_preds(in, out, out, out, di, uo)
+:- mode mercury_compile__backend_pass_by_preds(in, out, in, out, out, di, uo)
is det.
-mercury_compile__backend_pass_by_preds(HLDS0, HLDS, GlobalData, LLDS) -->
+mercury_compile__backend_pass_by_preds(HLDS0, HLDS, GlobalData0, GlobalData,
+ LLDS) -->
{ module_info_predids(HLDS0, PredIds) },
- { global_data_init(GlobalData0) },
mercury_compile__backend_pass_by_preds_2(PredIds, HLDS0, HLDS,
GlobalData0, GlobalData, LLDS).
@@ -2290,7 +2305,8 @@
mercury_compile__maybe_dead_procs(HLDS0, Verbose, Stats, HLDS) -->
globals__io_lookup_bool_option(optimize_dead_procs, Dead),
( { Dead = yes } ->
- maybe_write_string(Verbose, "% Eliminating dead procedures...\n"),
+ maybe_write_string(Verbose,
+ "% Eliminating dead procedures...\n"),
maybe_flush_output(Verbose),
dead_proc_elim(HLDS0, HLDS),
maybe_write_string(Verbose, "% done.\n"),
@@ -2299,6 +2315,26 @@
{ HLDS0 = HLDS }
).
+:- pred mercury_compile__maybe_deep_profiling(module_info, bool, bool,
+ module_info, list(layout_data), io__state, io__state).
+:- mode mercury_compile__maybe_deep_profiling(in, in, in, out, out, di, uo)
+ is det.
+
+mercury_compile__maybe_deep_profiling(HLDS0, Verbose, Stats, HLDS,
+ DeepProfilingStructures) -->
+ globals__io_lookup_bool_option(profile_deep, Dead),
+ ( { Dead = yes } ->
+ maybe_write_string(Verbose,
+ "% Applying deep profiling transformation...\n"),
+ maybe_flush_output(Verbose),
+ apply_deep_profiling_transformation(HLDS0, HLDS,
+ DeepProfilingStructures),
+ maybe_write_string(Verbose, "% done.\n"),
+ maybe_report_stats(Stats)
+ ;
+ { HLDS0 = HLDS },
+ { DeepProfilingStructures = [] }
+ ).
:- pred mercury_compile__maybe_introduce_accumulators(module_info, bool, bool,
module_info, io__state, io__state).
@@ -3040,22 +3076,28 @@
},
globals__io_lookup_bool_option(profile_calls, ProfileCalls),
{ ProfileCalls = yes ->
- ProfileCallsOpt = "-DPROFILE_CALLS "
+ ProfileCallsOpt = "-DMR_MPROF_PROFILE_CALLS "
;
ProfileCallsOpt = ""
},
globals__io_lookup_bool_option(profile_time, ProfileTime),
{ ProfileTime = yes ->
- ProfileTimeOpt = "-DPROFILE_TIME "
+ ProfileTimeOpt = "-DMR_MPROF_PROFILE_TIME "
;
ProfileTimeOpt = ""
},
globals__io_lookup_bool_option(profile_memory, ProfileMemory),
{ ProfileMemory = yes ->
- ProfileMemoryOpt = "-DPROFILE_MEMORY "
+ ProfileMemoryOpt = "-DMR_MPROF_PROFILE_MEMORY "
;
ProfileMemoryOpt = ""
},
+ globals__io_lookup_bool_option(profile_deep, ProfileDeep),
+ { ProfileDeep = yes ->
+ ProfileDeepOpt = "-DMR_DEEP_PROFILING "
+ ;
+ ProfileDeepOpt = ""
+ },
globals__io_lookup_bool_option(pic_reg, PIC_Reg),
{ PIC_Reg = yes ->
PIC_Reg_Opt = "-DPIC_REG "
@@ -3171,7 +3213,7 @@
CFLAGS_FOR_REGS, " ", CFLAGS_FOR_GOTOS, " ",
CFLAGS_FOR_THREADS, " ",
GC_Opt, ProfileCallsOpt, ProfileTimeOpt, ProfileMemoryOpt,
- PIC_Reg_Opt, TagsOpt, NumTagBitsOpt,
+ ProfileDeepOpt, PIC_Reg_Opt, TagsOpt, NumTagBitsOpt,
Target_DebugOpt, LL_DebugOpt,
StackTraceOpt, RequireTracingOpt,
UseTrailOpt, MinimalModelOpt, TypeLayoutOpt,
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.186
diff -u -b -r1.186 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 2001/05/15 12:14:08 1.186
+++ compiler/mercury_to_mercury.m 2001/05/16 09:59:33
@@ -1188,6 +1188,8 @@
[i(InstanceNum), s(InstanceString)]).
mercury_output_cons_id(tabling_pointer_const(_, _), _) -->
io__write_string("<tabling pointer>").
+mercury_output_cons_id(deep_profiling_proc_static(_), _) -->
+ io__write_string("<deep_profiling_proc_static>").
mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) -->
io__write_string(":- mode ("),
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.33
diff -u -b -r1.33 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2001/05/02 11:36:37 1.33
+++ compiler/ml_unify_gen.m 2001/05/03 06:44:13
@@ -391,6 +391,9 @@
{ Rval = unop(cast(MLDS_VarType),
const(data_addr_const(DataAddr))) }.
+ml_gen_constant(deep_profiling_proc_static_tag(_), _, _) -->
+ { error("ml_gen_constant: deep_profiling_proc_static_tag not yet supported") }.
+
ml_gen_constant(code_addr_constant(PredId, ProcId), _, ProcAddrRval) -->
ml_gen_proc_addr_rval(PredId, ProcId, ProcAddrRval).
@@ -1326,6 +1329,9 @@
{ Tag = tabling_pointer_constant(_, _) },
{ MLDS_Statements = [] }
;
+ { Tag = deep_profiling_proc_static_tag(_) },
+ { MLDS_Statements = [] }
+ ;
{ Tag = no_tag },
( { Args = [Arg], Modes = [Mode] } ->
ml_variable_type(Arg, ArgType),
@@ -1403,6 +1409,9 @@
Tag = tabling_pointer_constant(_, _),
error("ml_tag_offset_and_argnum")
;
+ Tag = deep_profiling_proc_static_tag(_),
+ error("ml_tag_offset_and_argnum")
+ ;
Tag = no_tag,
error("ml_tag_offset_and_argnum")
;
@@ -1745,6 +1754,9 @@
ml_gen_tag_test_rval(tabling_pointer_constant(_, _), _, _, _) = _ :-
% This should never happen
error("Attempted tabling_pointer unification").
+ml_gen_tag_test_rval(deep_profiling_proc_static_tag(_), _, _, _) = _ :-
+ % This should never happen
+ error("Attempted deep_profiling_proc_static unification").
ml_gen_tag_test_rval(no_tag, _, _, _Rval) = const(true).
ml_gen_tag_test_rval(unshared_tag(UnsharedTag), _, _, Rval) =
binop(eq, unop(std_unop(tag), Rval),
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.164
diff -u -b -r1.164 modules.m
--- compiler/modules.m 2001/05/12 05:03:34 1.164
+++ compiler/modules.m 2001/05/15 07:17:00
@@ -1413,6 +1413,7 @@
mercury_public_builtin_module(MercuryPublicBuiltin),
mercury_private_builtin_module(MercuryPrivateBuiltin),
mercury_table_builtin_module(MercuryTableBuiltin),
+ mercury_profiling_builtin_module(MercuryProfilingBuiltin),
ImportDeps = [MercuryPublicBuiltin | ImportDeps0],
UseDeps1 = [MercuryPrivateBuiltin | UseDeps0],
(
@@ -1425,11 +1426,17 @@
; globals__lookup_bool_option(Globals, trace_table_io, yes)
)
->
- UseDeps = [MercuryTableBuiltin | UseDeps1]
+ UseDeps2 = [MercuryTableBuiltin | UseDeps1]
;
- UseDeps = UseDeps1
+ UseDeps2 = UseDeps1
+ ),
+ ( globals__lookup_bool_option(Globals, profile_deep, yes) ->
+ UseDeps = [MercuryProfilingBuiltin|UseDeps2]
+ ;
+ UseDeps = UseDeps2
).
+
:- pred contains_tabling_pragma(item_list::in) is semidet.
contains_tabling_pragma([Item|Items]) :-
@@ -3302,7 +3309,8 @@
:- mode append_to_init_list(in, in, in, di, uo) is det.
append_to_init_list(DepStream, InitFileName, Module) -->
- { llds_out__make_init_name(Module, InitFuncName) },
+ { llds_out__make_init_name(Module, InitFuncName0) },
+ { string__append(InitFuncName0, "init", InitFuncName) },
{ llds_out__make_rl_data_name(Module, RLName) },
io__write_strings(DepStream, [
"\techo ""INIT ", InitFuncName, """ >> ", InitFileName, "\n",
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.115
diff -u -b -r1.115 opt_debug.m
--- compiler/opt_debug.m 2001/05/15 07:11:21 1.115
+++ compiler/opt_debug.m 2001/05/15 10:17:49
@@ -121,7 +121,7 @@
:- import_module prog_out.
:- import_module hlds_pred.
-:- import_module llds_out, opt_util.
+:- import_module llds_out, code_util, opt_util.
:- import_module globals, options.
:- import_module int, set, map, string.
@@ -351,6 +351,10 @@
opt_debug__dump_data_name(tabling_pointer(ProcLabel), Str) :-
opt_debug__dump_proclabel(ProcLabel, ProcLabelStr),
string__append_list(["tabling_pointer(", ProcLabelStr, ")"], Str).
+opt_debug__dump_data_name(deep_profiling_procedure_data(ProcLabel), Str) :-
+ opt_debug__dump_proclabel(ProcLabel, ProcLabelStr),
+ string__append_list(["deep_profiling_procedure_data(",
+ ProcLabelStr, ")"], Str).
opt_debug__dump_rtti_type_id(rtti_type_id(ModuleName, TypeName, Arity), Str) :-
llds_out__sym_name_mangle(ModuleName, ModuleName_str),
@@ -456,6 +460,15 @@
opt_debug__dump_layout_name(module_layout(ModuleName), Str) :-
llds_out__sym_name_mangle(ModuleName, ModuleNameStr),
string__append_list(["module_layout(", ModuleNameStr, ")"], Str).
+opt_debug__dump_layout_name(proc_static(RttiProcLabel), Str) :-
+ ProcLabel = code_util__make_proc_label_from_rtti(RttiProcLabel),
+ opt_debug__dump_proclabel(ProcLabel, ProcLabelStr),
+ string__append_list(["proc_static(", ProcLabelStr, ")"], Str).
+opt_debug__dump_layout_name(proc_static_call_sites(RttiProcLabel), Str) :-
+ ProcLabel = code_util__make_proc_label_from_rtti(RttiProcLabel),
+ opt_debug__dump_proclabel(ProcLabel, ProcLabelStr),
+ string__append_list(["proc_static_call_sites(", ProcLabelStr, ")"],
+ Str).
opt_debug__dump_unop(mktag, "mktag").
opt_debug__dump_unop(tag, "tag").
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.27
diff -u -b -r1.27 optimize.m
--- compiler/optimize.m 2001/05/15 07:11:22 1.27
+++ compiler/optimize.m 2001/05/15 10:18:28
@@ -198,6 +198,8 @@
globals__io_lookup_bool_option(very_verbose, VeryVerbose),
globals__io_lookup_bool_option(optimize_jumps, Jumpopt),
globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt),
+ globals__io_lookup_bool_option(pessimize_tailcalls,
+ PessimizeTailCalls),
globals__io_lookup_bool_option(checked_nondet_tailcalls,
CheckedNondetTailCalls),
globals__io_get_trace_level(TraceLevel),
@@ -210,8 +212,8 @@
[]
),
{ jumpopt_main(Instrs0, LayoutLabelSet, TraceLevel, ProcLabel,
- C0, C1, FullJumpopt, Final, CheckedNondetTailCalls,
- Instrs1, Mod1) },
+ C0, C1, FullJumpopt, Final, PessimizeTailCalls,
+ CheckedNondetTailCalls, Instrs1, Mod1) },
optimize__maybe_opt_debug(Instrs1, C1, "after jump opt",
OptDebugInfo0, OptDebugInfo1)
;
@@ -306,6 +308,8 @@
optimize__maybe_opt_debug(Instrs1, C1, "after frame opt",
OptDebugInfo0, OptDebugInfo1),
globals__io_lookup_bool_option(optimize_fulljumps, FullJumpopt),
+ globals__io_lookup_bool_option(pessimize_tailcalls,
+ PessimizeTailCalls),
globals__io_lookup_bool_option(checked_nondet_tailcalls,
CheckedNondetTailCalls),
globals__io_get_trace_level(TraceLevel),
@@ -319,7 +323,8 @@
),
{ jumpopt_main(Instrs1, LayoutLabelSet, TraceLevel,
ProcLabel, C1, C2, FullJumpopt, Final,
- CheckedNondetTailCalls, Instrs2, _Mod2) },
+ PessimizeTailCalls, CheckedNondetTailCalls,
+ Instrs2, _Mod2) },
optimize__maybe_opt_debug(Instrs2, C2, "after jumps",
OptDebugInfo1, OptDebugInfo2)
;
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.321
diff -u -b -r1.321 options.m
--- compiler/options.m 2001/05/15 07:11:22 1.321
+++ compiler/options.m 2001/05/17 06:39:32
@@ -145,11 +145,24 @@
; profiling % profile_time + profile_calls
; time_profiling % profile_time + profile_calls
; memory_profiling % profime_mem + profile_calls
- ; deep_profiling % profile_time + profile_deep
+ ; deep_profiling % profile_deep
; profile_calls
; profile_time
; profile_memory
; profile_deep
+ ; use_activation_counts
+ % use_activation_counts is used to determine
+ % which mechanism for cycle detection should be
+ % used for deep profiling. Actually, we only
+ % want to use the `yes' value, but we keep
+ % support for the `no' value for benchmarks
+ % for the paper.
+ ; use_zeroing_for_ho_cycles
+ ; use_lots_of_ho_specialization
+ % We should always handle tail recursion
+ % specially in deep profiling; the options is
+ % only for benchmarks for the paper.
+ ; deep_profile_tail_recursion
; debug
; stack_trace
; require_tracing
@@ -380,6 +393,7 @@
; optimize_peep
; optimize_jumps
; optimize_fulljumps
+ ; pessimize_tailcalls
; checked_nondet_tailcalls
; use_local_vars
; optimize_labels
@@ -570,6 +584,12 @@
profile_time - bool(no),
profile_memory - bool(no),
profile_deep - bool(no),
+ use_activation_counts - bool(no),
+ use_zeroing_for_ho_cycles
+ - bool(yes),
+ use_lots_of_ho_specialization
+ - bool(no),
+ deep_profile_tail_recursion - bool(yes),
debug - bool_special,
require_tracing - bool(no),
stack_trace - bool(no),
@@ -770,6 +790,7 @@
optimize_peep - bool(no),
optimize_jumps - bool(no),
optimize_fulljumps - bool(no),
+ pessimize_tailcalls - bool(no),
checked_nondet_tailcalls - bool(no),
use_local_vars - bool(no),
optimize_labels - bool(no),
@@ -985,6 +1006,13 @@
long_option("profile-time", profile_time).
long_option("profile-memory", profile_memory).
long_option("profile-deep", profile_deep).
+long_option("use-activation-counts", use_activation_counts).
+long_option("use-zeroing-for-ho-cycles",
+ use_zeroing_for_ho_cycles).
+long_option("use-lots-of-ho-specialization",
+ use_lots_of_ho_specialization).
+long_option("deep-profile-tail-recursion",
+ deep_profile_tail_recursion).
long_option("debug", debug).
% The following options are not allowed, because they're
% not very useful and would probably only confuse people.
@@ -1206,6 +1234,7 @@
long_option("optimise-jumps", optimize_jumps).
long_option("optimize-fulljumps", optimize_fulljumps).
long_option("optimise-fulljumps", optimize_fulljumps).
+long_option("pessimize-tailcalls", pessimize_tailcalls).
long_option("checked-nondet-tailcalls", checked_nondet_tailcalls).
long_option("use-local-vars", use_local_vars).
long_option("optimize-labels", optimize_labels).
@@ -1301,7 +1330,7 @@
map__set(OptionTable2, profile_memory, bool(yes), OptionTable3),
map__set(OptionTable3, profile_deep, bool(no), OptionTable).
special_handler(deep_profiling, none, OptionTable0, ok(OptionTable)) :-
- map__set(OptionTable0, profile_time, bool(yes), OptionTable1),
+ map__set(OptionTable0, profile_time, bool(no), OptionTable1),
map__set(OptionTable1, profile_calls, bool(no), OptionTable2),
map__set(OptionTable2, profile_memory, bool(no), OptionTable3),
map__set(OptionTable3, profile_deep, bool(yes), OptionTable).
@@ -2064,6 +2093,9 @@
"--memory-profiling\t\t(grade modifier: `.memprof')",
"\tEnable memory and call profiling.",
"\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.",
/*****************
XXX The following options are not documented,
because they are currently not useful.
@@ -2547,6 +2579,8 @@
"\tDisable elimination of jumps to jumps.",
"--no-optimize-fulljumps",
"\tDisable elimination of jumps to ordinary code.",
+ "--pessimize-tailcalls",
+ "\tDisable the optimization of tailcalls.",
"--checked-nondet-tailcalls",
"\tConvert nondet calls into tail calls whenever possible, even",
"\twhen this requires a runtime check. This option tries to",
Index: compiler/prog_rep.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_rep.m,v
retrieving revision 1.7
diff -u -b -r1.7 prog_rep.m
--- compiler/prog_rep.m 2001/04/07 14:04:56 1.7
+++ compiler/prog_rep.m 2001/05/03 06:41:38
@@ -96,6 +96,8 @@
Rep = "$base_typeclass_info_const".
prog_rep__represent_cons_id(tabling_pointer_const(_, _), Rep) :-
Rep = "$tabling_pointer_const".
+prog_rep__represent_cons_id(deep_profiling_proc_static(_), Rep) :-
+ Rep = "$deep_profiling_procedure_data".
:- pred prog_rep__represent_sym_name(sym_name::in, string::out) is det.
Index: compiler/prog_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_util.m,v
retrieving revision 1.51
diff -u -b -r1.51 prog_util.m
--- compiler/prog_util.m 2000/09/21 00:21:06 1.51
+++ compiler/prog_util.m 2001/05/03 06:41:38
@@ -43,6 +43,13 @@
:- pred mercury_table_builtin_module(sym_name).
:- mode mercury_table_builtin_module(out) is det.
+ % Returns the name of the module containing the builtins for
+ % deep profiling.
+ % This module is automatically imported iff deep profiling is
+ % enabled.
+:- pred mercury_profiling_builtin_module(sym_name).
+:- mode mercury_profiling_builtin_module(out) is det.
+
% Succeeds iff the specified module is one of the three
% builtin modules listed above which are automatically imported.
@@ -192,11 +199,13 @@
mercury_public_builtin_module(unqualified("builtin")).
mercury_private_builtin_module(unqualified("private_builtin")).
mercury_table_builtin_module(unqualified("table_builtin")).
+mercury_profiling_builtin_module(unqualified("profiling_builtin")).
any_mercury_builtin_module(Module) :-
( mercury_public_builtin_module(Module)
; mercury_private_builtin_module(Module)
; mercury_table_builtin_module(Module)
+ ; mercury_profiling_builtin_module(Module)
).
unqualify_name(unqualified(PredName), PredName).
Index: compiler/rl_exprn.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_exprn.m,v
retrieving revision 1.20
diff -u -b -r1.20 rl_exprn.m
--- compiler/rl_exprn.m 2001/04/07 14:04:57 1.20
+++ compiler/rl_exprn.m 2001/05/03 06:41:38
@@ -502,6 +502,9 @@
rl_exprn__set_term_arg_cons_id_code(tabling_pointer_const(_, _),
_, _, _, _, _, _) -->
{ error("rl_exprn__set_term_arg_cons_id_code") }.
+rl_exprn__set_term_arg_cons_id_code(deep_profiling_proc_static(_),
+ _, _, _, _, _, _) -->
+ { error("rl_exprn__set_term_arg_cons_id_code") }.
:- pred rl_exprn__set_term_arg_cons_id_code_2(aditi_type::in, tuple_num::in,
int::in, bool::in, bytecode::out) is det.
@@ -1148,6 +1151,9 @@
;
{ ConsId = tabling_pointer_const(_, _) },
{ error("rl_exprn__unify: unsupported cons_id - tabling_pointer_const") }
+ ;
+ { ConsId = deep_profiling_proc_static(_) },
+ { error("rl_exprn__unify: unsupported cons_id - deep_profiling_proc_static") }
).
rl_exprn__unify(deconstruct(Var, ConsId, Args, UniModes, CanFail, _CanCGC),
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.12
diff -u -b -r1.12 rtti.m
--- compiler/rtti.m 2000/12/18 07:40:33 1.12
+++ compiler/rtti.m 2001/05/03 08:09:14
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2000 The University of Melbourne.
+% Copyright (C) 2000-2001 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -417,6 +417,10 @@
% Construct an rtti_proc_label for a given procedure.
:- func rtti__make_proc_label(module_info, pred_id, proc_id) = rtti_proc_label.
+ % Construct an rtti_proc_label for a given procedure.
+:- pred rtti__proc_label_pred_proc_id(rtti_proc_label::in,
+ pred_id::out, proc_id::out) is det.
+
% Return the C variable name of the RTTI data structure identified
% by the input arguments.
% XXX this should be in rtti_out.m
@@ -545,6 +549,10 @@
ProcVarSet, ProcHeadVars, ProcArgModes, ProcCodeModel,
IsImported, IsPseudoImp, IsExported, IsSpecialPredInstance).
+rtti__proc_label_pred_proc_id(ProcLabel, PredId, ProcId) :-
+ ProcLabel = rtti_proc_label(_, _, _, _, _, _, PredId, ProcId,
+ _, _, _, _, _, _, _, _).
+
rtti__addr_to_string(RttiTypeId, RttiName, Str) :-
rtti__mangle_rtti_type_id(RttiTypeId, ModuleName, TypeName, A_str),
(
@@ -625,8 +633,8 @@
TypeName, "_", A_str], Str)
).
-:- pred rtti__mangle_rtti_type_id(rtti_type_id, string, string, string).
-:- mode rtti__mangle_rtti_type_id(in, out, out, out) is det.
+:- pred rtti__mangle_rtti_type_id(rtti_type_id::in,
+ string::out, string::out, string::out) is det.
rtti__mangle_rtti_type_id(RttiTypeId, ModuleName, TypeName, A_str) :-
RttiTypeId = rtti_type_id(ModuleName0, TypeName0, TypeArity),
Index: compiler/switch_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/switch_util.m,v
retrieving revision 1.2
diff -u -b -r1.2 switch_util.m
--- compiler/switch_util.m 2000/11/21 13:37:45 1.2
+++ compiler/switch_util.m 2001/05/03 06:41:38
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 2000 The University of Melbourne.
+% Copyright (C) 2000-2001 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
@@ -287,6 +287,7 @@
switch_util__switch_priority(type_ctor_info_constant(_, _, _), 6).
switch_util__switch_priority(base_typeclass_info_constant(_, _, _), 6).
switch_util__switch_priority(tabling_pointer_constant(_, _), 6).
+switch_util__switch_priority(deep_profiling_proc_static_tag(_), 6).
% Determine the range of an atomic type.
% Fail if the type isn't the sort of type that has a range
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.95
diff -u -b -r1.95 type_util.m
--- compiler/type_util.m 2001/05/08 13:37:43 1.95
+++ compiler/type_util.m 2001/05/09 06:27:51
@@ -167,6 +167,7 @@
:- func string_type = (type).
:- func float_type = (type).
:- func char_type = (type).
+:- func c_pointer_type = (type).
% Given a constant and an arity, return a type_id.
% Fails if the constant is not an atom.
@@ -756,10 +757,21 @@
term__functor(term__atom("aditi_bottom_up"), [Type0], Context)) :-
term__context_init(Context).
-int_type = Type :- construct_type(unqualified("int") - 0, [], Type).
-string_type = Type :- construct_type(unqualified("string") - 0, [], Type).
-float_type = Type :- construct_type(unqualified("float") - 0, [], Type).
-char_type = Type :- construct_type(unqualified("character") - 0, [], Type).
+int_type = Type :-
+ construct_type(unqualified("int") - 0, [], Type).
+
+string_type = Type :-
+ construct_type(unqualified("string") - 0, [], Type).
+
+float_type = Type :-
+ construct_type(unqualified("float") - 0, [], Type).
+
+char_type = Type :-
+ construct_type(unqualified("character") - 0, [], Type).
+
+c_pointer_type = Type :-
+ mercury_public_builtin_module(BuiltinModule),
+ construct_type(qualified(BuiltinModule, "c_pointer") - 0, [], Type).
%-----------------------------------------------------------------------------%
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.113
diff -u -b -r1.113 unify_gen.m
--- compiler/unify_gen.m 2001/01/18 01:18:59 1.113
+++ compiler/unify_gen.m 2001/05/03 06:41:38
@@ -38,7 +38,7 @@
:- implementation.
-:- import_module rtti, builtin_ops.
+:- import_module rtti, layout, builtin_ops.
:- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
:- import_module globals, options, continuation_info, stack_layout.
@@ -242,6 +242,9 @@
unify_gen__generate_tag_rval_2(tabling_pointer_constant(_, _), _, _) :-
% This should never happen
error("Attempted tabling_pointer unification").
+unify_gen__generate_tag_rval_2(deep_profiling_proc_static_tag(_), _, _) :-
+ % This should never happen
+ error("Attempted deep_profiling_proc_static_tag unification").
unify_gen__generate_tag_rval_2(no_tag, _Rval, TestRval) :-
TestRval = const(true).
unify_gen__generate_tag_rval_2(unshared_tag(UnsharedTag), Rval, TestRval) :-
@@ -359,6 +362,20 @@
{ module_info_name(ModuleInfo, ModuleName) },
{ DataAddr = data_addr(ModuleName, tabling_pointer(ProcLabel)) },
code_info__assign_const_to_var(Var, const(data_addr_const(DataAddr))).
+unify_gen__generate_construction_2(
+ deep_profiling_proc_static_tag(RttiProcLabel),
+ Var, Args, _Modes, _, _, empty) -->
+ ( { Args = [] } ->
+ []
+ ;
+ { 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),
Var, Args, _Modes, _, _, empty) -->
( { Args = [] } ->
@@ -422,7 +439,12 @@
% But det is compatible with nondet.
{ CodeModel = CallCodeModel
; CodeModel = model_non, CallCodeModel = model_det
- }
+ },
+ % This optimization distorts deep profiles, so don't
+ % perform it in deep profiling grades.
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_bool_option(Globals, profile_deep, Deep) },
+ { Deep = no }
->
( { CallArgs = [] } ->
% if there are no new arguments, we can just use the old
@@ -707,6 +729,9 @@
{ Code = empty }
;
{ Tag = tabling_pointer_constant(_, _) },
+ { Code = empty }
+ ;
+ { Tag = deep_profiling_proc_static_tag(_) },
{ Code = empty }
;
{ Tag = no_tag },
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.61
diff -u -b -r1.61 compiler_design.html
--- compiler/notes/compiler_design.html 2001/05/16 04:50:55 1.61
+++ compiler/notes/compiler_design.html 2001/05/16 09:59:34
@@ -621,6 +621,11 @@
for high-level optimizations (but which is not yet used).
<p>
+
+The last HLDS-to-HLDS transformation implements deep profiling
+(deep_profiling.m).
+
+<p>
<hr>
<!---------------------------------------------------------------------------->
cvs diff: Diffing debian
cvs diff: Diffing deep
Index: deep/Mmakefile
===================================================================
RCS file: Mmakefile
diff -N Mmakefile
--- /dev/null Fri Dec 1 02:25:58 2000
+++ Mmakefile Wed May 16 00:39:43 2001
@@ -0,0 +1,142 @@
+#-----------------------------------------------------------------------------#
+# Copyright (C) 1995-2001 The University of Melbourne.
+# This file may only be copied under the terms of the GNU General
+# Public Licence - see the file COPYING in the Mercury distribution.
+#-----------------------------------------------------------------------------#
+
+# Mmake - this is Mmake file for building the Mercury deep profiler
+
+-include Mmake.deep.params
+
+MERCURY_DIR=..
+include $(MERCURY_DIR)/Mmake.common
+
+MAIN_TARGET=mdprof_cgi mdprof_server
+
+VPATH=$(LIBRARY_DIR)
+
+#-----------------------------------------------------------------------------#
+
+# Specify which compilers to use to compile the profiler.
+# Don't change these without good reason - if you want to
+# do a temporary change, change ../Mmake.params
+
+M_ENV = MERCURY_INT_DIR=$(LIBRARY_DIR) \
+ MERCURY_ALL_C_INCL_DIRS="\
+ -I$(TRACE_DIR) \
+ -I$(LIBRARY_DIR) \
+ -I$(RUNTIME_DIR) \
+ -I$(BOEHM_GC_DIR) \
+ -I$(BOEHM_GC_DIR)/include \
+ "
+MCD = $(M_ENV) $(MC) --generate-dependencies
+MCI = $(M_ENV) $(MC) --make-interface
+MCPI = $(M_ENV) $(MC) --make-private-interface
+MCSI = $(M_ENV) $(MC) --make-short-interface
+MCOI = $(M_ENV) $(MC) --make-optimization-interface
+MCTOI = $(M_ENV) $(MC) --make-transitive-optimization-interface
+MCG = $(M_ENV) $(MC) --compile-to-c
+MCS = $(M_ENV) $(MC) --split-c-files -c --cflags "$(ALL_CFLAGS)"
+MGNUC = $(M_ENV) $(SCRIPTS_DIR)/mgnuc
+C2INIT = MERCURY_MOD_LIB_MODS="$(LIBRARY_DIR)/$(STD_LIB_NAME).init $(RUNTIME_DIR)/$(RT_LIB_NAME).init" \
+ MERCURY_TRACE_LIB_MODS="$(BROWSER_DIR)/$(BROWSER_LIB_NAME).init" \
+ MERCURY_MKINIT=$(UTIL_DIR)/mkinit $(SCRIPTS_DIR)/c2init
+ML = MERCURY_C_LIB_DIR=. $(SCRIPTS_DIR)/ml
+MLFLAGS = --shared --mercury-libs none
+MLLIBS = $(TRACE_DIR)/lib$(TRACE_LIB_NAME).$A \
+ $(BROWSER_DIR)/lib$(BROWSER_LIB_NAME).$A \
+ $(LIBRARY_DIR)/lib$(STD_LIB_NAME).$A \
+ $(RUNTIME_DIR)/lib$(RT_LIB_NAME).$A ` \
+ case $(GRADE) in \
+ *.par*.gc*.prof*) \
+ echo $(BOEHM_GC_DIR)/libpar_gc_prof.$A ;; \
+ *.par*.gc*) echo $(BOEHM_GC_DIR)/libpar_gc.$A ;; \
+ *.gc*.prof*) echo $(BOEHM_GC_DIR)/libgc_prof.$A ;; \
+ *.gc*) echo $(BOEHM_GC_DIR)/libgc.$A ;; \
+ esac \
+ ` $(MATH_LIB)
+MSL = MERCURY_SP_LIB_DIR=$(LIBRARY_DIR) $(SCRIPTS_DIR)/msl
+MNLFLAGS = -u 6000
+MTAGS = $(SCRIPTS_DIR)/mtags
+
+#-----------------------------------------------------------------------------#
+
+.PHONY: depend
+depend: mdprof_cgi.depend mdprof_server.depend
+
+.PHONY: all
+all: mdprof_cgi mdprof_server
+
+#-----------------------------------------------------------------------------#
+
+# Add some additional dependencies, so that Mmake knows to remake the
+# profiler if one of the libraries changes.
+
+mdprof_cgi: $(RUNTIME_DIR)/lib$(RT_LIB_NAME).$A
+mdprof_cgi: $(LIBRARY_DIR)/lib$(STD_LIB_NAME).$A
+mdprof_server: $(RUNTIME_DIR)/lib$(RT_LIB_NAME).$A
+mdprof_server: $(LIBRARY_DIR)/lib$(STD_LIB_NAME).$A
+# Should also depend on $(BOEHM_GC_DIR)/libgc(_prof).$A, but only
+# if in .gc(.prof) grade; GNU make does not support dynamic dependencies,
+# so just leave it out.
+
+$(cs_subdir)mdprof_cgi_init.c: $(UTIL_DIR)/mkinit
+$(cs_subdir)mdprof_server.c: $(UTIL_DIR)/mkinit
+
+#-----------------------------------------------------------------------------#
+
+.PHONY: check
+check: mdprof_cgi.check mdprof_server.check
+
+.PHONY: ints
+ints: mdprof_cgi.ints mdprof_server.ints
+
+#-----------------------------------------------------------------------------#
+
+# We need the shenanigans with .deep.tags to avoid situations in which an
+# "mmake tags" in this directory does nothing even in the absence of a tags
+# file in this directory, because mmake uses VPATH to find ../library/tags
+# and believes it to be the tags file we are asking for.
+
+.PHONY: tags
+tags: .deep.tags
+
+.deep.tags: $(MTAGS) $(mdprof_cgi.ms) $(mdprof_server.ms) $(LIBRARY_DIR)/*.m
+ $(MTAGS) $(mdprof_cgi.ms) $(mdprof_server.ms) $(LIBRARY_DIR)/*.m
+ touch .deep.tags
+
+#-----------------------------------------------------------------------------#
+
+.PHONY: dates
+dates:
+ touch $(mdprof_cgi.dates) $(mdprof_server.dates)
+
+#-----------------------------------------------------------------------------#
+
+.PHONY: os cs
+os: $(mdprof_cgi.os) $(os_subdir)mdprof_cgi_init.o
+os: $(mdprof_server.os) $(os_subdir)mdprof_server.o
+cs: $(mdprof_cgi.cs) $(cs_subdir)mdprof_cgi_init.c
+cs: $(mdprof_server.cs) $(cs_subdir)mdprof_server.c
+
+#-----------------------------------------------------------------------------#
+
+realclean_local:
+ rm -f tags
+
+#-----------------------------------------------------------------------------#
+
+# Installation targets
+
+.PHONY: install
+install: install_deep
+
+.PHONY: install_deep
+install_deep: mdprof_cgi mdprof_server
+ -[ -d $(INSTALL_MERC_BIN_DIR) ] || mkdir -p $(INSTALL_MERC_BIN_DIR)
+ cp `vpath_find mdprof_cgi$(EXT_FOR_EXE)` \
+ $(INSTALL_MERC_BIN_DIR)/mdprof_cgi
+ cp `vpath_find mdprof_server$(EXT_FOR_EXE)`\
+ $(INSTALL_MERC_BIN_DIR)/mdprof_server
+
+#-----------------------------------------------------------------------------#
Index: deep/array_util.m
===================================================================
RCS file: array_util.m
diff -N array_util.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ array_util.m Mon May 14 12:51:48 2001
@@ -0,0 +1,116 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains utility predicates for handling arrays.
+
+:- module array_util.
+
+:- interface.
+
+:- import_module array, list.
+
+:- func u(T) = T.
+:- mode (u(in) = array_uo) is det.
+
+:- pred array_foldl(pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl(pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl(pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl(pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl0(pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl0(pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl0(pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl0(pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl(int, int, pred(int, T, U, U), array(T), U, U).
+:- mode array_foldl(in, in, pred(in, in, di, uo) is det, in, di, uo) is det.
+:- mode array_foldl(in, in, pred(in, in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+:- mode array_foldl(in, in, pred(in, in, in, out) is det, in, in, out) is det.
+
+:- pred array_foldl2(pred(int, T, U, U, V, V), array(T), U, U, V, V).
+:- mode array_foldl2(pred(in, in, di, uo, di, uo) is det, in, di, uo, di, uo)
+ is det.
+:- mode array_foldl2(pred(in, in, array_di, array_uo, array_di, array_uo)
+ is det, in, array_di, array_uo, array_di, array_uo)
+ is det.
+:- mode array_foldl2(pred(in, in, in, out, di, uo) is det, in, in, out, di, uo)
+ is det.
+
+:- pred array_foldl2(int, int, pred(int, T, U, U, V, V), array(T), U, U, V, V).
+:- mode array_foldl2(in, in, pred(in, in, di, uo, di, uo) is det, in,
+ di, uo, di, uo) is det.
+:- mode array_foldl2(in, in, pred(in, in,
+ array_di, array_uo, array_di, array_uo) is det, in,
+ array_di, array_uo, array_di, array_uo) is det.
+:- mode array_foldl2(in, in, pred(in, in, in, out, di, uo) is det, in,
+ in, out, di, uo) is det.
+
+:- pred array_list_foldl(pred(T, array(U), array(U)), list(T),
+ array(U), array(U)).
+:- mode array_list_foldl(pred(in, array_di, array_uo) is det, in,
+ array_di, array_uo) is det.
+
+:- pred array_list_foldl2(pred(T, array(U), array(U), array(V), array(V)),
+ list(T), array(U), array(U), array(V), array(V)).
+:- mode array_list_foldl2(pred(in, array_di, array_uo, array_di, array_uo)
+ is det, in, array_di, array_uo, array_di, array_uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int, string.
+
+:- pragma foreign_proc("C", u(A::in) = (B::array_uo),
+ [will_not_call_mercury, thread_safe],
+ "B = A;"
+).
+
+array_foldl(P, A, U0, U) :-
+ array__max(A, Max),
+ array_foldl(1, Max, P, A, U0, U).
+
+array_foldl0(P, A, U0, U) :-
+ array__max(A, Max),
+ array_foldl(0, Max, P, A, U0, U).
+
+array_foldl(N, Max, P, A, U0, U) :-
+ ( N =< Max ->
+ array__lookup(A, N, E),
+ call(P, N, E, U0, U1),
+ array_foldl(N + 1, Max, P, A, U1, U)
+ ;
+ U = U0
+ ).
+
+array_foldl2(P, A, U0, U, V0, V) :-
+ array__max(A, Max),
+ array_foldl2(1, Max, P, A, U0, U, V0, V).
+
+array_foldl2(N, Max, P, A, U0, U, V0, V) :-
+ ( N =< Max ->
+ array__lookup(A, N, E),
+ call(P, N, E, U0, U1, V0, V1),
+ array_foldl2(N + 1, Max, P, A, U1, U, V1, V)
+ ;
+ U = U0,
+ V = V0
+ ).
+
+array_list_foldl(_, [], Acc, Acc).
+array_list_foldl(P, [X | Xs], Acc0, Acc) :-
+ call(P, X, Acc0, Acc1),
+ array_list_foldl(P, Xs, Acc1, Acc).
+
+array_list_foldl2(_, [], AccU, AccU, AccV, AccV).
+array_list_foldl2(P, [X | Xs], AccU0, AccU, AccV0, AccV) :-
+ call(P, X, AccU0, AccU1, AccV0, AccV1),
+ array_list_foldl2(P, Xs, AccU1, AccU, AccV1, AccV).
Index: deep/cliques.m
===================================================================
RCS file: cliques.m
diff -N cliques.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ cliques.m Mon May 14 12:51:49 2001
@@ -0,0 +1,170 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% 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.
+
+:- module cliques.
+
+:- interface.
+
+:- type graph.
+
+:- import_module list, set.
+
+% Create a graph with no edges.
+:- pred init(graph::out) is det.
+
+% Add an arc from one node to another.
+:- pred add_arc(graph::in, int::in, int::in, graph::out) is det.
+
+% Perform a topological sort on the graph. Each set of integers in the
+% resulting list gives the ids of the nodes in a clique. The list contains
+% the cliques in bottom-up order: if there is an arc from node A to node B
+% and the two nodes are not in the same clique, then the clique containing
+% node A will be before the clique containing node B.
+:- pred topological_sort(graph::in, list(set(int))::out) is det.
+
+:- implementation.
+
+:- import_module array_util, dense_bitset.
+:- import_module array, int.
+
+:- type graph --->
+ graph(
+ int,
+ array(set(int))
+ ).
+
+:- type visit == dense_bitset.
+
+init(graph(1, Array)) :-
+ % The initial array size doesn't really matter.
+ array__init(16, set__init, Array).
+
+add_arc(graph(Size0, Array0), From, To, Graph) :-
+ ( array__in_bounds(Array0, From) ->
+ array__lookup(Array0, From, Tos0),
+ set__insert(Tos0, To, Tos),
+ array__set(u(Array0), From, Tos, Array),
+ Size = int__max(int__max(From, To), Size0),
+ Graph = graph(Size, Array)
+ ;
+ array__size(Array0, Size),
+ array__resize(u(Array0), Size * 2, init, Array1),
+ add_arc(graph(Size0, Array1), From, To, Graph)
+ ).
+
+:- pred successors(graph::in, int::in, set(int)::out) is det.
+
+successors(graph(_Size, Array), From, Tos) :-
+ ( array__in_bounds(Array, From) ->
+ array__lookup(Array, From, Tos)
+ ;
+ Tos = set__init
+ ).
+
+:- pred mklist(int::in, list(int)::in, list(int)::out) is det.
+
+mklist(N, Acc0, Acc) :-
+ ( N < 0 ->
+ Acc = Acc0
+ ;
+ Acc1 = [N | Acc0],
+ mklist(N - 1, Acc1, Acc)
+ ).
+
+topological_sort(Graph, TSort) :-
+ dfs_graph(Graph, Dfs),
+ inverse(Graph, InvGraph),
+ Visit = dense_bitset__init,
+ tsort(Dfs, InvGraph, Visit, [], TSort0),
+ reverse(TSort0, TSort).
+
+:- pred tsort(list(int)::in, graph::in, visit::array_di, list(set(int))::in,
+ list(set(int))::out) is det.
+
+tsort([], _InvGraph, _Visit, TSort, TSort).
+tsort([Node | Nodes], InvGraph, Visit0, TSort0, TSort) :-
+ ( dense_bitset__member(Node, Visit0) ->
+ tsort(Nodes, InvGraph, Visit0, TSort0, TSort)
+ ;
+ dfs([Node], InvGraph, Visit0, [], Visit, CliqueList),
+ set__list_to_set(CliqueList, Clique),
+ tsort(Nodes, InvGraph, Visit, [Clique | TSort0], TSort)
+ ).
+
+% Return a list containing all the nodes of the graph. The list is effectively
+% computed by randomly breaking all cycles, doing a pre-order traversal of
+% the resulting trees, and concatenating the resulting lists in a random order.
+
+:- pred dfs_graph(graph::in, list(int)::out) is det.
+
+dfs_graph(Graph, Dfs) :-
+ Graph = graph(Size, _Array),
+ mklist(Size, [], NodeList),
+ Visit = dense_bitset__init,
+ dfs_graph_2(NodeList, Graph, Visit, [], Dfs).
+
+:- pred dfs_graph_2(list(int)::in, graph::in, visit::array_di,
+ list(int)::in, list(int)::out) is det.
+
+dfs_graph_2([], _Graph, _Visit, Dfs, Dfs).
+dfs_graph_2([Node | Nodes], Graph, Visit0, Dfs0, Dfs) :-
+ dfs([Node], Graph, Visit0, Dfs0, Visit, Dfs1),
+ dfs_graph_2(Nodes, Graph, Visit, Dfs1, Dfs).
+
+% dfs(NodeList, Graph, Visit0, Dfs0, Visit, Dfs):
+% For every node in NodeList, add the node and all its successors to the front
+% of Dfs0, giving Dfs. The descendants of a node will in general be after that
+% node in Dfs. The only situation where that may not be the case is when two
+% nodes are descendants of each other. We detect such situations by passing
+% along the set of nodes that have been visited already.
+
+:- pred dfs(list(int)::in, graph::in, visit::array_di, list(int)::in,
+ visit::array_uo, list(int)::out) is det.
+
+dfs([], _Graph, Visit, Dfs, Visit, Dfs).
+dfs([Node | Nodes], Graph, Visit0, Dfs0, Visit, Dfs) :-
+ ( dense_bitset__member(Node, Visit0) ->
+ dfs(Nodes, Graph, Visit0, Dfs0, Visit, Dfs)
+ ;
+ Visit1 = dense_bitset__insert(Visit0, Node),
+ successors(Graph, Node, Succ),
+ set__to_sorted_list(Succ, SuccList),
+ dfs(SuccList, Graph, Visit1, Dfs0, Visit2, Dfs1),
+ Dfs2 = [Node | Dfs1],
+ dfs(Nodes, Graph, Visit2, Dfs2, Visit, Dfs)
+ ).
+
+:- pred inverse(graph::in, graph::out) is det.
+
+inverse(Graph, InvGraph) :-
+ init(InvGraph0),
+ Graph = graph(Size, _Array),
+ inverse_2(Size, Graph, InvGraph0, InvGraph).
+
+:- pred inverse_2(int::in, graph::in, graph::in, graph::out) is det.
+
+inverse_2(To, Graph, InvGraph0, InvGraph) :-
+ ( To >= 0 ->
+ successors(Graph, To, Froms),
+ set__to_sorted_list(Froms, FromList),
+ add_arcs_to(FromList, To, InvGraph0, InvGraph1),
+ inverse_2(To - 1, Graph, InvGraph1, InvGraph)
+ ;
+ InvGraph = InvGraph0
+ ).
+
+:- pred add_arcs_to(list(int)::in, int::in, graph::in, graph::out) is det.
+
+add_arcs_to([], _, Graph, Graph).
+add_arcs_to([From | FromList], To, Graph0, Graph) :-
+ add_arc(Graph0, From, To, Graph1),
+ add_arcs_to(FromList, To, Graph1, Graph).
Index: deep/conf.m
===================================================================
RCS file: conf.m
diff -N conf.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ conf.m Wed May 16 00:58:01 2001
@@ -0,0 +1,89 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: zs.
+%
+% This module contains primitives whose parameters are decided by
+% ../configure.in. This module picks them up from the #defines put into
+% runtime/mercury_conf.h by the configure script.
+
+:- module conf.
+
+:- interface.
+
+:- import_module io.
+
+ % Given a pathname, return a shell command that will create
+ % a named pipe with that pathname.
+:- func make_pipe_cmd(string) = string.
+
+ % The name of the server on which mdprof is being run.
+:- pred server_name(string::out, io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module string, list, require.
+
+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)
+ ;
+ error("make_pipe_cmd: do not know what command to use")
+ ).
+
+server_name(ServerName) -->
+ io__make_temp(TmpFile),
+ { hostname_cmd(HostnameCmd) },
+ { ServerRedirectCmd =
+ string__format("%s > %s", [s(HostnameCmd), s(TmpFile)]) },
+ io__call_system(ServerRedirectCmd, Res1),
+ ( { Res1 = ok(0) } ->
+ io__see(TmpFile, Res2),
+ ( { Res2 = ok } ->
+ io__read_file(Res3),
+ ( { Res3 = ok(ServerNameChars0) } ->
+ (
+ { list__remove_suffix(ServerNameChars0,
+ ['\n'], ServerNameChars) }
+ ->
+ { string__from_char_list(
+ ServerNameChars, ServerName) },
+ io__seen
+ ;
+ { error("malformed server name") }
+ )
+ ;
+ { error("cannot read server's name") }
+ )
+ ;
+ { error("cannot open file to out the server's name") }
+ )
+ ;
+ { error("cannot execute cmd to find out the server's name") }
+ ).
+
+:- pred mkfifo_cmd(string::out) is det.
+
+:- pragma foreign_proc("C", mkfifo_cmd(Mkfifo::out),
+ [will_not_call_mercury],
+"
+ /* shut up warnings about casting away const */
+ Mkfifo = (MR_String) (MR_Integer) MR_MKFIFO;
+").
+
+:- pred hostname_cmd(string::out) is det.
+
+:- pragma foreign_proc("C", hostname_cmd(Hostname::out),
+ [will_not_call_mercury],
+"
+ /* shut up warnings about casting away const */
+ Hostname = (MR_String) (MR_Integer) MR_HOSTNAMECMD;
+").
Index: deep/dense_bitset.m
===================================================================
RCS file: dense_bitset.m
diff -N dense_bitset.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ dense_bitset.m Mon May 14 12:51:48 2001
@@ -0,0 +1,139 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: conway.
+%
+% 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.
+
+:- module dense_bitset.
+
+:- interface.
+
+:- import_module array, int.
+
+:- type dense_bitset.
+
+:- func init = dense_bitset.
+:- mode (init = array_uo) is det.
+
+:- pred member(int, dense_bitset).
+:- mode member(in, array_ui) is semidet.
+
+:- func insert(dense_bitset, int) = dense_bitset.
+:- mode (insert(array_di, in) = array_uo) is det.
+
+:- func delete(dense_bitset, int) = dense_bitset.
+:- mode (delete(array_di, in) = array_uo) is det.
+
+:- func union(dense_bitset, dense_bitset) = dense_bitset.
+:- mode (union(array_di, array_di) = array_uo) is det.
+
+% Not yet implemented.
+% :- func intersection(dense_bitset, dense_bitset) = dense_bitset.
+% :- mode (intersection(array_di, array_di) = array_uo) is det.
+
+% Not yet implemented.
+% :- func difference(dense_bitset, dense_bitset) = dense_bitset.
+% :- mode (difference(array_di, array_di) = array_uo) is det.
+
+:- pred foldl(pred(int, T, T), dense_bitset, T, T).
+:- mode foldl(pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl(pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl(pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+:- implementation.
+
+:- import_module list, require.
+
+:- type dense_bitset == array(int).
+
+init = array([0]).
+
+member(I, A) :-
+ max(A, Max),
+ ( word(I) >= 0, word(I) =< Max ->
+ lookup(A, word(I), Word),
+ bit(I) /\ Word \= 0
+ ;
+ fail
+ ).
+
+insert(A0, I) = A :-
+ max(A0, Max),
+ ( word(I) > Max ->
+ resize(A0, (Max + 1) * 2, 0, A1),
+ A = insert(A1, I)
+ ; I >= 0 ->
+ lookup(A0, word(I), Word0),
+ Word = Word0 \/ bit(I),
+ set(A0, word(I), Word, A)
+ ;
+ error("insert: cannot use indexes < 0")
+ ).
+
+delete(A0, I) = A :-
+ max(A0, Max),
+ ( I > Max ->
+ A = A0
+ ; I >= 0 ->
+ lookup(A0, word(I), Word0),
+ Word = Word0 /\ \ bit(I),
+ set(A0, word(I), Word, A)
+ ;
+ error("delete: cannot use indexes < 0")
+ ).
+
+union(A, B) = C :-
+ foldl((pred(I::in, C0::array_di, C1::array_uo) is det :-
+ C1 = insert(C0, I)
+ ), A, B, C).
+
+foldl(P, A0, Acc0, Acc) :-
+ max(A0, Max),
+ foldl1(0, Max, P, A0, Acc0, Acc).
+
+:- pred foldl1(int, int, pred(int, T, T), dense_bitset, T, T).
+:- mode foldl1(in, in, pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl1(in, in, pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl1(in, in, pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+foldl1(Min, Max, P, A0, Acc0, Acc) :-
+ ( Min =< Max ->
+ foldl2(0, Min, P, A0, Acc0, Acc1),
+ foldl1(Min + 1, Max, P, A0, Acc1, Acc)
+ ;
+ Acc = Acc0
+ ).
+
+:- pred foldl2(int, int, pred(int, T, T), dense_bitset, T, T).
+:- mode foldl2(in, in, pred(in, in, out) is det, array_ui, in, out) is det.
+:- mode foldl2(in, in, pred(in, di, uo) is det, array_ui, di, uo) is det.
+:- mode foldl2(in, in, pred(in, array_di, array_uo) is det, array_ui,
+ array_di, array_uo) is det.
+
+foldl2(B, W, P, A0, Acc0, Acc) :-
+ ( B =< 31 ->
+ lookup(A0, W, Word),
+ ( (1 << B) /\ Word \= 0 ->
+ I = B + W * 32,
+ call(P, I, Acc0, Acc1)
+ ;
+ Acc1 = Acc0
+ ),
+ foldl2(B + 1, W, P, A0, Acc1, Acc)
+ ;
+ Acc = Acc0
+ ).
+
+:- func word(int) = int.
+word(I) = I // 32.
+
+:- func bit(int) = int.
+bit(I) = (1 << (I /\ 31)).
Index: deep/interface.m
===================================================================
RCS file: interface.m
diff -N interface.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ interface.m Thu May 17 16:54:46 2001
@@ -0,0 +1,406 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: zs.
+%
+% This module defines the type of the commands that the CGI program
+% (mdprof_cgi.m) passes to the deep profiling server (mdprof_server.m),
+% as well as utility predicates for manipulating commands and responses.
+
+:- module interface.
+
+:- interface.
+
+:- import_module std_util, io.
+
+:- type cmd
+ ---> quit
+ ; timeout(int)
+ ; menu
+ ; root(fields)
+ ; clique(int, fields)
+ ; proc(int, fields)
+ ; top_procs(sort_measurement, include_descendants,
+ display_limit, fields)
+ ; proc_static(int)
+ ; proc_dynamic(int)
+ ; call_site_static(int)
+ ; call_site_dynamic(int)
+ ; raw_clique(int)
+ ; num_proc_statics
+ ; num_call_site_statics
+ ; num_proc_dynamics
+ ; num_call_site_dynamics.
+
+:- type sort_measurement
+ ---> calls
+ ; time
+ ; allocs
+ ; words.
+
+:- type include_descendants
+ ---> self
+ ; self_and_desc.
+
+:- type display_limit
+ ---> rank_range(int, int)
+ ; threshold(float).
+
+:- type resp
+ ---> html(string).
+
+:- type fields == string. % some subset of "apqtw", meaning
+ % a: memory allocations
+ % p: port counts
+ % q: quanta
+ % t: times
+ % w: memory words
+ % The characters must be sorted.
+
+:- func default_fields = string.
+:- func all_fields = string.
+
+:- func to_server_pipe_name(string) = string.
+:- func from_server_pipe_name(string) = string.
+:- func server_startup_name(string) = string.
+
+:- pred to(string::in, cmd::in, io__state::di, io__state::uo) is det.
+:- pred from(string::in, resp::out, io__state::di, io__state::uo) is det.
+
+:- pred cmd_to_url(string::in, string::in, cmd::in, string::out) is det.
+:- pred cmd_to_query(cmd::in, string::out) is det.
+:- pred query_to_cmd(string::in, maybe(cmd)::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module util.
+:- import_module char, string, list, set, require.
+
+default_fields = "pqw".
+
+all_fields = "apqtw".
+
+to_server_pipe_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_server_to" ++
+ filename_mangle(DataFileName).
+
+from_server_pipe_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_server_from" ++
+ filename_mangle(DataFileName).
+
+server_startup_name(DataFileName) =
+ server_dir ++ "/" ++
+ "mdprof_startup_err" ++
+ filename_mangle(DataFileName).
+
+:- func server_dir = string.
+
+server_dir = "/var/tmp".
+
+:- func filename_mangle(string) = string.
+
+filename_mangle(FileName) = MangledFileName :-
+ FileNameChars = string__to_char_list(FileName),
+ MangledFileNameChars = filename_mangle_2(FileNameChars),
+ MangledFileName = string__from_char_list(MangledFileNameChars).
+
+ % This mangling scheme ensures that (a) the mangled filename doesn't
+ % contain any slashes, and (b) two different original filenames will
+ % always yield different mangled filenames.
+
+:- func filename_mangle_2(list(char)) = list(char).
+
+filename_mangle_2([]) = [].
+filename_mangle_2([First | Rest]) = MangledChars :-
+ MangledRest = filename_mangle_2(Rest),
+ ( First = ('/') ->
+ MangledChars = [':', '.' | MangledRest]
+ ; First = (':') ->
+ MangledChars = [':', ':' | MangledRest]
+ ;
+ MangledChars = [First | MangledRest]
+ ).
+
+%-----------------------------------------------------------------------------%
+
+cmd_to_url(Machine, DataFileName, Cmd, URL) :-
+ cmd_to_query(Cmd, Query),
+ URL =
+ "http://" ++
+ Machine ++
+ "/cgi-bin/mdprof?" ++
+ Query ++
+ "$" ++
+ DataFileName.
+
+cmd_to_query(Cmd, Query) :-
+ (
+ Cmd = quit,
+ Query = "quit"
+ ;
+ Cmd = timeout(Minutes),
+ Query = format("timeout+%d", [i(Minutes)])
+ ;
+ Cmd = menu,
+ Query = "menu"
+ ;
+ Cmd = root(Fields),
+ Query = format("root+%s", [s(Fields)])
+ ;
+ Cmd = clique(CliqueNum, Fields),
+ Query = format("clique+%s+%d", [s(Fields), i(CliqueNum)])
+ ;
+ Cmd = proc(ProcNum, Fields),
+ Query = format("proc+%s+%d", [s(Fields), i(ProcNum)])
+ ;
+ Cmd = top_procs(Sort, InclDesc, Limit, Fields),
+ sort_to_str(Sort, SortStr),
+ incl_desc_to_str(InclDesc, InclDescStr),
+ limit_to_str(Limit, LimitStr),
+ Query = format("procs+%s+%s+%s+%s",
+ [s(SortStr), s(InclDescStr), s(LimitStr), s(Fields)])
+ ;
+ Cmd = proc_static(PSI),
+ Query = format("proc_static+%d", [i(PSI)])
+ ;
+ Cmd = proc_dynamic(PDI),
+ Query = format("proc_dynamic+%d", [i(PDI)])
+ ;
+ Cmd = call_site_static(CSSI),
+ Query = format("call_site_static+%d", [i(CSSI)])
+ ;
+ Cmd = call_site_dynamic(CSDI),
+ Query = format("call_site_dynamic+%d", [i(CSDI)])
+ ;
+ Cmd = raw_clique(CI),
+ Query = format("raw_clique+%d", [i(CI)])
+ ;
+ Cmd = num_proc_statics,
+ Query = "num_proc_statics"
+ ;
+ Cmd = num_proc_dynamics,
+ Query = "num_proc_dynamics"
+ ;
+ Cmd = num_call_site_statics,
+ Query = "num_call_site_statics"
+ ;
+ Cmd = num_call_site_dynamics,
+ Query = "num_call_site_dynamics"
+ ).
+
+query_to_cmd(QueryString, MaybeCmd) :-
+ split(QueryString, ('+'), Pieces),
+ (
+ (
+ Pieces = ["clique", NStr],
+ string__to_int(NStr, N),
+ Fields = default_fields
+ ;
+ Pieces = ["clique", Fields, NStr],
+ string__to_int(NStr, N),
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(clique(N, Fields))
+ ;
+ (
+ Pieces = ["proc", NStr],
+ string__to_int(NStr, N),
+ Fields = default_fields
+ ;
+ Pieces = ["proc", Fields, NStr],
+ string__to_int(NStr, N),
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(proc(N, Fields))
+ ;
+ (
+ Pieces = ["procs", SortStr, InclDescStr,
+ LimitStr],
+ Fields = default_fields
+ ;
+ Pieces = ["procs", SortStr, InclDescStr,
+ LimitStr, Fields],
+ validate_fields(Fields)
+ ),
+ translate_criteria(SortStr, Sort,
+ InclDescStr, InclDesc, LimitStr, Limit)
+ ->
+ MaybeCmd = yes(top_procs(Sort, InclDesc, Limit, Fields))
+ ;
+ (
+ Pieces = ["root"],
+ Fields = default_fields
+ ;
+ Pieces = ["root", Fields],
+ validate_fields(Fields)
+ )
+ ->
+ MaybeCmd = yes(root(Fields))
+ ;
+ Pieces = ["menu"]
+ ->
+ MaybeCmd = yes(menu)
+ ;
+ Pieces = ["proc_static", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(proc_static(N))
+ ;
+ Pieces = ["proc_dynamic", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(proc_dynamic(N))
+ ;
+ Pieces = ["call_site_static", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(call_site_static(N))
+ ;
+ Pieces = ["call_site_dynamic", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(call_site_dynamic(N))
+ ;
+ Pieces = ["raw_clique", NStr],
+ string__to_int(NStr, N)
+ ->
+ MaybeCmd = yes(raw_clique(N))
+ ;
+ Pieces = ["num_proc_statics"]
+ ->
+ MaybeCmd = yes(num_proc_statics)
+ ;
+ Pieces = ["num_call_site_statics"]
+ ->
+ MaybeCmd = yes(num_call_site_statics)
+ ;
+ Pieces = ["num_proc_dynamics"]
+ ->
+ MaybeCmd = yes(num_proc_dynamics)
+ ;
+ Pieces = ["num_call_site_dynamics"]
+ ->
+ MaybeCmd = yes(num_call_site_dynamics)
+ ;
+ Pieces = ["timeout", TStr],
+ string__to_int(TStr, TimeOut)
+ ->
+ MaybeCmd = yes(timeout(TimeOut))
+ ;
+ Pieces = ["quit"]
+ ->
+ MaybeCmd = yes(quit)
+ ;
+ MaybeCmd = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred sort_to_str(sort_measurement::in, string::out) is det.
+
+sort_to_str(calls, "calls").
+sort_to_str(time, "time").
+sort_to_str(allocs, "allocs").
+sort_to_str(words, "words").
+
+:- pred incl_desc_to_str(include_descendants::in, string::out) is det.
+
+incl_desc_to_str(self, "self").
+incl_desc_to_str(self_and_desc, "both").
+
+:- pred limit_to_str(display_limit::in, string::out) is det.
+
+limit_to_str(rank_range(Lo, Hi), format("%d-%d", [i(Lo), i(Hi)])).
+limit_to_str(threshold(Threshold), format("%f", [f(Threshold)])).
+
+:- pred translate_criteria(string::in, sort_measurement::out,
+ string::in, include_descendants::out, string::in, display_limit::out)
+ is semidet.
+
+translate_criteria(SortStr, Sort, InclDescStr, InclDesc, LimitStr, Limit) :-
+ (
+ SortStr = "calls",
+ Sort = calls
+ ;
+ SortStr = "time",
+ Sort = time
+ ;
+ SortStr = "allocs",
+ Sort = allocs
+ ;
+ SortStr = "words",
+ Sort = words
+ ),
+ (
+ InclDescStr = "self",
+ InclDesc = self
+ ;
+ InclDescStr = "both",
+ InclDesc = self_and_desc
+ ),
+ (
+ split(LimitStr, '-', Pieces),
+ Pieces = [FirstStr, LastStr],
+ string__to_int(FirstStr, First),
+ string__to_int(LastStr, Last)
+ ->
+ Limit = rank_range(First, Last)
+ ;
+ string__to_float(LimitStr, Threshold)
+ ->
+ Limit = threshold(Threshold)
+ ;
+ fail
+ ).
+
+:- pred validate_fields(string::in) is semidet.
+
+validate_fields(String) :-
+ Chars = string__to_char_list(String),
+ list__sort_and_remove_dups(Chars, Chars),
+ validate_field_chars(Chars,
+ set__list_to_set(string__to_char_list(all_fields))).
+
+:- pred validate_field_chars(list(char)::in, set(char)::in) is semidet.
+
+validate_field_chars([], _).
+validate_field_chars([Char | Chars], AvailFields0) :-
+ set__delete(AvailFields0, Char, AvailFields1),
+ validate_field_chars(Chars, AvailFields1).
+
+%-----------------------------------------------------------------------------%
+
+to(Where, Cmd) -->
+ io__tell(Where, Res),
+ ( { Res = ok } ->
+ io__write(Cmd),
+ io__write_string(".\n"),
+ io__told
+ ;
+ { error("mdprof to: couldn't open pipe") }
+ ).
+
+from(Where, Resp) -->
+ io__see(Where, Res0),
+ ( { Res0 = ok } ->
+ io__read(Res1),
+ ( { Res1 = ok(Resp0) } ->
+ { Resp = Resp0 }
+ ;
+ { error("mdprof from: read failed") }
+ ),
+ io__seen
+ ;
+ { error("mdprof from: couldn't open pipe") }
+ ).
+
+%-----------------------------------------------------------------------------%
Index: deep/mdprof_cgi.m
===================================================================
RCS file: mdprof_cgi.m
diff -N mdprof_cgi.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mdprof_cgi.m Thu May 17 01:36:05 2001
@@ -0,0 +1,129 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This file contains the CGI "script" that is executed by the web server
+% 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
+
+:- module mdprof_cgi.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+
+:- import_module interface, util.
+:- import_module char, string, int, list, set, require, std_util.
+
+main -->
+ io__get_environment_var("QUERY_STRING", MaybeQueryString),
+ (
+ { MaybeQueryString = yes(QueryString0) },
+ { split(QueryString0, ('$'), Pieces) },
+ ( { Pieces = [ActualQuery, FileName] } ->
+ process_query(ActualQuery, FileName)
+ ; { Pieces = [FileName] } ->
+ process_query("menu", FileName)
+ ;
+ io__write_string(
+ "Bad URL; expected query$:full:path:name")
+ )
+ ;
+ { MaybeQueryString = no }
+ ).
+
+:- pred process_query(string::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+process_query(ActualQuery, DataFileName) -->
+ { ToServer = to_server_pipe_name(DataFileName) },
+ { FromServer = from_server_pipe_name(DataFileName) },
+ { TestCmd = string__format("test -p %s -a -p %s",
+ [s(ToServer), s(FromServer)]) },
+ io__call_system(TestCmd, TestRes),
+ io__write_string("Content-type: text/html\n\n"),
+ (
+ { TestRes = ok(ExitStatus) },
+ ( { ExitStatus = 0 } ->
+ { MaybeError = no }
+ ;
+ create_server(DataFileName, MaybeError)
+ ),
+ (
+ { MaybeError = no },
+ handle_query(ActualQuery, ToServer, FromServer)
+ ;
+ { MaybeError = yes(Error) },
+ io__write_string(Error)
+ )
+ ;
+ { TestRes = error(Err) },
+ { io__error_message(Err, Msg) },
+ io__write_string(Msg)
+ ).
+
+:- pred create_server(string::in, maybe(string)::out,
+ io__state::di, io__state::uo) is det.
+
+create_server(DataFileName, MaybeError) -->
+ { ServerCmd = string__format(
+ "%s -f %s < /dev/null > /dev/null 2> %s",
+ [s(server_path_name), s(DataFileName),
+ s(server_startup_name(DataFileName))]) },
+ io__call_system(ServerCmd, Res),
+ (
+ { Res = ok(ExitStatus) },
+ ( { ExitStatus = 0 } ->
+ { MaybeError = no }
+ ;
+ { MaybeError = yes("Command to start server failed") },
+ { ToServer = to_server_pipe_name(DataFileName) },
+ { FromServer = from_server_pipe_name(DataFileName) },
+ { RemoveToServerCmd = string__format(
+ "rm -f %s", [s(ToServer)]) },
+ { RemoveFromServerCmd = string__format(
+ "rm -f %s", [s(FromServer)]) },
+ % We ignore any errors since we can't do anything
+ % about them anyway.
+ io__call_system(RemoveToServerCmd, _),
+ io__call_system(RemoveFromServerCmd, _)
+ )
+ ;
+ { Res = error(Err) },
+ { io__error_message(Err, Msg) },
+ { MaybeError = yes(Msg) }
+ ).
+
+:- 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.
+
+handle_query(QueryString, ToServer, FromServer) -->
+ { query_to_cmd(QueryString, MaybeCmd) },
+ (
+ { MaybeCmd = yes(Cmd) },
+ to(ToServer, Cmd),
+ from(FromServer, html(Str)),
+ io__write_string(Str)
+ ;
+ { MaybeCmd = no }
+ ).
Index: deep/mdprof_server.m
===================================================================
RCS file: mdprof_server.m
diff -N mdprof_server.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mdprof_server.m Wed May 16 01:52:00 2001
@@ -0,0 +1,213 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This file defines the top level predicates of the server process of the
+% Mercury deep profiler. It is mostly concerned with option handling.
+
+:- module mdprof_server.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module conf, interface, profile, read_profile, startup, server.
+:- import_module array, bool, char, getopt, int, list, assoc_list.
+:- import_module map, require, set, std_util, string, require.
+
+:- type option
+ ---> canonical_clique
+ ; data_file
+ ; debug
+ ; test
+ ; test_dir
+ ; test_fields
+ ; timeout.
+
+:- type options ---> options.
+:- type option_table == (option_table(option)).
+
+main -->
+ io__stderr_stream(StdErr),
+ io__report_stats,
+ io__write_string(StdErr, " Handling options...\n"),
+ io__command_line_arguments(Args0),
+ { getopt__process_options(option_ops(short, long, defaults),
+ Args0, Args, MaybeOptions) },
+ (
+ { MaybeOptions = ok(Options) },
+ ( { Args = [] } ->
+ main2(Options)
+ ;
+ io__set_exit_status(1),
+ io__write_string(StdErr,
+ "unexpected non-option argument\n")
+ )
+ ;
+ { MaybeOptions = error(Msg) },
+ io__set_exit_status(1),
+ io__format(StdErr, "error parsing options: %s\n", [s(Msg)])
+ ).
+
+:- pred main2(option_table::in, io__state::di, io__state::uo) is cc_multi.
+
+main2(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),
+ (
+ { Res = ok(Deep) },
+ { lookup_string_option(Options, test_dir, TestDir) },
+ { lookup_string_option(Options, test_fields,
+ TestFields) },
+ test_server(TestDir, Deep, TestFields)
+ ;
+ { Res = error(Error) },
+ io__set_exit_status(1),
+ io__format(StdErr,
+ "error reading data file: %s\n",
+ [s(Error)])
+ )
+ ;
+ { Test = no },
+ make_pipes(FileName, IsOK),
+ (
+ { IsOK = yes },
+ read_and_startup(Machine, FileName, CanonicalClique,
+ Res),
+ (
+ { Res = ok(Deep) },
+ { lookup_int_option(Options, timeout,
+ TimeOut) },
+ { lookup_bool_option(Options, debug, Debug) },
+ server(TimeOut, Debug, Deep)
+ ;
+ { Res = error(Error) },
+ io__set_exit_status(1),
+ io__format(StdErr,
+ "error reading data file: %s\n",
+ [s(Error)])
+ )
+ ;
+ { IsOK = no },
+ io__set_exit_status(1),
+ io__write_string(StdErr,
+ "could not make pipes to CGI script\n")
+ )
+ ).
+
+:- pred make_pipes(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) },
+ { MakeInputPipeCmd = make_pipe_cmd(InputPipe) },
+ { MakeOutputPipeCmd = make_pipe_cmd(OutputPipe) },
+ io__call_system(MakeInputPipeCmd, InputRes),
+ io__call_system(MakeOutputPipeCmd, OutputRes),
+ {
+ InputRes = ok(0),
+ OutputRes = ok(0)
+ ->
+ OK = yes
+ ;
+ OK = no
+ }.
+
+%-----------------------------------------------------------------------------%
+
+:- pred short(char::in, option::out) is semidet.
+
+short('c', canonical_clique).
+short('D', test_dir).
+short('f', data_file).
+short('F', test_fields).
+short('t', timeout).
+short('T', test).
+
+:- 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).
+long("test-fields", test_fields).
+long("timeout", timeout).
+
+:- pred defaults(option::out, option_data::out) is nondet.
+
+defaults(Option, Data) :-
+ semidet_succeed,
+ defaults0(Option, Data).
+
+:- pred defaults0(option::out, option_data::out) is multi.
+
+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")
+ ).
Index: deep/measurements.m
===================================================================
RCS file: measurements.m
diff -N measurements.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ measurements.m Mon May 14 12:51:49 2001
@@ -0,0 +1,231 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module defines the data structures that store deep profiling
+% measurements and the operations on them.
+
+:- module measurements.
+
+:- interface.
+
+:- import_module list.
+
+:- type own_prof_info.
+:- type inherit_prof_info.
+
+:- func calls(own_prof_info) = int.
+:- func exits(own_prof_info) = int.
+:- func fails(own_prof_info) = int.
+:- func redos(own_prof_info) = int.
+:- func quanta(own_prof_info) = int.
+:- func mallocs(own_prof_info) = int.
+:- func words(own_prof_info) = int.
+
+:- func zero_own_prof_info = own_prof_info.
+
+:- func inherit_quanta(inherit_prof_info) = int.
+:- func inherit_mallocs(inherit_prof_info) = int.
+:- func inherit_words(inherit_prof_info) = int.
+
+:- func zero_inherit_prof_info = inherit_prof_info.
+
+:- func add_inherit_to_inherit(inherit_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func add_own_to_inherit(own_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func subtract_own_from_inherit(own_prof_info, inherit_prof_info)
+ = inherit_prof_info.
+:- func add_inherit_to_own(inherit_prof_info, own_prof_info) = own_prof_info.
+:- func add_own_to_own(own_prof_info, own_prof_info) = own_prof_info.
+
+:- func sum_own_infos(list(own_prof_info)) = own_prof_info.
+:- func sum_inherit_infos(list(inherit_prof_info)) = inherit_prof_info.
+
+:- func compress_profile(int, int, int, int, int, int, int) = own_prof_info.
+:- func compress_profile(own_prof_info) = own_prof_info.
+
+:- func own_to_string(own_prof_info) = string.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module string.
+
+:- type own_prof_info
+ ---> all(int, int, int, int, int, int, int)
+ % calls, exits, fails, redos, quanta,
+ % memory_mallocs, memory_words
+ ; det(int, int, int, int) % calls, quanta, mallocs, words;
+ % implicit exits == calls,
+ % implicit fails == redos == 0
+ ; zdet(int, int, int). % calls, mallocs, words;
+ % implicit exits == calls,
+ % implicit fails == redos == 0
+ % implicit quanta == 0
+
+:- type inherit_prof_info
+ ---> inherit_prof_info(
+ int, % quanta
+ int, % memory_mallocs
+ int % memory_words
+ ).
+
+calls(zdet(Calls, _, _)) = Calls.
+exits(zdet(Calls, _, _)) = Calls.
+fails(zdet(_, _, _)) = 0.
+redos(zdet(_, _, _)) = 0.
+quanta(zdet(_, _, _)) = 0.
+mallocs(zdet(_, Mallocs, _)) = Mallocs.
+words(zdet(_, _, Words)) = Words.
+
+calls(det(Calls, _, _, _)) = Calls.
+exits(det(Calls, _, _, _)) = Calls.
+fails(det(_, _, _, _)) = 0.
+redos(det(_, _, _, _)) = 0.
+quanta(det(_, Quanta, _, _)) = Quanta.
+mallocs(det(_, _, Mallocs, _)) = Mallocs.
+words(det(_, _, _, Words)) = Words.
+
+calls(all(Calls, _, _, _, _, _, _)) = Calls.
+exits(all(_, Exits, _, _, _, _, _)) = Exits.
+fails(all(_, _, Fails, _, _, _, _)) = Fails.
+redos(all(_, _, _, Redos, _, _, _)) = Redos.
+quanta(all(_, _, _, _, Quanta, _, _)) = Quanta.
+mallocs(all(_, _, _, _, _, Mallocs, _)) = Mallocs.
+words(all(_, _, _, _, _, _, Words)) = Words.
+
+zero_own_prof_info = zdet(0, 0, 0).
+
+inherit_quanta(inherit_prof_info(Quanta, _, _)) = Quanta.
+inherit_mallocs(inherit_prof_info(_, Mallocs, _)) = Mallocs.
+inherit_words(inherit_prof_info(_, _, Words)) = Words.
+
+zero_inherit_prof_info = inherit_prof_info(0, 0, 0).
+
+add_inherit_to_inherit(PI1, PI2) = SumPI :-
+ Quanta = inherit_quanta(PI1) + inherit_quanta(PI2),
+ Mallocs = inherit_mallocs(PI1) + inherit_mallocs(PI2),
+ Words = inherit_words(PI1) + inherit_words(PI2),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+add_own_to_inherit(PI1, PI2) = SumPI :-
+ Quanta = quanta(PI1) + inherit_quanta(PI2),
+ Mallocs = mallocs(PI1) + inherit_mallocs(PI2),
+ Words = words(PI1) + inherit_words(PI2),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+subtract_own_from_inherit(PI1, PI2) = SumPI :-
+ Quanta = inherit_quanta(PI2) - quanta(PI1),
+ Mallocs = inherit_mallocs(PI2) - mallocs(PI1),
+ Words = inherit_words(PI2) - words(PI1),
+ SumPI = inherit_prof_info(Quanta, Mallocs, Words).
+
+add_inherit_to_own(PI1, PI2) = SumPI :-
+ Calls = calls(PI2),
+ Exits = exits(PI2),
+ Fails = fails(PI2),
+ Redos = redos(PI2),
+ Quanta = inherit_quanta(PI1) + quanta(PI2),
+ Mallocs = inherit_mallocs(PI1) + mallocs(PI2),
+ Words = inherit_words(PI1) + words(PI2),
+ SumPI = compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words).
+
+add_own_to_own(PI1, PI2) = SumPI :-
+ Calls = calls(PI1) + calls(PI2),
+ Exits = exits(PI1) + exits(PI2),
+ Fails = fails(PI1) + fails(PI2),
+ Redos = redos(PI1) + redos(PI2),
+ Quanta = quanta(PI1) + quanta(PI2),
+ Mallocs = mallocs(PI1) + mallocs(PI2),
+ Words = words(PI1) + words(PI2),
+ SumPI = compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words).
+
+sum_own_infos(Owns) =
+ list__foldl(add_own_to_own, Owns, zero_own_prof_info).
+
+sum_inherit_infos(Inherits) =
+ list__foldl(add_inherit_to_inherit, Inherits, zero_inherit_prof_info).
+
+compress_profile(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words) = PI :-
+ (
+ Calls = Exits,
+ Fails = 0,
+ Redos = 0
+ ->
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = det(Calls, Quanta, Mallocs, Words)
+ )
+ ;
+ PI = all(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words)
+ ).
+
+compress_profile(PI0) = PI :-
+ (
+ PI0 = all(Calls, Exits, Fails, Redos, Quanta, Mallocs, Words),
+ (
+ Calls = Exits,
+ Fails = 0,
+ Redos = 0
+ ->
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = det(Calls, Quanta, Mallocs, Words)
+ )
+ ;
+ PI = PI0
+ )
+ ;
+ PI0 = det(Calls, Quanta, Mallocs, Words),
+ (
+ Quanta = 0
+ ->
+ PI = zdet(Calls, Mallocs, Words)
+ ;
+ PI = PI0
+ )
+ ;
+ PI0 = zdet(_, _, _),
+ PI = PI0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+own_to_string(all(Calls, Exits, Fails, Redos, Quanta, Allocs, Words)) =
+ "all(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Exits) ++ ", " ++
+ string__int_to_string(Fails) ++ ", " ++
+ string__int_to_string(Redos) ++ ", " ++
+ string__int_to_string(Quanta) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
+own_to_string(det(Calls, Quanta, Allocs, Words)) =
+ "det(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Quanta) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
+own_to_string(zdet(Calls, Allocs, Words)) =
+ "det(" ++
+ string__int_to_string(Calls) ++ ", " ++
+ string__int_to_string(Allocs) ++ ", " ++
+ string__int_to_string(Words) ++
+ ")".
Index: deep/profile.m
===================================================================
RCS file: profile.m
diff -N profile.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ profile.m Mon May 14 18:11:52 2001
@@ -0,0 +1,554 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This file defines the main data structures of the Mercury deep profiler,
+% and predicates for accessing it. The main concern of the access predicates
+% is ensuring the safety of array accesses.
+%
+% For historical reasons, all the top-level arrays (i.e. those directly
+% contained in initial_deep and deep structures) have a dummy element
+% at index 0; their first real element is at index 1. The arrays in
+% proc_static and proc_dynamic structures, being reflections of arrays created
+% in C code, start at index 0.
+
+:- module profile.
+
+:- interface.
+
+:- import_module measurements.
+:- import_module std_util, array, list, map.
+
+:- type profile_stats --->
+ profile_stats(
+ instrument_quanta :: int,
+ user_quanta :: int,
+ num_csds :: int,
+ num_pds :: int,
+ num_csss :: int,
+ num_pss :: int
+ ).
+
+:- type initial_deep --->
+ initial_deep(
+ init_profile_stats :: profile_stats,
+ init_root :: proc_dynamic_ptr,
+ % The main arrays, each indexed by own xxx_ptr int
+ init_call_site_dynamics :: call_site_dynamics,
+ init_proc_dynamics :: proc_dynamics,
+ init_call_site_statics :: call_site_statics,
+ init_proc_statics :: proc_statics
+ ).
+
+:- type deep --->
+ deep(
+ profile_stats :: profile_stats,
+ server_name :: string,
+ data_file_name :: string,
+
+ root :: proc_dynamic_ptr,
+ % The main arrays, each indexed by own xxx_ptr int
+ call_site_dynamics :: call_site_dynamics,
+ proc_dynamics :: proc_dynamics,
+ call_site_statics :: call_site_statics,
+ proc_statics :: proc_statics,
+ % Clique information
+ clique_index :: array(clique_ptr),
+ % index: proc_dynamic_ptr int
+ clique_members :: array(list(proc_dynamic_ptr)),
+ % index: clique_ptr int
+ clique_parents :: array(call_site_dynamic_ptr),
+ % index: clique_ptr int
+ clique_maybe_child :: array(maybe(clique_ptr)),
+ % index: call_site_dynamic_ptr int
+ % Reverse links
+ proc_callers :: array(list(call_site_dynamic_ptr)),
+ % index: proc_static_ptr int
+ call_site_static_map :: call_site_static_map,
+ % index: call_site_dynamic_ptr int
+ call_site_calls :: array(map(proc_static_ptr,
+ list(call_site_dynamic_ptr))),
+ % index: call_site_static_ptr int
+ % Propagated timing info
+ pd_own :: array(own_prof_info),
+ pd_desc :: array(inherit_prof_info),
+ csd_desc :: array(inherit_prof_info),
+ ps_own :: array(own_prof_info),
+ ps_desc :: array(inherit_prof_info),
+ css_own :: array(own_prof_info),
+ css_desc :: array(inherit_prof_info)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type proc_dynamics == array(proc_dynamic).
+:- type proc_statics == array(proc_static).
+:- type call_site_dynamics == array(call_site_dynamic).
+:- type call_site_statics == array(call_site_static).
+:- type call_site_static_map == array(call_site_static_ptr).
+
+:- type proc_dynamic_ptr
+ ---> proc_dynamic_ptr(int).
+
+:- type proc_static_ptr
+ ---> proc_static_ptr(int).
+
+:- type call_site_dynamic_ptr
+ ---> call_site_dynamic_ptr(int).
+
+:- type call_site_static_ptr
+ ---> call_site_static_ptr(int).
+
+:- type clique_ptr
+ ---> clique_ptr(int).
+
+%-----------------------------------------------------------------------------%
+
+:- type proc_dynamic
+ ---> proc_dynamic(
+ pd_proc_static :: proc_static_ptr,
+ pd_sites :: array(call_site_array_slot),
+ pd_redirect :: maybe(proc_dynamic_ptr)
+ ).
+
+:- type proc_static
+ ---> proc_static(
+ ps_id :: proc_id, % procedure ID
+ ps_refined_id :: string, % refined procedure id
+ ps_raw_id :: string, % raw procedure id
+ ps_filename :: string, % file name
+ ps_sites :: array(call_site_static_ptr)
+ ).
+
+:- type call_site_dynamic
+ ---> call_site_dynamic(
+ csd_caller :: proc_dynamic_ptr,
+ csd_callee :: proc_dynamic_ptr,
+ csd_own_prof :: own_prof_info,
+ csd_redirect :: maybe(call_site_dynamic_ptr)
+ ).
+
+:- type call_site_static
+ ---> call_site_static(
+ css_container :: proc_static_ptr,
+ % the containing procedure
+ css_slot_num :: int,
+ % slot number in the
+ % containing procedure
+ css_kind :: call_site_kind_and_callee,
+ css_line_num :: int,
+ css_goal_path :: string
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type pred_or_func
+ ---> predicate
+ ; function.
+
+:- type proc_id
+ ---> user_defined(
+ user_pred_or_func :: pred_or_func,
+ user_decl_module :: string,
+ user_def_module :: string,
+ user_name :: string,
+ user_arity :: int,
+ user_mode :: int
+ )
+ ; compiler_generated(
+ comp_gen_type_name :: string,
+ comp_gen_type_module :: string,
+ comp_gen_def_module :: string,
+ comp_gen_pred_name :: string,
+ comp_gen_arity :: int,
+ comp_gen_mode :: int
+ ).
+
+:- type call_site_array_slot
+ ---> normal(call_site_dynamic_ptr)
+ ; multi(array(call_site_dynamic_ptr)).
+
+:- type call_site_kind
+ ---> normal_call
+ ; special_call
+ ; higher_order_call
+ ; method_call
+ ; callback.
+
+:- type call_site_kind_and_callee
+ ---> normal_call(proc_static_ptr, string)
+ ; special_call
+ ; higher_order_call
+ ; method_call
+ ; callback.
+
+:- type call_site_callees
+ ---> call_site_callees(
+ list(proc_dynamic_ptr)
+ ).
+
+:- type call_site_caller
+ ---> call_site_caller(
+ call_site_static_ptr
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func dummy_proc_id = proc_id.
+:- func main_parent_proc_id = proc_id.
+
+:- pred valid_clique_ptr(deep::in, clique_ptr::in) is semidet.
+:- pred valid_proc_dynamic_ptr(deep::in, proc_dynamic_ptr::in) is semidet.
+:- pred valid_proc_static_ptr(deep::in, proc_static_ptr::in) is semidet.
+:- pred valid_call_site_dynamic_ptr(deep::in, call_site_dynamic_ptr::in)
+ is semidet.
+:- pred valid_call_site_static_ptr(deep::in, call_site_static_ptr::in)
+ is semidet.
+
+:- pred valid_proc_dynamic_ptr_raw(proc_dynamics::in, proc_dynamic_ptr::in)
+ is semidet.
+:- pred valid_proc_static_ptr_raw(proc_statics::in, proc_static_ptr::in)
+ is semidet.
+:- pred valid_call_site_dynamic_ptr_raw(call_site_dynamics::in,
+ call_site_dynamic_ptr::in) is semidet.
+:- pred valid_call_site_static_ptr_raw(call_site_statics::in,
+ call_site_static_ptr::in) is semidet.
+
+:- pred lookup_call_site_dynamics(call_site_dynamics::in,
+ call_site_dynamic_ptr::in, call_site_dynamic::out) is det.
+:- pred lookup_call_site_statics(call_site_statics::in,
+ call_site_static_ptr::in, call_site_static::out) is det.
+:- pred lookup_proc_dynamics(proc_dynamics::in,
+ proc_dynamic_ptr::in, proc_dynamic::out) is det.
+:- pred lookup_proc_statics(proc_statics::in,
+ proc_static_ptr::in, proc_static::out) is det.
+:- pred lookup_clique_index(array(clique_ptr)::in,
+ proc_dynamic_ptr::in, clique_ptr::out) is det.
+:- pred lookup_clique_members(array(list(proc_dynamic_ptr))::in,
+ clique_ptr::in, list(proc_dynamic_ptr)::out) is det.
+:- pred lookup_clique_parents(array(call_site_dynamic_ptr)::in,
+ clique_ptr::in, call_site_dynamic_ptr::out) is det.
+:- pred lookup_clique_maybe_child(array(maybe(clique_ptr))::in,
+ call_site_dynamic_ptr::in, maybe(clique_ptr)::out) is det.
+:- pred lookup_call_site_static_map(call_site_static_map::in,
+ call_site_dynamic_ptr::in, call_site_static_ptr::out) is det.
+:- pred lookup_call_site_calls(array(map(proc_static_ptr,
+ list(call_site_dynamic_ptr)))::in, call_site_static_ptr::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det.
+
+:- pred deep_lookup_call_site_dynamics(deep::in, call_site_dynamic_ptr::in,
+ call_site_dynamic::out) is det.
+:- pred deep_lookup_call_site_statics(deep::in, call_site_static_ptr::in,
+ call_site_static::out) is det.
+:- pred deep_lookup_proc_dynamics(deep::in, proc_dynamic_ptr::in,
+ proc_dynamic::out) is det.
+:- pred deep_lookup_proc_statics(deep::in, proc_static_ptr::in,
+ proc_static::out) is det.
+:- pred deep_lookup_clique_index(deep::in, proc_dynamic_ptr::in,
+ clique_ptr::out) is det.
+:- pred deep_lookup_clique_members(deep::in, clique_ptr::in,
+ list(proc_dynamic_ptr)::out) is det.
+:- pred deep_lookup_clique_parents(deep::in, clique_ptr::in,
+ call_site_dynamic_ptr::out) is det.
+:- pred deep_lookup_clique_maybe_child(deep::in, call_site_dynamic_ptr::in,
+ maybe(clique_ptr)::out) is det.
+:- pred deep_lookup_call_site_static_map(deep::in, call_site_dynamic_ptr::in,
+ call_site_static_ptr::out) is det.
+:- pred deep_lookup_call_site_calls(deep::in, call_site_static_ptr::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det.
+:- pred deep_lookup_proc_dynamic_sites(deep::in, proc_dynamic_ptr::in,
+ array(call_site_array_slot)::out) is det.
+
+:- pred deep_lookup_pd_own(deep::in, proc_dynamic_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_pd_desc(deep::in, proc_dynamic_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_csd_own(deep::in, call_site_dynamic_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_csd_desc(deep::in, call_site_dynamic_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_ps_own(deep::in, proc_static_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_ps_desc(deep::in, proc_static_ptr::in,
+ inherit_prof_info::out) is det.
+:- pred deep_lookup_css_own(deep::in, call_site_static_ptr::in,
+ own_prof_info::out) is det.
+:- pred deep_lookup_css_desc(deep::in, call_site_static_ptr::in,
+ inherit_prof_info::out) is det.
+
+:- pred update_call_site_dynamics(call_site_dynamics::array_di,
+ call_site_dynamic_ptr::in, call_site_dynamic::in,
+ call_site_dynamics::array_uo) is det.
+:- pred update_call_site_statics(call_site_statics::array_di,
+ call_site_static_ptr::in, call_site_static::in,
+ call_site_statics::array_uo) is det.
+:- pred update_proc_dynamics(proc_dynamics::array_di,
+ proc_dynamic_ptr::in, proc_dynamic::in,
+ proc_dynamics::array_uo) is det.
+:- pred update_proc_statics(proc_statics::array_di,
+ proc_static_ptr::in, proc_static::in, proc_statics::array_uo) is det.
+:- pred update_call_site_static_map(call_site_static_map::array_di,
+ call_site_dynamic_ptr::in, call_site_static_ptr::in,
+ call_site_static_map::array_uo) is det.
+
+:- pred deep_update_csd_desc(deep::in, call_site_dynamic_ptr::in,
+ inherit_prof_info::in, deep::out) is det.
+:- pred deep_update_pd_desc(deep::in, proc_dynamic_ptr::in,
+ inherit_prof_info::in, deep::out) is det.
+:- pred deep_update_pd_own(deep::in, proc_dynamic_ptr::in,
+ own_prof_info::in, deep::out) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module array_util.
+:- import_module int, require.
+
+dummy_proc_id = user_defined(predicate, "unknown", "unknown", "unknown",
+ -1, -1).
+
+main_parent_proc_id = user_defined(predicate, "mercury_runtime",
+ "mercury_runtime", "main_parent", 0, 0).
+
+%-----------------------------------------------------------------------------%
+
+valid_clique_ptr(Deep, clique_ptr(CliqueNum)) :-
+ CliqueNum > 0,
+ array__in_bounds(Deep ^ clique_members, CliqueNum).
+
+valid_proc_dynamic_ptr(Deep, proc_dynamic_ptr(PDI)) :-
+ PDI > 0,
+ array__in_bounds(Deep ^ proc_dynamics, PDI).
+
+valid_proc_static_ptr(Deep, proc_static_ptr(PSI)) :-
+ PSI > 0,
+ array__in_bounds(Deep ^ proc_statics, PSI).
+
+valid_call_site_dynamic_ptr(Deep, call_site_dynamic_ptr(CSDI)) :-
+ CSDI > 0,
+ array__in_bounds(Deep ^ call_site_dynamics, CSDI).
+
+valid_call_site_static_ptr(Deep, call_site_static_ptr(CSSI)) :-
+ CSSI > 0,
+ array__in_bounds(Deep ^ call_site_statics, CSSI).
+
+%-----------------------------------------------------------------------------%
+
+valid_proc_dynamic_ptr_raw(ProcDynamics, proc_dynamic_ptr(PDI)) :-
+ PDI > 0,
+ array__in_bounds(ProcDynamics, PDI).
+
+valid_proc_static_ptr_raw(ProcStatics, proc_static_ptr(PSI)) :-
+ PSI > 0,
+ array__in_bounds(ProcStatics, PSI).
+
+valid_call_site_dynamic_ptr_raw(CallSiteDynamics,
+ call_site_dynamic_ptr(CSDI)) :-
+ CSDI > 0,
+ array__in_bounds(CallSiteDynamics, CSDI).
+
+valid_call_site_static_ptr_raw(CallSiteStatics, call_site_static_ptr(CSSI)) :-
+ CSSI > 0,
+ array__in_bounds(CallSiteStatics, CSSI).
+
+%-----------------------------------------------------------------------------%
+
+lookup_call_site_dynamics(CallSiteDynamics, CSDPtr, CSD) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CallSiteDynamics, CSDI) ->
+ array__lookup(CallSiteDynamics, CSDI, CSD)
+ ;
+ error("lookup_call_site_dynamics: bounds error")
+ ).
+
+lookup_call_site_statics(CallSiteStatics, CSSPtr, CSS) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0, array__in_bounds(CallSiteStatics, CSSI) ->
+ array__lookup(CallSiteStatics, CSSI, CSS)
+ ;
+ error("lookup_call_site_statics: bounds error")
+ ).
+
+lookup_proc_dynamics(ProcDynamics, PDPtr, PD) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(ProcDynamics, PDI) ->
+ array__lookup(ProcDynamics, PDI, PD)
+ ;
+ error("lookup_proc_dynamics: bounds error")
+ ).
+
+lookup_proc_statics(ProcStatics, PSPtr, PS) :-
+ PSPtr = proc_static_ptr(PSI),
+ ( PSI > 0, array__in_bounds(ProcStatics, PSI) ->
+ array__lookup(ProcStatics, PSI, PS)
+ ;
+ error("lookup_proc_statics: bounds error")
+ ).
+
+lookup_clique_index(CliqueIndex, PDPtr, CliquePtr) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(CliqueIndex, PDI) ->
+ array__lookup(CliqueIndex, PDI, CliquePtr)
+ ;
+ error("lookup_clique_index: bounds error")
+ ).
+
+lookup_clique_members(CliqueMembers, CliquePtr, PDPtrs) :-
+ CliquePtr = clique_ptr(CI),
+ ( array__in_bounds(CliqueMembers, CI) ->
+ array__lookup(CliqueMembers, CI, PDPtrs)
+ ;
+ error("lookup_clique_members: bounds error")
+ ).
+
+lookup_clique_parents(CliqueParents, CliquePtr, CSDPtr) :-
+ CliquePtr = clique_ptr(CI),
+ ( array__in_bounds(CliqueParents, CI) ->
+ array__lookup(CliqueParents, CI, CSDPtr)
+ ;
+ error("lookup_clique_parents: bounds error")
+ ).
+
+lookup_clique_maybe_child(CliqueMaybeChild, CSDPtr, MaybeCliquePtr) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CliqueMaybeChild, CSDI) ->
+ array__lookup(CliqueMaybeChild, CSDI, MaybeCliquePtr)
+ ;
+ error("lookup_clique_maybe_child: bounds error")
+ ).
+
+lookup_call_site_static_map(CallSiteStaticMap, CSDPtr, CSSPtr) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0, array__in_bounds(CallSiteStaticMap, CSDI) ->
+ array__lookup(CallSiteStaticMap, CSDI, CSSPtr)
+ ;
+ error("lookup_call_site_static_map: bounds error")
+ ).
+
+lookup_call_site_calls(CallSiteCalls, CSSPtr, Calls) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0, array__in_bounds(CallSiteCalls, CSSI) ->
+ array__lookup(CallSiteCalls, CSSI, Calls)
+ ;
+ error("lookup_call_site_static_map: bounds error")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD) :-
+ lookup_call_site_dynamics(Deep ^ call_site_dynamics, CSDPtr, CSD).
+
+deep_lookup_call_site_statics(Deep, CSSPtr, CSS) :-
+ lookup_call_site_statics(Deep ^ call_site_statics, CSSPtr, CSS).
+
+deep_lookup_proc_dynamics(Deep, PDPtr, PD) :-
+ lookup_proc_dynamics(Deep ^ proc_dynamics, PDPtr, PD).
+
+deep_lookup_proc_statics(Deep, PSPtr, PS) :-
+ lookup_proc_statics(Deep ^ proc_statics, PSPtr, PS).
+
+deep_lookup_clique_index(Deep, PDPtr, CliquePtr) :-
+ lookup_clique_index(Deep ^ clique_index, PDPtr, CliquePtr).
+
+deep_lookup_clique_members(Deep, CliquePtr, PDPtrs) :-
+ lookup_clique_members(Deep ^ clique_members, CliquePtr, PDPtrs).
+
+deep_lookup_clique_parents(Deep, CliquePtr, CSDPtr) :-
+ lookup_clique_parents(Deep ^ clique_parents, CliquePtr, CSDPtr).
+
+deep_lookup_clique_maybe_child(Deep, CSDPtr, MaybeCliquePtr) :-
+ lookup_clique_maybe_child(Deep ^ clique_maybe_child, CSDPtr,
+ MaybeCliquePtr).
+
+deep_lookup_call_site_static_map(Deep, CSDPtr, CSSPtr) :-
+ lookup_call_site_static_map(Deep ^ call_site_static_map, CSDPtr,
+ CSSPtr).
+
+deep_lookup_call_site_calls(Deep, CSSPtr, Calls) :-
+ lookup_call_site_calls(Deep ^ call_site_calls, CSSPtr, Calls).
+
+deep_lookup_proc_dynamic_sites(Deep, PDPtr, PDSites) :-
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PDSites = PD ^ pd_sites.
+
+%-----------------------------------------------------------------------------%
+
+deep_lookup_pd_own(Deep, PDPtr, Own) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep ^ pd_own, PDI, Own).
+
+deep_lookup_pd_desc(Deep, PDPtr, Desc) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep ^ pd_desc, PDI, Desc).
+
+deep_lookup_csd_own(Deep, CSDPtr, Own) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__lookup(Deep ^ call_site_dynamics, CSDI, CSD),
+ Own = CSD ^ csd_own_prof.
+
+deep_lookup_csd_desc(Deep, CSDPtr, Desc) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__lookup(Deep ^ csd_desc, CSDI, Desc).
+
+deep_lookup_ps_own(Deep, PSPtr, Own) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(Deep ^ ps_own, PSI, Own).
+
+deep_lookup_ps_desc(Deep, PSPtr, Desc) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(Deep ^ ps_desc, PSI, Desc).
+
+deep_lookup_css_own(Deep, CSSPtr, Own) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(Deep ^ css_own, CSSI, Own).
+
+deep_lookup_css_desc(Deep, CSSPtr, Desc) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(Deep ^ css_desc, CSSI, Desc).
+
+%-----------------------------------------------------------------------------%
+
+update_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD, CallSiteDynamics) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(CallSiteDynamics0, CSDI, CSD, CallSiteDynamics).
+
+update_call_site_statics(CallSiteStatics0, CSSPtr, CSS, CallSiteStatics) :-
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__set(CallSiteStatics0, CSSI, CSS, CallSiteStatics).
+
+update_proc_dynamics(ProcDynamics0, PDPtr, PD, ProcDynamics) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(ProcDynamics0, PDI, PD, ProcDynamics).
+
+update_proc_statics(ProcStatics0, PSPtr, PS, ProcStatics) :-
+ PSPtr = proc_static_ptr(PSI),
+ array__set(ProcStatics0, PSI, PS, ProcStatics).
+
+update_call_site_static_map(CallSiteStaticMap0, CSDPtr, CSSPtr,
+ CallSiteStaticMap) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(CallSiteStaticMap0, CSDI, CSSPtr, CallSiteStaticMap).
+
+%-----------------------------------------------------------------------------%
+
+deep_update_csd_desc(Deep0, CSDPtr, CSDDesc, Deep) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ array__set(u(Deep0 ^ csd_desc), CSDI, CSDDesc, CSDDescs),
+ Deep = Deep0 ^ csd_desc := CSDDescs.
+
+deep_update_pd_desc(Deep0, PDPtr, PDDesc, Deep) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(u(Deep0 ^ pd_desc), PDI, PDDesc, PDDescs),
+ Deep = Deep0 ^ pd_desc := PDDescs.
+
+deep_update_pd_own(Deep0, PDPtr, PDOwn, Deep) :-
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__set(u(Deep0 ^ pd_own), PDI, PDOwn, PDOwns),
+ Deep = Deep0 ^ pd_own := PDOwns.
+
+%-----------------------------------------------------------------------------%
Index: deep/read_profile.m
===================================================================
RCS file: read_profile.m
diff -N read_profile.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ read_profile.m Mon May 14 12:54:30 2001
@@ -0,0 +1,1381 @@
+%-----------------------------------------------------------------------------% % Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains code for reading in a deep profiling data file.
+% Such files, named Deep.data, are created by deep profiled executables.
+
+:- module read_profile.
+
+:- interface.
+
+:- import_module profile.
+:- import_module io, std_util.
+
+:- pred read_call_graph(string::in, maybe_error(initial_deep)::out,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module measurements, array_util.
+:- import_module array, char, string, int, float, std_util, list, require.
+
+:- type deep_result(T)
+ ---> ok(T)
+ ; error(string).
+
+:- type deep_result2(T1, T2)
+ ---> ok2(T1, T2)
+ ; error2(string).
+
+:- type ptr_info --->
+ ptr_info(
+ ps :: int,
+ css :: int,
+ pd :: int,
+ csd :: int
+ ).
+
+:- type ptr_kind
+ ---> ps
+ ; pd
+ ; css
+ ; csd.
+
+read_call_graph(FileName, Res) -->
+ io__see_binary(FileName, Res0),
+ (
+ { Res0 = ok },
+ read_id_string(Res1),
+ (
+ { Res1 = ok(_) },
+ read_sequence6(
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_fixed_size_int,
+ read_num,
+ read_num,
+ (pred(NumCSDs::in, NumCSSs::in,
+ NumPDs::in, NumPSs::in,
+ InstrumentQuanta::in,
+ UserQuanta::in,
+ ResInitDeep::out) is det :-
+ init_deep(NumCSDs, NumCSSs,
+ NumPDs, NumPSs,
+ InstrumentQuanta, UserQuanta,
+ InitDeep0),
+ ResInitDeep = ok(InitDeep0)
+ ),
+ Res2),
+ (
+ { Res2 = ok(InitDeep) },
+ { PtrInfo0 = ptr_info(0, 0, 0, 0) },
+ read_nodes(InitDeep, PtrInfo0, Res3),
+ io__seen_binary,
+ { resize_arrays(Res3, Res) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Msg) },
+ { Res = error(Msg) }
+ )
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+:- pred read_id_string(deep_result(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_id_string(Res) -->
+ read_n_byte_string(string__length(id_string), Res0),
+ (
+ { Res0 = ok(String) },
+ ( { String = id_string } ->
+ { Res = ok(id_string) }
+ ;
+ { Res = error("not a deep profiling data file") }
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- func id_string = string.
+
+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.
+
+init_deep(NumCSDs, NumCSSs, NumPDs, NumPSs, InstrumentQuanta, UserQuanta,
+ InitDeep) :-
+ InitStats = profile_stats(
+ InstrumentQuanta,
+ UserQuanta,
+ -1, -1, -1, -1),
+ InitDeep = initial_deep(
+ InitStats,
+ proc_dynamic_ptr(-1),
+ array__init(NumCSDs + 1,
+ call_site_dynamic(
+ proc_dynamic_ptr(-1),
+ proc_dynamic_ptr(-1),
+ zero_own_prof_info,
+ no
+ )),
+ array__init(NumPDs + 1,
+ proc_dynamic(proc_static_ptr(-1), array([]), no)),
+ array__init(NumCSSs + 1,
+ call_site_static(
+ proc_static_ptr(-1), -1,
+ normal_call(proc_static_ptr(-1), ""), -1, ""
+ )),
+ array__init(NumPSs + 1,
+ proc_static(dummy_proc_id, "", "", "", array([])))
+ ).
+
+:- pred read_nodes(initial_deep::in, ptr_info::in,
+ deep_result2(initial_deep, ptr_info)::out,
+ io__state::di, io__state::uo) is det.
+
+read_nodes(InitDeep0, PtrInfo0, Res) -->
+ read_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_call_site_static } ->
+ read_call_site_static(Res1),
+ (
+ { Res1 = ok2(CallSiteStatic, CSSI) },
+ { deep_insert(
+ InitDeep0 ^ init_call_site_statics,
+ CSSI, CallSiteStatic, CSSs) },
+ { InitDeep1 = InitDeep0
+ ^ init_call_site_statics := CSSs },
+ { PtrInfo1 = PtrInfo0 ^ css
+ := max(PtrInfo0 ^ css, CSSI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_proc_static } ->
+ read_proc_static(Res1),
+ (
+ { Res1 = ok2(ProcStatic, PSI) },
+ { deep_insert(
+ InitDeep0 ^ init_proc_statics,
+ PSI, ProcStatic, PSs) },
+ { InitDeep1 = InitDeep0
+ ^ init_proc_statics := PSs },
+ { PtrInfo1 = PtrInfo0 ^ ps
+ := max(PtrInfo0 ^ ps, PSI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_call_site_dynamic } ->
+ read_call_site_dynamic(Res1),
+ (
+ { Res1 = ok2(CallSiteDynamic, CSDI) },
+ { deep_insert(
+ InitDeep0 ^ init_call_site_dynamics,
+ CSDI, CallSiteDynamic, CSDs) },
+ { InitDeep1 = InitDeep0
+ ^ init_call_site_dynamics := CSDs },
+ { PtrInfo1 = PtrInfo0 ^ csd
+ := max(PtrInfo0 ^ csd, CSDI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_proc_dynamic } ->
+ read_proc_dynamic(Res1),
+ (
+ { Res1 = ok2(ProcDynamic, PDI) },
+ { deep_insert(
+ InitDeep0 ^ init_proc_dynamics,
+ PDI, ProcDynamic, PDs) },
+ { InitDeep1 = InitDeep0
+ ^ init_proc_dynamics := PDs },
+ { PtrInfo1 = PtrInfo0 ^ pd
+ := max(PtrInfo0 ^ pd, PDI) },
+ read_nodes(InitDeep1, PtrInfo1, Res)
+ ;
+ { Res1 = error2(Err) },
+ { Res = error2(Err) }
+ )
+ ; { Byte = token_root } ->
+ read_root(Res1),
+ (
+ { Res1 = ok(PDPtr) },
+ { InitDeep1 = InitDeep0 ^ init_root := PDPtr },
+ read_nodes(InitDeep1, PtrInfo0, Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { format("unexpected token %d", [i(Byte)], Msg) },
+ { Res = error2(Msg) }
+ )
+ ;
+ { Res0 = eof },
+ { Res = ok2(InitDeep0, PtrInfo0) }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error2(Msg) }
+ ).
+
+:- pred read_root(deep_result(proc_dynamic_ptr)::out,
+ io__state::di, io__state::uo) is det.
+
+read_root(Res) -->
+ % format("reading root.\n", []),
+ read_ptr(pd, Res0),
+ (
+ { Res0 = ok(PDI) },
+ { PDPtr = proc_dynamic_ptr(PDI) },
+ { Res = ok(PDPtr) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_static(deep_result2(call_site_static, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_static(Res) -->
+ % format("reading call_site_static.\n", []),
+ read_sequence4(
+ read_ptr(css),
+ read_call_site_kind_and_callee,
+ read_num,
+ read_string,
+ (pred(CSSI0::in, Kind::in, LineNumber::in, Str::in, Res0::out)
+ is det :-
+ DummyPSPtr = proc_static_ptr(-1),
+ DummySlotNum = -1,
+ CallSiteStatic0 = call_site_static(DummyPSPtr,
+ DummySlotNum, Kind, LineNumber, Str),
+ Res0 = ok({CallSiteStatic0, CSSI0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({CallSiteStatic, CSSI}) },
+ { Res = ok2(CallSiteStatic, CSSI) }
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+
+:- pred read_proc_static(deep_result2(proc_static, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_static(Res) -->
+ % format("reading proc_static.\n", []),
+ read_sequence4(
+ read_ptr(ps),
+ read_proc_id,
+ read_string,
+ read_num,
+ (pred(PSI0::in, Id0::in, F0::in, N0::in, Stuff0::out) is det :-
+ Stuff0 = ok({PSI0, Id0, F0, N0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({PSI, Id, FileName, N}) },
+ read_n_things(N, read_ptr(css), Res2),
+ (
+ { Res2 = ok(Ptrs0) },
+ { map((pred(Ptr1::in, Ptr2::out) is det :-
+ Ptr2 = call_site_static_ptr(Ptr1)
+ ), Ptrs0, Ptrs) },
+ { RefinedStr = refined_proc_id_to_string(Id) },
+ { RawStr = raw_proc_id_to_string(Id) },
+ { ProcStatic =
+ proc_static(Id, RefinedStr, RawStr,
+ FileName, array(Ptrs)) },
+ { Res = ok2(ProcStatic, PSI) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_proc_id(deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_isa_compiler_generated } ->
+ read_proc_id_compiler_generated(Res)
+ ; { Byte = token_isa_predicate } ->
+ read_proc_id_user_defined(predicate, Res)
+ ; { Byte = token_isa_function } ->
+ read_proc_id_user_defined(function, Res)
+ ;
+ { format("unexpected proc_id_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_proc_id_compiler_generated(deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id_compiler_generated(Res) -->
+ read_sequence6(
+ read_string,
+ read_string,
+ read_string,
+ read_string,
+ read_num,
+ read_num,
+ (pred(TypeName::in, TypeModule::in, DefModule::in,
+ PredName::in, Arity::in, Mode::in, ProcId::out)
+ is det :-
+ ProcId = ok(compiler_generated(TypeName, TypeModule,
+ DefModule, PredName, Arity, Mode))
+ ),
+ Res).
+
+:- pred read_proc_id_user_defined(pred_or_func::in, deep_result(proc_id)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_id_user_defined(PredOrFunc, Res) -->
+ read_sequence5(
+ read_string,
+ read_string,
+ read_string,
+ read_num,
+ read_num,
+ (pred(DeclModule::in, DefModule::in, Name::in,
+ Arity::in, Mode::in, ProcId::out)
+ is det :-
+ ProcId = ok(user_defined(PredOrFunc, DeclModule,
+ DefModule, Name, Arity, Mode))
+ ),
+ Res).
+
+:- func raw_proc_id_to_string(proc_id) = string.
+
+raw_proc_id_to_string(compiler_generated(TypeName, TypeModule, _DefModule,
+ PredName, Arity, Mode)) =
+ string__append_list(
+ [PredName, " for ", TypeModule, ":", TypeName,
+ "/", string__int_to_string(Arity),
+ " mode ", string__int_to_string(Mode)]).
+raw_proc_id_to_string(user_defined(PredOrFunc, DeclModule, _DefModule,
+ Name, Arity, Mode)) =
+ string__append_list([DeclModule, ":", Name,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode)]).
+
+:- func refined_proc_id_to_string(proc_id) = string.
+
+refined_proc_id_to_string(compiler_generated(TypeName, TypeModule, _DefModule,
+ RawPredName, Arity, Mode)) = Name :-
+ ( RawPredName = "__Unify__" ->
+ PredName = "Unify"
+ ; RawPredName = "__Compare__" ->
+ PredName = "Compare"
+ ; RawPredName = "__Index__" ->
+ PredName = "Index"
+ ;
+ string__append("unknown special predicate name ", RawPredName,
+ Msg),
+ error(Msg)
+ ),
+ Name0 = string__append_list(
+ [PredName, " for ", TypeModule, ":", TypeName,
+ "/", string__int_to_string(Arity)]),
+ ( Mode = 0 ->
+ Name = Name0
+ ;
+ Name = string__append_list([Name0, " mode ",
+ string__int_to_string(Mode)])
+ ).
+refined_proc_id_to_string(user_defined(PredOrFunc, DeclModule, _DefModule,
+ ProcName, Arity, Mode)) = Name :-
+ (
+ string__append("TypeSpecOf__", ProcName1, ProcName),
+ ( string__append("pred__", ProcName2A, ProcName1) ->
+ ProcName2 = ProcName2A
+ ; string__append("func__", ProcName2B, ProcName1) ->
+ ProcName2 = ProcName2B
+ ; string__append("pred_or_func__", ProcName2C, ProcName1) ->
+ ProcName2 = ProcName2C
+ ;
+ error("typespec: neither pred nor func")
+ ),
+ string__to_char_list(ProcName2, ProcName2Chars),
+ fix_type_spec_suffix(ProcName2Chars, ProcNameChars, SpecInfo)
+ ->
+ RefinedProcName = string__from_char_list(ProcNameChars),
+ Name = string__append_list([DeclModule, ":", RefinedProcName,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode),
+ " [", SpecInfo, "]"])
+ ;
+ string__append("IntroducedFrom__", ProcName1, ProcName),
+ ( string__append("pred__", ProcName2A, ProcName1) ->
+ ProcName2 = ProcName2A
+ ; string__append("func__", ProcName2B, ProcName1) ->
+ ProcName2 = ProcName2B
+ ;
+ error("lambda: neither pred nor func")
+ ),
+ string__to_char_list(ProcName2, ProcName2Chars),
+ split_lambda_name(ProcName2Chars, Segments),
+ glue_lambda_name(Segments, ContainingNameChars,
+ LineNumberChars)
+ ->
+ string__from_char_list(ContainingNameChars, ContainingName),
+ string__from_char_list(LineNumberChars, LineNumber),
+ Name = string__append_list([DeclModule, ":", ContainingName,
+ " lambda line ", LineNumber,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" )])
+ ;
+ Name = string__append_list([DeclModule, ":", ProcName,
+ "/", string__int_to_string(Arity),
+ ( PredOrFunc = function -> "+1" ; "" ),
+ "-", string__int_to_string(Mode)])
+ ).
+
+:- pred fix_type_spec_suffix(list(char)::in, list(char)::out, string::out)
+ is semidet.
+
+fix_type_spec_suffix(Chars0, Chars, SpecInfoStr) :-
+ ( Chars0 = ['_', '_', '[' | SpecInfo0 ] ->
+ Chars = [],
+ list__takewhile(non_right_bracket, SpecInfo0, SpecInfo, _),
+ string__from_char_list(SpecInfo, SpecInfoStr)
+ ; Chars0 = [Char | TailChars0] ->
+ fix_type_spec_suffix(TailChars0, TailChars, SpecInfoStr),
+ Chars = [Char | TailChars]
+ ;
+ fail
+ ).
+
+:- pred non_right_bracket(char::in) is semidet.
+
+non_right_bracket(C) :-
+ C \= ']'.
+
+:- pred split_lambda_name(list(char)::in, list(list(char))::out) is det.
+
+split_lambda_name([], []).
+split_lambda_name([Char0 | Chars0], StringList) :-
+ ( Chars0 = ['_', '_' | Chars1 ] ->
+ split_lambda_name(Chars1, StringList0),
+ StringList = [[Char0] | StringList0]
+ ;
+ split_lambda_name(Chars0, StringList0),
+ (
+ StringList0 = [],
+ StringList = [[Char0]]
+ ;
+ StringList0 = [String0 | StringList1],
+ StringList = [[Char0 | String0] | StringList1]
+ )
+ ).
+
+:- pred glue_lambda_name(list(list(char))::in, list(char)::out,
+ list(char)::out) is semidet.
+
+glue_lambda_name(Segments, PredName, LineNumber) :-
+ ( Segments = [LineNumberPrime, _] ->
+ PredName = [],
+ LineNumber = LineNumberPrime
+ ; Segments = [Segment | TailSegments] ->
+ glue_lambda_name(TailSegments, PredName1, LineNumber),
+ ( PredName1 = [] ->
+ PredName = Segment
+ ;
+ list__append(Segment, ['_', '_' | PredName1], PredName)
+ )
+ ;
+ fail
+ ).
+
+:- pred read_proc_dynamic(deep_result2(proc_dynamic, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_proc_dynamic(Res) -->
+ % format("reading proc_dynamic.\n", []),
+ read_sequence3(
+ read_ptr(pd),
+ read_ptr(ps),
+ read_num,
+ (pred(PDI0::in, PSI0::in, N0::in, Stuff0::out) is det :-
+ Stuff0 = ok({PDI0, PSI0, N0})
+ ),
+ Res1),
+ (
+ { Res1 = ok({PDI, PSI, N}) },
+ read_n_things(N, read_call_site_ref, Res2),
+ (
+ { Res2 = ok(Refs) },
+ { PSPtr = proc_static_ptr(PSI) },
+ { ProcDynamic = proc_dynamic(PSPtr, array(Refs), no) },
+ { Res = ok2(ProcDynamic, PDI) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_call_site_dynamic(deep_result2(call_site_dynamic, int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_dynamic(Res) -->
+ % format("reading call_site_dynamic.\n", []),
+ read_ptr(csd, Res1),
+ (
+ { Res1 = ok(CSDI) },
+ read_ptr(pd, Res2),
+ (
+ { Res2 = ok(PDI) },
+ read_profile(Res3),
+ (
+ { Res3 = ok(Profile) },
+ { PDPtr = proc_dynamic_ptr(PDI) },
+ { DummyPDPtr = proc_dynamic_ptr(-1) },
+ { CallSiteDynamic = call_site_dynamic(
+ DummyPDPtr, PDPtr, Profile, no) },
+ { Res = ok2(CallSiteDynamic, CSDI) }
+ ;
+ { Res3 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error2(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error2(Err) }
+ ).
+
+:- pred read_profile(deep_result(own_prof_info)::out,
+ io__state::di, io__state::uo) is det.
+
+read_profile(Res) -->
+ read_num(Res0),
+ (
+ { Res0 = ok(Mask) },
+ { MaybeError1 = no },
+ % { MaybeError0 = no },
+ % Calls are computed from the other counts below
+ % ( { Mask /\ 0x0001 \= 0 } ->
+ % maybe_read_num_handle_error(Calls,
+ % MaybeError0, MaybeError1)
+ % ;
+ % { Calls = 0 },
+ % { MaybeError1 = MaybeError0 }
+ % ),
+ ( { Mask /\ 0x0002 \= 0 } ->
+ maybe_read_num_handle_error(Exits,
+ MaybeError1, MaybeError2)
+ ;
+ { Exits = 0 },
+ { MaybeError2 = MaybeError1 }
+ ),
+ ( { Mask /\ 0x0004 \= 0 } ->
+ maybe_read_num_handle_error(Fails,
+ MaybeError2, MaybeError3)
+ ;
+ { Fails = 0 },
+ { MaybeError3 = MaybeError2 }
+ ),
+ ( { Mask /\ 0x0008 \= 0 } ->
+ maybe_read_num_handle_error(Redos,
+ MaybeError3, MaybeError4)
+ ;
+ { Redos = 0 },
+ { MaybeError4 = MaybeError3 }
+ ),
+ ( { Mask /\ 0x0010 \= 0 } ->
+ maybe_read_num_handle_error(Quanta,
+ MaybeError4, MaybeError5)
+ ;
+ { Quanta = 0 },
+ { MaybeError5 = MaybeError4 }
+ ),
+ ( { Mask /\ 0x0020 \= 0 } ->
+ maybe_read_num_handle_error(Mallocs,
+ MaybeError5, MaybeError6)
+ ;
+ { Mallocs = 0 },
+ { MaybeError6 = MaybeError5 }
+ ),
+ ( { Mask /\ 0x0040 \= 0 } ->
+ maybe_read_num_handle_error(Words,
+ MaybeError6, MaybeError7)
+ ;
+ { Words = 0 },
+ { MaybeError7 = MaybeError6 }
+ ),
+ (
+ { MaybeError7 = yes(Error) },
+ { Res = error(Error) }
+ ;
+ { MaybeError7 = no },
+ { Calls = Exits + Fails - Redos },
+ { Res = ok(compress_profile(Calls, Exits, Fails, Redos,
+ Quanta, Mallocs, Words)) }
+ )
+ ;
+ { Res0 = error(Error) },
+ { Res = error(Error) }
+ ).
+
+:- pred maybe_read_num_handle_error(int::out,
+ maybe(string)::in, maybe(string)::out,
+ io__state::di, io__state::uo) is det.
+
+maybe_read_num_handle_error(Value, MaybeError0, MaybeError) -->
+ read_num(Res),
+ (
+ { Res = ok(Value) },
+ { MaybeError = MaybeError0 }
+ ;
+ { Res = error(Error) },
+ { Value = 0 },
+ { MaybeError = yes(Error) }
+ ).
+
+:- pred read_call_site_ref(deep_result(call_site_array_slot)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_ref(Res) -->
+ % format("reading call_site_ref.\n", []),
+ read_call_site_kind(Res1),
+ (
+ { Res1 = ok(Kind) },
+ ( { Kind = normal_call } ->
+ read_ptr(csd, Res2),
+ (
+ { Res2 = ok(Ptr) },
+ { CDPtr = call_site_dynamic_ptr(Ptr) },
+ { Res = ok(normal(CDPtr)) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ read_things(read_ptr(csd), Res2),
+ (
+ { Res2 = ok(Ptrs0) },
+ { map((pred(PtrX::in, PtrY::out) is det :-
+ PtrY = call_site_dynamic_ptr(PtrX)
+ ), Ptrs0, Ptrs) },
+ { Res = ok(multi(array(Ptrs))) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_kind(deep_result(call_site_kind)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_kind(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_normal_call } ->
+ { Res = ok(normal_call) }
+ ; { Byte = token_special_call } ->
+ { Res = ok(special_call) }
+ ; { Byte = token_higher_order_call } ->
+ { Res = ok(higher_order_call) }
+ ; { Byte = token_method_call } ->
+ { Res = ok(method_call) }
+ ; { Byte = token_callback } ->
+ { Res = ok(callback) }
+ ;
+ { format("unexpected call_site_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ % io__write_string("call_site_kind "),
+ % io__write(Res),
+ % io__write_string("\n")
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_call_site_kind_and_callee(
+ deep_result(call_site_kind_and_callee)::out,
+ io__state::di, io__state::uo) is det.
+
+read_call_site_kind_and_callee(Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = token_normal_call } ->
+ read_num(Res1),
+ (
+ { Res1 = ok(CalleeProcStatic) },
+ read_string(Res2),
+ (
+ { Res2 = ok(TypeSubst) },
+ { Res = ok(normal_call(
+ proc_static_ptr(
+ CalleeProcStatic),
+ TypeSubst)) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ ; { Byte = token_special_call } ->
+ { Res = ok(special_call) }
+ ; { Byte = token_higher_order_call } ->
+ { Res = ok(higher_order_call) }
+ ; { Byte = token_method_call } ->
+ { Res = ok(method_call) }
+ ; { Byte = token_callback } ->
+ { Res = ok(callback) }
+ ;
+ { format("unexpected call_site_kind %d",
+ [i(Byte)], Msg) },
+ { Res = error(Msg) }
+ )
+ % io__write_string("call_site_kind_and_callee "),
+ % io__write(Res),
+ % io__write_string("\n")
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_n_things(int, pred(deep_result(T), io__state, io__state),
+ deep_result(list(T)), io__state, io__state).
+:- mode read_n_things(in, pred(out, di, uo) is det, out, di, uo) is det.
+
+read_n_things(N, ThingReader, Res) -->
+ read_n_things(N, ThingReader, [], Res0),
+ (
+ { Res0 = ok(Things0) },
+ { reverse(Things0, Things) },
+ { Res = ok(Things) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_things(int, pred(deep_result(T), io__state, io__state),
+ list(T), deep_result(list(T)), io__state, io__state).
+:- mode read_n_things(in, pred(out, di, uo) is det, in, out, di, uo) is det.
+
+read_n_things(N, ThingReader, Things0, Res) -->
+ ( { N =< 0 } ->
+ { Res = ok(Things0) }
+ ;
+ call(ThingReader, Res1),
+ (
+ { Res1 = ok(Thing) },
+ read_n_things(N - 1, ThingReader, [Thing|Things0], Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_things(pred(deep_result(T), io__state, io__state),
+ deep_result(list(T)), io__state, io__state).
+:- mode read_things(pred(out, di, uo) is det, out, di, uo) is det.
+
+read_things(ThingReader, Res) -->
+ read_things(ThingReader, [], Res).
+
+:- pred read_things(pred(deep_result(T), io__state, io__state),
+ list(T), deep_result(list(T)), io__state, io__state).
+:- mode read_things(pred(out, di, uo) is det, in, out, di, uo) is det.
+
+read_things(ThingReader, Things0, Res) -->
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ ( { Byte = 0 } ->
+ { Res = ok(Things0) }
+ ;
+ putback_byte(Byte),
+ call(ThingReader, Res1),
+ (
+ { Res1 = ok(Thing) },
+ read_things(ThingReader, [Thing|Things0], Res)
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ )
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred read_sequence2(
+ pred(deep_result(T1), io__state, io__state),
+ pred(deep_result(T2), io__state, io__state),
+ pred(T1, T2, deep_result(T3)),
+ deep_result(T3), io__state, io__state).
+:- mode read_sequence2(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence2(P1, P2, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ { call(Combine, T1, T2, Res) }
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence3(
+ 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(T1, T2, T3, deep_result(T4)),
+ deep_result(T4), io__state, io__state).
+:- mode read_sequence3(
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(out, di, uo) is det,
+ pred(in, in, in, out) is det,
+ out, di, uo) is det.
+
+read_sequence3(P1, P2, P3, Combine, Res) -->
+ call(P1, Res1),
+ (
+ { Res1 = ok(T1) },
+ call(P2, Res2),
+ (
+ { Res2 = ok(T2) },
+ call(P3, Res3),
+ (
+ { Res3 = ok(T3) },
+ { call(Combine, T1, T2, T3, Res) }
+ ;
+ { Res3 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res2 = error(Err) },
+ { Res = error(Err) }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_sequence4(
+ 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(T1, T2, T3, T4, deep_result(T5)),
+ deep_result(T5), io__state, io__state).
+:- mode read_sequence4(
+ 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, out) is det,
+ out, di, uo) is det.
+
+read_sequence4(P1, P2, P3, P4, 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(Combine, T1, T2, T3, T4, Res) }
+ ;
+ { 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_sequence5(
+ 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(T1, T2, T3, T4, T5, deep_result(T6)),
+ deep_result(T6), io__state, io__state).
+:- mode read_sequence5(
+ 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, out) is det,
+ out, di, uo) is det.
+
+read_sequence5(P1, P2, P3, P4, P5, 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(Combine, T1, T2, T3, T4,
+ T5, Res) }
+ ;
+ { 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_sequence6(
+ 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(T1, T2, T3, T4, T5, T6, deep_result(T7)),
+ deep_result(T7), io__state, io__state).
+:- mode read_sequence6(
+ 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, out) is det,
+ out, di, uo) is det.
+
+read_sequence6(P1, P2, P3, P4, P5, P6, 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(Combine, T1, T2,
+ T3, T4, T5,
+ T6, Res) }
+ ;
+ { 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,
+ io__state::di, io__state::uo) is det.
+
+read_string(Res) -->
+ read_num(Res0),
+ (
+ { Res0 = ok(Length) },
+ ( { Length = 0 } ->
+ { Res = ok("") }
+ ;
+ read_n_byte_string(Length, Res)
+ )
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_byte_string(int::in, deep_result(string)::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_byte_string(Length, Res) -->
+ read_n_bytes(Length, Res1),
+ (
+ { Res1 = ok(Bytes) },
+ (
+ { map((pred(I::in, C::out) is semidet :-
+ char__to_int(C, I)
+ ), Bytes, Chars) }
+ ->
+ { string__from_char_list(Chars, Str) },
+ { Res = ok(Str) }
+ ;
+ { Res = error("string contained bad char") }
+ )
+ ;
+ { Res1 = error(Err) },
+ { Res = error(Err) }
+ ).
+ % io__write_string("string "),
+ % io__write(Res),
+ % io__write_string("\n")
+
+:- pred read_ptr(ptr_kind::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_ptr(_Kind, Res) -->
+ read_num1(0, Res).
+ % io__write_string("ptr "),
+ % io__write(Res),
+ % io__write_string("\n").
+
+:- pred read_num(deep_result(int)::out, io__state::di, io__state::uo) is det.
+
+read_num(Res) -->
+ read_num1(0, Res).
+ % io__write_string("num "),
+ % io__write(Res),
+ % io__write_string("\n").
+
+:- pred read_num1(int::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_num1(Num0, Res) -->
+ read_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ { Num1 = (Num0 << 7) \/ (Byte /\ 0x7F) },
+ ( { Byte /\ 0x80 \= 0 } ->
+ read_num1(Num1, Res)
+ ;
+ { Res = ok(Num1) }
+ )
+ ;
+ { Res0 = eof },
+ { Res = error("unexpected end of file") }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+:- func fixed_size_int_bytes = int.
+
+% Must correspond to MR_FIXED_SIZE_INT_BYTES
+% in runtime/mercury_deep_profiling.c.
+
+fixed_size_int_bytes = 4.
+
+:- pred read_fixed_size_int(deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_fixed_size_int(Res) -->
+ read_fixed_size_int1(fixed_size_int_bytes, 0, 0, Res).
+
+:- pred read_fixed_size_int1(int::in, int::in, int::in, deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_fixed_size_int1(BytesLeft, Num0, ShiftBy, Res) -->
+ ( { BytesLeft =< 0 } ->
+ { Res = ok(Num0) }
+ ;
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ { Num1 = Num0 \/ ( Byte << ShiftBy) },
+ read_fixed_size_int1(BytesLeft - 1, Num1, ShiftBy + 8,
+ Res)
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_n_bytes(int::in, deep_result(list(int))::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_bytes(N, Res) -->
+ read_n_bytes(N, [], Res0),
+ (
+ { Res0 = ok(Bytes0) },
+ { reverse(Bytes0, Bytes) },
+ { Res = ok(Bytes) }
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ ).
+
+:- pred read_n_bytes(int::in, list(int)::in, deep_result(list(int))::out,
+ io__state::di, io__state::uo) is det.
+
+read_n_bytes(N, Bytes0, Res) -->
+ ( { N =< 0 } ->
+ { Res = ok(Bytes0) }
+ ;
+ read_deep_byte(Res0),
+ (
+ { Res0 = ok(Byte) },
+ read_n_bytes(N - 1, [Byte | Bytes0], Res)
+ ;
+ { Res0 = error(Err) },
+ { Res = error(Err) }
+ )
+ ).
+
+:- pred read_deep_byte(deep_result(int)::out,
+ io__state::di, io__state::uo) is det.
+
+read_deep_byte(Res) -->
+ read_byte(Res0),
+ % io__write_string("byte "),
+ % io__write(Res),
+ % io__write_string("\n"),
+ (
+ { Res0 = ok(Byte) },
+ { Res = ok(Byte) }
+ ;
+ { Res0 = eof },
+ { Res = error("unexpected end of file") }
+ ;
+ { Res0 = error(Err) },
+ { io__error_message(Err, Msg) },
+ { Res = error(Msg) }
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pred deep_insert(array(T)::in, int::in, T::in, array(T)::out) is det.
+
+deep_insert(A0, Ind, Thing, A) :-
+ array__max(A0, Max),
+ ( Ind > Max ->
+ array__lookup(A0, 0, X),
+ array__resize(u(A0), 2 * (Max + 1), X, A1),
+ deep_insert(A1, Ind, Thing, A)
+ ;
+ set(u(A0), Ind, Thing, A)
+ ).
+
+%------------------------------------------------------------------------------%
+
+:- pragma c_header_code("
+#include ""mercury_deep_profiling.h""
+").
+
+:- func token_root = int.
+:- pragma c_code(token_root = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_root;").
+
+:- func token_call_site_static = int.
+:- pragma c_code(token_call_site_static = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_call_site_static;").
+
+:- func token_call_site_dynamic = int.
+:- pragma c_code(token_call_site_dynamic = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_call_site_dynamic;").
+
+:- func token_proc_static = int.
+:- pragma c_code(token_proc_static = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_proc_static;").
+
+:- func token_proc_dynamic = int.
+:- pragma c_code(token_proc_dynamic = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_proc_dynamic;").
+
+:- func token_normal_call = int.
+:- pragma c_code(token_normal_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_normal_call;").
+
+:- func token_special_call = int.
+:- pragma c_code(token_special_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_special_call;").
+
+:- func token_higher_order_call = int.
+:- pragma c_code(token_higher_order_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_higher_order_call;").
+
+:- func token_method_call = int.
+:- pragma c_code(token_method_call = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_method_call;").
+
+:- func token_callback = int.
+:- pragma c_code(token_callback = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_callback;").
+
+:- func token_isa_predicate = int.
+:- pragma c_code(token_isa_predicate = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_predicate;").
+
+:- func token_isa_function = int.
+:- pragma c_code(token_isa_function = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_function;").
+
+:- func token_isa_compiler_generated = int.
+:- pragma c_code(token_isa_compiler_generated = (X::out),
+ [will_not_call_mercury, thread_safe],
+ "X = MR_deep_token_isa_compiler_generated;").
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+:- pred resize_arrays(deep_result2(initial_deep, ptr_info)::in,
+ maybe_error(initial_deep)::out) is det.
+
+resize_arrays(error2(Err), error(Err)).
+resize_arrays(ok2(InitDeep0, PI), ok(InitDeep)) :-
+ PI ^ csd = CSDMax,
+ CSDs0 = InitDeep0 ^ init_call_site_dynamics,
+ array__lookup(CSDs0, 0, CSDx),
+ array__resize(u(CSDs0), CSDMax + 1, CSDx, CSDs),
+ InitDeep1 = InitDeep0 ^ init_call_site_dynamics := CSDs,
+
+ PI ^ pd = PDMax,
+ PDs0 = InitDeep1 ^ init_proc_dynamics,
+ array__lookup(PDs0, 0, PDx),
+ array__resize(u(PDs0), PDMax + 1, PDx, PDs),
+ InitDeep2 = InitDeep1 ^ init_proc_dynamics := PDs,
+
+ PI ^ css = CSSMax,
+ CSSs0 = InitDeep2 ^ init_call_site_statics,
+ array__lookup(CSSs0, 0, CSSx),
+ array__resize(u(CSSs0), CSSMax + 1, CSSx, CSSs),
+ InitDeep3 = InitDeep2 ^ init_call_site_statics := CSSs,
+
+ PI ^ ps = PSMax,
+ PSs0 = InitDeep3 ^ init_proc_statics,
+ array__lookup(PSs0, 0, PSx),
+ array__resize(u(PSs0), PSMax + 1, PSx, PSs),
+ InitDeep4 = InitDeep3 ^ init_proc_statics := PSs,
+
+ ProfileStats0 = InitDeep4 ^ init_profile_stats,
+ ProfileStats0 = profile_stats(InstrumentQuanta, UserQuanta,
+ _, _, _, _),
+ ProfileStats = profile_stats(InstrumentQuanta, UserQuanta,
+ CSDMax, PDMax, CSSMax, PSMax),
+ InitDeep = InitDeep4 ^ init_profile_stats := ProfileStats.
+
+%-----------------------------------------------------------------------------%
Index: deep/server.m
===================================================================
RCS file: server.m
diff -N server.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ server.m Thu May 17 01:45:21 2001
@@ -0,0 +1,1781 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains the main server loop of the Mercury deep profiler:
+% each iteration of the server loop serves up one web page.
+%
+% The module also contains test code for checking that all the web pages
+% can be created without runtime aborts.
+
+:- module server.
+
+:- interface.
+
+:- import_module profile.
+:- import_module bool, io.
+
+:- pred test_server(string::in, deep::in, string::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+:- pred server(int::in, bool::in, deep::in,
+ io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module interface, measurements, timeout.
+:- import_module std_util, int, float, char, string.
+:- import_module array, list, assoc_list, map.
+:- import_module exception, require.
+
+:- type call_site_line_number
+ ---> call_site_line_number
+ ; no_call_site_line_number.
+
+%-----------------------------------------------------------------------------%
+
+test_server(DirName, Deep, Fields) -->
+ { string__format("mkdir -p %s", [s(DirName)], Cmd) },
+ io__call_system(Cmd, _),
+ { array__max(Deep ^ clique_members, NumCliques) },
+ test_cliques(1, NumCliques, DirName, Deep, Fields),
+ { array__max(Deep ^ proc_statics, NumProcStatics) },
+ test_procs(1, NumProcStatics, DirName, Deep, Fields).
+
+:- pred test_cliques(int::in, int::in, string::in, deep::in,
+ string::in, io__state::di, io__state::uo) is cc_multi.
+
+test_cliques(Cur, Max, DirName, Deep, Fields) -->
+ ( { Cur =< Max } ->
+ { try_exec(clique(Cur, Fields), Deep, HTML) },
+ write_html(DirName, "clique", Cur, HTML),
+ test_cliques(Cur + 1, Max, DirName, Deep, Fields)
+ ;
+ []
+ ).
+
+:- pred test_procs(int::in, int::in, string::in, deep::in,
+ string::in, io__state::di, io__state::uo) is cc_multi.
+
+test_procs(Cur, Max, DirName, Deep, Fields) -->
+ ( { Cur =< Max } ->
+ { try_exec(proc(Cur, Fields), Deep, HTML) },
+ write_html(DirName, "proc", Cur, HTML),
+ test_procs(Cur + 1, Max, DirName, Deep, Fields)
+ ;
+ []
+ ).
+
+:- pred write_html(string::in, string::in, int::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+write_html(DirName, BaseName, Num, HTML) -->
+ % For large programs such as the Mercury compiler, the profiler data
+ % file may contain hundreds of thousands of cliques. We therefore put
+ % each batch of pages in a different subdirectory, thus limiting the
+ % number of files/subdirs in each directory.
+ { Bunch = (Num - 1) // 1000 },
+ ( { (Num - 1) rem 1000 = 0 } ->
+ { string__format("mkdir -p %s/%s_%04d",
+ [s(DirName), s(BaseName), i(Bunch)], Cmd) },
+ io__call_system(Cmd, _)
+ ;
+ []
+ ),
+ { string__format("%s/%s_%04d/%s_%06d.html",
+ [s(DirName), s(BaseName), i(Bunch), s(BaseName), i(Num)],
+ FileName) },
+ io__tell(FileName, _),
+ io__write_string(HTML),
+ io__told.
+
+%-----------------------------------------------------------------------------%
+
+server(TimeOut, Debug, Deep) -->
+ { DataFileName = Deep ^ data_file_name },
+ { InputPipe = to_server_pipe_name(DataFileName) },
+ { OutputPipe = from_server_pipe_name(DataFileName) },
+ detach_server_loop,
+ server_loop(InputPipe, OutputPipe, TimeOut, Debug, 0, Deep).
+
+:- pragma foreign_decl("C", "
+#include <unistd.h>
+").
+
+:- pred detach_server_loop(io__state::di, io__state::uo) is cc_multi.
+
+:- pragma foreign_proc("C", detach_server_loop(S0::di, S::uo),
+ [will_not_call_mercury], "
+{
+ int status;
+
+ S = S0;
+ fflush(stdout);
+ fflush(stderr);
+ status = fork();
+ if (status < 0) {
+ /*
+ ** The fork failed; we cannot detach the server loop from the
+ ** startup process. The cgi script would therefore wait forever
+ ** if we did not exit now
+ */
+
+ exit(1);
+ } else if (status > 0) {
+ /*
+ ** The fork succeeded; we are in the parent. We therefore exit
+ ** now to let the io__call_system in the cgi script succeed.
+ */
+
+ exit(0);
+ }
+
+ /*
+ ** Else the fork succeeded; we are in the child. We continue
+ ** executing, and start serving answers to queries.
+ */
+}").
+
+:- pred server_loop(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),
+ io__see(InputPipe, SeeRes),
+ (
+ { SeeRes = ok },
+ io__read(ReadRes),
+ stderr_stream(StdErr),
+ (
+ { Debug = yes },
+ io__write(StdErr, ReadRes),
+ io__nl(StdErr)
+ ;
+ { Debug = no }
+ ),
+ (
+ { ReadRes = eof },
+ (
+ { Debug = yes },
+ write_string(StdErr, "eof.\n")
+ ;
+ { Debug = no }
+ ),
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ { ReadRes = error(Msg, Line) },
+ (
+ { Debug = yes },
+ format(StdErr,
+ "error reading input line %d: %s\n",
+ [i(Line), s(Msg)])
+ ;
+ { Debug = no }
+ ),
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ { ReadRes = ok(Cmd) },
+ { try_exec(Cmd, Deep, HTML) },
+ (
+ { Debug = yes },
+ format(StdErr, "query %d output:\n%s\n",
+ [i(QueryNum), s(HTML)])
+ ;
+ { Debug = no }
+ ),
+
+ % If we can't open the output pipe, then we have
+ % no way to report our failure anyway.
+ io__tell(OutputPipe, _),
+ io__write(html(HTML)),
+ 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, _)
+ ; { Cmd = timeout(NewTimeOut) } ->
+ server_loop(InputPipe, OutputPipe,
+ NewTimeOut, Debug, QueryNum + 1, Deep)
+ ;
+ server_loop(InputPipe, OutputPipe,
+ TimeOut, Debug, QueryNum + 1, Deep)
+ )
+ )
+ ;
+ { SeeRes = error(Error) },
+ { io__error_message(Error, Msg) },
+ io__write_string(Msg),
+ io__set_exit_status(1)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred try_exec(cmd::in, deep::in, string::out) is cc_multi.
+
+try_exec(Cmd, Deep, HTML) :-
+ try(exec(Cmd, Deep), Result),
+ (
+ Result = succeeded(HTML)
+ ;
+ Result = exception(Exception),
+ ( univ_to_type(Exception, MsgPrime) ->
+ Msg = MsgPrime
+ ;
+ Msg = "unknown exception"
+ ),
+ HTML =
+ format("<H1>AN EXCEPTION HAS OCCURRED: %s.</H1>\n",
+ [s(Msg)])
+ ).
+
+:- pred exec(cmd::in, deep::in, string::out) is det.
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = quit,
+ HTML =
+ format("<H1>Shutting down deep profile server for %s.</H1>\n",
+ [s(Deep ^ data_file_name)]).
+
+exec(Cmd, _Deep, HTML) :-
+ Cmd = timeout(TimeOut),
+ HTML = format("<H1>Timeout set to %d minutes</H1>\n", [i(TimeOut)]).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = menu,
+ HTML =
+ banner ++
+ "<p>\n" ++
+ menu_text ++
+ "<ul>\n" ++
+ "<li>\n" ++
+ menu_item(Deep, root(default_fields),
+ "Exploring the call graph.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: time, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self_and_desc,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: time, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: words, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self_and_desc,
+ rank_range(1, 100), default_fields),
+ "Top 100 most expensive procedures: words, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self,
+ threshold(0.1), default_fields),
+ "Procedures above 0.1% threshold: time, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(time, self_and_desc,
+ threshold(1.0), default_fields),
+ "Procedures above 1% threshold: time, self+desc.")
+ ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self,
+ threshold(0.1), default_fields),
+ "Procedures above 0.1% threshold: words, self.") ++
+ "<li>\n" ++
+ menu_item(Deep, top_procs(words, self_and_desc,
+ threshold(1.0), default_fields),
+ "Procedures above 1% threshold: words, self+desc.")
+ ++
+ "</ul>\n" ++
+ "<p>\n" ++
+ present_stats(Deep) ++
+ footer(Cmd, Deep).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = root(Fields),
+ deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
+ RootCliquePtr = clique_ptr(RootCliqueNum),
+ exec(clique(RootCliqueNum, Fields), Deep, HTML).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = clique(CliqueNum, Fields),
+ ( valid_clique_ptr(Deep, clique_ptr(CliqueNum)) ->
+ HTML =
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ clique_to_html(Deep, Fields,
+ clique_ptr(CliqueNum)) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep)
+ ;
+ HTML =
+ banner ++
+ "There is no clique with that number.\n" ++
+ footer(Cmd, Deep)
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = top_procs(Sort, InclDesc, Limit, Fields),
+ find_top_procs(Sort, InclDesc, Limit, Deep, MaybeTopPSIs),
+ (
+ MaybeTopPSIs = error(ErrorMessage),
+ HTML =
+ banner ++
+ ErrorMessage ++ "\n" ++
+ footer(Cmd, Deep)
+ ;
+ MaybeTopPSIs = ok(TopPSIs),
+ ( TopPSIs = [] ->
+ HTML =
+ banner ++
+ "No procedures match the specification.\n" ++
+ footer(Cmd, Deep)
+ ;
+ TopProcSummaries = list__map(
+ proc_total_summary_to_html(Deep, Fields),
+ TopPSIs),
+ HTML =
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ string__append_list(TopProcSummaries) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep)
+ )
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc(PSI, Fields),
+ HTML =
+ "<HTML>\n" ++
+ banner ++
+ "<TABLE>\n" ++
+ fields_header(Fields) ++
+ proc_summary_to_html(Deep, Fields, PSI) ++
+ "</TABLE>\n" ++
+ footer(Cmd, Deep).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc_static(PSI),
+ PSPtr = proc_static_ptr(PSI),
+ ( valid_proc_static_ptr(Deep, PSPtr) ->
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ Refined = PS ^ ps_refined_id,
+ Raw = PS ^ ps_raw_id,
+ FileName = PS ^ ps_filename,
+ HTML =
+ "<HTML>\n" ++
+ Refined ++ " " ++ Raw ++ " " ++ FileName ++ " " ++
+ string__int_to_string(array__max(PS ^ ps_sites)) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid proc_static_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = proc_dynamic(PDI),
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( valid_proc_dynamic_ptr(Deep, PDPtr) ->
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ PSPtr = proc_static_ptr(PSI),
+ HTML =
+ "<HTML>\n" ++
+ format("proc_static %d, ", [i(PSI)]) ++
+ array_slots_to_html(PD ^ pd_sites) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid proc_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = call_site_static(CSSI),
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( valid_call_site_static_ptr(Deep, CSSPtr) ->
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ ContainerPtr = CSS ^ css_container,
+ ContainerPtr = proc_static_ptr(Container),
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Container) ++ " " ++
+ string__int_to_string(CSS ^ css_slot_num) ++ " " ++
+ string__int_to_string(CSS ^ css_line_num) ++ " " ++
+ kind_and_callee_to_string(CSS ^ css_kind) ++ " " ++
+ CSS ^ css_goal_path ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_static_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = call_site_dynamic(CSDI),
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ CSD ^ csd_caller = proc_dynamic_ptr(CallerPDI),
+ CSD ^ csd_callee = proc_dynamic_ptr(CalleePDI),
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(CallerPDI) ++ " -> " ++
+ string__int_to_string(CalleePDI) ++ ": " ++
+ own_to_string(CSD ^ csd_own_prof) ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = raw_clique(CI),
+ CliquePtr = clique_ptr(CI),
+ ( valid_clique_ptr(Deep, CliquePtr) ->
+ deep_lookup_clique_parents(Deep, CliquePtr, Parent),
+ Parent = call_site_dynamic_ptr(ParentPDI),
+ ParentStr = format("%d ->", [i(ParentPDI)]),
+ deep_lookup_clique_members(Deep, CliquePtr, Members),
+ HTML =
+ "<HTML>\n" ++
+ ParentStr ++
+ list__foldl(append_pdi_to_string, Members, "") ++
+ "</HTML>\n"
+ ;
+ HTML =
+ "<HTML>\n" ++
+ "Invalid call_site_dynamic_ptr" ++
+ "</HTML>\n"
+ ).
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_proc_dynamics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_pds) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_call_site_dynamics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_csds) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_proc_statics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_pss) ++
+ "</HTML>\n".
+
+exec(Cmd, Deep, HTML) :-
+ Cmd = num_call_site_statics,
+ HTML =
+ "<HTML>\n" ++
+ string__int_to_string(Deep ^ profile_stats ^ num_csss) ++
+ "</HTML>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func array_slots_to_html(array(call_site_array_slot)) = string.
+
+array_slots_to_html(SlotArray) = HTML :-
+ array__to_list(SlotArray, SlotList),
+ list__foldl(append_slot_to_string, SlotList, "multi", HTML).
+
+:- pred append_slot_to_string(call_site_array_slot::in,
+ string::in, string::out) is det.
+
+append_slot_to_string(Slot, Str0, Str) :-
+ Str = Str0 ++ " " ++ array_slot_to_html(Slot).
+
+:- func array_slot_to_html(call_site_array_slot) = string.
+
+array_slot_to_html(normal(CSDPtr)) = HTML :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ HTML = "normal " ++ string__int_to_string(CSDI).
+array_slot_to_html(multi(CSDPtrArray)) = HTML :-
+ array__to_list(CSDPtrArray, CSDPtrs),
+ list__foldl(append_csdi_to_string, CSDPtrs, "", CSDI_HTML),
+ list__length(CSDPtrs, CSDPtrCount),
+ HTML = format("multi(%d): [", [i(CSDPtrCount)]) ++ CSDI_HTML ++ "]".
+
+:- pred append_csdi_to_string(call_site_dynamic_ptr::in,
+ string::in, string::out) is det.
+
+append_csdi_to_string(call_site_dynamic_ptr(CSDI), Str0, Str) :-
+ Str = Str0 ++ " " ++ string__int_to_string(CSDI).
+
+:- func append_pdi_to_string(proc_dynamic_ptr, string) = string.
+
+append_pdi_to_string(proc_dynamic_ptr(PDI), Str0) =
+ Str0 ++ " " ++ string__int_to_string(PDI).
+
+%-----------------------------------------------------------------------------%
+
+:- func kind_and_callee_to_string(call_site_kind_and_callee) = string.
+
+kind_and_callee_to_string(normal_call(proc_static_ptr(PSI), TypeSpec)) =
+ "normal " ++ string__int_to_string(PSI) ++ " " ++ TypeSpec.
+kind_and_callee_to_string(special_call) = "special_call".
+kind_and_callee_to_string(higher_order_call) = "higher_order_call".
+kind_and_callee_to_string(method_call) = "method_call".
+kind_and_callee_to_string(callback) = "callback".
+
+:- func present_stats(deep) = string.
+
+present_stats(Deep) = HTML :-
+ Stats = Deep ^ profile_stats,
+ HTML =
+ "<TABLE>\n" ++
+ "<TR><TD ALIGN=left>Quanta in user code:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ user_quanta)]) ++
+ "<TR><TD ALIGN=left>Quanta in instrumentation:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ instrument_quanta)]) ++
+ "<TR><TD ALIGN=left>CallSiteDynamic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_csds)]) ++
+ "<TR><TD ALIGN=left>ProcDynamic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_pds)]) ++
+ "<TR><TD ALIGN=left>CallSiteStatic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_csss)]) ++
+ "<TR><TD ALIGN=left>ProcStatic structures:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(Stats ^ num_pss)]) ++
+ "<TR><TD ALIGN=left>Cliques:</TD>\n" ++
+ format("<TD ALIGN=right>%d</TD></TR>\n",
+ [i(array__max(Deep ^ clique_members))]) ++
+ "</TABLE>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func clique_to_html(deep, fields, clique_ptr) = string.
+
+clique_to_html(Deep, Fields, CliquePtr) = HTML :-
+ Ancestors = clique_ancestors_to_html(Deep, Fields, CliquePtr),
+ deep_lookup_clique_members(Deep, CliquePtr, PDPtrs),
+ list__foldl(group_proc_dynamics_by_proc_static(Deep), PDPtrs,
+ map__init, PStoPDsMap),
+ map__to_assoc_list(PStoPDsMap, PStoPDsList0),
+
+ deep_lookup_clique_parents(Deep, CliquePtr, EntryCSDPtr),
+ ( valid_call_site_dynamic_ptr(Deep, EntryCSDPtr) ->
+ deep_lookup_call_site_dynamics(Deep, EntryCSDPtr, EntryCSD),
+ EntryPDPtr = EntryCSD ^ csd_callee,
+ list__filter(proc_group_contains(EntryPDPtr), PStoPDsList0,
+ EntryGroup, RestGroup),
+ list__append(EntryGroup, RestGroup, PStoPDsList)
+ ;
+ PStoPDsList = PStoPDsList0
+ ),
+
+ PDsStrs = list__map(procs_in_clique_to_html(Deep, Fields, CliquePtr),
+ PStoPDsList),
+ string__append_list(PDsStrs, ProcGroups),
+ HTML =
+ Ancestors ++
+ "<a name=""body"">\n" ++
+ ProcGroups ++
+ "</a>".
+
+:- pred proc_group_contains(proc_dynamic_ptr::in,
+ pair(proc_static_ptr, list(proc_dynamic_ptr))::in) is semidet.
+
+proc_group_contains(EntryPDPtr, _ - PDPtrs) :-
+ list__member(EntryPDPtr, PDPtrs).
+
+:- func clique_ancestors_to_html(deep, fields, clique_ptr) = string.
+
+clique_ancestors_to_html(Deep, Fields, CliquePtr) = HTML :-
+ deep_lookup_clique_index(Deep, Deep ^ root, RootCliquePtr),
+ ( CliquePtr = RootCliquePtr ->
+ HTML = ""
+ ;
+ deep_lookup_clique_parents(Deep, CliquePtr, EntryCSDPtr),
+ ThisHTML = call_site_dynamic_to_html(Deep, Fields,
+ call_site_line_number, no, EntryCSDPtr),
+ deep_lookup_call_site_dynamics(Deep, EntryCSDPtr, EntryCSD),
+ EntryPDPtr = EntryCSD ^ csd_caller,
+ require(valid_proc_dynamic_ptr(Deep, EntryPDPtr),
+ "clique_ancestors_to_html: invalid proc_dynamic"),
+ deep_lookup_clique_index(Deep, EntryPDPtr, EntryCliquePtr),
+ AncestorHTML = clique_ancestors_to_html(Deep, Fields,
+ EntryCliquePtr),
+ HTML =
+ AncestorHTML ++
+ ThisHTML
+ ).
+
+:- pred group_proc_dynamics_by_proc_static(deep::in, proc_dynamic_ptr::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::out) is det.
+
+group_proc_dynamics_by_proc_static(Deep, PDPtr, PStoPDsMap0, PStoPDsMap) :-
+ require(valid_proc_dynamic_ptr(Deep, PDPtr),
+ "group_proc_dynamics_by_proc_static: invalid PDPtr"),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ ( map__search(PStoPDsMap0, PSPtr, PSPDs0) ->
+ PSPDs = [PDPtr | PSPDs0],
+ map__det_update(PStoPDsMap0, PSPtr, PSPDs, PStoPDsMap)
+ ;
+ map__det_insert(PStoPDsMap0, PSPtr, [PDPtr], PStoPDsMap)
+ ).
+
+:- func procs_in_clique_to_html(deep, fields, clique_ptr,
+ pair(proc_static_ptr, list(proc_dynamic_ptr))) = string.
+
+procs_in_clique_to_html(Deep, Fields, CliquePtr, PSPtr - PDPtrs) = HTML :-
+ ( PDPtrs = [] ->
+ HTML = ""
+ ; PDPtrs = [PDPtr] ->
+ HTML = proc_in_clique_to_html(Deep, Fields, CliquePtr, PDPtr)
+ ;
+ Separator = separator_row(Fields),
+ list__map(deep_lookup_pd_own(Deep), PDPtrs, ProcOwns),
+ list__map(deep_lookup_pd_desc(Deep), PDPtrs, ProcDescs),
+ ProcOwn = sum_own_infos(ProcOwns),
+ ProcDesc = sum_inherit_infos(ProcDescs),
+ ProcTotal = proc_total_in_clique(Deep, Fields,
+ PSPtr, no, ProcOwn, ProcDesc),
+ ComponentHTMLs = list__map(proc_in_clique_to_html(Deep, Fields,
+ CliquePtr), PDPtrs),
+ string__append_list(ComponentHTMLs, ComponentHTML),
+ HTML =
+ Separator ++
+ ProcTotal ++
+ Separator ++
+ ComponentHTML
+ ).
+
+:- func proc_in_clique_to_html(deep, fields, clique_ptr, proc_dynamic_ptr)
+ = string.
+
+proc_in_clique_to_html(Deep, Fields, CliquePtr, PDPtr) = HTML :-
+ ( valid_proc_dynamic_ptr(Deep, PDPtr) ->
+ InitialSeparator = separator_row(Fields),
+ deep_lookup_pd_own(Deep, PDPtr, ProcOwn),
+ deep_lookup_pd_desc(Deep, PDPtr, ProcDesc),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ ProcTotal = proc_total_in_clique(Deep, Fields,
+ PSPtr, yes, ProcOwn, ProcDesc),
+ child_call_sites(Deep ^ proc_dynamics, Deep ^ proc_statics,
+ PDPtr, GroupPairs),
+ list__foldl(call_site_group_to_html(Deep, Fields, CliquePtr),
+ GroupPairs, map__init, GroupMap),
+ map__to_assoc_list(GroupMap, GroupPairLists),
+ assoc_list__values(GroupPairLists, GroupLists),
+ list__condense(GroupLists, GroupList),
+ string__append_list(GroupList, GroupStr0),
+ ( GroupList = [] ->
+ GroupStr = GroupStr0
+ ;
+ GroupStr = separator_row(Fields) ++ GroupStr0
+ ),
+ HTML =
+ InitialSeparator ++
+ ProcTotal ++
+ GroupStr
+ ;
+ HTML = ""
+ ).
+
+:- pred child_call_sites(proc_dynamics::in, proc_statics::in,
+ proc_dynamic_ptr::in,
+ assoc_list(call_site_static_ptr, call_site_array_slot)::out) is det.
+
+child_call_sites(ProcDynamics, ProcStatics, PDPtr, PairedSlots) :-
+ lookup_proc_dynamics(ProcDynamics, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ CSDArray = PD ^ pd_sites,
+ lookup_proc_statics(ProcStatics, PSPtr, PS),
+ CSSArray = PS ^ ps_sites,
+ array__to_list(CSDArray, CSDSlots),
+ array__to_list(CSSArray, CSSSlots),
+ assoc_list__from_corresponding_lists(CSSSlots, CSDSlots, PairedSlots).
+
+:- func proc_total_in_clique(deep, fields, proc_static_ptr, bool,
+ own_prof_info, inherit_prof_info) = string.
+
+proc_total_in_clique(Deep, Fields, PSPtr, Only, Own, Desc) = HTML :-
+ ProcName = proc_static_to_html_ref(Deep, Fields, PSPtr),
+ (
+ Only = no,
+ OnlyStr = "summary "
+ ;
+ Only = yes,
+ OnlyStr = ""
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD COLSPAN=2><B>%s%s</B></TD>\n",
+ [s(OnlyStr), s(ProcName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- pred call_site_group_to_html(deep::in, fields::in,
+ clique_ptr::in, pair(call_site_static_ptr, call_site_array_slot)::in,
+ map(pair(string, int), list(string))::in,
+ map(pair(string, int), list(string))::out) is det.
+
+call_site_group_to_html(Deep, Fields, ThisCliquePtr, Pair,
+ GroupMap0, GroupMap) :-
+ Pair = CSSPtr - CallSiteArray,
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _SlotNum, Kind, LineNumber, _GoalPath),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ FileName = PS ^ ps_filename,
+ ( Kind = normal_call(_CalleePSPtr, _) ->
+ ( CallSiteArray = normal(CSDPtr0) ->
+ CSDPtr = CSDPtr0
+ ;
+ error("call_site_group_to_html: normal_call error")
+ ),
+ HTML = maybe_call_site_dynamic_to_html(Deep, Fields,
+ call_site_line_number, ThisCliquePtr, CSDPtr)
+ ;
+ ( CallSiteArray = multi(CSDPtrs0) ->
+ array__to_list(CSDPtrs0, CSDPtrs)
+ ;
+ error("call_site_group_to_html: non-normal_call error")
+ ),
+ Tuple0 = { "", zero_own_prof_info, zero_inherit_prof_info },
+ Tuple = list__foldl(call_site_array_to_html(Deep, Fields,
+ no_call_site_line_number, ThisCliquePtr),
+ CSDPtrs, Tuple0),
+ Tuple = { GroupHTML, SumOwn, SumDesc },
+ CallSiteName0 = call_site_kind_and_callee_to_html(Kind),
+ ( GroupHTML = "" ->
+ CallSiteName = CallSiteName0 ++ " (no calls made)"
+ ;
+ CallSiteName = CallSiteName0
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD>%s:%d</TD>\n",
+ [s(FileName), i(LineNumber)]) ++
+ format("<TD>%s</TD>\n", [s(CallSiteName)]) ++
+ own_and_desc_to_html(SumOwn, SumDesc, Deep, Fields) ++
+ "</TR>\n" ++
+ GroupHTML
+ ),
+ Key = FileName - LineNumber,
+ ( map__search(GroupMap0, Key, HTMLs0) ->
+ map__det_update(GroupMap0, Key, [HTML | HTMLs0], GroupMap)
+ ;
+ map__det_insert(GroupMap0, Key, [HTML], GroupMap)
+ ).
+
+:- func call_site_array_to_html(deep, fields, call_site_line_number,
+ clique_ptr, call_site_dynamic_ptr,
+ {string, own_prof_info, inherit_prof_info}) =
+ {string, own_prof_info, inherit_prof_info}.
+
+call_site_array_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ ThisCliquePtr, CSDPtr, Tuple0) = Tuple :-
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ Tuple0 = { HTML0, Own0, Desc0 },
+ HTML1 = call_site_dynamic_to_html(Deep, Fields,
+ PrintCallSiteLineNmber, yes(ThisCliquePtr), CSDPtr),
+ string__append(HTML0, HTML1, HTML),
+ deep_lookup_csd_own(Deep, CSDPtr, CallSiteOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CallSiteDesc),
+ Own = add_own_to_own(Own0, CallSiteOwn),
+ Desc = add_inherit_to_inherit(Desc0, CallSiteDesc),
+ Tuple = { HTML, Own, Desc }
+ ;
+ Tuple = Tuple0
+ ).
+
+:- pred process_call_site_dynamics_group(list(call_site_dynamic_ptr)::in,
+ deep::in, proc_static_ptr::in,
+ maybe(clique_ptr)::in, maybe(clique_ptr)::out,
+ own_prof_info::in, own_prof_info::out,
+ inherit_prof_info::in, inherit_prof_info::out) is det.
+
+process_call_site_dynamics_group([], _, _, MaybeToCliquePtr, MaybeToCliquePtr,
+ Own, Own, Desc, Desc).
+process_call_site_dynamics_group([CSDPtr | CSDPtrs], Deep, CalleePSPtr,
+ MaybeToCliquePtr0, MaybeToCliquePtr, Own0, Own, Desc0, Desc) :-
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ PDPtr = CSD ^ csd_callee,
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ require(unify(CalleePSPtr, PSPtr),
+ "process_call_site_dynamics_group: callee mismatch"),
+ deep_lookup_clique_index(Deep, PDPtr, ToCliquePtr),
+ (
+ MaybeToCliquePtr0 = no,
+ MaybeToCliquePtr1 = yes(ToCliquePtr)
+ ;
+ MaybeToCliquePtr0 = yes(PrevToCliquePtr),
+ MaybeToCliquePtr1 = MaybeToCliquePtr0,
+ require(unify(PrevToCliquePtr, ToCliquePtr),
+ "process_call_site_dynamics_group: clique mismatch")
+ ),
+ deep_lookup_csd_own(Deep, CSDPtr, CSDOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CSDDesc),
+ Own1 = add_own_to_own(Own0, CSDOwn),
+ Desc1 = add_inherit_to_inherit(Desc0, CSDDesc),
+ process_call_site_dynamics_group(CSDPtrs, Deep, CalleePSPtr,
+ MaybeToCliquePtr1, MaybeToCliquePtr, Own1, Own, Desc1, Desc).
+
+:- func call_site_dynamics_to_html(deep, fields, maybe(pair(string, int)),
+ clique_ptr, clique_ptr, proc_static_ptr,
+ own_prof_info, inherit_prof_info) = string.
+
+call_site_dynamics_to_html(Deep, Fields, MaybeFileNameLineNumber,
+ ThisCliquePtr, ToCliquePtr, PSPtr, Own, Desc) = HTML :-
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ CalleeName = PS ^ ps_refined_id,
+ ( ThisCliquePtr = ToCliquePtr ->
+ % We don't link recursive calls
+ ProcName = CalleeName
+ ;
+ ToCliquePtr = clique_ptr(ToCliqueNum),
+ ToCliqueURL = deep_cmd_to_url(Deep,
+ clique(ToCliqueNum, Fields)),
+ ProcName =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(ToCliqueURL), s(CalleeName)])
+ ),
+ ( MaybeFileNameLineNumber = yes(FileName - LineNumber) ->
+ SourceField =
+ format("<TD>%s:%d</TD>\n",
+ [s(FileName), i(LineNumber)])
+ ;
+ SourceField = "<TD> </TD>\n"
+ ),
+ HTML =
+ "<TR>\n" ++
+ SourceField ++
+ format("<TD>%s</TD>\n", [s(ProcName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- func maybe_call_site_dynamic_to_html(deep, fields, call_site_line_number,
+ clique_ptr, call_site_dynamic_ptr) = string.
+
+maybe_call_site_dynamic_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ ThisCliquePtr, CSDPtr) = HTML :-
+ ( valid_call_site_dynamic_ptr(Deep, CSDPtr) ->
+ HTML = call_site_dynamic_to_html(Deep, Fields,
+ PrintCallSiteLineNmber, yes(ThisCliquePtr), CSDPtr)
+ ;
+ HTML = ""
+ ).
+
+:- func call_site_dynamic_to_html(deep, fields, call_site_line_number,
+ maybe(clique_ptr), call_site_dynamic_ptr) = string.
+
+call_site_dynamic_to_html(Deep, Fields, PrintCallSiteLineNmber,
+ MaybeThisCliquePtr, CSDPtr) = HTML :-
+ require(valid_call_site_dynamic_ptr(Deep, CSDPtr),
+ "call_site_dynamic_to_html: invalid call_site_dynamic_ptr"),
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ ToProcPtr = CSD ^ csd_callee,
+ CallSiteOwn = CSD ^ csd_own_prof,
+ deep_lookup_csd_desc(Deep, CSDPtr, CallSiteDesc),
+ ( valid_proc_dynamic_ptr(Deep, ToProcPtr) ->
+ deep_lookup_clique_index(Deep, ToProcPtr, ToCliquePtr),
+ CalleeName = call_site_dynamic_label(Deep, CSDPtr),
+ (
+ MaybeThisCliquePtr = yes(ThisCliquePtr),
+ ThisCliquePtr = ToCliquePtr
+ ->
+ % We don't link recursive calls
+ ProcName = CalleeName
+ ;
+ ToCliquePtr = clique_ptr(ToCliqueNum),
+ ToCliqueURL = deep_cmd_to_url(Deep,
+ clique(ToCliqueNum, Fields)),
+ ProcName =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(ToCliqueURL), s(CalleeName)])
+ )
+ ;
+ ProcName = "builtin special procedure"
+ ),
+ ( PrintCallSiteLineNmber = call_site_line_number ->
+ deep_lookup_call_site_static_map(Deep, CSDPtr, CSSPtr),
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _, _, LineNumber, _),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ SourceField =
+ format("<TD>%s:%d</TD>\n",
+ [s(PS ^ ps_filename), i(LineNumber)])
+ ;
+ SourceField = "<TD> </TD>\n"
+ ),
+ HTML =
+ "<TR>\n" ++
+ SourceField ++
+ format("<TD>%s</TD>\n", [s(ProcName)]) ++
+ own_and_desc_to_html(CallSiteOwn, CallSiteDesc,
+ Deep, Fields) ++
+ "</TR>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func proc_summary_to_html(deep, string, int) = string.
+
+proc_summary_to_html(Deep, Fields, PSI) = HTML :-
+ deep_lookup_proc_statics(Deep, proc_static_ptr(PSI), PS),
+ CSSPtrsArray = PS ^ ps_sites,
+ array__to_list(CSSPtrsArray, CSSPtrs),
+ CallSiteSummaryList =
+ list__map(call_site_summary_to_html(Deep, Fields), CSSPtrs),
+ string__append_list(CallSiteSummaryList, CallSiteSummaries),
+ HTML =
+ proc_total_summary_to_html(Deep, Fields, PSI) ++
+ CallSiteSummaries.
+
+:- func proc_total_summary_to_html(deep, string, int) = string.
+
+proc_total_summary_to_html(Deep, Fields, PSI) = HTML :-
+ PSPtr = proc_static_ptr(PSI),
+ deep_lookup_ps_own(Deep, PSPtr, Own),
+ deep_lookup_ps_desc(Deep, PSPtr, Desc),
+ HTML =
+ "<TR>\n" ++
+ format("<TD COLSPAN=2>%s</TD>\n",
+ [s(proc_static_to_html_ref(Deep, Fields,
+ proc_static_ptr(PSI)))]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+%-----------------------------------------------------------------------------%
+
+:- func call_site_summary_to_html(deep, string, call_site_static_ptr) = string.
+
+call_site_summary_to_html(Deep, Fields, CSSPtr) = HTML :-
+ deep_lookup_css_own(Deep, CSSPtr, Own),
+ deep_lookup_css_desc(Deep, CSSPtr, Desc),
+ deep_lookup_call_site_statics(Deep, CSSPtr, CSS),
+ CSS = call_site_static(PSPtr, _, Kind, LineNumber, _GoalPath),
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ FileName = PS ^ ps_filename,
+ deep_lookup_call_site_calls(Deep, CSSPtr, CallSiteCallMap),
+ map__to_assoc_list(CallSiteCallMap, CallSiteCallList),
+ ( Kind = normal_call(CalleePSPtr, _) ->
+ ( CallSiteCallList = [] ->
+ deep_lookup_proc_statics(Deep, CalleePSPtr, CalleePS)
+ ; CallSiteCallList = [CallSiteCall] ->
+ CallSiteCall = CalleePSPtr2 - _CallSet,
+ require(unify(CalleePSPtr, CalleePSPtr2),
+ "call_site_summary_to_html: callee mismatch"),
+ deep_lookup_proc_statics(Deep, CalleePSPtr, CalleePS)
+ ;
+ error("normal call site calls more than one procedure")
+ ),
+ MainLineRest =
+ format("<TD>%s</TD>\n",
+ [s(CalleePS ^ ps_refined_id)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields),
+ AdditionalLines = ""
+ ;
+ CallSiteName0 = call_site_kind_and_callee_to_html(Kind),
+ ( CallSiteCallList = [] ->
+ CallSiteName = CallSiteName0 ++
+ " (no&nbps;calls&nbps;made)"
+ ;
+ CallSiteName = CallSiteName0
+ ),
+ MainLineRest =
+ format("<TD>%s</TD>\n",
+ [s(CallSiteName)]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields),
+ CallSiteCallLines = list__map(
+ call_site_summary_group_to_html(Deep, Fields),
+ CallSiteCallList),
+ string__append_list(CallSiteCallLines, AdditionalLines)
+ ),
+ HTML =
+ "<TR>\n" ++
+ format("<TD>%s:%d</TD>\n", [s(FileName), i(LineNumber)]) ++
+ MainLineRest ++
+ "</TR>\n" ++
+ AdditionalLines.
+
+:- func call_site_kind_and_callee_to_html(call_site_kind_and_callee) = string.
+
+call_site_kind_and_callee_to_html(normal_call(_, _)) = "normal_call".
+call_site_kind_and_callee_to_html(special_call) = "special_call".
+call_site_kind_and_callee_to_html(higher_order_call) = "higher_order_call".
+call_site_kind_and_callee_to_html(method_call) = "method_call".
+call_site_kind_and_callee_to_html(callback) = "callback".
+
+:- func call_site_summary_group_to_html(deep, string,
+ pair(proc_static_ptr, list(call_site_dynamic_ptr))) = string.
+
+call_site_summary_group_to_html(Deep, Fields, PSPtr - CSDPtrs) = HTML :-
+ list__foldl2(accumulate_csd_prof_info(Deep), CSDPtrs,
+ zero_own_prof_info, Own, zero_inherit_prof_info, Desc),
+ HTML =
+ "<TR>\n" ++
+ format("<TD></TD><TD>%s</TD>\n",
+ [s(proc_static_to_html_ref(Deep, Fields, PSPtr))]) ++
+ own_and_desc_to_html(Own, Desc, Deep, Fields) ++
+ "</TR>\n".
+
+:- pred accumulate_csd_prof_info(deep::in, call_site_dynamic_ptr::in,
+ own_prof_info::in, own_prof_info::out,
+ inherit_prof_info::in, inherit_prof_info::out) is det.
+
+accumulate_csd_prof_info(Deep, CSDPtr, Own0, Own, Desc0, Desc) :-
+ deep_lookup_csd_own(Deep, CSDPtr, CSDOwn),
+ deep_lookup_csd_desc(Deep, CSDPtr, CSDDesc),
+
+ add_own_to_own(Own0, CSDOwn) = Own,
+ add_inherit_to_inherit(Desc0, CSDDesc) = Desc.
+
+%-----------------------------------------------------------------------------%
+
+:- func call_site_dynamic_label(deep, call_site_dynamic_ptr) = string.
+
+call_site_dynamic_label(Deep, CSDPtr) = Name :-
+ (
+ valid_call_site_dynamic_ptr(Deep, CSDPtr),
+ deep_lookup_call_site_dynamics(Deep, CSDPtr, CSD),
+ PDPtr = CSD ^ csd_callee,
+ valid_proc_dynamic_ptr(Deep, PDPtr),
+ deep_lookup_proc_dynamics(Deep, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ valid_proc_static_ptr(Deep, PSPtr),
+ deep_lookup_proc_statics(Deep, PSPtr, PS)
+ ->
+ Name = PS ^ ps_refined_id
+ ;
+ Name = "unknown procedure"
+ ).
+
+:- func proc_static_to_html_ref(deep, string, proc_static_ptr) = string.
+
+proc_static_to_html_ref(Deep, Fields, PSPtr) = HTML :-
+ ( valid_proc_static_ptr(Deep, PSPtr) ->
+ deep_lookup_proc_statics(Deep, PSPtr, PS),
+ PSPtr = proc_static_ptr(PSI),
+ PSURL = deep_cmd_to_url(Deep, proc(PSI, Fields)),
+ HTML = format("<A HREF=""%s"">%s</A>\n",
+ [s(PSURL), s(PS ^ ps_refined_id)])
+ ;
+ HTML =
+ "mercury_runtime"
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- func quantum_time(int) = string.
+
+quantum_time(Quanta) = TimeStr :-
+ Time = Quanta * 10, % a quantum is 10 milliseconds on our machines
+ format("%d", [i(Time)], Str0),
+ string__to_char_list(Str0, Chars0),
+ reverse(Chars0, RevChars0),
+ string__from_char_list(reverse(
+ milliseconds_to_seconds(RevChars0)), TimeStr).
+
+:- func commas(int) = string.
+
+commas(Num) = Str :-
+ format("%d", [i(Num)], Str0),
+ string__to_char_list(Str0, Chars0),
+ reverse(Chars0, RevChars0),
+ string__from_char_list(reverse(add_commas(RevChars0)), Str).
+
+:- func milliseconds_to_seconds(list(char)) = list(char).
+
+milliseconds_to_seconds([]) = ['0', '0', '.', '0'].
+milliseconds_to_seconds([_C]) = ['0', '0', '.', '0'].
+milliseconds_to_seconds([_C, D]) = [D, '0', '.', '0'].
+milliseconds_to_seconds([_C, D, E]) = [D, E, '.', '0'].
+milliseconds_to_seconds([_C, D, E, F | R]) = [D, E, '.' | add_commas([F | R])].
+
+:- func add_commas(list(char)) = list(char).
+
+add_commas([]) = [].
+add_commas([C]) = [C].
+add_commas([C, D]) = [C, D].
+add_commas([C, D, E]) = [C, D, E].
+add_commas([C, D, E, F | R]) = [C, D, E, (',') | add_commas([F | R])].
+
+%-----------------------------------------------------------------------------%
+
+:- pred show_port_counts(fields::in) is semidet.
+
+show_port_counts(Fields) :-
+ string__contains_char(Fields, 'p').
+
+:- pred show_quanta(fields::in) is semidet.
+
+show_quanta(Fields) :-
+ string__contains_char(Fields, 'q').
+
+:- pred show_times(fields::in) is semidet.
+
+show_times(Fields) :-
+ string__contains_char(Fields, 't').
+
+:- pred show_allocs(fields::in) is semidet.
+
+show_allocs(Fields) :-
+ string__contains_char(Fields, 'a').
+
+:- pred show_words(fields::in) is semidet.
+
+show_words(Fields) :-
+ string__contains_char(Fields, 'w').
+
+%-----------------------------------------------------------------------------%
+
+:- pred find_top_procs(sort_measurement::in, include_descendants::in,
+ display_limit::in, deep::in, maybe_error(list(int))::out) is det.
+
+find_top_procs(Sort, InclDesc, Limit, Deep, MaybeTopPSIs) :-
+ find_top_sort_predicate(Sort, InclDesc, SortCompatible, RawSortPred),
+ (
+ SortCompatible = no,
+ MaybeTopPSIs = error("bad sort specification")
+ ;
+ SortCompatible = yes,
+ ProcStatics = Deep ^ proc_statics,
+ array__max(ProcStatics, MaxProcStatic),
+ PSIs = int_list_from_to(1, MaxProcStatic),
+ SortPred = (pred(PSI1::in, PSI2::in, ComparisonResult::out)
+ is det :-
+ call(RawSortPred, Deep, PSI1, PSI2, ComparisonResult)
+ ),
+ list__sort(SortPred, PSIs, AscendingPSIs),
+ list__reverse(AscendingPSIs, DescendingPSIs),
+ (
+ Limit = rank_range(First, Last),
+ (
+ list__drop(First - 1, DescendingPSIs,
+ RemainingPSIs)
+ ->
+ list__take_upto(Last - First + 1,
+ RemainingPSIs, TopPSIs),
+ MaybeTopPSIs = ok(TopPSIs)
+ ;
+ MaybeTopPSIs = ok([])
+ )
+ ;
+ Limit = threshold(Threshold),
+ find_threshold_predicate(Sort, InclDesc,
+ ThresholdCompatible, RawThresholdPred),
+ (
+ ThresholdCompatible = no,
+ MaybeTopPSIs =
+ error("bad threshold specification")
+ ;
+ ThresholdCompatible = yes,
+ ThresholdPred = (pred(PSI::in) is semidet :-
+ call(RawThresholdPred, Deep, Threshold,
+ PSI)
+ ),
+ list__takewhile(ThresholdPred, DescendingPSIs,
+ TopPSIs, _),
+ MaybeTopPSIs = ok(TopPSIs)
+ )
+ )
+ ).
+
+:- func int_list_from_to(int, int) = list(int).
+
+int_list_from_to(From, To) = List :-
+ ( From > To ->
+ List = []
+ ;
+ List = [From | int_list_from_to(From + 1, To)]
+ ).
+
+:- pred find_top_sort_predicate(sort_measurement, include_descendants,
+ bool, pred(deep, int, int, comparison_result)).
+:- mode find_top_sort_predicate(in, in, out, out(pred(in, in, in, out) is det))
+ is det.
+
+find_top_sort_predicate(calls, self, yes, compare_ps_calls_self).
+find_top_sort_predicate(calls, self_and_desc, no, compare_ps_calls_self).
+find_top_sort_predicate(time, self, yes, compare_ps_time_self).
+find_top_sort_predicate(time, self_and_desc, yes, compare_ps_time_both).
+find_top_sort_predicate(allocs, self, yes, compare_ps_allocs_self).
+find_top_sort_predicate(allocs, self_and_desc, yes, compare_ps_allocs_both).
+find_top_sort_predicate(words, self, yes, compare_ps_words_self).
+find_top_sort_predicate(words, self_and_desc, yes, compare_ps_words_both).
+
+:- pred find_threshold_predicate(sort_measurement, include_descendants,
+ bool, pred(deep, float, int)).
+:- mode find_threshold_predicate(in, in, out, out(pred(in, in, in) is semidet))
+ is det.
+
+find_threshold_predicate(calls, self, no, threshold_ps_time_self).
+find_threshold_predicate(calls, self_and_desc, no, threshold_ps_time_self).
+find_threshold_predicate(time, self, yes, threshold_ps_time_self).
+find_threshold_predicate(time, self_and_desc, yes, threshold_ps_time_both).
+find_threshold_predicate(allocs, self, yes, threshold_ps_allocs_self).
+find_threshold_predicate(allocs, self_and_desc, yes, threshold_ps_allocs_both).
+find_threshold_predicate(words, self, yes, threshold_ps_words_self).
+find_threshold_predicate(words, self_and_desc, yes, threshold_ps_words_both).
+
+:- pred compare_ps_calls_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_calls_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnCalls1 = calls(Own1),
+ OwnCalls2 = calls(Own2),
+ compare(Result, OwnCalls1, OwnCalls2).
+
+:- pred compare_ps_time_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_time_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnQuanta1 = quanta(Own1),
+ OwnQuanta2 = quanta(Own2),
+ compare(Result, OwnQuanta1, OwnQuanta2).
+
+:- pred compare_ps_time_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_time_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnQuanta1 = quanta(Own1),
+ OwnQuanta2 = quanta(Own2),
+ DescQuanta1 = inherit_quanta(Desc1),
+ DescQuanta2 = inherit_quanta(Desc2),
+ TotalQuanta1 = OwnQuanta1 + DescQuanta1,
+ TotalQuanta2 = OwnQuanta2 + DescQuanta2,
+ compare(Result, TotalQuanta1, TotalQuanta2).
+
+:- pred compare_ps_allocs_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_allocs_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnAllocs1 = mallocs(Own1),
+ OwnAllocs2 = mallocs(Own2),
+ compare(Result, OwnAllocs1, OwnAllocs2).
+
+:- pred compare_ps_allocs_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_allocs_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnAllocs1 = mallocs(Own1),
+ OwnAllocs2 = mallocs(Own2),
+ DescAllocs1 = inherit_mallocs(Desc1),
+ DescAllocs2 = inherit_mallocs(Desc2),
+ TotalAllocs1 = OwnAllocs1 + DescAllocs1,
+ TotalAllocs2 = OwnAllocs2 + DescAllocs2,
+ compare(Result, TotalAllocs1, TotalAllocs2).
+
+:- pred compare_ps_words_self(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_words_self(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ OwnWords1 = words(Own1),
+ OwnWords2 = words(Own2),
+ compare(Result, OwnWords1, OwnWords2).
+
+:- pred compare_ps_words_both(deep::in, int::in, int::in,
+ comparison_result::out) is det.
+
+compare_ps_words_both(Deep, PSI1, PSI2, Result) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI1, Own1),
+ array__lookup(PSOwn, PSI2, Own2),
+ array__lookup(PSDesc, PSI1, Desc1),
+ array__lookup(PSDesc, PSI2, Desc2),
+ OwnWords1 = words(Own1),
+ OwnWords2 = words(Own2),
+ DescWords1 = inherit_words(Desc1),
+ DescWords2 = inherit_words(Desc2),
+ TotalWords1 = OwnWords1 + DescWords1,
+ TotalWords2 = OwnWords2 + DescWords2,
+ compare(Result, TotalWords1, TotalWords2).
+
+:- pred threshold_ps_time_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_time_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnQuanta = quanta(Own),
+ RootOwnQuanta = quanta(RootOwn),
+ RootDescQuanta = inherit_quanta(RootDesc),
+ RootTotalQuanta = RootOwnQuanta + RootDescQuanta,
+ 100.0 * float(OwnQuanta) > Threshold * float(RootTotalQuanta).
+
+:- pred threshold_ps_time_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_time_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnQuanta = quanta(Own),
+ RootOwnQuanta = quanta(RootOwn),
+ DescQuanta = inherit_quanta(Desc),
+ RootDescQuanta = inherit_quanta(RootDesc),
+ TotalQuanta = OwnQuanta + DescQuanta,
+ RootTotalQuanta = RootOwnQuanta + RootDescQuanta,
+ 100.0 * float(TotalQuanta) > Threshold * float(RootTotalQuanta).
+
+:- pred threshold_ps_allocs_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_allocs_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnAllocs = mallocs(Own),
+ RootOwnAllocs = mallocs(RootOwn),
+ RootDescAllocs = inherit_mallocs(RootDesc),
+ RootTotalAllocs = RootOwnAllocs + RootDescAllocs,
+ 100.0 * float(OwnAllocs) > Threshold * float(RootTotalAllocs).
+
+:- pred threshold_ps_allocs_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_allocs_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnAllocs = mallocs(Own),
+ RootOwnAllocs = mallocs(RootOwn),
+ DescAllocs = inherit_mallocs(Desc),
+ RootDescAllocs = inherit_mallocs(RootDesc),
+ TotalAllocs = OwnAllocs + DescAllocs,
+ RootTotalAllocs = RootOwnAllocs + RootDescAllocs,
+ 100.0 * float(TotalAllocs) > Threshold * float(RootTotalAllocs).
+
+:- pred threshold_ps_words_self(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_words_self(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ array__lookup(PSOwn, PSI, Own),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnWords = words(Own),
+ RootOwnWords = words(RootOwn),
+ RootDescWords = inherit_words(RootDesc),
+ RootTotalWords = RootOwnWords + RootDescWords,
+ 100.0 * float(OwnWords) > Threshold * float(RootTotalWords).
+
+:- pred threshold_ps_words_both(deep::in, float::in, int::in) is semidet.
+
+threshold_ps_words_both(Deep, Threshold, PSI) :-
+ PSOwn = Deep ^ ps_own,
+ PSDesc = Deep ^ ps_desc,
+ array__lookup(PSOwn, PSI, Own),
+ array__lookup(PSDesc, PSI, Desc),
+ RootOwn = root_own_info(Deep),
+ RootDesc = root_desc_info(Deep),
+ OwnWords = words(Own),
+ RootOwnWords = words(RootOwn),
+ DescWords = inherit_words(Desc),
+ RootDescWords = inherit_words(RootDesc),
+ TotalWords = OwnWords + DescWords,
+ RootTotalWords = RootOwnWords + RootDescWords,
+ 100.0 * float(TotalWords) > Threshold * float(RootTotalWords).
+
+%-----------------------------------------------------------------------------%
+
+:- func banner = string.
+
+banner =
+ "<HTML>\n" ++
+ "<TITLE>The University of Melbourne Mercury Deep Profiler.</TITLE>\n".
+
+:- func footer(cmd, deep) = string.
+
+footer(Cmd, Deep) = HTML :-
+ % Link back to root,
+ % Search, etc, etc.
+ HTML =
+ footer_field_select(Cmd, Deep) ++
+ "<p>\n" ++
+ format("<A HREF=""%s"">Menu</A>\n",
+ [s(deep_cmd_to_url(Deep, menu))]) ++
+ format("<A HREF=""%s"">Quit</A>\n",
+ [s(deep_cmd_to_url(Deep, quit))]) ++
+ "</HTML>\n".
+
+:- func footer_field_select(cmd, deep) = string.
+
+footer_field_select(quit, _) = "".
+footer_field_select(timeout(_), _) = "".
+footer_field_select(menu, _) = "".
+footer_field_select(root(Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = root(ArgFields) :- true).
+footer_field_select(clique(CI, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = clique(CI, ArgFields) :- true).
+footer_field_select(proc(PSI, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = proc(PSI, ArgFields) :- true).
+footer_field_select(top_procs(Sort, InclDesc, Limit, Fields), Deep) =
+ footer_field_toggle(Deep, Fields,
+ func(ArgFields) = top_procs(Sort, InclDesc, Limit, ArgFields)
+ :- true).
+footer_field_select(proc_static(_), _) = "".
+footer_field_select(proc_dynamic(_), _) = "".
+footer_field_select(call_site_static(_), _) = "".
+footer_field_select(call_site_dynamic(_), _) = "".
+footer_field_select(raw_clique(_), _) = "".
+footer_field_select(num_proc_statics, _) = "".
+footer_field_select(num_call_site_statics, _) = "".
+footer_field_select(num_proc_dynamics, _) = "".
+footer_field_select(num_call_site_dynamics, _) = "".
+
+:- func footer_field_toggle(deep, string, func(string) = cmd) = string.
+
+footer_field_toggle(Deep, Fields, MakeCmd) = HTML :-
+ FieldsChars = string__to_char_list(Fields),
+ ( show_port_counts(Fields) ->
+ PortChars = list__delete_all(FieldsChars, 'p'),
+ PortMsg = "Don't show port counts"
+ ;
+ PortChars = ['p' | FieldsChars],
+ PortMsg = "Show port counts"
+ ),
+ ( show_quanta(Fields) ->
+ QuantaChars = list__delete_all(FieldsChars, 'q'),
+ QuantaMsg = "Don't show quanta"
+ ;
+ QuantaChars = ['q' | FieldsChars],
+ QuantaMsg = "Show quanta"
+ ),
+ ( show_times(Fields) ->
+ TimesChars = list__delete_all(FieldsChars, 't'),
+ TimesMsg = "Don't show time"
+ ;
+ TimesChars = ['t' | FieldsChars],
+ TimesMsg = "Show time"
+ ),
+ ( show_allocs(Fields) ->
+ AllocsChars = list__delete_all(FieldsChars, 'a'),
+ AllocsMsg = "Don't show allocations"
+ ;
+ AllocsChars = ['a' | FieldsChars],
+ AllocsMsg = "Show allocations"
+ ),
+ ( show_words(Fields) ->
+ WordsChars = list__delete_all(FieldsChars, 'w'),
+ WordsMsg = "Don't show words"
+ ;
+ WordsChars = ['w' | FieldsChars],
+ WordsMsg = "Show words"
+ ),
+ CmdPort = MakeCmd(string__from_char_list(list__sort(PortChars))),
+ CmdQuanta = MakeCmd(string__from_char_list(list__sort(QuantaChars))),
+ CmdTimes = MakeCmd(string__from_char_list(list__sort(TimesChars))),
+ CmdAllocs = MakeCmd(string__from_char_list(list__sort(AllocsChars))),
+ CmdWords = MakeCmd(string__from_char_list(list__sort(WordsChars))),
+ HTML =
+ "<p>\n" ++
+ "Toggle fields: " ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdPort)), s(PortMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdQuanta)), s(QuantaMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdTimes)), s(TimesMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdAllocs)), s(AllocsMsg)]) ++
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, CmdWords)), s(WordsMsg)]).
+
+:- func menu_text = string.
+
+menu_text =
+ "You can start exploring the deep profile at the following points.\n".
+
+:- func menu_item(deep, cmd, string) = string.
+
+menu_item(Deep, Cmd, Text) =
+ format("<A HREF=""%s"">%s</A>\n",
+ [s(deep_cmd_to_url(Deep, Cmd)), s(Text)]).
+
+%-----------------------------------------------------------------------------%
+
+:- func root_total_info(deep) = inherit_prof_info.
+
+root_total_info(Deep) = RootTotal :-
+ deep_lookup_pd_own(Deep, Deep ^ root, RootOwn),
+ deep_lookup_pd_desc(Deep, Deep ^ root, RootDesc),
+ add_own_to_inherit(RootOwn, RootDesc) = RootTotal.
+
+:- func root_desc_info(deep) = inherit_prof_info.
+
+root_desc_info(Deep) = RootDesc :-
+ deep_lookup_pd_desc(Deep, Deep ^ root, RootDesc).
+
+:- func root_own_info(deep) = own_prof_info.
+
+root_own_info(Deep) = RootOwn :-
+ deep_lookup_pd_own(Deep, Deep ^ root, RootOwn).
+
+%-----------------------------------------------------------------------------%
+
+:- func fields_header(fields) = string.
+
+fields_header(Fields) =
+ "<TR>\n" ++
+ "<TD>Source</TD>\n" ++
+ "<TD>Procedure</TD>\n" ++
+ ( show_port_counts(Fields) ->
+ "<TD ALIGN=RIGHT>Calls</TD>\n" ++
+ "<TD ALIGN=RIGHT>Exits</TD>\n" ++
+ "<TD ALIGN=RIGHT>Fails</TD>\n" ++
+ "<TD ALIGN=RIGHT>Redos</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ "<TD ALIGN=RIGHT>Self quanta</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ "<TD ALIGN=RIGHT>Self time</TD>\n"
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ "<TD ALIGN=RIGHT>Total quanta</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ "<TD ALIGN=RIGHT>Total time</TD>\n"
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_allocs(Fields) ->
+ "<TD ALIGN=RIGHT>Self allocs</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n" ++
+ "<TD ALIGN=RIGHT>Total allocs</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ ( show_words(Fields) ->
+ "<TD ALIGN=RIGHT>Self words</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n" ++
+ "<TD ALIGN=RIGHT>Total words</TD>\n" ++
+ "<TD ALIGN=RIGHT>% of root</TD>\n"
+ ;
+ ""
+ ) ++
+ "</TR>\n".
+
+:- func separator_row(fields) = string.
+
+separator_row(Fields) = Separator :-
+ Fixed = 2, % Source, Procedure
+ ( show_port_counts(Fields) ->
+ Port = 4
+ ;
+ Port = 4
+ ),
+ ( show_quanta(Fields) ->
+ Quanta = 2
+ ;
+ Quanta = 0
+ ),
+ ( show_times(Fields) ->
+ Times = 2
+ ;
+ Times = 0
+ ),
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ Percentage = 2
+ ;
+ Percentage = 0
+ ),
+ ( show_allocs(Fields) ->
+ Allocs = 4
+ ;
+ Allocs = 0
+ ),
+ ( show_words(Fields) ->
+ Words = 4
+ ;
+ Words = 0
+ ),
+ Count = Fixed + Port + Quanta + Times + Percentage + Allocs + Words,
+ Separator = string__format("<TR><TD COLSPAN=%d> </TD></TR>\n",
+ [i(Count)]).
+
+:- func own_and_desc_to_html(own_prof_info, inherit_prof_info,
+ deep, fields) = string.
+
+own_and_desc_to_html(Own, Desc, Deep, Fields) = HTML :-
+ add_own_to_inherit(Own, Desc) = OwnPlusDesc,
+ Root = root_total_info(Deep),
+ Calls = calls(Own),
+ Exits = exits(Own),
+ Fails = fails(Own),
+ Redos = redos(Own),
+
+ 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),
+
+ 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),
+
+ 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),
+
+ HTML =
+ ( show_port_counts(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Calls))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Exits))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Fails))]) ++
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(Redos))])
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(OwnQuanta))])
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(quantum_time(OwnQuanta))])
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(OwnQuantaProp)])
+ ;
+ ""
+ ) ++
+ ( show_quanta(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(commas(TotalQuanta))])
+ ;
+ ""
+ ) ++
+ ( show_times(Fields) ->
+ format("<TD ALIGN=RIGHT>%s</TD>\n",
+ [s(quantum_time(TotalQuanta))])
+ ;
+ ""
+ ) ++
+ ( (show_quanta(Fields) ; show_times(Fields)) ->
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(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(commas(TotalAllocs))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(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(commas(TotalWords))]) ++
+ format("<TD ALIGN=RIGHT>%2.2f</TD>\n",
+ [f(TotalWordProp)])
+ ;
+ ""
+ ).
+
+:- func deep_cmd_to_url(deep, cmd) = string.
+
+deep_cmd_to_url(Deep, Cmd) = URL :-
+ cmd_to_url(Deep ^ server_name, Deep ^ data_file_name, Cmd, URL).
+
+%-----------------------------------------------------------------------------%
Index: deep/startup.m
===================================================================
RCS file: startup.m
diff -N startup.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ startup.m Wed May 16 14:24:58 2001
@@ -0,0 +1,1139 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module contains the code for turning the raw list of nodes read in by
+% read_profile.m into the data structure that server.m needs to service
+% requests for web pages. The algorithm it implements is documented in the
+% deep profiling paper.
+
+:- module startup.
+
+:- interface.
+
+:- import_module profile.
+:- import_module io, bool, std_util.
+
+:- pred read_and_startup(string::in, string::in, bool::in,
+ maybe_error(deep)::out, io__state::di, io__state::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module unsafe.
+:- import_module profile, read_profile, cliques, measurements, array_util.
+:- import_module std_util, int, array, list, assoc_list, set, map, require.
+
+read_and_startup(Machine, DataFileName, CanonicalClique, Res) -->
+ io__stderr_stream(StdErr),
+ io__report_stats,
+ io__write_string(StdErr, " Reading graph data...\n"),
+ read_call_graph(DataFileName, Res0),
+ io__write_string(StdErr, " Done.\n"),
+ io__report_stats,
+ (
+ { Res0 = ok(InitialDeep) },
+ startup(Machine, DataFileName, CanonicalClique,
+ InitialDeep, Deep),
+ { Res = ok(Deep) }
+ ;
+ { Res0 = error(Error) },
+ { Res = error(Error) }
+ ).
+
+:- pred startup(string::in, string::in, bool::in, initial_deep::in, deep::out,
+ io__state::di, io__state::uo) is det.
+
+startup(Machine, DataFileName, CanonicalClique, InitialDeep0, Deep) -->
+ stderr_stream(StdErr),
+
+ { InitialDeep0 = initial_deep(InitStats, Root,
+ CallSiteDynamics0, ProcDynamics,
+ CallSiteStatics0, ProcStatics) },
+
+ format(StdErr,
+ " Mapping static call sites to containing procedures...\n",
+ []),
+ { array_foldl(record_css_containers, ProcStatics,
+ u(CallSiteStatics0), CallSiteStatics) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr,
+ " Mapping dynamic call sites to containing procedures...\n",
+ []),
+ { array_foldl(record_csd_containers, ProcDynamics,
+ u(CallSiteDynamics0), CallSiteDynamics) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ { InitialDeep1 = initial_deep(InitStats, Root,
+ CallSiteDynamics, ProcDynamics,
+ CallSiteStatics, ProcStatics) },
+
+ find_cliques(InitialDeep1, CliqueList0),
+ (
+ { CanonicalClique = no },
+ { InitialDeep = InitialDeep1 },
+ { CliqueList = CliqueList0 }
+ ;
+ { CanonicalClique = yes },
+ format(StdErr, " Canonicalizing cliques...\n", []),
+ { merge_cliques(CliqueList0, InitialDeep1, InitialDeep) },
+ io__report_stats,
+
+ find_cliques(InitialDeep, CliqueList)
+ ),
+
+ format(StdErr, " Constructing clique indexes...\n", []),
+ flush_output(StdErr),
+
+ { Cliques = array(CliqueList) },
+
+ { array__max(ProcDynamics, PDMax) },
+ { NPDs = PDMax + 1 },
+ { array__max(CallSiteDynamics, CSDMax) },
+ { NCSDs = CSDMax + 1 },
+ { array__max(ProcStatics, PSMax) },
+ { NPSs = PSMax + 1 },
+ { array__max(CallSiteStatics, CSSMax) },
+ { NCSSs = CSSMax + 1 },
+
+ { array__init(NPDs, clique_ptr(-1), CliqueIndex0) },
+
+ % For each clique, add entries in an array
+ % that maps from each clique member (ProcDynamic)
+ % back to the clique to which it belongs.
+ { array_foldl((pred(CliqueN::in, CliqueMembers::in,
+ I0::array_di, I::array_uo) is det :-
+ array_list_foldl((pred(X::in, I1::array_di, I2::array_uo)
+ is det :-
+ X = proc_dynamic_ptr(Y),
+ array__set(I1, Y, clique_ptr(CliqueN), I2)
+ ), CliqueMembers, I0, I)
+ ), Cliques, CliqueIndex0, CliqueIndex) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing clique parent map...\n", []),
+
+ % For each CallSiteDynamic pointer, if it points to
+ % a ProcDynamic which is in a different clique to
+ % the one from which the CallSiteDynamic's parent
+ % came, then this CallSiteDynamic is the entry to
+ % the [lower] clique. We need to compute this information
+ % so that we can print clique-based timing summaries in
+ % the browser.
+ { array__max(Cliques, CliqueMax) },
+ { NCliques = CliqueMax + 1 },
+ { array__init(NCliques, call_site_dynamic_ptr(-1), CliqueParents0) },
+ { array__init(NCSDs, no, CliqueMaybeChildren0) },
+ { array_foldl2(construct_clique_parents(InitialDeep, CliqueIndex),
+ CliqueIndex,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) },
+
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Finding procedure callers...\n", []),
+ { array__init(NPSs, [], ProcCallers0) },
+ { array_foldl(construct_proc_callers(InitialDeep), CallSiteDynamics,
+ ProcCallers0, ProcCallers) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing call site static map...\n", []),
+ { array__init(NCSDs, call_site_static_ptr(-1), CallSiteStaticMap0) },
+ { array_foldl(construct_call_site_caller(InitialDeep), ProcDynamics,
+ CallSiteStaticMap0, CallSiteStaticMap) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Finding call site calls...\n", []),
+ { array__init(NCSSs, map__init, CallSiteCalls0) },
+ { array_foldl(construct_call_site_calls(InitialDeep), ProcDynamics,
+ CallSiteCalls0, CallSiteCalls) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Propagating time up call graph...\n", []),
+
+ { array__init(NCSDs, zero_inherit_prof_info, CSDDesc0) },
+ { array__init(NPDs, zero_own_prof_info, PDOwn0) },
+ { array_foldl(sum_call_sites_in_proc_dynamic,
+ CallSiteDynamics, PDOwn0, PDOwn) },
+ { array__init(NPDs, zero_inherit_prof_info, PDDesc0) },
+ { array__init(NPSs, zero_own_prof_info, PSOwn0) },
+ { array__init(NPSs, zero_inherit_prof_info, PSDesc0) },
+ { array__init(NCSSs, zero_own_prof_info, CSSOwn0) },
+ { array__init(NCSSs, zero_inherit_prof_info, CSSDesc0) },
+
+ { Deep0 = deep(InitStats, Machine, DataFileName, Root,
+ CallSiteDynamics, ProcDynamics, CallSiteStatics, ProcStatics,
+ CliqueIndex, Cliques, CliqueParents, CliqueMaybeChildren,
+ ProcCallers, CallSiteStaticMap, CallSiteCalls,
+ PDOwn, PDDesc0, CSDDesc0,
+ PSOwn0, PSDesc0, CSSOwn0, CSSDesc0) },
+
+ { array_foldl(propagate_to_clique, Cliques, Deep0, Deep1) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Summarizing information...\n", []),
+ { summarize_proc_dynamics(Deep1, Deep2) },
+ { summarize_call_site_dynamics(Deep2, Deep) },
+ format(StdErr, " Done.\n", []),
+ io__report_stats.
+
+:- pred find_cliques(initial_deep::in, list(list(proc_dynamic_ptr))::out,
+ io__state::di, io__state::uo) is det.
+
+find_cliques(InitialDeep, CliqueList) -->
+ stderr_stream(StdErr),
+ format(StdErr, " Constructing graph...\n", []),
+ make_graph(InitialDeep, Graph),
+ format(StdErr, " Done.\n", []),
+ io__report_stats,
+
+ format(StdErr, " Constructing cliques...\n", []),
+ { topological_sort(Graph, CliqueList0) },
+
+ % Turn each of the sets into a list.
+ % (We use foldl here because the list may be very
+ % long and map runs out of stack space, and we
+ % want the final list in reverse order anyway.)
+ { list__foldl((pred(Set::in, L0::in, L::out) is det :-
+ set__to_sorted_list(Set, List0),
+ map((pred(PDI::in, PDPtr::out) is det :-
+ PDPtr = proc_dynamic_ptr(PDI)
+ ), List0, List),
+ L = [List | L0]
+ ), CliqueList0, [], CliqueList) },
+ % It's actually more convenient to have the list in
+ % reverse order so that foldl works from the bottom
+ % of the tsort to the top, so that we can use it to
+ % do the propagation simply.
+ format(StdErr, " Done.\n", []),
+ io__report_stats.
+
+%-----------------------------------------------------------------------------%
+
+:- pred make_graph(initial_deep::in, graph::out,
+ io__state::di, io__state::uo) is det.
+
+make_graph(InitialDeep, Graph) -->
+ { init(Graph0) },
+ array_foldl2((pred(PDI::in, PD::in, G1::in, G2::out, di, uo) is det -->
+ { From = PDI },
+ { CallSiteRefArray = PD ^ pd_sites },
+ { array__to_list(CallSiteRefArray, CallSiteRefList) },
+ list__foldl2((pred(CSR::in, G5::in, G6::out, di, uo) is det -->
+ (
+ { CSR = normal(call_site_dynamic_ptr(CSDI)) },
+ ( { CSDI > 0 } ->
+ { array__lookup(
+ InitialDeep ^ init_call_site_dynamics,
+ CSDI, CSD) },
+ { CPDPtr = CSD ^ csd_callee },
+ { CPDPtr = proc_dynamic_ptr(To) },
+ { add_arc(G5, From, To, G6) }
+ ;
+ { G6 = G5 }
+ )
+ ;
+ { CSR = multi(CallSiteArray) },
+ { array__to_list(CallSiteArray, CallSites) },
+ list__foldl2((pred(CSDPtr1::in, G7::in, G8::out,
+ di, uo) is det -->
+ { CSDPtr1 = call_site_dynamic_ptr(CSDI) },
+ ( { CSDI > 0 } ->
+ { array__lookup(
+ InitialDeep ^ init_call_site_dynamics,
+ CSDI, CSD) },
+ { CPDPtr = CSD ^ csd_callee },
+ { CPDPtr = proc_dynamic_ptr(To) },
+ { add_arc(G7, From, To, G8) }
+ ;
+ { G8 = G7 }
+ )
+ ), CallSites, G5, G6)
+ )
+ ), CallSiteRefList, G1, G2)
+ ), InitialDeep ^ init_proc_dynamics, Graph0, Graph).
+
+%-----------------------------------------------------------------------------%
+
+:- pred record_css_containers(int::in, proc_static::in,
+ array(call_site_static)::array_di,
+ array(call_site_static)::array_uo) is det.
+
+record_css_containers(PSI, PS, CallSiteStatics0, CallSiteStatics) :-
+ CSSPtrs = PS ^ ps_sites,
+ PSPtr = proc_static_ptr(PSI),
+ array__max(CSSPtrs, MaxCS),
+ record_css_containers_2(MaxCS, PSPtr, CSSPtrs,
+ CallSiteStatics0, CallSiteStatics).
+
+:- pred record_css_containers_2(int::in, proc_static_ptr::in,
+ array(call_site_static_ptr)::in,
+ array(call_site_static)::array_di,
+ array(call_site_static)::array_uo) is det.
+
+record_css_containers_2(SlotNum, PSPtr, CSSPtrs,
+ CallSiteStatics0, CallSiteStatics) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ lookup_call_site_statics(CallSiteStatics0, CSSPtr, CSS0),
+ CSS0 = call_site_static(PSPtr0, SlotNum0,
+ Kind, LineNumber, GoalPath),
+ require(unify(PSPtr0, proc_static_ptr(-1)),
+ "record_css_containers_2: real proc_static_ptr"),
+ require(unify(SlotNum0, -1),
+ "record_css_containers_2: real slot_num"),
+ CSS = call_site_static(PSPtr, SlotNum,
+ Kind, LineNumber, GoalPath),
+ update_call_site_statics(CallSiteStatics0, CSSPtr, CSS,
+ CallSiteStatics1),
+ record_css_containers_2(SlotNum - 1,
+ PSPtr, CSSPtrs, CallSiteStatics1, CallSiteStatics)
+ ;
+ CallSiteStatics = CallSiteStatics0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred record_csd_containers(int::in, proc_dynamic::in,
+ array(call_site_dynamic)::array_di,
+ array(call_site_dynamic)::array_uo) is det.
+
+record_csd_containers(PDI, PD, CallSiteDynamics0, CallSiteDynamics) :-
+ CSDArray = PD ^ pd_sites,
+ PDPtr = proc_dynamic_ptr(PDI),
+ flatten_call_sites(CSDArray, CSDPtrs),
+ record_csd_containers_2(PDPtr, CSDPtrs,
+ CallSiteDynamics0, CallSiteDynamics).
+
+:- pred record_csd_containers_2(proc_dynamic_ptr::in,
+ list(call_site_dynamic_ptr)::in,
+ array(call_site_dynamic)::array_di,
+ array(call_site_dynamic)::array_uo) is det.
+
+record_csd_containers_2(_, [], CallSiteDynamics, CallSiteDynamics).
+record_csd_containers_2(PDPtr, [CSDPtr | CSDPtrs],
+ CallSiteDynamics0, CallSiteDynamics) :-
+ lookup_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD0),
+ CSD0 = call_site_dynamic(CallerPDPtr0, CalleePDPtr, Own,
+ MaybeRedirect),
+ require(unify(CallerPDPtr0, proc_dynamic_ptr(-1)),
+ "record_csd_containers_2: real proc_dynamic_ptr"),
+ CSD = call_site_dynamic(PDPtr, CalleePDPtr, Own, MaybeRedirect),
+ update_call_site_dynamics(CallSiteDynamics0, CSDPtr, CSD,
+ CallSiteDynamics1),
+ record_csd_containers_2(PDPtr, CSDPtrs,
+ CallSiteDynamics1, CallSiteDynamics).
+
+%-----------------------------------------------------------------------------%
+
+:- pred construct_clique_parents(initial_deep::in, array(clique_ptr)::in,
+ int::in, clique_ptr::in,
+ array(call_site_dynamic_ptr)::array_di,
+ array(call_site_dynamic_ptr)::array_uo,
+ array(maybe(clique_ptr))::array_di,
+ array(maybe(clique_ptr))::array_uo) is det.
+
+construct_clique_parents(InitialDeep, CliqueIndex, PDI, CliquePtr,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) :-
+ ( PDI > 0 ->
+ flat_call_sites(InitialDeep ^ init_proc_dynamics,
+ proc_dynamic_ptr(PDI), CSDPtrs),
+ array_list_foldl2(
+ construct_clique_parents_2(InitialDeep,
+ CliqueIndex, CliquePtr),
+ CSDPtrs, CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren)
+ ;
+ error("emit nasal daemons")
+ ).
+
+:- pred construct_clique_parents_2(initial_deep::in, array(clique_ptr)::in,
+ clique_ptr::in, call_site_dynamic_ptr::in,
+ array(call_site_dynamic_ptr)::array_di,
+ array(call_site_dynamic_ptr)::array_uo,
+ array(maybe(clique_ptr))::array_di,
+ array(maybe(clique_ptr))::array_uo) is det.
+
+construct_clique_parents_2(InitialDeep, CliqueIndex, ParentCliquePtr, CSDPtr,
+ CliqueParents0, CliqueParents,
+ CliqueMaybeChildren0, CliqueMaybeChildren) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(InitialDeep ^ init_call_site_dynamics, CSDI,
+ CSD),
+ ChildPDPtr = CSD ^ csd_callee,
+ ChildPDPtr = proc_dynamic_ptr(ChildPDI),
+ ( ChildPDI > 0 ->
+ array__lookup(CliqueIndex, ChildPDI, ChildCliquePtr),
+ ( ChildCliquePtr \= ParentCliquePtr ->
+ ChildCliquePtr = clique_ptr(ChildCliqueNum),
+ array__set(CliqueParents0, ChildCliqueNum,
+ CSDPtr, CliqueParents),
+ array__set(CliqueMaybeChildren0, CSDI,
+ yes(ChildCliquePtr),
+ CliqueMaybeChildren)
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ )
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ )
+ ;
+ CliqueParents = CliqueParents0,
+ CliqueMaybeChildren = CliqueMaybeChildren0
+ ).
+
+:- pred flat_call_sites(proc_dynamics::in, proc_dynamic_ptr::in,
+ list(call_site_dynamic_ptr)::out) is det.
+
+flat_call_sites(ProcDynamics, PDPtr, CSDPtrs) :-
+ ( PDPtr = proc_dynamic_ptr(PDI), PDI > 0 ->
+ array__lookup(ProcDynamics, PDI, PD),
+ CallSiteArray = PD ^ pd_sites,
+ flatten_call_sites(CallSiteArray, CSDPtrs)
+ ;
+ CSDPtrs = []
+ ).
+
+:- pred flatten_call_sites(array(call_site_array_slot)::in,
+ list(call_site_dynamic_ptr)::out) is det.
+
+flatten_call_sites(CallSiteArray, CSDPtrs) :-
+ array__to_list(CallSiteArray, CallSites),
+ list__foldl((pred(Slot::in, CSDPtrs0::in, CSDPtrs1::out) is det :-
+ (
+ Slot = normal(CSDPtr),
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ CSDPtrs1 = [[CSDPtr] | CSDPtrs0]
+ ;
+ CSDPtrs1 = CSDPtrs0
+ )
+ ;
+ Slot = multi(PtrArray),
+ array__to_list(PtrArray, PtrList0),
+ filter((pred(CSDPtr::in) is semidet :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ CSDI > 0
+ ), PtrList0, PtrList1),
+ CSDPtrs1 = [PtrList1 | CSDPtrs0]
+ )
+ ), CallSites, [], CSDPtrsList0),
+ list__reverse(CSDPtrsList0, CSDPtrsList),
+ list__condense(CSDPtrsList, CSDPtrs).
+
+:- pred construct_proc_callers(initial_deep::in, int::in,
+ call_site_dynamic::in,
+ array(list(call_site_dynamic_ptr))::array_di,
+ array(list(call_site_dynamic_ptr))::array_uo) is det.
+
+construct_proc_callers(InitialDeep, CSDI, CSD, ProcCallers0, ProcCallers) :-
+ PDPtr = CSD ^ csd_callee,
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0, array__in_bounds(InitialDeep ^ init_proc_dynamics, PDI) ->
+ array__lookup(InitialDeep ^ init_proc_dynamics, PDI, PD),
+ PSPtr = PD ^ pd_proc_static,
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(ProcCallers0, PSI, Callers0),
+ Callers = [call_site_dynamic_ptr(CSDI) | Callers0],
+ array__set(ProcCallers0, PSI, Callers, ProcCallers)
+ ;
+ ProcCallers = ProcCallers0
+ ).
+
+:- pred construct_call_site_caller(initial_deep::in, int::in, proc_dynamic::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller(InitialDeep, _PDI, PD,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ PSPtr = PD ^ pd_proc_static,
+ CSDArraySlots = PD ^ pd_sites,
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(InitialDeep ^ init_proc_statics, PSI, PS),
+ PS = proc_static(_, _, _, _, CSSPtrs),
+ array__max(CSDArraySlots, MaxCS),
+ construct_call_site_caller_2(MaxCS,
+ InitialDeep ^ init_call_site_dynamics, CSSPtrs, CSDArraySlots,
+ CallSiteStaticMap0, CallSiteStaticMap).
+
+:- pred construct_call_site_caller_2(int::in, call_site_dynamics::in,
+ array(call_site_static_ptr)::in,
+ array(call_site_array_slot)::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller_2(SlotNum, Deep, CSSPtrs, CSDArraySlots,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSDArraySlots, SlotNum, CSDArraySlot),
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ (
+ CSDArraySlot = normal(CSDPtr),
+ construct_call_site_caller_3(Deep, CSSPtr, -1, CSDPtr,
+ CallSiteStaticMap0, CallSiteStaticMap1)
+
+ ;
+ CSDArraySlot = multi(CSDPtrs),
+ array_foldl0(
+ construct_call_site_caller_3(Deep, CSSPtr),
+ CSDPtrs,
+ CallSiteStaticMap0, CallSiteStaticMap1)
+ ),
+ construct_call_site_caller_2(SlotNum - 1, Deep, CSSPtrs,
+ CSDArraySlots, CallSiteStaticMap1, CallSiteStaticMap)
+ ;
+ CallSiteStaticMap = CallSiteStaticMap0
+ ).
+
+:- pred construct_call_site_caller_3(call_site_dynamics::in,
+ call_site_static_ptr::in, int::in, call_site_dynamic_ptr::in,
+ array(call_site_static_ptr)::array_di,
+ array(call_site_static_ptr)::array_uo) is det.
+
+construct_call_site_caller_3(CallSiteDynamics, CSSPtr, _Dummy, CSDPtr,
+ CallSiteStaticMap0, CallSiteStaticMap) :-
+ ( valid_call_site_dynamic_ptr_raw(CallSiteDynamics, CSDPtr) ->
+ update_call_site_static_map(CallSiteStaticMap0,
+ CSDPtr, CSSPtr, CallSiteStaticMap)
+ ;
+ CallSiteStaticMap = CallSiteStaticMap0
+ ).
+
+:- pred construct_call_site_calls(initial_deep::in, int::in, proc_dynamic::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls(InitialDeep, _PDI, PD,
+ CallSiteCalls0, CallSiteCalls) :-
+ PSPtr = PD ^ pd_proc_static,
+ CSDArraySlots = PD ^ pd_sites,
+ array__max(CSDArraySlots, MaxCS),
+ PSPtr = proc_static_ptr(PSI),
+ array__lookup(InitialDeep ^ init_proc_statics, PSI, PS),
+ CSSPtrs = PS ^ ps_sites,
+ CallSiteDynamics = InitialDeep ^ init_call_site_dynamics,
+ ProcDynamics = InitialDeep ^ init_proc_dynamics,
+ construct_call_site_calls_2(CallSiteDynamics, ProcDynamics, MaxCS,
+ CSSPtrs, CSDArraySlots, CallSiteCalls0, CallSiteCalls).
+
+:- pred construct_call_site_calls_2(call_site_dynamics::in, proc_dynamics::in,
+ int::in, array(call_site_static_ptr)::in,
+ array(call_site_array_slot)::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls_2(CallSiteDynamics, ProcDynamics, SlotNum,
+ CSSPtrs, CSDArraySlots, CallSiteCalls0, CallSiteCalls) :-
+ ( SlotNum >= 0 ->
+ array__lookup(CSDArraySlots, SlotNum, CSDArraySlot),
+ array__lookup(CSSPtrs, SlotNum, CSSPtr),
+ (
+ CSDArraySlot = normal(CSDPtr),
+ construct_call_site_calls_3(CallSiteDynamics,
+ ProcDynamics, CSSPtr, -1,
+ CSDPtr, CallSiteCalls0, CallSiteCalls1)
+ ;
+ CSDArraySlot = multi(CSDPtrs),
+ array_foldl0(
+ construct_call_site_calls_3(CallSiteDynamics,
+ ProcDynamics, CSSPtr),
+ CSDPtrs, CallSiteCalls0, CallSiteCalls1)
+ ),
+ construct_call_site_calls_2(CallSiteDynamics, ProcDynamics,
+ SlotNum - 1, CSSPtrs, CSDArraySlots,
+ CallSiteCalls1, CallSiteCalls)
+ ;
+ CallSiteCalls = CallSiteCalls0
+ ).
+
+:- pred construct_call_site_calls_3(call_site_dynamics::in, proc_dynamics::in,
+ call_site_static_ptr::in, int::in, call_site_dynamic_ptr::in,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_di,
+ array(map(proc_static_ptr, list(call_site_dynamic_ptr)))::array_uo)
+ is det.
+
+construct_call_site_calls_3(CallSiteDynamics, ProcDynamics, CSSPtr,
+ _Dummy, CSDPtr, CallSiteCalls0, CallSiteCalls) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(CallSiteDynamics, CSDI, CSD),
+ PDPtr = CSD ^ csd_callee,
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(ProcDynamics, PDI, PD),
+ PSPtr = PD ^ pd_proc_static,
+
+ CSSPtr = call_site_static_ptr(CSSI),
+ array__lookup(CallSiteCalls0, CSSI, CallMap0),
+ ( map__search(CallMap0, PSPtr, CallList0) ->
+ CallList = [CSDPtr | CallList0],
+ map__det_update(CallMap0, PSPtr, CallList, CallMap)
+ ;
+ CallList = [CSDPtr],
+ map__det_insert(CallMap0, PSPtr, CallList, CallMap)
+ ),
+ array__set(CallSiteCalls0, CSSI, CallMap, CallSiteCalls)
+ ;
+ CallSiteCalls = CallSiteCalls0
+ ).
+
+:- pred sum_call_sites_in_proc_dynamic(int::in, call_site_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo) is det.
+
+sum_call_sites_in_proc_dynamic(_, CSD, PDO0, PDO) :-
+ PDPtr = CSD ^ csd_callee,
+ PI = CSD ^ csd_own_prof,
+ PDPtr = proc_dynamic_ptr(PDI),
+ ( PDI > 0 ->
+ array__lookup(PDO0, PDI, OwnPI0),
+ OwnPI = add_own_to_own(PI, OwnPI0),
+ array__set(PDO0, PDI, OwnPI, PDO)
+ ;
+ PDO = PDO0
+ ).
+
+:- pred summarize_proc_dynamics(deep::in, deep::out) is det.
+
+summarize_proc_dynamics(Deep0, Deep) :-
+ PSOwn0 = Deep0 ^ ps_own,
+ PSDesc0 = Deep0 ^ ps_desc,
+ array_foldl2(summarize_proc_dynamic(Deep0 ^ pd_own, Deep0 ^ pd_desc),
+ Deep0 ^ proc_dynamics,
+ copy(PSOwn0), PSOwn, copy(PSDesc0), PSDesc),
+ Deep = ((Deep0
+ ^ ps_own := PSOwn)
+ ^ ps_desc := PSDesc).
+
+:- pred summarize_proc_dynamic(array(own_prof_info)::in,
+ array(inherit_prof_info)::in, int::in, proc_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo,
+ array(inherit_prof_info)::array_di, array(inherit_prof_info)::array_uo)
+ is det.
+
+summarize_proc_dynamic(PDOwn, PDDesc, PDI, PD,
+ PSOwn0, PSOwn, PSDesc0, PSDesc) :-
+ PSPtr = PD ^ pd_proc_static,
+ PSPtr = proc_static_ptr(PSI),
+ ( PSI > 0 ->
+ array__lookup(PDOwn, PDI, PDOwnPI),
+ array__lookup(PDDesc, PDI, PDDescPI),
+
+ array__lookup(PSOwn0, PSI, PSOwnPI0),
+ array__lookup(PSDesc0, PSI, PSDescPI0),
+
+ add_own_to_own(PDOwnPI, PSOwnPI0) = PSOwnPI,
+ add_inherit_to_inherit(PDDescPI, PSDescPI0) = PSDescPI,
+ array__set(u(PSOwn0), PSI, PSOwnPI, PSOwn),
+ array__set(u(PSDesc0), PSI, PSDescPI, PSDesc)
+ ;
+ error("emit nasal devils")
+ ).
+
+:- pred summarize_call_site_dynamics(deep::in, deep::out) is det.
+
+summarize_call_site_dynamics(Deep0, Deep) :-
+ CSSOwn0 = Deep0 ^ css_own,
+ CSSDesc0 = Deep0 ^ css_desc,
+ array_foldl2(summarize_call_site_dynamic(Deep0 ^ call_site_static_map,
+ Deep0 ^ csd_desc),
+ Deep0 ^ call_site_dynamics,
+ copy(CSSOwn0), CSSOwn, copy(CSSDesc0), CSSDesc),
+ Deep = ((Deep0
+ ^ css_own := CSSOwn)
+ ^ css_desc := CSSDesc).
+
+:- pred summarize_call_site_dynamic(call_site_static_map::in,
+ array(inherit_prof_info)::in, int::in, call_site_dynamic::in,
+ array(own_prof_info)::array_di, array(own_prof_info)::array_uo,
+ array(inherit_prof_info)::array_di, array(inherit_prof_info)::array_uo)
+ is det.
+
+summarize_call_site_dynamic(CallSiteStaticMap, CSDDescs, CSDI, CSD,
+ CSSOwn0, CSSOwn, CSSDesc0, CSSDesc) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ lookup_call_site_static_map(CallSiteStaticMap, CSDPtr, CSSPtr),
+ CSSPtr = call_site_static_ptr(CSSI),
+ ( CSSI > 0 ->
+ CSDOwnPI = CSD ^ csd_own_prof,
+ array__lookup(CSDDescs, CSDI, CSDDescPI),
+
+ array__lookup(CSSOwn0, CSSI, CSSOwnPI0),
+ array__lookup(CSSDesc0, CSSI, CSSDescPI0),
+
+ add_own_to_own(CSDOwnPI, CSSOwnPI0)
+ = CSSOwnPI,
+ add_inherit_to_inherit(CSDDescPI, CSSDescPI0)
+ = CSSDescPI,
+ array__set(u(CSSOwn0), CSSI, CSSOwnPI, CSSOwn),
+ array__set(u(CSSDesc0), CSSI, CSSDescPI, CSSDesc)
+ ;
+ error("emit nasal gorgons")
+ ).
+
+:- pred propagate_to_clique(int::in, list(proc_dynamic_ptr)::in,
+ deep::in, deep::out) is det.
+
+propagate_to_clique(CliqueNumber, Members, Deep0, Deep) :-
+ array__lookup(Deep0 ^ clique_parents, CliqueNumber, ParentCSDPtr),
+ list__foldl(propagate_to_proc_dynamic(CliqueNumber, ParentCSDPtr),
+ Members, Deep0, Deep1),
+ (
+ valid_call_site_dynamic_ptr_raw(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr)
+ ->
+ lookup_call_site_dynamics(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr, ParentCSD),
+ ParentOwnPI = ParentCSD ^ csd_own_prof,
+ deep_lookup_csd_desc(Deep1, ParentCSDPtr, ParentDesc0),
+ subtract_own_from_inherit(ParentOwnPI, ParentDesc0) =
+ ParentDesc,
+ deep_update_csd_desc(Deep1, ParentCSDPtr, ParentDesc, Deep)
+ ;
+ Deep = Deep1
+ ).
+
+:- pred propagate_to_proc_dynamic(int::in, call_site_dynamic_ptr::in,
+ proc_dynamic_ptr::in, deep::in, deep::out) is det.
+
+propagate_to_proc_dynamic(CliqueNumber, ParentCSDPtr, PDPtr,
+ Deep0, Deep) :-
+ flat_call_sites(Deep0 ^ proc_dynamics, PDPtr, CSDPtrs),
+ list__foldl(propagate_to_call_site(CliqueNumber, PDPtr),
+ CSDPtrs, Deep0, Deep1),
+ (
+ valid_call_site_dynamic_ptr_raw(Deep1 ^ call_site_dynamics,
+ ParentCSDPtr)
+ ->
+ deep_lookup_csd_desc(Deep1, ParentCSDPtr, ParentDesc0),
+ deep_lookup_pd_desc(Deep1, PDPtr, DescPI),
+ deep_lookup_pd_own(Deep1, PDPtr, OwnPI),
+ add_own_to_inherit(OwnPI, ParentDesc0) = ParentDesc1,
+ add_inherit_to_inherit(DescPI, ParentDesc1) = ParentDesc,
+ deep_update_csd_desc(Deep1, ParentCSDPtr, ParentDesc, Deep)
+ ;
+ Deep = Deep1
+ ).
+
+:- pred propagate_to_call_site(int::in, proc_dynamic_ptr::in,
+ call_site_dynamic_ptr::in, deep::in, deep::out) is det.
+
+propagate_to_call_site(CliqueNumber, PDPtr, CSDPtr, Deep0, Deep) :-
+ CSDPtr = call_site_dynamic_ptr(CSDI),
+ ( CSDI > 0 ->
+ array__lookup(Deep0 ^ call_site_dynamics, CSDI, CSD),
+ CPDPtr = CSD ^ csd_callee,
+ CPI = CSD ^ csd_own_prof,
+ CPDPtr = proc_dynamic_ptr(CPDI),
+ ( CPDI > 0 ->
+ array__lookup(Deep0 ^ clique_index, CPDI,
+ clique_ptr(ChildCliqueNumber)),
+ ( ChildCliqueNumber \= CliqueNumber ->
+ PDPtr = proc_dynamic_ptr(PDI),
+ array__lookup(Deep0 ^ pd_desc, PDI, PDTotal0),
+ array__lookup(Deep0 ^ csd_desc, CSDI, CDesc),
+ add_own_to_inherit(CPI, PDTotal0) = PDTotal1,
+ add_inherit_to_inherit(CDesc, PDTotal1)
+ = PDTotal,
+ array__set(u(Deep0 ^ pd_desc), PDI, PDTotal,
+ PDDesc),
+ Deep = Deep0 ^ pd_desc := PDDesc
+ ;
+ Deep = Deep0
+ )
+ ;
+ Deep = Deep0
+ )
+ ;
+ Deep = Deep0
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred merge_cliques(list(list(proc_dynamic_ptr))::in,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_cliques([], InitDeep, InitDeep).
+merge_cliques([Clique | Cliques], InitDeep0, InitDeep) :-
+ merge_clique(Clique, InitDeep0, InitDeep1),
+ merge_cliques(Cliques, InitDeep1, InitDeep).
+
+:- pred merge_clique(list(proc_dynamic_ptr)::in,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_clique(CliquePDs, InitDeep0, InitDeep) :-
+ map__init(ProcMap0),
+ set__list_to_set(CliquePDs, Clique),
+ list__foldl(cluster_pds_by_ps(InitDeep0), CliquePDs,
+ ProcMap0, ProcMap),
+ map__values(ProcMap, PDsList),
+ list__filter(two_or_more, PDsList, ToMergePDsList),
+ list__foldl(merge_proc_dynamics(Clique), ToMergePDsList,
+ InitDeep0, InitDeep).
+
+:- pred merge_proc_dynamics(set(proc_dynamic_ptr)::in,
+ list(proc_dynamic_ptr)::in,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_proc_dynamics(Clique, CandidatePDPtrs, InitDeep0, InitDeep) :-
+ ProcDynamics0 = InitDeep0 ^ init_proc_dynamics,
+ list__filter(valid_proc_dynamic_ptr_raw(ProcDynamics0),
+ CandidatePDPtrs, ValidPDPtrs),
+ ( ValidPDPtrs = [PrimePDPtr | RestPDPtrs] ->
+ record_pd_redirect(RestPDPtrs, PrimePDPtr,
+ InitDeep0, InitDeep1),
+ ProcDynamics1 = InitDeep1 ^ init_proc_dynamics,
+ lookup_proc_dynamics(ProcDynamics1, PrimePDPtr, PrimePD0),
+ list__map(lookup_proc_dynamics(ProcDynamics1),
+ RestPDPtrs, RestPDs),
+ list__map(extract_pd_sites, RestPDs, RestSites),
+ require(unify(PrimePD0 ^ pd_redirect, no),
+ "merge_proc_dynamics: pd already redirected"),
+ PrimeSites0 = PrimePD0 ^ pd_sites,
+ array__max(PrimeSites0, MaxSiteNum),
+ merge_proc_dynamic_slots(MaxSiteNum, Clique, PrimePDPtr,
+ u(PrimeSites0), RestSites, PrimeSites,
+ InitDeep1, InitDeep2),
+ PrimePD = PrimePD0 ^ pd_sites := PrimeSites,
+ ProcDynamics2 = InitDeep2 ^ init_proc_dynamics,
+ update_proc_dynamics(u(ProcDynamics2), PrimePDPtr, PrimePD,
+ ProcDynamics),
+ InitDeep = InitDeep2 ^ init_proc_dynamics := ProcDynamics
+ ;
+ % This can happen when merging the callees of CSDs
+ % representing special calls.
+ InitDeep = InitDeep0
+ ).
+
+:- pred merge_proc_dynamic_slots(int::in, set(proc_dynamic_ptr)::in,
+ proc_dynamic_ptr::in, array(call_site_array_slot)::array_di,
+ list(array(call_site_array_slot))::in,
+ array(call_site_array_slot)::array_uo,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_proc_dynamic_slots(SlotNum, Clique, PrimePDPtr, PrimeSiteArray0,
+ RestSiteArrays, PrimeSiteArray, InitDeep0, InitDeep) :-
+ ( SlotNum >= 0 ->
+ array__lookup(PrimeSiteArray0, SlotNum, PrimeSite0),
+ (
+ PrimeSite0 = normal(PrimeCSDPtr0),
+ merge_proc_dynamic_normal_slot(SlotNum, Clique,
+ PrimePDPtr, PrimeCSDPtr0, RestSiteArrays,
+ PrimeCSDPtr, InitDeep0, InitDeep1),
+ array__set(PrimeSiteArray0, SlotNum,
+ normal(PrimeCSDPtr), PrimeSiteArray1)
+ ;
+ PrimeSite0 = multi(PrimeCSDPtrArray0),
+ array__to_list(PrimeCSDPtrArray0, PrimeCSDPtrList0),
+ merge_proc_dynamic_multi_slot(SlotNum, Clique,
+ PrimePDPtr, PrimeCSDPtrList0, RestSiteArrays,
+ PrimeCSDPtrList, InitDeep0, InitDeep1),
+ PrimeCSDPtrArray = array(PrimeCSDPtrList),
+ array__set(PrimeSiteArray0, SlotNum,
+ multi(PrimeCSDPtrArray), PrimeSiteArray1)
+ ),
+ merge_proc_dynamic_slots(SlotNum - 1, Clique, PrimePDPtr,
+ PrimeSiteArray1, RestSiteArrays, PrimeSiteArray,
+ InitDeep1, InitDeep)
+ ;
+ PrimeSiteArray = PrimeSiteArray0,
+ InitDeep = InitDeep0
+ ).
+
+:- pred merge_proc_dynamic_normal_slot(int::in, set(proc_dynamic_ptr)::in,
+ proc_dynamic_ptr::in, call_site_dynamic_ptr::in,
+ list(array(call_site_array_slot))::in, call_site_dynamic_ptr::out,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_proc_dynamic_normal_slot(SlotNum, Clique, PrimePDPtr, PrimeCSDPtr0,
+ RestSiteArrays, PrimeCSDPtr, InitDeep0, InitDeep) :-
+ lookup_normal_sites(RestSiteArrays, SlotNum, RestCSDPtrs),
+ merge_call_site_dynamics(Clique, PrimePDPtr,
+ [PrimeCSDPtr0 | RestCSDPtrs], PrimeCSDPtr,
+ InitDeep0, InitDeep).
+
+:- pred accumulate_csd_owns(call_site_dynamic::in,
+ own_prof_info::in, own_prof_info::out) is det.
+
+accumulate_csd_owns(CSD, Own0, Own) :-
+ Own = add_own_to_own(Own0, CSD ^ csd_own_prof).
+
+:- pred callee_in_clique(initial_deep::in, set(proc_dynamic_ptr)::in,
+ call_site_dynamic_ptr::in) is semidet.
+
+callee_in_clique(InitDeep, Clique, CSDPtr) :-
+ lookup_call_site_dynamics(InitDeep ^ init_call_site_dynamics,
+ CSDPtr, CSD),
+ CalleePDPtr = CSD ^ csd_callee,
+ set__member(CalleePDPtr, Clique).
+
+:- pred merge_proc_dynamic_multi_slot(int::in, set(proc_dynamic_ptr)::in,
+ proc_dynamic_ptr::in, list(call_site_dynamic_ptr)::in,
+ list(array(call_site_array_slot))::in,
+ list(call_site_dynamic_ptr)::out, initial_deep::in, initial_deep::out)
+ is det.
+
+merge_proc_dynamic_multi_slot(SlotNum, Clique, ParentPDPtr, PrimeCSDPtrs0,
+ RestSiteArrays, PrimeCSDPtrs, InitDeep0, InitDeep) :-
+ lookup_multi_sites(RestSiteArrays, SlotNum, RestCSDPtrLists),
+ list__condense([PrimeCSDPtrs0 | RestCSDPtrLists], AllCSDPtrs),
+ map__init(ProcMap0),
+ list__foldl(cluster_csds_by_ps(InitDeep0), AllCSDPtrs,
+ ProcMap0, ProcMap),
+ map__values(ProcMap, CSDPtrsClusters),
+ list__foldl2(merge_multi_slot_cluster(ParentPDPtr, Clique),
+ CSDPtrsClusters, [], PrimeCSDPtrs, InitDeep0, InitDeep).
+
+:- pred merge_multi_slot_cluster(proc_dynamic_ptr::in,
+ set(proc_dynamic_ptr)::in, list(call_site_dynamic_ptr)::in,
+ list(call_site_dynamic_ptr)::in, list(call_site_dynamic_ptr)::out,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_multi_slot_cluster(ParentPDPtr, Clique, ClusterCSDPtrs,
+ PrimeCSDPtrs0, PrimeCSDPtrs, InitDeep0, InitDeep) :-
+ merge_call_site_dynamics(Clique, ParentPDPtr, ClusterCSDPtrs,
+ PrimeCSDPtr, InitDeep0, InitDeep),
+ PrimeCSDPtrs = [PrimeCSDPtr | PrimeCSDPtrs0].
+
+:- pred merge_call_site_dynamics(set(proc_dynamic_ptr)::in,
+ proc_dynamic_ptr::in, list(call_site_dynamic_ptr)::in,
+ call_site_dynamic_ptr::out,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_call_site_dynamics(Clique, ParentPDPtr, CandidateCSDPtrs,
+ FirstCSDPtr, InitDeep0, InitDeep) :-
+ CallSiteDynamics0 = InitDeep0 ^ init_call_site_dynamics,
+ list__filter(valid_call_site_dynamic_ptr_raw(CallSiteDynamics0),
+ CandidateCSDPtrs, ValidCSDPtrs),
+ (
+ ValidCSDPtrs = [],
+ % This signifies that there is no call here.
+ FirstCSDPtr = call_site_dynamic_ptr(0),
+ InitDeep = InitDeep0
+ ;
+ ValidCSDPtrs = [FirstCSDPtr | LaterCSDPtrs],
+ lookup_call_site_dynamics(CallSiteDynamics0, FirstCSDPtr,
+ FirstCSD0),
+ FirstCSD = FirstCSD0 ^ csd_caller := ParentPDPtr,
+ update_call_site_dynamics(u(CallSiteDynamics0), FirstCSDPtr,
+ FirstCSD, CallSiteDynamics),
+ InitDeep1 = InitDeep0 ^ init_call_site_dynamics
+ := CallSiteDynamics,
+ (
+ LaterCSDPtrs = [],
+ InitDeep = InitDeep1
+ ;
+ LaterCSDPtrs = [_ | _],
+ merge_call_site_dynamics_2(Clique,
+ FirstCSDPtr, LaterCSDPtrs, InitDeep1, InitDeep)
+ )
+ ).
+
+:- pred merge_call_site_dynamics_2(set(proc_dynamic_ptr)::in,
+ call_site_dynamic_ptr::in, list(call_site_dynamic_ptr)::in,
+ initial_deep::in, initial_deep::out) is det.
+
+merge_call_site_dynamics_2(Clique, PrimeCSDPtr, RestCSDPtrs,
+ InitDeep0, InitDeep) :-
+ record_csd_redirect(RestCSDPtrs, PrimeCSDPtr, InitDeep0, InitDeep1),
+ CallSiteDynamics1 = InitDeep1 ^ init_call_site_dynamics,
+ lookup_call_site_dynamics(CallSiteDynamics1, PrimeCSDPtr, PrimeCSD1),
+ list__map(lookup_call_site_dynamics(CallSiteDynamics1),
+ RestCSDPtrs, RestCSDs),
+ PrimeOwn1 = PrimeCSD1 ^ csd_own_prof,
+ list__foldl(accumulate_csd_owns, RestCSDs, PrimeOwn1, PrimeOwn2),
+ PrimeCSD2 = PrimeCSD1 ^ csd_own_prof := PrimeOwn2,
+ update_call_site_dynamics(u(CallSiteDynamics1), PrimeCSDPtr, PrimeCSD2,
+ CallSiteDynamics2),
+ InitDeep2 = InitDeep1 ^ init_call_site_dynamics := CallSiteDynamics2,
+ list__filter(callee_in_clique(InitDeep2, Clique), RestCSDPtrs,
+ InClique, NotInClique),
+ ( callee_in_clique(InitDeep2, Clique, PrimeCSDPtr) ->
+ require(unify(NotInClique, []),
+ "merge_proc_dynamic_normal_slot: prime in clique, others not in clique"),
+ InitDeep = InitDeep2
+ ;
+ require(unify(InClique, []),
+ "merge_proc_dynamic_normal_slot: prime not in clique, others in clique"),
+ merge_call_site_dynamics_descendants(PrimeCSDPtr, RestCSDPtrs,
+ InitDeep2, InitDeep)
+ % XXX must ensure that PrimeCSDPtr ^ csd_callee is the chosen
+ % ProcDynamic
+ ).
+
+:- pred merge_call_site_dynamics_descendants(call_site_dynamic_ptr::in,
+ list(call_site_dynamic_ptr)::in, initial_deep::in, initial_deep::out)
+ is det.
+
+merge_call_site_dynamics_descendants(PrimeCSDPtr, RestCSDPtrs,
+ InitDeep0, InitDeep) :-
+ CallSiteDynamics = InitDeep0 ^ init_call_site_dynamics,
+ lookup_call_site_dynamics(CallSiteDynamics, PrimeCSDPtr, PrimeCSD),
+ extract_csd_callee(PrimeCSD, PrimeCSDCallee),
+ list__map(lookup_call_site_dynamics(CallSiteDynamics),
+ RestCSDPtrs, RestCSDs),
+ list__map(extract_csd_callee, RestCSDs, RestCSDCallees),
+ merge_proc_dynamics(set__init, [PrimeCSDCallee | RestCSDCallees],
+ InitDeep0, InitDeep).
+
+:- pred lookup_normal_sites(list(array(call_site_array_slot))::in, int::in,
+ list(call_site_dynamic_ptr)::out) is det.
+
+lookup_normal_sites([], _, []).
+lookup_normal_sites([RestArray | RestArrays], SlotNum, [CSDPtr | CSDPtrs]) :-
+ array__lookup(RestArray, SlotNum, Slot),
+ (
+ Slot = normal(CSDPtr)
+ ;
+ Slot = multi(_),
+ error("lookup_normal_sites: found multi")
+ ),
+ lookup_normal_sites(RestArrays, SlotNum, CSDPtrs).
+
+:- pred lookup_multi_sites(list(array(call_site_array_slot))::in, int::in,
+ list(list(call_site_dynamic_ptr))::out) is det.
+
+lookup_multi_sites([], _, []).
+lookup_multi_sites([RestArray | RestArrays], SlotNum, [CSDList | CSDLists]) :-
+ array__lookup(RestArray, SlotNum, Slot),
+ (
+ Slot = normal(_),
+ error("lookup_multi_sites: found normal")
+ ;
+ Slot = multi(CSDArray),
+ array__to_list(CSDArray, CSDList)
+ ),
+ lookup_multi_sites(RestArrays, SlotNum, CSDLists).
+
+:- pragma promise_pure(record_pd_redirect/4).
+:- pred record_pd_redirect(list(proc_dynamic_ptr)::in, proc_dynamic_ptr::in,
+ initial_deep::in, initial_deep::out) is det.
+
+record_pd_redirect(RestPDPtrs, PrimePDPtr, InitDeep0, InitDeep) :-
+ impure unsafe_perform_io(io__write_string("pd redirect: ")),
+ impure unsafe_perform_io(io__print(RestPDPtrs)),
+ impure unsafe_perform_io(io__write_string(" -> ")),
+ impure unsafe_perform_io(io__print(PrimePDPtr)),
+ impure unsafe_perform_io(io__nl),
+ record_pd_redirect_2(RestPDPtrs, PrimePDPtr, InitDeep0, InitDeep).
+
+:- pred record_pd_redirect_2(list(proc_dynamic_ptr)::in, proc_dynamic_ptr::in,
+ initial_deep::in, initial_deep::out) is det.
+
+record_pd_redirect_2([], _, InitDeep, InitDeep).
+record_pd_redirect_2([RestPDPtr | RestPDPtrs], PrimePDPtr,
+ InitDeep0, InitDeep) :-
+ ProcDynamics0 = InitDeep0 ^ init_proc_dynamics,
+ lookup_proc_dynamics(ProcDynamics0, RestPDPtr, RestPD0),
+ require(unify(RestPD0 ^ pd_redirect, no),
+ "record_pd_redirect: already redirected"),
+ RestPD = RestPD0 ^ pd_redirect := yes(PrimePDPtr),
+ update_proc_dynamics(u(ProcDynamics0), RestPDPtr, RestPD,
+ ProcDynamics),
+ InitDeep1 = InitDeep0 ^ init_proc_dynamics := ProcDynamics,
+ record_pd_redirect_2(RestPDPtrs, PrimePDPtr, InitDeep1, InitDeep).
+
+:- pragma promise_pure(record_csd_redirect/4).
+:- pred record_csd_redirect(list(call_site_dynamic_ptr)::in,
+ call_site_dynamic_ptr::in, initial_deep::in, initial_deep::out) is det.
+
+record_csd_redirect(RestCSDPtrs, PrimeCSDPtr, InitDeep0, InitDeep) :-
+ impure unsafe_perform_io(io__write_string("csd redirect: ")),
+ impure unsafe_perform_io(io__print(RestCSDPtrs)),
+ impure unsafe_perform_io(io__write_string(" -> ")),
+ impure unsafe_perform_io(io__print(PrimeCSDPtr)),
+ impure unsafe_perform_io(io__nl),
+ record_csd_redirect_2(RestCSDPtrs, PrimeCSDPtr, InitDeep0, InitDeep).
+
+:- pred record_csd_redirect_2(list(call_site_dynamic_ptr)::in,
+ call_site_dynamic_ptr::in, initial_deep::in, initial_deep::out) is det.
+
+record_csd_redirect_2([], _, InitDeep, InitDeep).
+record_csd_redirect_2([RestCSDPtr | RestCSDPtrs], PrimeCSDPtr,
+ InitDeep0, InitDeep) :-
+ CallSiteDynamics0 = InitDeep0 ^ init_call_site_dynamics,
+ lookup_call_site_dynamics(CallSiteDynamics0, RestCSDPtr, RestCSD0),
+ require(unify(RestCSD0 ^ csd_redirect, no),
+ "record_csd_redirect: already redirected"),
+ RestCSD = RestCSD0 ^ csd_redirect := yes(PrimeCSDPtr),
+ update_call_site_dynamics(u(CallSiteDynamics0), RestCSDPtr, RestCSD,
+ CallSiteDynamics),
+ InitDeep1 = InitDeep0 ^ init_call_site_dynamics := CallSiteDynamics,
+ record_csd_redirect_2(RestCSDPtrs, PrimeCSDPtr, InitDeep1, InitDeep).
+
+:- pred extract_pd_sites(proc_dynamic::in, array(call_site_array_slot)::out)
+ is det.
+
+extract_pd_sites(PD, PD ^ pd_sites).
+
+:- pred extract_csd_callee(call_site_dynamic::in, proc_dynamic_ptr::out)
+ is det.
+
+extract_csd_callee(CSD, CSD ^ csd_callee).
+
+:- pred two_or_more(list(proc_dynamic_ptr)::in) is semidet.
+
+two_or_more([_, _ | _]).
+
+:- pred cluster_pds_by_ps(initial_deep::in, proc_dynamic_ptr::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::in,
+ map(proc_static_ptr, list(proc_dynamic_ptr))::out) is det.
+
+cluster_pds_by_ps(InitDeep, PDPtr, ProcMap0, ProcMap) :-
+ ProcDynamics = InitDeep ^ init_proc_dynamics,
+ ( valid_proc_dynamic_ptr_raw(ProcDynamics, PDPtr) ->
+ lookup_proc_dynamics(ProcDynamics, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static,
+ ( map__search(ProcMap0, PSPtr, PDPtrs0) ->
+ map__det_update(ProcMap0, PSPtr, [PDPtr | PDPtrs0],
+ ProcMap)
+ ;
+ map__det_insert(ProcMap0, PSPtr, [PDPtr], ProcMap)
+ )
+ ;
+ ProcMap = ProcMap0
+ ).
+
+:- pred cluster_csds_by_ps(initial_deep::in, call_site_dynamic_ptr::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::in,
+ map(proc_static_ptr, list(call_site_dynamic_ptr))::out) is det.
+
+cluster_csds_by_ps(InitDeep, CSDPtr, ProcMap0, ProcMap) :-
+ CallSiteDynamics = InitDeep ^ init_call_site_dynamics,
+ ( valid_call_site_dynamic_ptr_raw(CallSiteDynamics, CSDPtr) ->
+ lookup_call_site_dynamics(CallSiteDynamics, CSDPtr, CSD),
+ PDPtr = CSD ^ csd_callee,
+ ProcDynamics = InitDeep ^ init_proc_dynamics,
+ ( valid_proc_dynamic_ptr_raw(ProcDynamics, PDPtr) ->
+ lookup_proc_dynamics(ProcDynamics, PDPtr, PD),
+ PSPtr = PD ^ pd_proc_static
+ ;
+ PSPtr = proc_static_ptr(0)
+ ),
+ ( map__search(ProcMap0, PSPtr, CSDPtrs0) ->
+ map__det_update(ProcMap0, PSPtr, [CSDPtr | CSDPtrs0],
+ ProcMap)
+ ;
+ map__det_insert(ProcMap0, PSPtr, [CSDPtr], ProcMap)
+ )
+ ;
+ ProcMap = ProcMap0
+ ).
Index: deep/timeout.m
===================================================================
RCS file: timeout.m
diff -N timeout.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ timeout.m Mon May 14 12:51:49 2001
@@ -0,0 +1,83 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Author: zs.
+%
+% This module implements timeouts for the deep profiler.
+%
+% The deep profiler uses timeouts to shut down the server process if the
+% programmer has not sent it queries in a while. Before shutdown, we remove the
+% named pipes that the CGI script and the server process use to communicate.
+% Any later invocation of the CGI script will take the absence of the named
+% pipes as indicating that there is no server process for the given data file,
+% and will create a new server process, which will recreate the named pipes.
+%
+% Since the receipt of the alarm signal, the removal the pipes and exiting
+% 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.
+
+:- module timeout.
+
+:- interface.
+
+:- import_module io.
+
+:- pred setup_timeout(string::in, string::in, int::in,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+:- import_module string.
+
+:- pragma foreign_decl("C",
+"
+#include <stdio.h>
+#include <signal.h>
+#include <unistd.h>
+#include ""mercury_signal.h""
+
+extern char *MP_timeout_file1;
+extern char *MP_timeout_file2;
+
+extern void delete_timeout_files_and_exit(void);
+").
+
+:- pragma foreign_code("C",
+"
+char *MP_timeout_file1;
+char *MP_timeout_file2;
+
+void
+delete_timeout_files_and_exit(void)
+{
+ if (unlink(MP_timeout_file1) != 0) {
+ perror(MP_timeout_file1);
+ }
+
+ if (unlink(MP_timeout_file2) != 0) {
+ perror(MP_timeout_file2);
+ }
+
+ exit(0);
+}
+").
+
+:- pragma foreign_proc("C",
+ setup_timeout(File1::in, File2::in, Minutes::in, IO0::di, IO::uo),
+ [will_not_call_mercury],
+"
+ int seconds;
+
+ seconds = Minutes * 60;
+ MP_timeout_file1 = File1;
+ MP_timeout_file2 = File2;
+ MR_setup_signal(SIGALRM, delete_timeout_files_and_exit, FALSE,
+ ""Mercury deep profiler: cannot setup timeout"");
+ (void) alarm(seconds);
+ IO = IO0;
+").
Index: deep/util.m
===================================================================
RCS file: util.m
diff -N util.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ util.m Mon May 14 12:51:51 2001
@@ -0,0 +1,56 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% Authors: conway, zs.
+%
+% This module defines utility predicates for both the CGI program and
+% for the server.
+
+:- module util.
+
+:- interface.
+
+:- import_module char, list.
+
+:- pred split(string::in, char::in, list(string)::out) is det.
+
+:- implementation.
+
+:- import_module string, require.
+
+split(Str0, SChar, Strs) :-
+ string__to_char_list(Str0, Chars0),
+ split(Chars0, SChar, [], [], Strs0),
+ list__reverse(Strs0, Strs).
+
+:- pred split(list(char)::in, char::in, list(char)::in,
+ list(string)::in, list(string)::out) is det.
+
+split([], _SChar, Chars0, Strs0, Strs) :-
+ (
+ Chars0 = [],
+ Strs = Strs0
+ ;
+ Chars0 = [_|_],
+ list__reverse(Chars0, Chars),
+ string__from_char_list(Chars, Str),
+ Strs = [Str|Strs0]
+ ).
+split([C|Cs], SChar, Chars0, Strs0, Strs) :-
+ ( C = SChar ->
+ (
+ Chars0 = [],
+ Strs1 = Strs0
+ ;
+ Chars0 = [_|_],
+ list__reverse(Chars0, Chars),
+ string__from_char_list(Chars, Str),
+ Strs1 = [Str|Strs0]
+ ),
+ split(Cs, SChar, [], Strs1, Strs)
+ ;
+ split(Cs, SChar, [C|Chars0], Strs0, Strs)
+ ).
cvs diff: Diffing doc
Index: doc/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/Mmakefile,v
retrieving revision 1.23
diff -u -b -r1.23 Mmakefile
--- doc/Mmakefile 2000/09/20 12:12:24 1.23
+++ doc/Mmakefile 2001/05/04 02:47:10
@@ -1,5 +1,5 @@
#-----------------------------------------------------------------------------#
-# Copyright (C) 1996-2000 The University of Melbourne.
+# Copyright (C) 1996-2001 The University of Melbourne.
# This file may only be copied under the terms of the GNU General
# Public License - see the file COPYING in the Mercury distribution.
#-----------------------------------------------------------------------------#
@@ -166,15 +166,17 @@
# 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)/*.m
+library-menu.texi: $(LIBRARY_DIR)/[a-z]*.m
{ \
echo ""; \
- for filename in $(LIBRARY_DIR)/*.m; do \
+ for filename in $(LIBRARY_DIR)/[a-z]*.m; do \
case $$filename in \
$(LIBRARY_DIR)/private_builtin.m) \
;; \
$(LIBRARY_DIR)/table_builtin.m) \
;; \
+ $(LIBRARY_DIR)/profiling_builtin.m) \
+ ;; \
*) \
echo "* `basename $$filename .m`::"; \
;; \
@@ -182,12 +184,14 @@
done; \
} > library-menu.texi
-library-chapters.texi: $(LIBRARY_DIR)/*.m
- for filename in $(LIBRARY_DIR)/*.m; do \
+library-chapters.texi: $(LIBRARY_DIR)/[a-z]*.m
+ for filename in $(LIBRARY_DIR)/[a-z]*.m; do \
case $$filename in \
$(LIBRARY_DIR)/private_builtin.m) \
;; \
$(LIBRARY_DIR)/table_builtin.m) \
+ ;; \
+ $(LIBRARY_DIR)/profiling_builtin.m) \
;; \
*) \
file="`basename $$filename .m`"; \
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.250
diff -u -b -r1.250 user_guide.texi
--- doc/user_guide.texi 2001/05/15 07:12:01 1.250
+++ doc/user_guide.texi 2001/05/17 06:31:09
@@ -81,8 +81,7 @@
* Using Aditi:: Executing Mercury predicates using the Aditi
deductive database.
* Debugging:: The Mercury debugger @samp{mdb}.
-* Profiling:: The Mercury profiler @samp{mprof}, a tool for analyzing
- program performance.
+* Profiling:: Analyzing the performance of Mercury programs.
* Invocation:: List of options for the Mercury compiler.
* Environment:: Environment variables used by the compiler and utilities.
* C compilers:: How to use a C compiler other than GNU C.
@@ -2523,56 +2522,121 @@
@menu
* Profiling introduction:: What is profiling useful for?
* Building profiled applications:: How to enable profiling.
-* Time profiling methods:: Choose user, user + system, or real time.
-* Creating the profile:: How to create profile data.
-* Displaying the profile:: How to display the profile data.
-* Analysis of results:: How to interpret the output.
-* Memory profiling:: Profiling memory usage rather than time.
+* Creating profiles:: How to create profile data.
+* Using mprof for time profiling:: How to analyze the time performance of a
+ program with mprof.
+* Using mprof for memory profiling::How to analyze the memory performance of a
+ program with mprof.
+* Using mdprof:: How to analyze the time and/or memory
+ performance of a program with mdprof.
* Profiling and shared libraries:: Profiling dynamically linked executables.
@end menu
@node Profiling introduction
- at section Introduction
+ at section Profiling introduction
-The Mercury profiler @samp{mprof} is a tool which can be used to
-analyze a Mercury program's performance, so that the programmer can
-determine which predicates or functions are taking up a
-disproportionate amount of the execution time.
-
To obtain the best trade-off between productivity and efficiency,
programmers should not spend too much time optimizing their code
-until they know which parts of the code are really taking up most
-of the time. Only once the code has been profiled should the
-programmer consider making optimizations that would improve
-efficiency at the expense of readability or ease of maintenance.
-
-A good profiler is a tool that should be part of every software
-engineer's toolkit.
+until they know which parts of the code are really taking up most of the time.
+Only once the code has been profiled should the programmer consider
+making optimizations that would improve efficiency
+at the expense of readability or ease of maintenance.
+A good profiler is therefore a tool
+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 deep profiler @samp{mdprof} is a new kind of profiler
+that associates a lot more context with each measurement.
+ at samp{mprof} can be used to profile either time or space,
+but not both at the same time;
+ at samp{mdprof} can profile both time and space at the same time.
@node Building profiled applications
@section Building profiled applications
To enable profiling, your program must be built with profiling enabled.
-This can be done by passing the @samp{-p} (@samp{--profiling}) option
-to @samp{mmc} (and also to @samp{mgnuc} and @samp{ml}, if you invoke them
-separately). If you are using Mmake, then
-you can do this by setting the @samp{GRADEFLAGS} variable in your Mmakefile,
-e.g. by adding the line @samp{GRADEFLAGS=--profiling}.
-For more information about the different grades, see
- at ref{Compilation model options}.
+The two different profilers require different support,
+and thus you must choose which one to enable when you build your program.
-Enabling profiling has several effects. Firstly, it causes the
-compiler to generate slightly modified code which counts the number
-of times each predicate or function is called, and for every call,
-records the caller and callee. Secondly, your program will be linked
-with versions of the library and runtime that were compiled with
-profiling enabled. (It also has the effect for each source file the compiler
-generates the static call graph for that file in @samp{@var{module}.prof}.)
+ at itemize @bullet
+ at item
+To build your program with time profiling enabled for @samp{mprof},
+pass the @samp{-p} (@samp{--profiling}) option to @samp{mmc}
+(and also to @samp{mgnuc} and @samp{ml}, if you invoke them separately).
+ at item
+To build your program with memory profiling enabled for @samp{mprof},
+pass the @samp{--memory-profiling} option to @samp{mmc},
+ at samp{mgnuc} and @samp{ml}.
+ at item
+To build your program with deep profiling enabled (for @samp{mdprof}),
+pass the @samp{--deep-profiling} option to @samp{mmc},
+ at samp{mgnuc} and @samp{ml}.
+ at end itemize
- at node Time profiling methods
- at section Time profiling methods
+If you are using Mmake,
+then you pass these options to all the relevant programs
+by setting the @samp{GRADEFLAGS} variable in your Mmakefile,
+e.g. by adding the line @samp{GRADEFLAGS=--profiling}.
+(For more information about the different grades,
+see @ref{Compilation model options}.)
+
+Enabling profiling has several effects.
+First, it causes the compiler to generate slightly modified code,
+which counts the number of times each predicate or function is called,
+and for every call, records the caller and callee.
+With deep profiling, there are other modifications as well,
+the most important impact of which is the loss of tail-recursion
+for groups of mutually tail-recursive predicates
+(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,
+the compiler will generate for each source file
+the static call graph for that file in @samp{@var{module}.prof}.
+
+ at node Creating profiles
+ at section Creating profiles
+
+Once you have created a profiled executable,
+you can gather profiling information by running the profiled executable
+on some test data that is representative of the intended uses of the program.
+The profiling version of your program
+will collect profiling information during execution,
+and save this information at the end of execution,
+provided execution terminates normally and not via an abort.
+
+Executables compiled with @samp{--profiling}
+save profiling data in the files
+ at file{Prof.Counts}, @file{Prof.Decls}, and @file{Prof.CallPair}.
+(@file{Prof.Decl} contains the names
+of the procedures and their associated addresses,
+ at file{Prof.CallPair} records the number of times
+each procedure was called by each different caller,
+and @file{Prof.Counts} records the number of times
+that execution was in each procedure when a profiling interrupt occurred.)
+Executables compiled with @samp{--memory-profiling}
+will use two of those files (@file{Prof.Decls} and @file{Prof.CallPair})
+and a two others: @file{Prof.MemoryWords} and @file{Prof.MemoryCells}.
+Executables compiled with @samp{--deep-profiling}
+save profiling data in a single file, @file{Deep.data}.
+
+It is also possible to combine @samp{mprof} profiling results
+from multiple runs of your program.
+You can do by running your program several times,
+and typing @samp{mprof_merge_counts} after each run.
+It is not (yet) possible to combine @samp{mdprof} profiling results
+from multiple runs of your program.
+
+Due to a known timing-related bug in our code,
+you may occasionally get segmentation violations
+when running your program with @samp{mprof} profiling enabled.
+If this happens, just run it again --- the problem occurs only very rarely.
+The same vulnerability does not occur with @samp{mdprof} profiling.
-You can control whether profiling measures
+With both profilers,
+you can control whether time profiling measures
real (elapsed) time, user time plus system time, or user time only,
by including the options @samp{-Tr}, @samp{-Tp}, or @samp{-Tv} respectively
in the environment variable MERCURY_OPTIONS
@@ -2584,88 +2648,75 @@
The default is user time plus system time,
which counts all time spent executing the process,
-including time spent by the operating system performing
-working on behalf of the process,
+including time spent by the operating system working on behalf of the process,
but not including time that the process was suspended
(e.g. due to time slicing, or while waiting for input).
-When measuring real time, profiling counts
-even periods during which the process was suspended.
-When measuring user time only, profiling does not count
-time inside the operating system at all.
-
- at node Creating the profile
- at section Creating the profile
-
-The next step is to run your program. The profiling version of your
-program will collect profiling information during execution, and
-save this information in the files @file{Prof.Counts}, @file{Prof.Decls},
-and @file{Prof.CallPair}.
-(@file{Prof.Decl} contains the names of the procedures and their
-associated addresses, @file{Prof.CallPair} records the number of times
-each procedure was called by each different caller, and @file{Prof.Counts}
-records the number of times that execution was in each procedure
-when a profiling interrupt occurred.)
-
-It is also possible to combine profiling results from multiple runs of
-your program. You can do by running your program several times, and
-typing @samp{mprof_merge_counts} after each run.
+When measuring real time,
+profiling counts even periods during which the process was suspended.
+When measuring user time only,
+profiling does not count time inside the operating system at all.
+
+ at node Using mprof for time profiling
+ at section Using mprof for time profiling
+
+To display the graph profile information
+gathered from one or more profiling runs,
+just type @samp{mprof} or @samp{mprof -c}.
+(For programs built with @samp{--high-level-code},
+you need to also pass the @samp{--no-demangle} option to @samp{mprof} as well.)
+Note that @samp{mprof} can take quite a while to execute
+(especially with @samp{-c}),
+and will usually produce quite a lot of output,
+so you will usually want to redirect the output into a file
+with a command such as @samp{mprof > mprof.out}.
+
+The output of @samp{mprof -c} consists of three major sections.
+These are named the call graph profile,
+the flat profile and the alphabetic listing.
+The output of @samp{mprof} contains
+the flat profile and the alphabetic listing only.
+
+The call graph profile presents the local call graph of each procedure.
+For each procedure it shows
+the parents (callers) and children (callees) of that procedure,
+and shows the execution time and call counts for each parent and child.
+It is sorted on the total amount of time spent
+in the procedure and all of its descendents
+(i.e. all of the procedures that it calls, directly or indirectly.)
-Due to a known timing-related bug in our code, you may occasionally get
-segmentation violations when running your program with time profiling enabled.
-If this happens, just run it again --- the problem occurs only very rarely.
-
- at node Displaying the profile
- at section Displaying the profile
-
-To display the profile, just type @samp{mprof}. This will read the
- at file{Prof.*} files and display the flat profile in a nice human-readable
-format. If you also want to see the call graph profile, which takes a lot
-longer to generate, type @samp{mprof -c}.
-
-Note that @samp{mprof} can take quite a while to execute, and will
-usually produce quite a lot of output, so you will usually want to
-redirect the output into a file with a command such as
- at samp{mprof > mprof.out}.
-
-For programs built with @samp{--high-level-code}, you need to also
-pass the @samp{--no-demangle} option to @samp{mprof}.
-
- at node Analysis of results
- at section Analysis of results
-
-The profile output consists of three major sections. These are
-named the call graph profile, the flat profile and the alphabetic listing.
-
-The call graph profile presents the local call graph of each
-procedure. For each procedure it shows the parents (callers) and
-children (callees) of that procedure, and shows the execution time and
-call counts for each parent and child. It is sorted on the total
-amount of time spent in the procedure and all of its descendents (i.e.
-all of the procedures that it calls, directly or indirectly.)
-
The flat profile presents the just execution time spent in each procedure.
It does not count the time spent in descendents of a procedure.
The alphabetic listing just lists the procedures in alphabetical order,
-along with their index number in the call graph profile, so that you can
-quickly find the entry for a particular procedure in the call graph profile.
+along with their index number in the call graph profile,
+so that you can quickly find the entry for a particular procedure
+in the call graph profile.
The profiler works by interrupting the program at frequent intervals,
and each time recording the currently active procedure and its caller.
-It uses these counts to determine the proportion of the total time spent in
-each procedure. This means that the figures calculated for these times
-are only a statistical approximation to the real values, and so they
-should be treated with some caution.
+It uses these counts to determine
+the proportion of the total time spent in each procedure.
+This means that the figures calculated for these times
+are only a statistical approximation to the real values,
+and so they should be treated with some caution.
+In particular, if the profiler's assumption
+that calls to a procedure from different callers have roughly similar costs
+is not true,
+the graph profile can be quite misleading.
The time spent in a procedure and its descendents is calculated by
-propagating the times up the call graph, assuming that each call to a
-procedure from a particular caller takes the same amount of time.
-This assumption is usually reasonable, but again the results should
-be treated with caution.
-
-Note that any time spent in a C function (e.g. time spent in
- at samp{GC_malloc()}, which does memory allocation and garbage collection) is
-credited to the Mercury procedure that called that C function.
+propagating the times up the call graph,
+assuming that each call to a procedure from a particular caller
+takes the same amount of time.
+This assumption is usually reasonable,
+but again the results should be treated with caution.
+(The deep profiler does not make such an assumption,
+and hence its output is significantly more reliable.)
+
+Note that any time spent in a C function
+(e.g. time spent in @samp{GC_malloc()},
+which does memory allocation and garbage collection)
+is credited to the Mercury procedure that called that C function.
Here is a small portion of the call graph profile from an example program.
@@ -2799,55 +2850,70 @@
time due to that parent. These times are obtained using the assumption that
each call contributes equally to the total time of the current procedure.
- at node Memory profiling
- at section Memory profiling
+ at node Using mprof for memory profiling
+ at section Using mprof for memory profiling
-It is also possible to profile memory allocation. To enable memory
-profiling, your program must be built with memory profiling enabled,
-using the @samp{--memory-profiling} option. Then, as with time
-profiling, you run your program to create the profiling data.
-This will be stored in the files @file{Prof.MemoryWords}
- at file{Prof.MemoryCells}, @file{Prof.Decls}, and @file{Prof.CallPair}.
-
-To create the profile, you need to invoke @samp{mprof} with the
- at samp{-m} (@samp{--profile memory-words}) option. This will profile
-the amount of memory allocated, measured in units of words.
-(A word is 4 bytes on a 32-bit architecture, and 8 bytes on a 64-bit
-architecture.)
+To create a memory profile, you can invoke @samp{mprof}
+with the @samp{-m} (@samp{--profile memory-words}) option.
+This will profile the amount of memory allocated, measured in units of words.
+(A word is 4 bytes on a 32-bit architecture,
+and 8 bytes on a 64-bit architecture.)
Alternatively, you can use @samp{mprof}'s @samp{-M}
-(@samp{--profile memory-cells}) option. This will profile memory in
-units of ``cells''. A cell is a group of words allocated together in a
-single allocation, to hold a single object. Selecting this option this
-will therefore profile the number of memory allocations, while ignoring
-the size of each memory allocation.
+(@samp{--profile memory-cells}) option.
+This will profile memory in units of ``cells''.
+A cell is a group of words allocated together in a single allocation,
+to hold a single object.
+Selecting this option this will therefore profile
+the number of memory allocations,
+while ignoring the size of each memory allocation.
With memory profiling, just as with time profiling,
you can use the @samp{-c} (@samp{--call-graph}) option to display
call graph profiles in addition to flat profiles.
-Note that Mercury's memory profiler will only tell you about
-allocation, not about deallocation (garbage collection).
+Note that Mercury's memory profiler will only tell you about allocation,
+not about deallocation (garbage collection).
It can tell you how much memory was allocated by each procedure,
but it won't tell you how long the memory was live for,
or how much of that memory was garbage-collected.
+This is also true for @samp{mdprof}.
+
+ at node Using mdprof
+ at section Using mdprof
+
+To display the information contained in a deep profiling data file
+(which will be called @file{Deep.data} unless you renamed it),
+start up your browser and give it a URL of the form
+ at file{http://server.domain.name/cgi-bin/mdprof?/full/path/name/Deep.data}.
+The @file{server.domain.name} part should be the name of a machine
+with the following qualifications:
+it should have a web server running on it,
+and it should have the @samp{mdprof} program installed
+in its @file{/usr/lib/cgi-bin} directory.
+The @file{/full/path/name/Deep.data} part
+should be the full path name of the deep profiling data file
+whose data you wish to explore.
+The name of this file must not have dollar signs in it.
@node Profiling and shared libraries
@section Profiling and shared libraries
-On some operating systems, Mercury's profiling doesn't work properly
-with shared libraries. The symptom is errors ("map__lookup failed")
-or warnings from @samp{mprof}. On some systems, the problem occurs
-because the C implementation fails to conform to the semantics
-specified by the ISO C standard for programs that use shared
-libraries. For other systems, we have not been able to analyze the
-cause of the failure (but we suspect that the cause may be the same as
-on those systems where we have been able to analyze it).
-
-If you get errors or warnings from @samp{mprof}, and your program is
-dynamically linked, try rebuilding your application statically linked,
-e.g. by using @samp{MLFLAGS=--static} in your Mmakefile. Another
-work-around that sometimes works is to set the environment variable
+On some operating systems,
+Mercury's profiling doesn't work properly with shared libraries.
+The symptom is errors ("map__lookup failed") or warnings from @samp{mprof}.
+On some systems, the problem occurs because the C implementation
+fails to conform to the semantics specified by the ISO C standard
+for programs that use shared libraries.
+For other systems, we have not been able to analyze the cause of the failure
+(but we suspect that the cause may be the same as on those systems
+where we have been able to analyze it).
+
+If you get errors or warnings from @samp{mprof},
+and your program is dynamically linked,
+try rebuilding your application statically linked,
+e.g. by using @samp{MLFLAGS=--static} in your Mmakefile.
+Another work-around that sometimes works is to set the environment variable
@samp{LD_BIND_NOW} to a non-null value before running the program.
@node Invocation
@@ -3538,6 +3604,9 @@
@item @samp{.memprof}
@code{--memory-profiling}.
+ at item @samp{.profdeep}
+ at code{--deep-profiling}.
+
@c The following are undocumented because
@c they are basically useless... documenting
@c them would just confuse people.
@@ -3641,9 +3710,14 @@
Enable memory profiling. Insert memory profiling hooks in the
generated code, and also output some profiling
information (the static call graph) to the file
- at samp{@var{module}.prof}. @xref{Memory profiling}.
+ at samp{@var{module}.prof}. @xref{Using mprof for memory profiling}.
This option is not supported for the IL and Java back-ends.
+ at sp 1
+ at 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.
+
@ignore
The following are basically useless, hence undocumented.
@@ -4272,6 +4346,10 @@
@sp 1
@item --no-optimize-fulljumps
Disable elimination of jumps to ordinary code.
+
+ at sp 1
+ at item --pessimize-tailcalls
+Disable the optimization of tailcalls.
@sp 1
@item --checked-nondet-tailcalls
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing library
Index: library/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mmakefile,v
retrieving revision 1.66
diff -u -b -r1.66 Mmakefile
--- library/Mmakefile 2001/05/14 14:38:11 1.66
+++ library/Mmakefile 2001/05/15 07:17:04
@@ -80,7 +80,8 @@
$(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 --trace minimum \
+MCG = $(M_ENV) $(MC) --compile-to-c \
$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
MCS = $(M_ENV) $(MC) --split-c-files -c --cflags "$(ALL_CFLAGS)" \
$(INTERMODULE_OPTS) $(CHECK_TERM_OPTS)
@@ -319,6 +320,11 @@
$(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
#-----------------------------------------------------------------------------#
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.91
diff -u -b -r1.91 array.m
--- library/array.m 2001/05/14 13:24:49 1.91
+++ library/array.m 2001/05/15 16:16:43
@@ -417,6 +417,8 @@
:- pragma foreign_code("C", "
+#include ""mercury_deep_profiling_hand.h""
+
#ifdef MR_HIGHLEVEL_CODE
MR_define_type_ctor_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
@@ -468,6 +470,13 @@
#else
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_compiler_plain(array, __Unify__, array, 1, 0,
+ array, array_equal, 2, 0, ""array.m"", 99);
+MR_proc_static_compiler_plain(array, __Compare__, array, 1, 0,
+ array, array_compare, 3, 0, ""array.m"", 99);
+#endif
+
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY);
MR_declare_entry(mercury__array__array_equal_2_0);
@@ -476,10 +485,69 @@
MR_BEGIN_MODULE(array_module_builtins)
MR_init_entry(mercury____Unify___array__array_1_0);
MR_init_entry(mercury____Compare___array__array_1_0);
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury____Unify___array__array_1_0_i1);
+ MR_init_label(mercury____Unify___array__array_1_0_i2);
+ MR_init_label(mercury____Unify___array__array_1_0_i3);
+ MR_init_label(mercury____Unify___array__array_1_0_i4);
+ MR_init_label(mercury____Unify___array__array_1_0_i5);
+ MR_init_label(mercury____Unify___array__array_1_0_i6);
+ MR_init_label(mercury____Compare___array__array_1_0_i1);
+ MR_init_label(mercury____Compare___array__array_1_0_i2);
+ MR_init_label(mercury____Compare___array__array_1_0_i3);
+ MR_init_label(mercury____Compare___array__array_1_0_i4);
+#endif
MR_BEGIN_CODE
+ /*
+ ** Unification and comparison for arrays are implemented in Mercury,
+ ** not hand-coded low-level C
+ */
+
+#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)
+#define body_code MR_deep_prepare_normal_call( \
+ mercury____Unify___array__array_1_0, 3, \
+ mercury____Unify___array__array_1_0_i5, 0); \
+ MR_call_localret( \
+ MR_ENTRY(mercury__array__array_equal_2_0), \
+ mercury____Unify___array__array_1_0_i6, \
+ MR_ENTRY(mercury____Unify___array__array_1_0));\
+ MR_define_label( \
+ mercury____Unify___array__array_1_0_i6);
+
+#include ""mercury_hand_unify_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+
+#define proc_label mercury____Compare___array__array_1_0
+#define proc_static MR_proc_static_compiler_name(array, __Compare__,\
+ array, 1, 0)
+#define body_code MR_deep_prepare_normal_call( \
+ mercury____Compare___array__array_1_0, 3, \
+ mercury____Compare___array__array_1_0_i3, 0); \
+ MR_call_localret( \
+ MR_ENTRY(mercury__array__array_compare_3_0), \
+ mercury____Compare___array__array_1_0_i4, \
+ MR_ENTRY(mercury____Compare___array__array_1_0));\
+ MR_define_label( \
+ mercury____Compare___array__array_1_0_i4);
+
+#include ""mercury_hand_compare_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+#else
+
MR_define_entry(mercury____Unify___array__array_1_0);
- /* this is implemented in Mercury, not hand-coded low-level C */
MR_tailcall(MR_ENTRY(mercury__array__array_equal_2_0),
MR_ENTRY(mercury____Unify___array__array_1_0));
@@ -488,6 +556,8 @@
MR_tailcall(MR_ENTRY(mercury__array__array_compare_3_0),
MR_ENTRY(mercury____Compare___array__array_1_0));
+#endif
+
MR_END_MODULE
/* Ensure that the initialization code for the above module gets run. */
@@ -495,19 +565,42 @@
INIT sys_init_array_module_builtins
*/
+/* suppress gcc -Wmissing-decl warning */
+void sys_init_array_module_builtins_init(void);
+void sys_init_array_module_builtins_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_array_module_builtins_write_out_proc_statics(FILE *fp);
+#endif
+
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc array_module_builtins;
-void sys_init_array_module_builtins(void);
- /* suppress gcc -Wmissing-decl warning */
-void sys_init_array_module_builtins(void) {
+void
+sys_init_array_module_builtins_init(void)
+{
array_module_builtins();
MR_INIT_TYPE_CTOR_INFO(
mercury_data_array__type_ctor_info_array_1,
array__array_1_0);
+}
+
+void
+sys_init_array_module_builtins_init_type_tables(void)
+{
MR_register_type_ctor_info(
&mercury_data_array__type_ctor_info_array_1);
}
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_array_module_builtins_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(array, __Unify__, array, 1, 0));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(array, __Compare__, array, 1, 0));
+}
+#endif
+
#endif /* ! MR_HIGHLEVEL_CODE */
").
@@ -610,7 +703,15 @@
:- pragma foreign_decl("C", "
#include ""mercury_heap.h"" /* for MR_maybe_record_allocation() */
#include ""mercury_library_types.h"" /* for MR_ArrayType */
-#include ""mercury_misc.h"" /* for MR_fatal_error() */
+
+#ifdef ML_ARRAY_THROW_EXCEPTIONS
+ #include ""exception.h"" /* for ML_throw_string */
+ /* shut up warnings about casting away const */
+ #define ML_array_raise(s) ML_throw_string((char *) (void *) s)
+#else
+ #include ""mercury_misc.h"" /* for MR_fatal_error() */
+ #define ML_array_raise(s) MR_fatal_error(s)
+#endif
").
:- pragma foreign_decl("C", "
@@ -636,6 +737,11 @@
:- pragma foreign_proc("C",
array__init(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, thread_safe], "
+#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
+ if (Size < 0) {
+ ML_array_raise(""array__init: negative size"");
+ }
+#endif
MR_maybe_record_allocation(Size + 1, MR_PROC_LABEL, ""array:array/1"");
Array = (MR_Word) ML_make_array(Size, Item);
").
@@ -781,7 +887,8 @@
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""array__lookup: array index out of bounds"");
+ ML_array_raise(
+ ""array__lookup: array index out of bounds"");
}
#endif
Item = array->elements[Index];
@@ -792,7 +899,8 @@
MR_ArrayType *array = (MR_ArrayType *)Array;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""array__lookup: array index out of bounds"");
+ ML_array_raise(
+ ""array__lookup: array index out of bounds"");
}
#endif
Item = array->elements[Index];
@@ -821,7 +929,8 @@
MR_ArrayType *array = (MR_ArrayType *)Array0;
#ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""array__set: array index out of bounds"");
+ ML_array_raise(
+ ""array__set: array index out of bounds"");
}
#endif
array->elements[Index] = Item; /* destructive update! */
@@ -911,7 +1020,7 @@
old_array_size = old_array->size;
if (old_array_size == array_size) return old_array;
if (old_array_size < array_size) {
- MR_fatal_error(
+ ML_array_raise(
""array__shrink: can't shrink to a larger size"");
}
@@ -1262,6 +1371,7 @@
else foldr_0(Fn, A, Fn(A ^ elem(I), X), Min, I - 1)
).
+% ---------------------------------------------------------------------------- %
% ---------------------------------------------------------------------------- %
% SAMsort (smooth applicative merge) invented by R.A. O'Keefe.
Index: library/benchmarking.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/benchmarking.m,v
retrieving revision 1.40
diff -u -b -r1.40 benchmarking.m
--- library/benchmarking.m 2001/03/15 07:42:21 1.40
+++ library/benchmarking.m 2001/05/03 06:41:38
@@ -75,7 +75,7 @@
:- pragma foreign_proc("C", report_full_memory_stats, will_not_call_mercury,
"
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
ML_report_full_memory_stats();
#endif
").
@@ -100,7 +100,7 @@
#include ""mercury_heap_profile.h""
#include ""mercury_wrapper.h"" /* for MR_time_at_last_stat */
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
#define MEMORY_PROFILE_SIZE 10 /* Profile the top 10 entries */
@@ -147,7 +147,7 @@
static int ML_memory_profile_compare_final(const void *, const void *);
-#endif /* PROFILE_MEMORY */
+#endif /* MR_MPROF_PROFILE_MEMORY */
void
ML_report_stats(void)
@@ -156,7 +156,7 @@
#ifndef MR_HIGHLEVEL_CODE
MercuryEngine *eng;
#endif
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
int num_table_entries;
ML_memprof_report_entry table[MEMORY_PROFILE_SIZE];
#endif
@@ -181,9 +181,11 @@
#ifndef MR_HIGHLEVEL_CODE
fprintf(stderr, "" D Stack: %.3fk, ND Stack: %.3fk,"",
((char *) MR_sp - (char *)
- eng->context.detstack_zone->min) / 1024.0,
+ eng->MR_eng_context.MR_ctxt_detstack_zone->min)
+ / 1024.0,
((char *) MR_maxfr - (char *)
- eng->context.nondetstack_zone->min) / 1024.0
+ eng->MR_eng_context.MR_ctxt_nondetstack_zone->min)
+ / 1024.0
);
#endif
@@ -221,7 +223,7 @@
);
#endif
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
/*
** Update the overall counter (this needs to be done first,
@@ -257,12 +259,12 @@
ML_overall_counter.words_at_period_end
);
-#endif /* PROFILE_MEMORY */
+#endif /* MR_MPROF_PROFILE_MEMORY */
fprintf(stderr, ""]\\n"");
}
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
void
ML_report_full_memory_stats(void)
@@ -557,7 +559,7 @@
}
}
-#endif /* PROFILE_MEMORY */
+#endif /* MR_MPROF_PROFILE_MEMORY */
").
%-----------------------------------------------------------------------------%
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.54
diff -u -b -r1.54 builtin.m
--- library/builtin.m 2001/05/14 13:24:49 1.54
+++ library/builtin.m 2001/05/15 07:17:04
@@ -280,22 +280,14 @@
:- pragma foreign_code("C", "
-#ifdef MR_HIGHLEVEL_CODE
-
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void sys_init_builtin_types_module(void);
-
-/*
-** This empty initialization function is needed just to
-** match the one that we use for LLDS grades.
-*/
-void
-sys_init_builtin_types_module(void)
-{
- /* no initialization needed */
-}
+/* forward decls, to suppress gcc -Wmissing-decl warning */
+void sys_init_builtin_types_module_init(void);
+void sys_init_builtin_types_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_builtin_types_module_write_out_proc_statics(FILE *fp);
+#endif
-#else
+#ifndef MR_HIGHLEVEL_CODE
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, int, 0,
MR_TYPECTOR_REP_INT,
@@ -369,9 +361,12 @@
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc builtin_types_module;
extern void mercury__private_builtin__init(void);
-void sys_init_builtin_types_module(void); /* suppress gcc warning */
-void sys_init_builtin_types_module(void) {
+#endif /* ! HIGHLEVEL_CODE */
+void
+sys_init_builtin_types_module_init(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
/*
** We had better call this init() because we use the
** labels for the special preds of int, float, pred,
@@ -397,7 +392,12 @@
mercury_data___type_ctor_info_tuple_0, _tuple_);
MR_INIT_TYPE_CTOR_INFO_WITH_PRED(
mercury_data___type_ctor_info_void_0, mercury__unused_0_0);
+#endif
+}
+void
+sys_init_builtin_types_module_init_type_tables(void)
+{
MR_register_type_ctor_info(
&mercury_data___type_ctor_info_int_0);
MR_register_type_ctor_info(
@@ -416,7 +416,13 @@
&mercury_data___type_ctor_info_void_0);
}
-#endif /* ! HIGHLEVEL_CODE */
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_builtin_types_module_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
").
@@ -947,32 +953,36 @@
:- external(copy/2).
-:- pragma c_header_code("#include ""mercury_deep_copy.h""").
+:- pragma foreign_decl("C", "
+#include ""mercury_deep_copy.h""
+#include ""mercury_deep_profiling_hand.h""
+").
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#ifdef MR_HIGHLEVEL_CODE
void MR_CALL mercury__builtin__copy_2_p_0(MR_Mercury_Type_Info, MR_Box, MR_Box *);
void MR_CALL mercury__builtin__copy_2_p_1(MR_Mercury_Type_Info, MR_Box, MR_Box *);
#endif
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
#ifdef MR_HIGHLEVEL_CODE
void MR_CALL
mercury__builtin__copy_2_p_0(MR_Mercury_Type_Info type_info,
- MR_Box value, MR_Box * copy)
+ MR_Box value, MR_Box *copy)
{
MR_Word val = (MR_Word) value;
- *copy = (MR_Box) MR_deep_copy(&val,
- (MR_TypeInfo) type_info, NULL, NULL);
+ *copy = (MR_Box) MR_deep_copy(&val, (MR_TypeInfo) type_info,
+ NULL, NULL);
}
void MR_CALL
-mercury__builtin__copy_2_p_1(MR_Mercury_Type_Info type_info, MR_Box x, MR_Box * y)
+mercury__builtin__copy_2_p_1(MR_Mercury_Type_Info type_info,
+ MR_Box value, MR_Box *copy)
{
- mercury__builtin__copy_2_p_0(type_info, x, y);
+ mercury__builtin__copy_2_p_0(type_info, value, copy);
}
/* forward decl, to suppress gcc -Wmissing-decl warning */
@@ -990,36 +1000,90 @@
#else /* ! MR_HIGHLEVEL_CODE */
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_user_builtin_empty(copy, 2, 0, ""builtin.m"");
+MR_proc_static_user_builtin_empty(copy, 2, 1, ""builtin.m"");
+#endif
+
MR_define_extern_entry(mercury__copy_2_0);
MR_define_extern_entry(mercury__copy_2_1);
MR_BEGIN_MODULE(copy_module)
MR_init_entry(mercury__copy_2_0);
MR_init_entry(mercury__copy_2_1);
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury__copy_2_0_i1);
+ MR_init_label(mercury__copy_2_0_i2);
+ MR_init_label(mercury__copy_2_1_i1);
+ MR_init_label(mercury__copy_2_1_i2);
+#endif
MR_BEGIN_CODE
-#ifdef PROFILE_CALLS
- #define fallthru(target, caller) { MR_tailcall((target), (caller)); }
+#ifdef MR_DEEP_PROFILING
+ #define call_label(proc_label) MR_PASTE3(proc_label, _i, 1)
+ #define exit_label(proc_label) MR_PASTE3(proc_label, _i, 2)
+ #define first_slot 3
+
+ #define copy_body(proc_label, proc_static) \
+ MR_incr_sp_push_msg(6, ""builtin:copy/2""); \
+ MR_stackvar(6) = (MR_Word) MR_succip; \
+ MR_stackvar(1) = MR_r1; \
+ MR_stackvar(2) = MR_r2; \
+ \
+ MR_deep_det_call(proc_label, proc_static, first_slot, \
+ call_label(proc_label)); \
+ \
+ { \
+ MR_Word value, copy; \
+ MR_TypeInfo type_info; \
+ \
+ type_info = (MR_TypeInfo) MR_stackvar(1); \
+ value = MR_stackvar(2); \
+ \
+ MR_save_transient_registers(); \
+ copy = MR_deep_copy(&value, type_info, NULL, NULL); \
+ MR_restore_transient_registers(); \
+ \
+ MR_stackvar(1) = copy; \
+ } \
+ \
+ MR_deep_det_exit(proc_label, first_slot, \
+ exit_label(proc_label)); \
+ \
+ MR_r1 = MR_stackvar(1); \
+ MR_succip = (MR_Code *) MR_stackvar(6); \
+ MR_decr_sp_pop_msg(6); \
+ MR_proceed();
#else
- #define fallthru(target, caller)
+ #define copy_body(proc_label, proc_static) \
+ { \
+ MR_Word value, copy; \
+ MR_TypeInfo type_info; \
+ \
+ type_info = (MR_TypeInfo) MR_r1; \
+ value = MR_r2; \
+ \
+ MR_save_transient_registers(); \
+ copy = MR_deep_copy(&value, type_info, NULL, NULL); \
+ MR_restore_transient_registers(); \
+ \
+ MR_r1 = copy; \
+ MR_proceed(); \
+ }
#endif
MR_define_entry(mercury__copy_2_0);
-fallthru(MR_ENTRY(mercury__copy_2_1), MR_ENTRY(mercury__copy_2_0))
-MR_define_entry(mercury__copy_2_1);
-{
- MR_Word value, copy, type_info;
+ copy_body(mercury__copy_2_0,
+ MR_proc_static_user_builtin_name(copy, 2, 0))
- type_info = MR_r1;
- value = MR_r2;
-
- MR_save_transient_registers();
- copy = MR_deep_copy(&value, (MR_TypeInfo) type_info, NULL, NULL);
- MR_restore_transient_registers();
+MR_define_entry(mercury__copy_2_1);
+ copy_body(mercury__copy_2_1,
+ MR_proc_static_user_builtin_name(copy, 2, 1))
- MR_r1 = copy;
- MR_proceed();
-}
+#undef call_label
+#undef exit_label
+#undef first_slot
+#undef copy_body
MR_END_MODULE
/* Ensure that the initialization code for the above module gets run. */
@@ -1027,13 +1091,38 @@
/*
INIT sys_init_copy_module
*/
+
+/* suppress gcc -Wmissing-decl warnings */
+void sys_init_copy_module_init(void);
+void sys_init_copy_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_copy_module_write_out_proc_statics(FILE *fp);
+#endif
+
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc copy_module;
-void sys_init_copy_module(void);
- /* extra declaration to suppress gcc -Wmissing-decl warning */
-void sys_init_copy_module(void) {
+
+void
+sys_init_copy_module_init(void)
+{
copy_module();
}
+void
+sys_init_copy_module_init_type_tables(void)
+{
+}
+
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_copy_module_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &mercury_data__proc_static__mercury__copy_2_0);
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &mercury_data__proc_static__mercury__copy_2_1);
+}
+#endif
+
#endif /* ! MR_HIGHLEVEL_CODE */
").
@@ -1041,25 +1130,31 @@
% The type c_pointer can be used by predicates which use the C interface.
-:- pragma c_code("
+:- pragma foreign_code("C", "
-#ifdef MR_HIGHLEVEL_CODE
+#include ""mercury_deep_profiling_hand.h""
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void sys_init_unify_c_pointer_module(void);
-
+/* Ensure that the initialization code for the above module gets run. */
/*
-** This empty initialization function is needed just to
-** match the one that we use for LLDS grades.
+INIT sys_init_c_pointer_module
*/
-void
-sys_init_unify_c_pointer_module(void)
-{
- /* no initialization needed */
-}
-#else
+/* duplicate declarations to suppress gcc -Wmissing-decl warning */
+void sys_init_c_pointer_module_init(void);
+void sys_init_c_pointer_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_c_pointer_module_write_out_proc_statics(FILE *fp);
+#endif
+#ifndef MR_HIGHLEVEL_CODE
+
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_compiler_empty(builtin, __Unify__, c_pointer,
+ 0, 0, ""builtin.m"");
+MR_proc_static_compiler_empty(builtin, __Compare__, c_pointer,
+ 0, 0, ""builtin.m"");
+#endif
+
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(builtin, c_pointer, 0,
MR_TYPECTOR_REP_C_POINTER,
mercury____Unify___builtin__c_pointer_0_0,
@@ -1069,12 +1164,19 @@
MR_declare_entry(mercury____Index___builtin__c_pointer_0_0);
MR_declare_entry(mercury____Compare___builtin__c_pointer_0_0);
-MR_BEGIN_MODULE(unify_c_pointer_module)
+MR_BEGIN_MODULE(c_pointer_module)
MR_init_entry(mercury____Unify___builtin__c_pointer_0_0);
MR_init_entry(mercury____Compare___builtin__c_pointer_0_0);
-
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i1);
+ MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i2);
+ MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i3);
+ MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i4);
+ MR_init_label(mercury____Compare___builtin__c_pointer_0_0_i1);
+ MR_init_label(mercury____Compare___builtin__c_pointer_0_0_i2);
+#endif
MR_BEGIN_CODE
-MR_define_entry(mercury____Unify___builtin__c_pointer_0_0);
+
/*
** For c_pointer, we assume that equality and comparison
** can be based on object identity (i.e. using address comparisons).
@@ -1082,38 +1184,68 @@
** the io__state contains a map(io__stream, filename).
** However, it might not be correct in general...
*/
- MR_r1 = (MR_r1 == MR_r2);
- MR_proceed();
-MR_define_entry(mercury____Compare___builtin__c_pointer_0_0);
- MR_r1 = (MR_r1 == MR_r2 ? MR_COMPARE_EQUAL :
- MR_r1 < MR_r2 ? MR_COMPARE_LESS :
- MR_COMPARE_GREATER);
- MR_proceed();
+#define proc_label mercury____Unify___builtin__c_pointer_0_0
+#define proc_static MR_proc_static_compiler_name(builtin, __Unify__, \
+ c_pointer, 0, 0)
+#define body_code do { MR_r1 = (MR_r1 == MR_r2); } while(0)
+
+#include ""mercury_hand_unify_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+
+#define proc_label mercury____Compare___builtin__c_pointer_0_0
+#define proc_static MR_proc_static_compiler_name(builtin, __Compare__, \
+ c_pointer, 0, 0)
+#define body_code do { \
+ MR_r1 = (MR_r1 == MR_r2 ? MR_COMPARE_EQUAL : \
+ MR_r1 < MR_r2 ? MR_COMPARE_LESS : \
+ MR_COMPARE_GREATER); \
+ } while (0)
+
+#include ""mercury_hand_compare_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
MR_END_MODULE
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_unify_c_pointer_module
-*/
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc c_pointer_module;
+#endif /* ! MR_HIGHLEVEL_CODE */
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc unify_c_pointer_module;
-void sys_init_unify_c_pointer_module(void);
- /* duplicate declaration to suppress gcc -Wmissing-decl warning */
-void sys_init_unify_c_pointer_module(void) {
- unify_c_pointer_module();
+void
+sys_init_c_pointer_module_init(void)
+{
+ c_pointer_module();
MR_INIT_TYPE_CTOR_INFO(
mercury_data_builtin__type_ctor_info_c_pointer_0,
builtin__c_pointer_0_0);
+}
+void
+sys_init_c_pointer_module_init_type_tables(void)
+{
MR_register_type_ctor_info(
&mercury_data_builtin__type_ctor_info_c_pointer_0);
}
-#endif /* ! MR_HIGHLEVEL_CODE */
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_c_pointer_module_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(builtin, __Unify__, c_pointer,
+ 0, 0));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(builtin, __Compare__, c_pointer,
+ 0, 0));
+}
+#endif
").
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.47
diff -u -b -r1.47 exception.m
--- library/exception.m 2001/05/02 16:13:25 1.47
+++ library/exception.m 2001/05/03 06:44:16
@@ -31,6 +31,9 @@
:- func throw(T) = _.
:- mode throw(in) = out is erroneous.
+:- pred throw_string(string).
+:- mode throw_string(in) is erroneous.
+
% The following types are used by try/3 and try/5.
:- type exception_result(T)
@@ -592,6 +595,11 @@
%-----------------------------------------------------------------------------%
+:- pragma export(throw_string(in), "ML_throw_string").
+
+throw_string(Msg) :-
+ throw(Msg).
+
:- pred builtin_throw(univ).
:- mode builtin_throw(in) is erroneous.
@@ -1165,6 +1173,7 @@
#include ""mercury_trace_base.h""
#include ""mercury_stack_trace.h""
#include ""mercury_layout_util.h""
+ #include ""mercury_deep_profiling_hand.h""
MR_DECLARE_TYPE_CTOR_INFO_STRUCT( \
mercury_data_std_util__type_ctor_info_univ_0);
@@ -1172,22 +1181,15 @@
").
:- pragma c_code("
-#ifdef MR_HIGHLEVEL_CODE
-
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void mercury_sys_init_exceptions(void);
-/*
-** This empty initialization function is needed just to
-** match the one that we use for LLDS grades.
-*/
-void
-mercury_sys_init_exceptions(void)
-{
- /* no initialization needed */
-}
+/* forward decls, to suppress gcc -Wmissing-decl warnings */
+void mercury_sys_init_exceptions_init(void);
+void mercury_sys_init_exceptions_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_exceptions_write_out_proc_statics(FILE *fp);
+#endif
-#else
+#ifndef MR_HIGHLEVEL_CODE
/*
** MR_trace_throw():
@@ -1213,9 +1215,13 @@
""being omitted from the trace.\\n"", (msg)); \\
} while (0)
+/*
+** base_sp and base_curfr always hold MR_sp and MR_curfr. They exist
+** only because we cannot take the addresses of MR_sp and MR_curfr.
+*/
+
static MR_Code *
-MR_trace_throw(MR_Code *success_pointer, MR_Word *det_stack_pointer,
- MR_Word *current_frame)
+MR_trace_throw(MR_Code *success_pointer, MR_Word *base_sp, MR_Word *base_curfr)
{
const MR_Internal *label;
const MR_Label_Layout *return_label_layout;
@@ -1241,7 +1247,7 @@
*/
entry_layout = return_label_layout->MR_sll_entry;
if (!MR_DETISM_DET_STACK(entry_layout->MR_sle_detism)
- && MR_redoip_slot(current_frame) ==
+ && MR_redoip_slot(base_curfr) ==
MR_ENTRY(MR_exception_handler_do_fail))
{
return NULL;
@@ -1263,14 +1269,14 @@
** unwind the stacks back to the previous stack frame
*/
result = MR_stack_walk_step(entry_layout, &return_label_layout,
- &det_stack_pointer, ¤t_frame, &problem);
+ &base_sp, &base_curfr, &problem);
if (result != STEP_OK) {
WARNING(problem);
return NULL;
}
MR_restore_transient_registers();
- MR_sp = det_stack_pointer;
- MR_curfr = current_frame;
+ MR_sp = base_sp;
+ MR_curfr = base_curfr;
MR_save_transient_registers();
}
return NULL;
@@ -1284,15 +1290,16 @@
MR_MemoryZone *swap_heaps_temp_hp_zone; \\
\\
swap_heaps_temp_hp = MR_hp; \\
- swap_heaps_temp_hp_zone = MR_ENGINE(heap_zone); \\
+ swap_heaps_temp_hp_zone = MR_ENGINE(MR_eng_heap_zone); \\
\\
/* set heap to solutions heap */ \\
MR_hp = MR_sol_hp; \\
- MR_ENGINE(heap_zone) = MR_ENGINE(solutions_heap_zone); \\
+ MR_ENGINE(MR_eng_heap_zone) = \\
+ MR_ENGINE(MR_eng_solutions_heap_zone); \\
\\
/* set the solutions heap to be the old heap */ \\
MR_sol_hp = swap_heaps_temp_hp; \\
- MR_ENGINE(solutions_heap_zone) = swap_heaps_temp_hp_zone; \\
+ MR_ENGINE(MR_eng_solutions_heap_zone) = swap_heaps_temp_hp_zone;\\
}
MR_define_extern_entry(mercury__exception__builtin_catch_3_0); /* det */
@@ -1310,179 +1317,194 @@
/* the following is defined in runtime/mercury_trace_base.c */
MR_declare_entry(MR_do_trace_redo_fail);
+#ifdef MR_DEEP_PROFILING
+MR_declare_label(mercury__exception__builtin_catch_3_0_i1);
+MR_declare_label(mercury__exception__builtin_catch_3_1_i1);
+MR_declare_label(mercury__exception__builtin_catch_3_2_i1);
+MR_declare_label(mercury__exception__builtin_catch_3_3_i1);
+MR_declare_label(mercury__exception__builtin_catch_3_4_i1);
+MR_declare_label(mercury__exception__builtin_catch_3_5_i1);
+#endif
+
+MR_declare_label(mercury__exception__builtin_catch_3_0_i2);
+MR_declare_label(mercury__exception__builtin_catch_3_1_i2);
MR_declare_label(mercury__exception__builtin_catch_3_2_i2);
MR_declare_label(mercury__exception__builtin_catch_3_3_i2);
+MR_declare_label(mercury__exception__builtin_catch_3_4_i2);
MR_declare_label(mercury__exception__builtin_catch_3_5_i2);
-#ifdef MR_USE_TRAIL
- MR_declare_label(mercury__exception__builtin_catch_3_5_i3);
-#endif
-MR_declare_label(mercury__exception__builtin_throw_1_0_i1);
-#define BUILTIN_THROW_STACK_SIZE 1
+#ifdef MR_DEEP_PROFILING
+MR_declare_label(mercury__exception__builtin_catch_3_0_i3);
+MR_declare_label(mercury__exception__builtin_catch_3_1_i3);
+MR_declare_label(mercury__exception__builtin_catch_3_2_i3);
+MR_declare_label(mercury__exception__builtin_catch_3_3_i3);
+MR_declare_label(mercury__exception__builtin_catch_3_4_i3);
+MR_declare_label(mercury__exception__builtin_catch_3_5_i3);
+
+MR_declare_label(mercury__exception__builtin_catch_3_4_i4);
+MR_declare_label(mercury__exception__builtin_catch_3_5_i4);
+MR_declare_label(mercury__exception__builtin_catch_3_4_i5);
+MR_declare_label(mercury__exception__builtin_catch_3_5_i5);
+#endif
+
+#if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING)
+ MR_declare_label(mercury__exception__builtin_catch_3_4_i6);
+ MR_declare_label(mercury__exception__builtin_catch_3_5_i6);
+#endif
+
+#ifdef MR_DEEP_PROFILING
+MR_declare_label(mercury__exception__builtin_catch_3_4_i7);
+MR_declare_label(mercury__exception__builtin_catch_3_5_i7);
+#endif
+MR_declare_label(mercury__exception__builtin_throw_1_0_i1);
/*
** MR_MAKE_PROC_LAYOUT(entry, detism, slots, succip_locn, pred_or_func,
** module, name, arity, mode)
*/
-MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_throw_1_0,
- MR_DETISM_DET, BUILTIN_THROW_STACK_SIZE, MR_LONG_LVAL_STACKVAR(1),
- MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0);
-MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_throw_1_0, 1);
-
/*
-** The following procedures all allocate their stack frames on
-** the nondet stack, so for the purposes of doing stack traces
-** we say they have MR_DETISM_NON, even though they are not
-** actually nondet.
+** The various procedures of builtin_catch all allocate their stack frames
+** on the nondet stack, so for the purposes of doing stack traces we say
+** they have MR_DETISM_NON, even though they are not actually nondet.
*/
+
+MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_0,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 0);
+MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_1,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 1);
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_2,
- MR_DETISM_NON, /* really cc_multi; also used for det */
- MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 2);
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_3,
- MR_DETISM_NON, /* really cc_nondet; also used for semidet */
- MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 3);
+MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_4,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 4);
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_5,
- MR_DETISM_NON, /* ; also used for multi */
- MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 5);
+#ifdef MR_DEEP_PROFILING
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 1);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 1);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 1);
-MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 2);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 1);
-MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 2);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 1);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 1);
+#endif
+
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 2);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 2);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 2);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 2);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 2);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 2);
-#ifdef MR_USE_TRAIL
- MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 3);
+
+#ifdef MR_DEEP_PROFILING
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_0, 3);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_1, 3);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 3);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 3);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 3);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 3);
+#endif
+
+#ifdef MR_DEEP_PROFILING
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 4);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 4);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 5);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 5);
+#endif
+
+#if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING)
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 6);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 6);
+#endif
+
+#ifdef MR_DEEP_PROFILING
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_4, 7);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 7);
#endif
+MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_throw_1_0,
+ MR_DETISM_DET, 1, MR_LONG_LVAL_STACKVAR(1),
+ MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0);
+MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_throw_1_0, 1);
+
+#ifdef MR_DEEP_PROFILING
+/* XXX the final 0s are fake line numbers */
+MR_proc_static_user_ho(exception, builtin_catch, 3, 0, ""exception.m"", 0);
+MR_proc_static_user_ho(exception, builtin_catch, 3, 1, ""exception.m"", 0);
+MR_proc_static_user_ho(exception, builtin_catch, 3, 2, ""exception.m"", 0);
+MR_proc_static_user_ho(exception, builtin_catch, 3, 3, ""exception.m"", 0);
+MR_proc_static_user_ho(exception, builtin_catch, 3, 4, ""exception.m"", 0);
+MR_proc_static_user_ho(exception, builtin_catch, 3, 5, ""exception.m"", 0);
+/*
+** XXX Builtin_throw will eventually be able to make calls in deep profiling
+** grades. In the meantime, we need its proc_static structure for its callers.
+*/
+MR_proc_static_user_empty(exception, builtin_throw, 1, 0, ""exception.m"");
+#endif
+
MR_BEGIN_MODULE(exceptions_module)
- MR_init_entry(mercury__exception__builtin_catch_3_0);
- MR_init_entry(mercury__exception__builtin_catch_3_1);
+ MR_init_entry_sl(mercury__exception__builtin_catch_3_0);
+ MR_init_entry_sl(mercury__exception__builtin_catch_3_1);
MR_init_entry_sl(mercury__exception__builtin_catch_3_2);
MR_init_entry_sl(mercury__exception__builtin_catch_3_3);
- MR_init_entry(mercury__exception__builtin_catch_3_4);
+ MR_init_entry_sl(mercury__exception__builtin_catch_3_4);
MR_init_entry_sl(mercury__exception__builtin_catch_3_5);
+
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury__exception__builtin_catch_3_0_i1);
+ MR_init_label(mercury__exception__builtin_catch_3_1_i1);
+ MR_init_label(mercury__exception__builtin_catch_3_2_i1);
+ MR_init_label(mercury__exception__builtin_catch_3_3_i1);
+ MR_init_label(mercury__exception__builtin_catch_3_4_i1);
+ MR_init_label(mercury__exception__builtin_catch_3_5_i1);
+#endif
+
+ MR_init_label_sl(mercury__exception__builtin_catch_3_0_i2);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_1_i2);
MR_init_label_sl(mercury__exception__builtin_catch_3_2_i2);
MR_init_label_sl(mercury__exception__builtin_catch_3_3_i2);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i2);
MR_init_label_sl(mercury__exception__builtin_catch_3_5_i2);
-#ifdef MR_USE_TRAIL
- MR_init_label(mercury__exception__builtin_catch_3_5_i3);
-#endif
- MR_init_entry(mercury__exception__builtin_throw_1_0);
- MR_init_label(mercury__exception__builtin_throw_1_0_i1);
-MR_BEGIN_CODE
-/*
-** builtin_catch(Goal, Handler, Result)
-** call Goal(R).
-** if succeeds, set Result = R.
-** if throws an exception, call Handler(Exception, Result).
-**
-** This is the model_det version.
-** On entry, we have a type_info (which we don't use) in MR_r1,
-** the Goal to execute in MR_r2 and the Handler in MR_r3.
-** On exit, we should put Result in MR_r1.
-*/
-MR_define_entry(mercury__exception__builtin_catch_3_0); /* det */
-#ifdef PROFILE_CALLS
-{
- MR_tailcall(MR_ENTRY(mercury__exception__builtin_catch_3_2),
- MR_ENTRY(mercury__exception__builtin_catch_3_0));
-}
+#ifdef MR_DEEP_PROFILING
+ MR_init_label_sl(mercury__exception__builtin_catch_3_0_i3);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_1_i3);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_2_i3);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_3_i3);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i3);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_5_i3);
#endif
-MR_define_entry(mercury__exception__builtin_catch_3_2); /* cc_multi */
- /*
- ** Create an exception handler entry on the nondet stack.
- ** (Register MR_r3 holds the Handler closure.)
- */
- MR_create_exception_handler(""builtin_catch/3 [model_det]"",
- MR_MODEL_DET_HANDLER, MR_r3, MR_ENTRY(MR_do_fail));
-
- /*
- ** Now call `Goal(Result)'.
- */
- MR_r1 = MR_r2; /* The Goal to call */
- MR_r2 = 0; /* Zero additional input arguments */
- MR_r3 = 1; /* One output argument */
- MR_call(MR_ENTRY(mercury__do_call_closure),
- MR_LABEL(mercury__exception__builtin_catch_3_2_i2),
- MR_ENTRY(mercury__exception__builtin_catch_3_2));
-MR_define_label(mercury__exception__builtin_catch_3_2_i2);
- MR_update_prof_current_proc(
- MR_LABEL(mercury__exception__builtin_catch_3_2));
- /*
- ** On exit from mercury__do_call_closure, Result is in MR_r1
- **
- ** We must now deallocate the ticket and nondet stack frame that
- ** were allocated by MR_create_exception_handler().
- */
-#ifdef MR_USE_TRAIL
- MR_prune_ticket();
+#ifdef MR_DEEP_PROFILING
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i4);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_5_i4);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i5);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_5_i5);
#endif
- MR_succeed_discard();
-/*
-** builtin_catch(Goal, Handler, Result)
-** call Goal(R).
-** if succeeds, set Result = R.
-** if fails, fail.
-** if throws an exception, call Handler(Exception, Result).
-**
-** This is the model_semi version.
-** On entry, we have a type_info (which we don't use) in MR_r1,
-** the Goal to execute in MR_r2 and the Handler in MR_r3,
-** and on exit, we should put Result in MR_r2.
-*/
-MR_define_entry(mercury__exception__builtin_catch_3_1); /* semidet */
-#ifdef PROFILE_CALLS
-{
- MR_tailcall(MR_ENTRY(mercury__exception__builtin_catch_3_3),
- MR_ENTRY(mercury__exception__builtin_catch_3_1));
-}
+#if defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING)
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i6);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_5_i6);
#endif
-MR_define_entry(mercury__exception__builtin_catch_3_3); /* cc_nondet */
- /*
- ** Create an exception handler entry on the nondet stack.
- ** (Register MR_r3 holds the Handler closure.)
- */
- MR_create_exception_handler(""builtin_catch/3 [model_semi]"",
- MR_MODEL_SEMI_HANDLER, MR_r3, MR_ENTRY(MR_do_fail));
-
- /*
- ** Now call `Goal(Result)'.
- */
- MR_r1 = MR_r2; /* The Goal to call */
- MR_r2 = 0; /* Zero additional input arguments */
- MR_r3 = 1; /* One output argument */
- MR_call(MR_ENTRY(mercury__do_call_closure),
- MR_LABEL(mercury__exception__builtin_catch_3_3_i2),
- MR_ENTRY(mercury__exception__builtin_catch_3_3));
-MR_define_label(mercury__exception__builtin_catch_3_3_i2);
- MR_update_prof_current_proc(
- MR_LABEL(mercury__exception__builtin_catch_3_3));
- /*
- ** On exit from do_call_semidet_closure, the success/failure
- ** indicator is in MR_r1, and Result is in MR_r2.
- ** Note that we call succeed_discard() to exit regardless
- ** of whether MR_r1 is true or false. We just return the MR_r1 value
- ** back to our caller.
- */
-#ifdef MR_USE_TRAIL
- if (MR_r1) {
- MR_prune_ticket();
- } else {
- MR_discard_ticket();
- }
+#ifdef MR_DEEP_PROFILING
+ MR_init_label_sl(mercury__exception__builtin_catch_3_4_i7);
+ MR_init_label_sl(mercury__exception__builtin_catch_3_5_i7);
#endif
- MR_succeed_discard();
+ MR_init_entry_sl(mercury__exception__builtin_throw_1_0);
+ MR_init_label_sl(mercury__exception__builtin_throw_1_0_i1);
+MR_BEGIN_CODE
+
/*
** builtin_catch(Goal, Handler, Result)
** call Goal(R).
@@ -1490,62 +1512,136 @@
** if fails, fail.
** if throws an exception, call Handler(Exception, Result).
**
-** This is the model_non version.
** On entry, we have a type_info (which we don't use) in MR_r1,
** the Goal to execute in MR_r2 and the Handler in MR_r3.
** On exit, we should put Result in MR_r1.
+**
+** There are slight differences between the versions of the code
+** for the different determinisms.
*/
-MR_define_entry(mercury__exception__builtin_catch_3_4); /* multi */
-#ifdef PROFILE_CALLS
-{
- MR_tailcall(MR_ENTRY(mercury__exception__builtin_catch_3_5),
- MR_ENTRY(mercury__exception__builtin_catch_3_4));
-}
-#endif
-MR_define_entry(mercury__exception__builtin_catch_3_5); /* nondet */
- /*
- ** Create an exception handler entry on the nondet stack.
- ** (Register MR_r3 holds the Handler closure.)
- */
-#ifdef MR_USE_TRAIL
- MR_create_exception_handler(""builtin_catch/3 [model_nondet]"",
- MR_MODEL_NON_HANDLER, MR_r3,
- MR_LABEL(mercury__exception__builtin_catch_3_5_i3));
-#else
- MR_create_exception_handler(""builtin_catch/3 [model_nondet]"",
- MR_MODEL_NON_HANDLER, MR_r3, MR_ENTRY(MR_do_fail));
-#endif
+#define save_r1 do { \
+ MR_framevar(1) = MR_r1; \
+ } while (0)
+#define save_r1r2 do { \
+ MR_framevar(1) = MR_r1; \
+ MR_framevar(2) = MR_r2; \
+ } while (0)
+#define restore_r1 do { \
+ MR_r1 = MR_framevar(1); \
+ } while (0)
+#define restore_r1r2 do { \
+ MR_r1 = MR_framevar(1); \
+ MR_r2 = MR_framevar(2); \
+ } while (0)
- /*
- ** Now call `Goal(Result)'.
- */
- MR_r1 = MR_r2; /* the Goal to call */
- MR_r2 = 0; /* Zero additional input arguments */
- MR_r3 = 1; /* One output argument */
- MR_call(MR_ENTRY(mercury__do_call_closure),
- MR_LABEL(mercury__exception__builtin_catch_3_5_i2),
- MR_ENTRY(mercury__exception__builtin_catch_3_5));
+/* mercury__exception__builtin_catch_3_0: the det version */
+#define proc_label mercury__exception__builtin_catch_3_0
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 0)
+#define excp_handler MR_MODEL_DET_HANDLER
+#define model ""[model det]""
+#define save_results() save_r1
+#define restore_results() restore_r1
+#define handle_ticket_on_exit() do { \
+ MR_prune_ticket(); \
+ } while (0)
-MR_define_label(mercury__exception__builtin_catch_3_5_i2);
- MR_update_prof_current_proc(
- MR_LABEL(mercury__exception__builtin_catch_3_5));
- /*
- ** On exit from do_call_nondet_closure, Result is in MR_r1
- **
- ** Note that we need to keep the trail ticket still,
- ** in case it is needed again on backtracking.
- ** We can only discard it when we MR_fail() out, or
- ** (if an exception is thrown) in the throw.
- */
- MR_succeed();
+#include ""mercury_exception_catch_body.h""
-#ifdef MR_USE_TRAIL
-MR_define_label(mercury__exception__builtin_catch_3_5_i3);
- MR_discard_ticket();
- MR_fail();
-#endif
+#undef proc_static
+#undef proc_label
+
+/* mercury__exception__builtin_catch_3_2: the cc_multi version */
+/* identical to mercury__exception__builtin_catch_3_0 except for label names */
+#define proc_label mercury__exception__builtin_catch_3_2
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 2)
+
+#include ""mercury_exception_catch_body.h""
+
+#undef handle_ticket_on_exit
+#undef restore_results
+#undef save_results
+#undef model
+#undef excp_handler
+#undef proc_static
+#undef proc_label
+
+/* mercury__exception__builtin_catch_3_1: the semidet version */
+#define proc_label mercury__exception__builtin_catch_3_1
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 1)
+#define excp_handler MR_MODEL_SEMI_HANDLER
+#define model ""[model semi]""
+#define save_results() save_r1r2
+#define restore_results() restore_r1r2
+#define handle_ticket_on_exit() do { \
+ if (MR_r1) { \
+ MR_prune_ticket(); \
+ } else { \
+ MR_discard_ticket(); \
+ } \
+ } while (0)
+
+#include ""mercury_exception_catch_body.h""
+
+#undef proc_static
+#undef proc_label
+/* mercury__exception__builtin_catch_3_3: the cc_nondet version */
+/* identical to mercury__exception__builtin_catch_3_1 except for label names */
+#define proc_label mercury__exception__builtin_catch_3_3
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 3)
+
+#include ""mercury_exception_catch_body.h""
+
+#undef handle_ticket_on_exit
+#undef restore_results
+#undef save_results
+#undef model
+#undef excp_handler
+#undef proc_static
+#undef proc_label
+
+/* mercury__exception__builtin_catch_3_4: the multi version */
+#define proc_label mercury__exception__builtin_catch_3_4
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 4)
+#define excp_handler MR_MODEL_NON_HANDLER
+#define model ""[model non]""
+#define save_results() save_r1
+#define restore_results() restore_r1
+#define version_model_non TRUE
+#define handle_ticket_on_exit() ((void) 0)
+#define handle_ticket_on_fail() do { \
+ MR_prune_ticket(); \
+ } while (0)
+
+#include ""mercury_exception_catch_body.h""
+
+#undef proc_static
+#undef proc_label
+
+/* mercury__exception__builtin_catch_3_5: the nondet version */
+/* identical to mercury__exception__builtin_catch_3_4 except for label names */
+#define proc_label mercury__exception__builtin_catch_3_5
+#define proc_static MR_proc_static_user_name(exception, \
+ builtin_catch, 3, 5)
+
+#include ""mercury_exception_catch_body.h""
+
+#undef handle_ticket_on_fail
+#undef handle_ticket_on_exit
+#undef version_model_non
+#undef restore_results
+#undef save_results
+#undef model
+#undef excp_handler
+#undef proc_static
+#undef proc_label
+
/*
** builtin_throw(Exception):
** Throw the specified exception.
@@ -1557,13 +1653,17 @@
**
** On entry, we have Exception in MR_r1.
*/
+
MR_define_entry(mercury__exception__builtin_throw_1_0);
{
- MR_Word exception = MR_r1;
+ MR_Word exception;
MR_Word handler;
enum MR_HandlerCodeModel catch_code_model;
MR_Word *orig_curfr;
- MR_Unsigned exception_event_number = MR_trace_event_number;
+ MR_Unsigned exception_event_number;
+
+ exception = MR_r1;
+ exception_event_number = MR_trace_event_number;
/*
** let the debugger trace exception throwing
@@ -1592,7 +1692,7 @@
!= MR_ENTRY(MR_exception_handler_do_fail))
{
MR_curfr = MR_succfr_slot(MR_curfr);
- if (MR_curfr < MR_CONTEXT(nondetstack_zone)->min) {
+ if (MR_curfr < MR_CONTEXT(MR_ctxt_nondetstack_zone)->min) {
MR_Word *save_succip;
/*
** There was no exception handler.
@@ -1648,8 +1748,8 @@
/*
** Save the handler we found
*/
- catch_code_model = MR_EXCEPTION_FRAMEVARS->code_model;
- handler = MR_EXCEPTION_FRAMEVARS->handler;
+ catch_code_model = MR_EXCEPTION_STRUCT->MR_excp_code_model;
+ handler = MR_EXCEPTION_STRUCT->MR_excp_handler;
/*
** Reset the success ip (i.e. return address).
@@ -1661,14 +1761,15 @@
/*
** Reset the det stack.
*/
- MR_sp = MR_EXCEPTION_FRAMEVARS->stack_ptr;
+ MR_sp = MR_EXCEPTION_STRUCT->MR_excp_stack_ptr;
#ifdef MR_USE_TRAIL
/*
** Reset the trail.
*/
- MR_reset_ticket(MR_EXCEPTION_FRAMEVARS->trail_ptr, MR_exception);
- MR_discard_tickets_to(MR_EXCEPTION_FRAMEVARS->ticket_counter);
+ MR_reset_ticket(MR_EXCEPTION_STRUCT->MR_excp_trail_ptr,
+ MR_exception);
+ MR_discard_tickets_to(MR_EXCEPTION_STRUCT->MR_excp_ticket_counter);
#endif
#ifndef CONSERVATIVE_GC
/*
@@ -1689,7 +1790,9 @@
MR_Word * saved_solns_heap_ptr;
/* switch to the solutions heap */
- if (MR_ENGINE(heap_zone) == MR_EXCEPTION_FRAMEVARS->heap_zone) {
+ if (MR_ENGINE(MR_eng_heap_zone) ==
+ MR_EXCEPTION_STRUCT->MR_excp_heap_zone)
+ {
swap_heaps();
}
@@ -1700,33 +1803,35 @@
** Note that we need to save/restore the hp register, if it
** is transient, before/after calling MR_deep_copy().
*/
- assert(MR_EXCEPTION_FRAMEVARS->heap_ptr <=
- MR_EXCEPTION_FRAMEVARS->heap_zone->top);
+ assert(MR_EXCEPTION_STRUCT->MR_excp_heap_ptr <=
+ MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top);
MR_save_transient_registers();
exception = MR_deep_copy(&exception,
(MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0,
- MR_EXCEPTION_FRAMEVARS->heap_ptr,
- MR_EXCEPTION_FRAMEVARS->heap_zone->top);
+ MR_EXCEPTION_STRUCT->MR_excp_heap_ptr,
+ MR_EXCEPTION_STRUCT->MR_excp_heap_zone->top);
MR_restore_transient_registers();
/* switch back to the ordinary heap */
swap_heaps();
/* reset the heap */
- assert(MR_EXCEPTION_FRAMEVARS->heap_ptr <= MR_hp);
- MR_hp = MR_EXCEPTION_FRAMEVARS->heap_ptr;
+ assert(MR_EXCEPTION_STRUCT->MR_excp_heap_ptr <= MR_hp);
+ MR_hp = MR_EXCEPTION_STRUCT->MR_excp_heap_ptr;
/* MR_deep_copy the exception back to the ordinary heap */
- assert(MR_EXCEPTION_FRAMEVARS->solns_heap_ptr <=
- MR_ENGINE(solutions_heap_zone)->top);
+ assert(MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr <=
+ MR_ENGINE(MR_eng_solutions_heap_zone)->top);
MR_save_transient_registers();
exception = MR_deep_copy(&exception,
(MR_TypeInfo) &mercury_data_std_util__type_ctor_info_univ_0,
- saved_solns_heap_ptr, MR_ENGINE(solutions_heap_zone)->top);
+ saved_solns_heap_ptr,
+ MR_ENGINE(MR_eng_solutions_heap_zone)->top);
MR_restore_transient_registers();
/* reset the solutions heap */
- assert(MR_EXCEPTION_FRAMEVARS->solns_heap_ptr <= saved_solns_heap_ptr);
+ assert(MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr
+ <= saved_solns_heap_ptr);
assert(saved_solns_heap_ptr <= MR_sol_hp);
if (catch_code_model == MR_MODEL_NON_HANDLER) {
/*
@@ -1745,7 +1850,7 @@
** we can safely reset the solutions heap to where
** it was when it try (catch) was entered.
*/
- MR_sol_hp = MR_EXCEPTION_FRAMEVARS->solns_heap_ptr;
+ MR_sol_hp = MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr;
}
}
#endif /* !defined(CONSERVATIVE_GC) */
@@ -1770,18 +1875,23 @@
if (catch_code_model == MR_C_LONGJMP_HANDLER) {
#ifdef MR_DEBUG_JMPBUFS
fprintf(stderr, ""throw longjmp %p\\n"",
- *(MR_ENGINE(e_jmp_buf)));
+ *(MR_ENGINE(MR_eng_jmp_buf)));
#endif
- MR_ENGINE(e_exception) = (MR_Word *) exception;
+ MR_ENGINE(MR_eng_exception) = (MR_Word *) exception;
MR_save_registers();
- longjmp(*(MR_ENGINE(e_jmp_buf)), 1);
+ longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1);
}
/*
** Otherwise, the handler is a Mercury closure.
** Invoke the handler as `Handler(Exception, Result)'.
*/
+
+#ifdef MR_DEEP_PROFILING
+ MR_fatal_error(""builtin_throw cannot (yet) invoke Mercury handlers in deep profiling grades"");
+#endif
+
MR_r1 = handler; /* get the Handler closure */
MR_r2 = 1; /* One additional input argument */
MR_r3 = 1; /* One output argument */
@@ -1815,21 +1925,48 @@
MR_END_MODULE
+#endif /* ! MR_HIGHLEVEL_CODE */
/* Ensure that the initialization code for the above module gets run. */
/*
INIT mercury_sys_init_exceptions
*/
-/* suppress gcc -Wmissing-decls warning */
-void mercury_sys_init_exceptions(void);
-
-void mercury_sys_init_exceptions(void) {
+void
+mercury_sys_init_exceptions_init(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
exceptions_module();
+#endif
}
-#endif /* ! MR_HIGHLEVEL_CODE */
+void
+mercury_sys_init_exceptions_init_type_tables(void)
+{
+ /* no types to register */
+}
+#ifdef MR_DEEP_PROFILING
+void
+mercury_sys_init_exceptions_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 0));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 1));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 2));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 3));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 4));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_catch, 3, 5));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_user_name(exception, builtin_throw, 1, 0));
+}
+#endif
+
").
%-----------------------------------------------------------------------------%
@@ -1842,8 +1979,10 @@
report_uncaught_exception(Exception) -->
try_io(report_uncaught_exception_2(Exception), Result),
- ( { Result = succeeded(_) }
- ; { Result = exception(_) }
+ (
+ { Result = succeeded(_) }
+ ;
+ { Result = exception(_) }
% if we got a further exception while trying to report
% the uncaught exception, just ignore it
).
Index: library/gc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/gc.m,v
retrieving revision 1.5
diff -u -b -r1.5 gc.m
--- library/gc.m 2001/03/15 07:42:22 1.5
+++ library/gc.m 2001/05/03 06:41:38
@@ -42,8 +42,9 @@
#ifdef CONSERVATIVE_GC
#ifndef MR_HIGHLEVEL_CODE
/* clear out the stacks and registers before garbage collecting */
- MR_clear_zone_for_GC(MR_CONTEXT(detstack_zone), MR_sp + 1);
- MR_clear_zone_for_GC(MR_CONTEXT(nondetstack_zone), MR_maxfr + 1);
+ MR_clear_zone_for_GC(MR_CONTEXT(MR_ctxt_detstack_zone), MR_sp + 1);
+ MR_clear_zone_for_GC(MR_CONTEXT(MR_ctxt_nondetstack_zone),
+ MR_maxfr + 1);
MR_clear_regs_for_GC();
#endif
Index: library/library.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.56
diff -u -b -r1.56 library.m
--- library/library.m 2001/03/15 07:42:23 1.56
+++ library/library.m 2001/05/03 06:41:38
@@ -42,7 +42,7 @@
:- import_module bitmap.
:- import_module hash_table.
-:- import_module builtin, private_builtin, table_builtin.
+:- import_module builtin, private_builtin, table_builtin, profiling_builtin.
% library__version must be implemented using pragma c_code,
% so we can get at the MR_VERSION and MR_FULLARCH configuration
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.75
diff -u -b -r1.75 private_builtin.m
--- library/private_builtin.m 2001/05/14 14:34:13 1.75
+++ library/private_builtin.m 2001/05/15 07:17:04
@@ -362,24 +362,22 @@
% The definitions for type_ctor_info/1 and type_info/1.
-:- pragma foreign_code("C", "
-
-#ifdef MR_HIGHLEVEL_CODE
+:- pragma c_header_code("
+#ifdef MR_DEEP_PROFILING
+#include ""mercury_deep_profiling.h""
+#endif
+").
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void sys_init_type_info_module(void);
+:- pragma foreign_code("C", "
-/*
-** This empty initialization function is needed just to
-** match the one that we use for LLDS grades.
-*/
-void
-sys_init_type_info_module(void)
-{
- /* no initialization needed */
-}
+/* forward decls, to suppress gcc -Wmissing-decl warnings */
+void sys_init_type_info_module_init(void);
+void sys_init_type_info_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_type_info_module_write_out_proc_statics(FILE *fp);
+#endif
-#else
+#ifndef MR_HIGHLEVEL_CODE
/*
** For most purposes, type_ctor_info can be treated just like
@@ -457,8 +455,13 @@
INIT sys_init_type_info_module
*/
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc type_info_module;
-void sys_init_type_info_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_type_info_module(void) {
+
+#endif /* ! MR_HIGHLEVEL_CODE */
+
+void
+sys_init_type_info_module_init(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
type_info_module();
MR_INIT_TYPE_CTOR_INFO(
@@ -473,7 +476,12 @@
MR_INIT_TYPE_CTOR_INFO(
mercury_data_private_builtin__type_ctor_info_typeclass_info_1,
private_builtin__typeclass_info_1_0);
+#endif
+}
+void
+sys_init_type_info_module_init_type_tables(void)
+{
MR_register_type_ctor_info(
&mercury_data_private_builtin__type_ctor_info_type_ctor_info_1);
MR_register_type_ctor_info(
@@ -484,7 +492,13 @@
&mercury_data_private_builtin__type_ctor_info_typeclass_info_1);
}
-#endif /* ! MR_HIGHLEVEL_CODE */
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_type_info_module_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
").
Index: library/profiling_builtin.m
===================================================================
RCS file: profiling_builtin.m
diff -N profiling_builtin.m
--- /dev/null Fri Dec 1 02:25:58 2000
+++ profiling_builtin.m Sun May 13 01:16:44 2001
@@ -0,0 +1,918 @@
+%---------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%---------------------------------------------------------------------------%
+%
+% File: profiling_builtin.m.
+% Authors: conway, zs.
+% Stability: low.
+%
+% This file is automatically imported into every module when deep profiling
+% is enabled. It contains support predicates used for deep profiling.
+% The tasks of the support predicates are described in some detail in
+% ``Engineering a profiler for a logic programming language'' by Thomas Conway
+% and Zoltan Somogyi.
+%
+%---------------------------------------------------------------------------%
+
+:- module profiling_builtin.
+
+:- interface.
+
+:- type proc_static.
+:- type proc_dynamic.
+:- type call_site_dynamic.
+
+:- impure pred prepare_for_normal_call(call_site_dynamic::in, int::in) is det.
+
+:- impure pred prepare_for_special_call(call_site_dynamic::in, int::in,
+ c_pointer::in) is det.
+
+:- impure pred prepare_for_ho_call(call_site_dynamic::in, int::in,
+ c_pointer::in) is det.
+
+:- impure pred prepare_for_callback(call_site_dynamic::in, int::in) is det.
+
+:- impure pred det_call_port_code_ac(proc_static::in,
+ call_site_dynamic::out, call_site_dynamic::out) is det.
+
+:- impure pred det_call_port_code_sr(proc_static::in, call_site_dynamic::out,
+ call_site_dynamic::out, proc_dynamic::out) is det.
+
+:- impure pred det_exit_port_code_ac(call_site_dynamic::in,
+ call_site_dynamic::in) is det.
+
+:- impure pred det_exit_port_code_sr(call_site_dynamic::in,
+ call_site_dynamic::in, proc_dynamic::in) is det.
+
+:- impure pred semi_call_port_code_ac(proc_static::in,
+ call_site_dynamic::out, call_site_dynamic::out) is det.
+
+:- impure pred semi_call_port_code_sr(proc_static::in, call_site_dynamic::out,
+ call_site_dynamic::out, proc_dynamic::out) is det.
+
+:- impure pred semi_exit_port_code_ac(call_site_dynamic::in,
+ call_site_dynamic::in) is det.
+
+:- impure pred semi_exit_port_code_sr(call_site_dynamic::in,
+ call_site_dynamic::in, proc_dynamic::in) is det.
+
+:- impure pred semi_fail_port_code_ac(call_site_dynamic::in,
+ call_site_dynamic::in) is failure.
+
+:- impure pred semi_fail_port_code_sr(call_site_dynamic::in,
+ call_site_dynamic::in, proc_dynamic::in) is failure.
+
+:- impure pred non_call_port_code_ac(proc_static::in, call_site_dynamic::out,
+ call_site_dynamic::out, proc_dynamic::out) is det.
+
+:- impure pred non_call_port_code_sr(proc_static::in, call_site_dynamic::out,
+ call_site_dynamic::out, proc_dynamic::out, proc_dynamic::out) is det.
+
+:- impure pred non_exit_port_code_ac(call_site_dynamic::in,
+ call_site_dynamic::in) is det.
+
+:- impure pred non_exit_port_code_sr(call_site_dynamic::in,
+ call_site_dynamic::in, proc_dynamic::in) is det.
+
+:- impure pred non_redo_port_code_ac(call_site_dynamic::in, proc_dynamic::in)
+ is failure.
+
+:- impure pred non_redo_port_code_sr(call_site_dynamic::in, proc_dynamic::in)
+ is failure.
+
+:- impure pred non_fail_port_code_ac(call_site_dynamic::in,
+ call_site_dynamic::in) is failure.
+
+:- impure pred non_fail_port_code_sr(call_site_dynamic::in,
+ call_site_dynamic::in, proc_dynamic::in) is failure.
+
+:- impure pred inner_call_port_code(proc_static::in, call_site_dynamic::out)
+ is det.
+
+:- impure pred set_outermost_activation_ptr(call_site_dynamic::in,
+ proc_dynamic::in) is det.
+
+:- impure pred save_and_zero_activation_info_ac(call_site_dynamic::in,
+ int::out, proc_dynamic::out) is det.
+
+:- impure pred save_and_zero_activation_info_sr(call_site_dynamic::in,
+ proc_dynamic::out) is det.
+
+:- impure pred rezero_activation_info_ac(call_site_dynamic::in) is det.
+
+:- impure pred rezero_activation_info_sr(call_site_dynamic::in) is det.
+
+:- impure pred reset_activation_info_ac(call_site_dynamic::in,
+ int::in, proc_dynamic::in) is det.
+
+:- impure pred reset_activation_info_sr(call_site_dynamic::in,
+ proc_dynamic::in) is det.
+
+:- impure pred set_current_csd(call_site_dynamic::in) is det.
+
+:- impure pred save_recursion_depth_count(call_site_dynamic::in,
+ int::in, int::out) is det.
+
+:- impure pred restore_recursion_depth_count_exit(
+ call_site_dynamic::in, int::in, int::in) is det.
+
+:- impure pred restore_recursion_depth_count_fail(
+ call_site_dynamic::in, int::in, int::in) is det.
+
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- type proc_static ---> proc_static(c_pointer).
+:- type proc_dynamic ---> proc_dynamic(c_pointer).
+:- type call_site_dynamic ---> call_site_dynamic(c_pointer).
+
+:- pragma foreign_decl("C", "
+#ifndef MR_DEEP_PROFILING_GUARD
+#define MR_DEEP_PROFILING_GUARD
+
+ #ifdef MR_DEEP_PROFILING
+
+ #include ""mercury_deep_profiling.h""
+ #include ""mercury_ho_call.h""
+ #include <stdio.h>
+
+ #endif /* MR_DEEP_PROFILING */
+
+#endif /* MR_DEEP_PROFILING_GUARD */
+").
+
+%---------------------------------------------------------------------------%
+% Call port procedures
+%---------------------------------------------------------------------------%
+
+:- pragma c_code(det_call_port_code_ac(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+#define MR_PROCNAME ""det_call_port_code_ac""
+#define MR_VERSION_AC
+#undef MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(semi_call_port_code_ac(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+#define MR_PROCNAME ""semi_call_port_code_ac""
+#define MR_VERSION_AC
+#undef MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(non_call_port_code_ac(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out, NewOutermostActivationPtr::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+/* shut up warning: NewOutermostActivationPtr */
+#define MR_PROCNAME ""non_call_port_code_ac""
+#define MR_VERSION_AC
+#define MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_AC
+#undef MR_NEED_NEW_OUTERMOST
+}").
+
+:- pragma c_code(det_call_port_code_sr(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out, OldOutermostActivationPtr::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+/* shut up warning: OldOutermostActivationPtr */
+#define MR_PROCNAME ""det_call_port_code_sr""
+#define MR_VERSION_SR
+#undef MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(semi_call_port_code_sr(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out, OldOutermostActivationPtr::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+/* shut up warning: OldOutermostActivationPtr */
+#define MR_PROCNAME ""semi_call_port_code_sr""
+#define MR_VERSION_SR
+#undef MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(non_call_port_code_sr(ProcStatic::in, TopCSD::out,
+ MiddleCSD::out, OldOutermostActivationPtr::out,
+ NewOutermostActivationPtr::out),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
+/* shut up warning: OldOutermostActivationPtr, NewOutermostActivationPtr */
+#define MR_PROCNAME ""non_call_port_code_sr""
+#define MR_VERSION_SR
+#define MR_NEED_NEW_OUTERMOST
+#include ""mercury_deep_call_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_SR
+#undef MR_NEED_NEW_OUTERMOST
+}").
+
+%---------------------------------------------------------------------------%
+% Exit/Fail port procedures
+%---------------------------------------------------------------------------%
+
+:- pragma c_code(det_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD */
+#define MR_PROCNAME ""det_exit_port_code_ac""
+#define MR_EXIT_PORT
+#define MR_VERSION_AC
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(det_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+ OldOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
+#define MR_PROCNAME ""det_exit_port_code_sr""
+#define MR_EXIT_PORT
+#define MR_VERSION_SR
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(semi_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD */
+#define MR_PROCNAME ""semi_exit_port_code_ac""
+#define MR_EXIT_PORT
+#define MR_VERSION_AC
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(semi_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+ OldOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
+#define MR_PROCNAME ""semi_exit_port_code_sr""
+#define MR_EXIT_PORT
+#define MR_VERSION_SR
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(semi_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD */
+#define MR_PROCNAME ""semi_exit_port_code_ac""
+#define MR_FAIL_PORT
+#define MR_VERSION_AC
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_FAIL_PORT
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(semi_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
+ OldOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
+#define MR_PROCNAME ""semi_fail_port_code_sr""
+#define MR_FAIL_PORT
+#define MR_VERSION_SR
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_FAIL_PORT
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(non_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD */
+#define MR_PROCNAME ""non_exit_port_code_ac""
+#define MR_EXIT_PORT
+#define MR_VERSION_AC
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(non_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
+ OldOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
+#define MR_PROCNAME ""non_exit_port_code_sr""
+#define MR_EXIT_PORT
+#define MR_VERSION_SR
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_EXIT_PORT
+#undef MR_VERSION_SR
+}").
+
+:- pragma c_code(non_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD */
+#define MR_PROCNAME ""non_exit_port_code_ac""
+#define MR_FAIL_PORT
+#define MR_VERSION_AC
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_FAIL_PORT
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(non_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
+ OldOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
+#define MR_PROCNAME ""non_fail_port_code_sr""
+#define MR_FAIL_PORT
+#define MR_VERSION_SR
+#include ""mercury_deep_leave_port_body.h""
+#undef MR_PROCNAME
+#undef MR_FAIL_PORT
+#undef MR_VERSION_SR
+}").
+
+%---------------------------------------------------------------------------%
+% Redo port procedures
+%---------------------------------------------------------------------------%
+
+:- pragma c_code(non_redo_port_code_ac(MiddleCSD::in,
+ NewOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: MiddleCSD, NewOutermostActivationPtr */
+#define MR_PROCNAME ""non_redo_port_code_ac""
+#define MR_VERSION_AC
+#include ""mercury_deep_redo_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_AC
+}").
+
+:- pragma c_code(non_redo_port_code_sr(MiddleCSD::in,
+ NewOutermostActivationPtr::in),
+ [thread_safe, will_not_call_mercury],
+"{
+/* shut up warning: MiddleCSD, NewOutermostActivationPtr */
+#define MR_PROCNAME ""non_redo_port_code_sr""
+#define MR_VERSION_SR
+#include ""mercury_deep_redo_port_body.h""
+#undef MR_PROCNAME
+#undef MR_VERSION_SR
+}").
+
+%---------------------------------------------------------------------------%
+% Procedures that prepare for calls
+%---------------------------------------------------------------------------%
+
+:- pragma c_code(prepare_for_normal_call(CSD::in, N::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_CallSiteDynamic *child_csd;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+
+ child_csd = pd->MR_pd_call_site_ptr_ptrs[N];
+
+ #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++;
+ }
+ #endif
+
+ if (child_csd == NULL) {
+ MR_new_call_site_dynamic(child_csd);
+ pd->MR_pd_call_site_ptr_ptrs[N] = child_csd;
+ }
+
+ MR_next_call_site_dynamic = child_csd;
+ MR_leave_instrumentation();
+#else
+ MR_fatal_error(""prepare_for_normal_call: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(prepare_for_special_call(CSD::in, CSN::in, TInfo::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_CallSiteDynList *csdlist;
+ #ifdef MR_DEEP_PROFILING_MOVE_TO_FRONT_LISTS
+ MR_CallSiteDynList *prev = NULL;
+ #endif
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeInfo type_info;
+ void *void_key;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+
+ type_info = (MR_TypeInfo) TInfo;
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+ void_key = (void *) type_ctor_info;
+ MR_search_csdlist(csdlist, prev, pd, CSN, void_key);
+ MR_maybe_deep_profile_update_special_history(type_ctor_info);
+
+ #ifdef MR_DEEP_PROFILING_STATISTICS
+ if (csdlist != NULL) {
+ MR_deep_prof_prep_special_old++;
+ } else {
+ MR_deep_prof_prep_special_new++;
+ }
+ #endif
+
+ if (csdlist != NULL) {
+ MR_next_call_site_dynamic = csdlist->MR_csdlist_call_site;
+ } else {
+ MR_CallSiteDynamic *newcsd;
+
+ MR_new_call_site_dynamic(newcsd);
+ MR_make_and_link_csdlist(csdlist, newcsd, pd, CSN, void_key);
+ MR_next_call_site_dynamic = newcsd;
+ }
+
+ MR_leave_instrumentation();
+#else
+ MR_fatal_error(""prepare_for_special_call: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(prepare_for_ho_call(CSD::in, CSN::in, Closure::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_Closure *closure;
+ MR_CallSiteDynList *csdlist;
+ void *void_key;
+ #ifdef MR_DEEP_PROFILING_MOVE_TO_FRONT_LISTS
+ MR_CallSiteDynList *prev = NULL;
+ #endif
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ closure = (MR_Closure *) Closure;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+
+ #ifdef MR_DEEP_PROFILING_KEY_USES_ID
+ void_key = (void *) (closure->MR_closure_layout);
+ #else
+ void_key = (void *) (closure->MR_closure_code);
+ #endif
+
+ MR_search_csdlist(csdlist, prev, pd, CSN, void_key);
+ MR_maybe_deep_profile_update_closure_history(closure);
+
+ #ifdef MR_DEEP_PROFILING_STATISTICS
+ if (csdlist != NULL) {
+ MR_deep_prof_prep_ho_old++;
+ } else {
+ MR_deep_prof_prep_ho_new++;
+ }
+ #endif
+
+ if (csdlist != NULL) {
+ MR_next_call_site_dynamic = csdlist->MR_csdlist_call_site;
+ } else {
+ MR_CallSiteDynamic *newcsd;
+
+ MR_new_call_site_dynamic(newcsd);
+ MR_make_and_link_csdlist(csdlist, newcsd, pd, CSN, void_key);
+ MR_next_call_site_dynamic = newcsd;
+ }
+
+ MR_leave_instrumentation();
+#else
+ MR_fatal_error(""prepare_for_ho_call: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(prepare_for_callback(CSD::in, N::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynamic *csd;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ MR_deep_assert(csd->MR_csd_callee_ptr != NULL);
+
+ MR_current_callback_site = (MR_CallSiteDynList **)
+ &(csd->MR_csd_callee_ptr->MR_pd_call_site_ptr_ptrs[N]);
+ MR_leave_instrumentation();
+#else
+ MR_fatal_error(""prepare_for_callback: deep profiling not enabled"");
+#endif
+}").
+
+%---------------------------------------------------------------------------%
+% Procedures needed for handling directly recursive procedures
+%---------------------------------------------------------------------------%
+
+:- pragma c_code(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
+ MR_CallSiteDynamic *csd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+
+ #ifdef MR_DEEP_PROFILING_LOWLEVEL_DEBUG
+ MR_print_deep_prof_vars(stdout);
+ #endif
+
+ MiddleCSD = (MR_Word) MR_next_call_site_dynamic;
+ MR_current_call_site_dynamic = MR_next_call_site_dynamic;
+ csd = MR_current_call_site_dynamic;
+ csd->MR_csd_depth_count++;
+ ps = (MR_ProcStatic *) ProcStatic;
+
+ MR_deep_assert(ps->MR_ps_outermost_activation_ptr != NULL);
+
+ if (csd->MR_csd_callee_ptr == NULL) {
+ csd->MR_csd_callee_ptr = ps->MR_ps_outermost_activation_ptr;
+ }
+
+ MR_leave_instrumentation();
+ #endif
+#else
+ MR_fatal_error(""create_proc_dynamic_inner: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(set_current_csd(CSD::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_current_call_site_dynamic = (MR_CallSiteDynamic *) CSD;
+#else
+ MR_fatal_error(""set_current_csd: deep profiling not enabled"");
+#endif
+}").
+
+:- impure pred increment_activation_count(call_site_dynamic::in,
+ proc_dynamic::in) is det.
+
+:- pragma c_code(increment_activation_count(CSD::in, PD::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+ MR_deep_assert(ps != NULL);
+
+ ps->MR_ps_activation_count++;
+ ps->MR_ps_outermost_activation_ptr = (MR_ProcDynamic *) PD;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""increment_activation_count: no activation_count"");
+ #endif
+#else
+ MR_fatal_error(""increment_activation_count: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(set_outermost_activation_ptr(CSD::in, Ptr::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ ps->MR_ps_outermost_activation_ptr = (MR_ProcDynamic *) Ptr;
+ MR_leave_instrumentation();
+#else
+ MR_fatal_error(""set_outermost_activation_ptr: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(
+ save_and_zero_activation_info_ac(CSD::in, Count::out, Ptr::out),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ Count = ps->MR_ps_activation_count;
+ ps->MR_ps_activation_count = 0;
+ Ptr = (MR_Word) ps->MR_ps_outermost_activation_ptr;
+ ps->MR_ps_outermost_activation_ptr = NULL;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""save_and_zero_activation_info_ac called when not using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""save_and_zero_activation_info_ac: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(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
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ Ptr = (MR_Word) ps->MR_ps_outermost_activation_ptr;
+ ps->MR_ps_outermost_activation_ptr = NULL;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""save_and_zero_activation_info_sr called when using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""save_and_zero_activation_info_sr: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(rezero_activation_info_ac(CSD::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ ps->MR_ps_activation_count = 0;
+ ps->MR_ps_outermost_activation_ptr = NULL;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""rezero_activation_info_ac called when not using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""rezero_activation_info_ac: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(rezero_activation_info_sr(CSD::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ #ifndef MR_USE_ACTIVATION_COUNTS
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ ps->MR_ps_outermost_activation_ptr = NULL;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""rezero_activation_info_sr called when using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""rezero_activation_info_sr: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(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
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ ps->MR_ps_activation_count = Count;
+ ps->MR_ps_outermost_activation_ptr = (MR_ProcDynamic *) Ptr;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""reset_activation_info_ac called when not using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""reset_activation_info_ac: deep profiling not enabled"");
+#endif
+}").
+
+:- pragma c_code(reset_activation_info_sr(CSD::in, Ptr::in),
+ [thread_safe, will_not_call_mercury], "{
+#ifdef MR_DEEP_PROFILING
+ #ifndef MR_USE_ACTIVATION_COUNTS
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) CSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+
+ ps->MR_ps_outermost_activation_ptr = (MR_ProcDynamic *) Ptr;
+ MR_leave_instrumentation();
+ #else
+ MR_fatal_error(""reset_activation_info_sr called when using activation counts!"");
+ #endif
+#else
+ MR_fatal_error(""reset_activation_info_sr: deep profiling not enabled"");
+#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;
+
+ 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) {
+ Count = inner_csd->MR_csd_depth_count;
+ } else {
+ Count = 0;
+ }
+ 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
+}").
+
+:- 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;
+
+ 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;
+
+ inner_csd->MR_csd_depth_count = OuterCount;
+ } else {
+ MR_deep_assert(OuterCount == 0);
+ }
+ 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
+}").
+
+:- 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;
+
+ 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;
+
+ inner_csd->MR_csd_depth_count = OuterCount;
+ } else {
+ MR_deep_assert(OuterCount == 0);
+ }
+ 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
+}").
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.229
diff -u -b -r1.229 std_util.m
--- library/std_util.m 2001/05/14 13:24:50 1.229
+++ library/std_util.m 2001/05/15 07:17:04
@@ -888,9 +888,9 @@
MR_MemoryZone *temp_zone;
MR_Word *temp_hp;
- temp_zone = MR_ENGINE(heap_zone);
- MR_ENGINE(heap_zone) = MR_ENGINE(solutions_heap_zone);
- MR_ENGINE(solutions_heap_zone) = temp_zone;
+ temp_zone = MR_ENGINE(MR_eng_heap_zone);
+ MR_ENGINE(MR_eng_heap_zone) = MR_ENGINE(MR_eng_solutions_heap_zone);
+ MR_ENGINE(MR_eng_solutions_heap_zone) = temp_zone;
temp_hp = MR_hp;
MR_hp = MR_sol_hp;
MR_sol_hp = temp_hp;
@@ -942,7 +942,7 @@
MR_save_transient_hp(); \\
NewVal = MR_deep_copy(&OldVal, (MR_TypeInfo) TypeInfo_for_T,\\
(const MR_Word *) SolutionsHeapPtr, \\
- MR_ENGINE(solutions_heap_zone)->top); \\
+ MR_ENGINE(MR_eng_solutions_heap_zone)->top);\\
MR_restore_transient_hp(); \\
} while (0)
#endif
@@ -1238,22 +1238,28 @@
:- pragma foreign_code("C", "
-#ifdef MR_HIGHLEVEL_CODE
+#include ""mercury_deep_profiling_hand.h""
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void sys_init_unify_type_desc_module(void);
-
+/* Ensure that the initialization code for the above module gets run. */
/*
-** This empty initialization function is needed just to
-** match the one that we use for LLDS grades.
+INIT sys_init_type_desc_module
*/
-void
-sys_init_unify_type_desc_module(void)
-{
- /* no initialization needed */
-}
-#else
+/* suppress gcc -Wmissing-decl warnings */
+void sys_init_type_desc_module_init(void);
+void sys_init_type_desc_module_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void sys_init_type_desc_module_write_out_proc_statics(FILE *);
+#endif
+
+#ifndef MR_HIGHLEVEL_CODE
+
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_compiler_empty(std_util, __Unify__, type_desc, 0, 0,
+ ""std_util.m"");
+MR_proc_static_compiler_empty(std_util, __Compare__, type_desc, 0, 0,
+ ""std_util.m"");
+#endif
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, type_desc, 0,
MR_TYPECTOR_REP_TYPEINFO);
@@ -1261,58 +1267,96 @@
MR_define_extern_entry(mercury____Unify___std_util__type_desc_0_0);
MR_define_extern_entry(mercury____Compare___std_util__type_desc_0_0);
-MR_BEGIN_MODULE(unify_type_desc_module)
+MR_BEGIN_MODULE(type_desc_module)
MR_init_entry(mercury____Unify___std_util__type_desc_0_0);
MR_init_entry(mercury____Compare___std_util__type_desc_0_0);
+#ifdef MR_DEEP_PROFILING
+ MR_init_label(mercury____Unify___std_util__type_desc_0_0_i1);
+ MR_init_label(mercury____Unify___std_util__type_desc_0_0_i2);
+ MR_init_label(mercury____Unify___std_util__type_desc_0_0_i3);
+ MR_init_label(mercury____Unify___std_util__type_desc_0_0_i4);
+ MR_init_label(mercury____Compare___std_util__type_desc_0_0_i1);
+ MR_init_label(mercury____Compare___std_util__type_desc_0_0_i2);
+#endif
MR_BEGIN_CODE
-MR_define_entry(mercury____Unify___std_util__type_desc_0_0);
-{
- /*
- ** Unification for type_desc.
- */
- int comp;
- MR_save_transient_registers();
- comp = MR_compare_type_info((MR_TypeInfo) MR_r1, (MR_TypeInfo) MR_r2);
- MR_restore_transient_registers();
- MR_r1 = (comp == MR_COMPARE_EQUAL);
- MR_proceed();
-}
+#define proc_label mercury____Unify___std_util__type_desc_0_0
+#define proc_static MR_proc_static_compiler_name(std_util, __Unify__, \
+ type_desc, 0, 0)
+#define body_code do { \
+ int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL); \
+ } while (0)
-MR_define_entry(mercury____Compare___std_util__type_desc_0_0);
-{
- /*
- ** Comparison for type_desc.
- */
- int comp;
+#include ""mercury_hand_unify_body.h""
- MR_save_transient_registers();
- comp = MR_compare_type_info((MR_TypeInfo) MR_r1, (MR_TypeInfo) MR_r2);
- MR_restore_transient_registers();
- MR_r1 = comp;
- MR_proceed();
-}
+#undef body_code
+#undef proc_static
+#undef proc_label
+
+#define proc_label mercury____Compare___std_util__type_desc_0_0
+#define proc_static MR_proc_static_compiler_name(std_util, __Compare__, \
+ type_desc, 0, 0)
+#define body_code do { \
+ int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp; \
+ } while (0)
+#include ""mercury_hand_compare_body.h""
+
+#undef body_code
+#undef proc_static
+#undef proc_label
+
MR_END_MODULE
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_unify_type_desc_module
-*/
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc unify_type_desc_module;
-void sys_init_unify_type_desc_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_unify_type_desc_module(void) {
- unify_type_desc_module();
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc type_desc_module;
+
+#endif /* ! MR_HIGHLEVEL_CODE */
+
+void
+sys_init_type_desc_module_init(void)
+{
+#ifndef MR_HIGHLEVEL_CODE
+ type_desc_module();
MR_INIT_TYPE_CTOR_INFO(
mercury_data_std_util__type_ctor_info_type_desc_0,
std_util__type_desc_0_0);
+#endif
+}
+void
+sys_init_type_desc_module_init_type_tables(void)
+{
MR_register_type_ctor_info(
&mercury_data_std_util__type_ctor_info_type_desc_0);
}
-#endif /* ! MR_HIGHLEVEL_CODE */
+#ifdef MR_DEEP_PROFILING
+void
+sys_init_type_desc_module_write_out_proc_statics(FILE *fp)
+{
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(std_util, __Compare__, type_desc,
+ 0, 0));
+ MR_write_out_proc_static(fp, (MR_ProcStatic *)
+ &MR_proc_static_compiler_name(std_util, __Unify__, type_desc,
+ 0, 0));
+}
+#endif
").
@@ -2749,6 +2793,10 @@
:- pragma foreign_decl("C", "
#include <stdio.h>
+
+#ifdef MR_DEEP_PROFILING
+ #include ""mercury_deep_profiling.h""
+#endif
/*
** Code for functor, arg and deconstruct
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.144
diff -u -b -r1.144 string.m
--- library/string.m 2001/03/15 07:42:26 1.144
+++ library/string.m 2001/05/16 15:58:36
@@ -1828,19 +1828,21 @@
/*-----------------------------------------------------------------------*/
-/*
-:- pred string__append(string, string, string).
-:- mode string__append(in, in, in) is semidet. % implied
-:- mode string__append(in, out, in) is semidet.
-:- mode string__append(in, in, out) is det.
-:- mode string__append(out, out, in) is multi.
-*/
-
-/*
-:- mode string__append(in, in, in) is semidet.
-*/
+:- pragma promise_pure(string__append/3).
+
+string__append(S1::in, S2::in, S3::in) :-
+ string__append_iii(S1, S2, S3).
+string__append(S1::in, S2::out, S3::in) :-
+ string__append_ioi(S1, S2, S3).
+string__append(S1::in, S2::in, S3::out) :-
+ string__append_iio(S1, S2, S3).
+string__append(S1::out, S2::out, S3::in) :-
+ string__append_ooi(S1, S2, S3).
+
+:- pred string__append_iii(string::in, string::in, string::in) is semidet.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::in, S3::in),
+ string__append_iii(S1::in, S2::in, S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1 = strlen(S1);
SUCCESS_INDICATOR = (
@@ -1848,17 +1850,17 @@
strcmp(S2, S3 + len_1) == 0
);
}").
+
:- pragma foreign_proc("MC++",
- string__append(_S1::in, _S2::in, _S3::in),
+ string__append_iii(_S1::in, _S2::in, _S3::in),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""c code for this function"");
}").
-/*
-:- mode string__append(in, out, in) is semidet.
-*/
+:- pred string__append_ioi(string::in, string::out, string::in) is semidet.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::out,S3::in),
+ string__append_ioi(S1::in, S2::out,S3::in),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2, len_3;
@@ -1877,17 +1879,17 @@
SUCCESS_INDICATOR = TRUE;
}
}").
+
:- pragma foreign_proc("MC++",
- string__append(_S1::in, _S2::out, _S3::in),
+ string__append_ioi(_S1::in, _S2::out, _S3::in),
[will_not_call_mercury, thread_safe], "{
mercury::runtime::Errors::SORRY(""c code for this function"");
}").
-/*
-:- mode string__append(in, in, out) is det.
-*/
+:- pred string__append_iio(string::in, string::in, string::out) is det.
+
:- pragma foreign_proc("C",
- string__append(S1::in, S2::in, S3::out),
+ string__append_iio(S1::in, S2::in, S3::out),
[will_not_call_mercury, thread_safe], "{
size_t len_1, len_2;
len_1 = strlen(S1);
@@ -1896,58 +1898,54 @@
strcpy(S3, S1);
strcpy(S3 + len_1, S2);
}").
+
:- pragma foreign_proc("MC++",
- string__append(S1::in, S2::in, S3::out),
+ string__append_iio(S1::in, S2::in, S3::out),
[will_not_call_mercury, thread_safe], "{
S3 = System::String::Concat(S1, S2);
}").
+:- pred string__append_ooi(string::out, string::out, string::in) is multi.
+
+string__append_ooi(S1, S2, S3) :-
+ S3Len = string__length(S3),
+ string__append_ooi_2(0, S3Len, S1, S2, S3).
+
+:- pred string__append_ooi_2(int::in, int::in, string::out, string::out,
+ string::in) is multi.
+
+string__append_ooi_2(NextS1Len, S3Len, S1, S2, S3) :-
+ ( NextS1Len = S3Len ->
+ string__append_ooi_3(NextS1Len, S3Len, S1, S2, S3)
+ ;
+ (
+ string__append_ooi_3(NextS1Len, S3Len,
+ S1, S2, S3)
+ ;
+ string__append_ooi_2(NextS1Len + 1, S3Len,
+ S1, S2, S3)
+ )
+ ).
+
+:- pred string__append_ooi_3(int::in, int::in, string::out,
+ string::out, string::in) is det.
+
:- pragma foreign_proc("C",
- string__append(S1::out, S2::out, S3::in),
- [will_not_call_mercury, thread_safe],
- local_vars("
- MR_String s;
- size_t len;
- size_t count;
- "),
- first_code("
- LOCALS->s = S3;
- LOCALS->len = strlen(S3);
- LOCALS->count = 0;
- "),
- retry_code("
- LOCALS->count++;
- "),
- common_code("
- MR_allocate_aligned_string_msg(S1, LOCALS->count,
- MR_PROC_LABEL);
- memcpy(S1, LOCALS->s, LOCALS->count);
- S1[LOCALS->count] = '\\0';
- MR_allocate_aligned_string_msg(S2, LOCALS->len - LOCALS->count,
- MR_PROC_LABEL);
- strcpy(S2, LOCALS->s + LOCALS->count);
+ string__append_ooi_3(S1Len::in, S3Len::in, S1::out, S2::out, S3::in),
+ [will_not_call_mercury, thread_safe], "{
+ MR_allocate_aligned_string_msg(S1, S1Len, MR_PROC_LABEL);
+ memcpy(S1, S3, S1Len);
+ S1[S1Len] = '\\0';
+ MR_allocate_aligned_string_msg(S2, S3Len - S1Len, MR_PROC_LABEL);
+ strcpy(S2, S3 + S1Len);
+}").
- if (LOCALS->count < LOCALS->len) {
- SUCCEED;
- } else {
- SUCCEED_LAST;
- }
- ")
-).
:- pragma foreign_proc("MC++",
- string__append(_S1::out, _S2::out, _S3::in),
- [will_not_call_mercury, thread_safe],
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- common_code("
+ string__append_ooi_3(_S1Len::in, _S3Len::in,
+ _S1::out, _S2::out, _S3::in),
+ [will_not_call_mercury, thread_safe], "
mercury::runtime::Errors::SORRY(""c code for this function"");
- ")
-).
-
+").
/*-----------------------------------------------------------------------*/
Index: library/table_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/table_builtin.m,v
retrieving revision 1.8
diff -u -b -r1.8 table_builtin.m
--- library/table_builtin.m 2001/03/15 07:42:27 1.8
+++ library/table_builtin.m 2001/05/03 06:41:38
@@ -811,28 +811,44 @@
#endif
").
-/*
-** Note that the code for this is identical to the code for
-** table_multi_return_all_ans/2 (below).
-** Any changes to this code should also be made there.
-*/
-:- pragma foreign_proc("C",
- table_nondet_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
+table_nondet_return_all_ans(TrieNode, Answer) :-
+ semipure pickup_answer_list(TrieNode, CurNode0),
+ semipure table_nondet_return_all_ans_2(CurNode0, Answer).
+
+table_multi_return_all_ans(TrieNode, Answer) :-
+ semipure pickup_answer_list(TrieNode, CurNode0),
+ ( semipure return_next_answer(CurNode0, FirstAnswer, CurNode1) ->
+ (
+ Answer = FirstAnswer
+ ;
+ semipure table_nondet_return_all_ans_2(CurNode1,
+ Answer)
+ )
+ ;
+ error("table_multi_return_all_ans: no first answer")
+ ).
+
+:- semipure pred table_nondet_return_all_ans_2(c_pointer::in,
+ ml_answer_block::out) is nondet.
+
+table_nondet_return_all_ans_2(CurNode0, Answer) :-
+ semipure return_next_answer(CurNode0, FirstAnswer, CurNode1),
+ (
+ Answer = FirstAnswer
+ ;
+ semipure table_nondet_return_all_ans_2(CurNode1, Answer)
+ ).
+
+:- semipure pred pickup_answer_list(ml_subgoal_table_node::in, c_pointer::out)
+ is det.
+
+:- pragma foreign_proc("C", pickup_answer_list(T::in, CurNode::out),
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
MR_TrieNode table;
table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
+ CurNode = (MR_Word) table->MR_subgoal->answer_list;
#ifdef MR_TABLE_DEBUG
if (MR_tabledebug) {
@@ -840,73 +856,30 @@
table, table->MR_subgoal);
}
#endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
- } else {
- A = (MR_Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
- }
-#else
- MR_fatal_error(""minimal model code entered when not enabled"");
#endif
- ")
-).
+").
+
+:- semipure pred return_next_answer(c_pointer::in, ml_answer_block::out,
+ c_pointer::out) is semidet.
-/*
-** Note that the code for this is identical to the code for
-** table_nondet_return_all_ans/2 (above).
-** Any changes to this code should also be made there.
-*/
:- pragma foreign_proc("C",
- table_multi_return_all_ans(T::in, A::out),
- will_not_call_mercury,
- local_vars("
+ return_next_answer(CurNode0::in, AnswerBlock::out, CurNode::out),
+ [will_not_call_mercury], "
#ifdef MR_USE_MINIMAL_MODEL
- MR_AnswerList cur_node;
-#else
- /* ensure local var struct is non-empty */
- char bogus;
-#endif
- "),
- first_code("
-#ifdef MR_USE_MINIMAL_MODEL
- MR_TrieNode table;
+ MR_AnswerList cur_node0;
- table = (MR_TrieNode) T;
- LOCALS->cur_node = table->MR_subgoal->answer_list;
-
- #ifdef MR_TABLE_DEBUG
- if (MR_tabledebug) {
- printf(""restoring all answers in %p -> %p\\n"",
- table, table->MR_subgoal);
- }
- #endif
-#endif
- "),
- retry_code("
- "),
- shared_code("
-#ifdef MR_USE_MINIMAL_MODEL
- if (LOCALS->cur_node == NULL) {
- FAIL;
+ cur_node0 = (MR_AnswerList *) CurNode0;
+ if (cur_node0 == NULL) {
+ SUCCESS_INDICATOR = FALSE;
} else {
- A = (MR_Word) &LOCALS->cur_node->answer_data;
- LOCALS->cur_node = LOCALS->cur_node->next_answer;
- SUCCEED;
+ AnswerBlock = (MR_Word) &cur_node0->answer_data;
+ CurNode = (MR_Word) cur_node0->next_answer;
+ SUCCESS_INDICATOR = TRUE;
}
#else
MR_fatal_error(""minimal model code entered when not enabled"");
#endif
- ")
-).
-
+").
:- pragma foreign_proc("MC++",
table_nondet_is_complete(_T::in), [will_not_call_mercury], "
@@ -941,38 +914,17 @@
mercury::runtime::Errors::SORRY(""foreign code for this function"");
").
+:- pragma foreign_proc("MC++",
+ pickup_answer_list(_T::in, _CurNode::out),
+ [will_not_call_mercury], "
+ mercury::runtime::Errors::SORRY(""foreign code for this function"");
+").
+
:- pragma foreign_proc("MC++",
- table_nondet_return_all_ans(_T::in, _A::out),
- will_not_call_mercury,
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- shared_code("
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
- ")
-).
-
-/*
-** Note that the code for this is identical to the code for
-** table_nondet_return_all_ans/2 (above).
-** Any changes to this code should also be made there.
-*/
-:- pragma foreign_proc("MC++",
- table_multi_return_all_ans(_T::in, _A::out),
- will_not_call_mercury,
- local_vars("
- "),
- first_code("
- "),
- retry_code("
- "),
- shared_code("
+ return_next_answer(_CurNode0::in, _AnswerBlock::out, _CurNode::out),
+ [will_not_call_mercury], "
mercury::runtime::Errors::SORRY(""foreign code for this function"");
- ")
-).
+").
%-----------------------------------------------------------------------------%
cvs diff: Diffing profiler
Index: profiler/demangle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/profiler/demangle.m,v
retrieving revision 1.11
diff -u -b -r1.11 demangle.m
--- profiler/demangle.m 2000/11/11 13:36:53 1.11
+++ profiler/demangle.m 2001/05/03 06:41:38
@@ -270,6 +270,12 @@
{ IntroducedPredType = type_spec(TypeSpec) },
{ Seq = 0 },
{ Line = 0 }
+
+ % The compiler adds a redundant mode
+ % number to the predicate name to avoid
+ % creating two predicates with the same
+ % name (deep profiling doesn't like that).
+ % It isn't used here so we just ignore it.
;
{ IntroducedPredType = IntroducedPredType0 },
remove_int(Line),
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.70
diff -u -b -r1.70 Mmakefile
--- runtime/Mmakefile 2001/03/16 01:40:39 1.70
+++ runtime/Mmakefile 2001/05/03 06:41:39
@@ -43,6 +43,8 @@
mercury_context.h \
mercury_debug.h \
mercury_deep_copy.h \
+ mercury_deep_profiling.h \
+ mercury_deep_profiling_hand.h \
mercury_dummy.h \
mercury_dlist.h \
mercury_engine.h \
@@ -67,6 +69,7 @@
mercury_overflow.h \
mercury_prof.h \
mercury_prof_mem.h \
+ mercury_prof_time.h \
mercury_reg_workarounds.h \
mercury_regorder.h \
mercury_regs.h \
@@ -75,6 +78,7 @@
mercury_stack_layout.h \
mercury_stack_trace.h \
mercury_stacks.h \
+ mercury_strerror.h \
mercury_string.h \
mercury_tabling.h \
mercury_tabling_macros.h \
@@ -94,7 +98,13 @@
# They do not have to be syntactically well-formed.
BODY_HDRS = \
+ mercury_deep_call_port_body.h \
mercury_deep_copy_body.h \
+ mercury_deep_leave_port_body.h \
+ mercury_deep_redo_port_body.h \
+ mercury_exception_catch_body.h \
+ mercury_hand_compare_body.h \
+ mercury_hand_unify_body.h \
mercury_make_type_info_body.h \
mercury_unify_compare_body.h
@@ -123,6 +133,7 @@
mercury_context.c \
mercury_debug.c \
mercury_deep_copy.c \
+ mercury_deep_profiling.c \
mercury_dlist.c \
mercury_dummy.c \
mercury_engine.c \
@@ -142,11 +153,13 @@
mercury_misc.c \
mercury_prof.c \
mercury_prof_mem.c \
+ mercury_prof_time.c \
mercury_reg_workarounds.c \
mercury_regs.c \
mercury_signal.c \
mercury_stack_trace.c \
mercury_stacks.c \
+ mercury_strerror.c \
mercury_string.c \
mercury_tabling.c \
mercury_thread.c \
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.24
diff -u -b -r1.24 mercury.c
--- runtime/mercury.c 2001/02/04 04:10:41 1.24
+++ runtime/mercury.c 2001/05/03 06:41:39
@@ -886,6 +886,8 @@
return (MR_Box) ptr;
}
+#endif /* ! MR_HIGHLEVEL_CODE */
+
/*---------------------------------------------------------------------------*/
/*
@@ -893,12 +895,17 @@
ENDINIT
*/
-/* forward decl, to suppress gcc -Wmissing-decl warning. */
-void mercury_sys_init_mercury_hlc(void);
+/* forward decls, to suppress gcc -Wmissing-decl warnings. */
+void mercury_sys_init_mercury_hlc_init(void);
+void mercury_sys_init_mercury_hlc_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_mercury_hlc_write_out_proc_statics(FILE *fp);
+#endif
void
-mercury_sys_init_mercury_hlc(void)
+mercury_sys_init_mercury_hlc_init(void)
{
+#ifdef MR_HIGHLEVEL_CODE
/*
** We need to call MR_init_entry() for the unification and comparison
** predicates for builtin types. Note that we don't need to do this
@@ -922,23 +929,21 @@
MR_init_entry(mercury__builtin____Compare____void_0_0);
MR_init_entry(mercury__builtin____Compare____func_0_0);
MR_init_entry(mercury__builtin____Compare____pred_0_0);
+#else
+ /* no initialization needed */
+#endif
}
-/*---------------------------------------------------------------------------*/
-
-#else /* ! MR_HIGHLEVEL_CODE */
-
-/* suppress gcc -Wmissing-decl warn */
-void mercury_sys_init_mercury_hlc(void);
+void mercury_sys_init_mercury_hlc_init_type_tables(void)
+{
+ /* no types to register */
+}
-/*
-** This empty initialization function is needed only
-** to match the one that we use for MLDS grades.
-*/
-void
-mercury_sys_init_mercury_hlc(void)
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_mercury_hlc_write_out_proc_statics(FILE *fp)
{
- /* no initialization needed */
+ /* no proc_statics to write out */
}
+#endif
-#endif /* ! MR_HIGHLEVEL_CODE */
+/*---------------------------------------------------------------------------*/
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.36
diff -u -b -r1.36 mercury.h
--- runtime/mercury.h 2001/03/13 07:42:54 1.36
+++ runtime/mercury.h 2001/05/03 06:41:39
@@ -41,16 +41,16 @@
#endif
#endif
-#if defined(PROFILE_CALLS) || defined(PROFILE_TIME)
+#if defined(MR_MPROF_PROFILE_CALLS) || defined(MR_MPROF_PROFILE_TIME)
#include "mercury_prof.h" /* for MR_prof_call_profile */
/* and MR_set_prof_current_proc */
#endif
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
#include "mercury_heap_profile.h" /* for MR_record_allocation */
#endif
-#if defined(PROFILE_CALLS) || defined(PROFILE_MEMORY) || defined(PROFILE_TIME)
+#if defined(MR_MPROF_PROFILE_CALLS) || defined(MR_MPROF_PROFILE_MEMORY) || defined(MR_MPROF_PROFILE_TIME)
#include "mercury_goto.h" /* for MR_init_entry */
#endif
Index: runtime/mercury_conf.h.in
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf.h.in,v
retrieving revision 1.34
diff -u -b -r1.34 mercury_conf.h.in
--- runtime/mercury_conf.h.in 2001/03/13 18:02:25 1.34
+++ runtime/mercury_conf.h.in 2001/05/15 14:48:21
@@ -350,6 +350,20 @@
#undef HAVE_READLINE_READLINE
#undef HAVE_READLINE_HISTORY
+/*
+** MR_MKFIFO
+** The name of the shell command to make a named pipe. This will be the
+** empty string if autoconfiguration did not find such a command.
+*/
+#undef MR_MKFIFO
+
+/*
+** MR_HOSTNAMECMD
+** The name of the shell command to return the name of the host.
+** This will be the empty string if autoconfiguration did not find
+** such a command.
+*/
+#undef MR_HOSTNAMECMD
/*
** MR_NEW_MERCURYFILE_STRUCT
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.47
diff -u -b -r1.47 mercury_conf_param.h
--- runtime/mercury_conf_param.h 2001/03/18 23:10:12 1.47
+++ runtime/mercury_conf_param.h 2001/05/12 15:27:16
@@ -199,16 +199,38 @@
** uses which occur inside debugging routines, so to get an accurate
** count you should not also enable low-level debugging.)
**
-** PROFILE_CALLS
+** MR_MPROF_PROFILE_CALLS
** Enables call count profiling.
**
-** PROFILE_TIME
+** MR_MPROF_PROFILE_TIME
** Enables time profiling.
**
-** PROFILE_MEMORY
+** MR_MPROF_PROFILE_MEMORY
** Enables profiling of memory usage.
+**
+** 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
+
/*
** Experimental options:
**
@@ -306,7 +328,7 @@
#ifdef MR_INSERT_ENTRY_LABEL_NAMES
#error "MR_INSERT_ENTRY_LABEL_NAMES should not be defined on the command line"
#endif
-#if defined(PROFILE_CALLS) || defined(MR_LOWLEVEL_DEBUG) \
+#if defined(MR_MPROF_PROFILE_CALLS) || defined(MR_DEBUG_GOTOS) \
|| defined(MR_DEBUG_AGC_SCHEDULING)
#define MR_INSERT_ENTRY_LABEL_NAMES
#endif
@@ -322,7 +344,7 @@
#ifdef MR_INSERT_INTERNAL_LABEL_NAMES
#error "MR_INSERT_INTERNAL_LABEL_NAMES should not be defined on the command line"
#endif
-#if defined(MR_LOWLEVEL_DEBUG) || defined(MR_DEBUG_AGC_SCHEDULING)
+#if defined(MR_DEBUG_GOTOS) || defined(MR_DEBUG_AGC_SCHEDULING)
#define MR_INSERT_INTERNAL_LABEL_NAMES
#endif
@@ -339,8 +361,8 @@
#ifdef MR_NEED_INITIALIZATION_AT_START
#error "MR_NEED_INITIALIZATION_AT_START should not be defined on the command line"
#endif
-#if !defined(MR_STATIC_CODE_ADDRESSES) || defined(PROFILE_CALLS) \
- || defined(PROFILE_TIME) || defined(DEBUG_LABELS)
+#if !defined(MR_STATIC_CODE_ADDRESSES) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_TIME) || defined(DEBUG_LABELS)
#define MR_NEED_INITIALIZATION_AT_START
#endif
Index: runtime/mercury_context.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.c,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_context.c
--- runtime/mercury_context.c 2000/12/04 18:28:36 1.28
+++ runtime/mercury_context.c 2001/05/03 06:41:39
@@ -3,7 +3,7 @@
ENDINIT
*/
/*
-** Copyright (C) 1995-2000 The University of Melbourne.
+** Copyright (C) 1995-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -87,26 +87,26 @@
void
MR_init_context(MR_Context *c)
{
- c->next = NULL;
- c->resume = NULL;
+ c->MR_ctxt_next = NULL;
+ c->MR_ctxt_resume = NULL;
#ifdef MR_THREAD_SAFE
- c->owner_thread = (MercuryThread) NULL;
+ c->MR_ctxt_owner_thread = (MercuryThread) NULL;
#endif
- c->context_succip = MR_ENTRY(MR_do_not_reached);
+ c->MR_ctxt_succip = MR_ENTRY(MR_do_not_reached);
- if (c->detstack_zone != NULL) {
- MR_reset_redzone(c->detstack_zone);
+ if (c->MR_ctxt_detstack_zone != NULL) {
+ MR_reset_redzone(c->MR_ctxt_detstack_zone);
} else {
- c->detstack_zone = MR_create_zone("detstack", 0,
+ c->MR_ctxt_detstack_zone = MR_create_zone("detstack", 0,
MR_detstack_size, MR_next_offset(),
MR_detstack_zone_size, MR_default_handler);
}
- c->context_sp = c->detstack_zone->min;
+ c->MR_ctxt_sp = c->MR_ctxt_detstack_zone->min;
- if (c->nondetstack_zone != NULL) {
- MR_reset_redzone(c->nondetstack_zone);
+ if (c->MR_ctxt_nondetstack_zone != NULL) {
+ MR_reset_redzone(c->MR_ctxt_nondetstack_zone);
} else {
- c->nondetstack_zone = MR_create_zone("nondetstack", 0,
+ c->MR_ctxt_nondetstack_zone = MR_create_zone("nondetstack", 0,
MR_nondstack_size, MR_next_offset(),
MR_nondstack_zone_size, MR_default_handler);
}
@@ -116,48 +116,48 @@
** minus one word, to the base address to get the maxfr/curfr pointer
** for the first frame on the nondet stack.
*/
- c->context_maxfr = c->nondetstack_zone->min + MR_NONDET_FIXED_SIZE - 1;
- c->context_curfr = c->context_maxfr;
- MR_redoip_slot(c->context_curfr) = MR_ENTRY(MR_do_not_reached);
- MR_redofr_slot(c->context_curfr) = NULL;
- MR_prevfr_slot(c->context_curfr) = NULL;
- MR_succip_slot(c->context_curfr) = MR_ENTRY(MR_do_not_reached);
- MR_succfr_slot(c->context_curfr) = NULL;
+ c->MR_ctxt_maxfr = c->MR_ctxt_nondetstack_zone->min + MR_NONDET_FIXED_SIZE - 1;
+ c->MR_ctxt_curfr = c->MR_ctxt_maxfr;
+ MR_redoip_slot(c->MR_ctxt_curfr) = MR_ENTRY(MR_do_not_reached);
+ MR_redofr_slot(c->MR_ctxt_curfr) = NULL;
+ MR_prevfr_slot(c->MR_ctxt_curfr) = NULL;
+ MR_succip_slot(c->MR_ctxt_curfr) = MR_ENTRY(MR_do_not_reached);
+ MR_succfr_slot(c->MR_ctxt_curfr) = NULL;
#ifdef MR_USE_MINIMAL_MODEL
- if (c->generatorstack_zone != NULL) {
- MR_reset_redzone(c->generatorstack_zone);
+ if (c->MR_ctxt_generatorstack_zone != NULL) {
+ MR_reset_redzone(c->MR_ctxt_generatorstack_zone);
} else {
- c->generatorstack_zone = MR_create_zone("generatorstack", 0,
+ c->MR_ctxt_generatorstack_zone = MR_create_zone("generatorstack", 0,
MR_generatorstack_size, MR_next_offset(),
MR_generatorstack_zone_size, MR_default_handler);
}
- c->context_gen_next = 0;
+ c->MR_ctxt_gen_next = 0;
- if (c->cutstack_zone != NULL) {
- MR_reset_redzone(c->cutstack_zone);
+ if (c->MR_ctxt_cutstack_zone != NULL) {
+ MR_reset_redzone(c->MR_ctxt_cutstack_zone);
} else {
- c->cutstack_zone = MR_create_zone("cutstack", 0,
+ c->MR_ctxt_cutstack_zone = MR_create_zone("cutstack", 0,
MR_cutstack_size, MR_next_offset(),
MR_cutstack_zone_size, MR_default_handler);
}
- c->context_cut_next = 0;
+ c->MR_ctxt_cut_next = 0;
#endif
#ifdef MR_USE_TRAIL
- if (c->trail_zone != NULL) {
- MR_reset_redzone(c->trail_zone);
+ if (c->MR_ctxt_trail_zone != NULL) {
+ MR_reset_redzone(c->MR_ctxt_trail_zone);
} else {
- c->trail_zone = MR_create_zone("trail", 0,
+ c->MR_ctxt_trail_zone = MR_create_zone("trail", 0,
MR_trail_size, MR_next_offset(),
MR_trail_zone_size, MR_default_handler);
}
- c->context_trail_ptr = (MR_TrailEntry *) c->trail_zone->min;
- c->context_ticket_counter = 1;
- c->context_ticket_high_water = 1;
+ c->MR_ctxt_trail_ptr = (MR_TrailEntry *) c->MR_ctxt_trail_zone->min;
+ c->MR_ctxt_ticket_counter = 1;
+ c->MR_ctxt_ticket_high_water = 1;
#endif
- c->context_hp = NULL;
+ c->MR_ctxt_hp = NULL;
}
MR_Context *
@@ -169,14 +169,14 @@
if (free_context_list == NULL) {
MR_UNLOCK(free_context_list_lock, "create_context i");
c = MR_GC_NEW(MR_Context);
- c->detstack_zone = NULL;
- c->nondetstack_zone = NULL;
+ c->MR_ctxt_detstack_zone = NULL;
+ c->MR_ctxt_nondetstack_zone = NULL;
#ifdef MR_USE_TRAIL
- c->trail_zone = NULL;
+ c->MR_ctxt_trail_zone = NULL;
#endif
} else {
c = free_context_list;
- free_context_list = c->next;
+ free_context_list = c->MR_ctxt_next;
MR_UNLOCK(free_context_list_lock, "create_context ii");
}
@@ -189,7 +189,7 @@
MR_destroy_context(MR_Context *c)
{
MR_LOCK(free_context_list_lock, "destroy_context");
- c->next = free_context_list;
+ c->MR_ctxt_next = free_context_list;
free_context_list = c;
MR_UNLOCK(free_context_list_lock, "destroy_context");
}
@@ -287,10 +287,10 @@
void
MR_schedule(MR_Context *ctxt)
{
- ctxt->next = NULL;
+ ctxt->MR_ctxt_next = NULL;
MR_LOCK(MR_runqueue_lock, "schedule");
if (MR_runqueue_tail) {
- MR_runqueue_tail->next = ctxt;
+ MR_runqueue_tail->MR_ctxt_next = ctxt;
MR_runqueue_tail = ctxt;
} else {
MR_runqueue_head = ctxt;
@@ -313,8 +313,8 @@
unsigned depth;
MercuryThread thd;
- depth = MR_ENGINE(c_depth);
- thd = MR_ENGINE(owner_thread);
+ depth = MR_ENGINE(MR_eng_c_depth);
+ thd = MR_ENGINE(MR_eng_owner_thread);
MR_LOCK(MR_runqueue_lock, "MR_do_runnext (i)");
@@ -327,30 +327,32 @@
/* XXX check pending io */
prev = NULL;
while(tmp != NULL) {
- if ((depth > 0 && tmp->owner_thread == thd)
- || (tmp->owner_thread == (MercuryThread) NULL)) {
+ if ((depth > 0 && tmp->MR_ctxt_owner_thread == thd) ||
+ (tmp->MR_ctxt_owner_thread ==
+ (MercuryThread) NULL))
+ {
break;
}
prev = tmp;
- tmp = tmp->next;
+ tmp = tmp->MR_ctxt_next;
}
if (tmp != NULL) {
break;
}
MR_WAIT(MR_runqueue_cond, MR_runqueue_lock);
}
- MR_ENGINE(this_context) = tmp;
+ MR_ENGINE(MR_eng_this_context) = tmp;
if (prev != NULL) {
- prev->next = tmp->next;
+ prev->MR_ctxt_next = tmp->MR_ctxt_next;
} else {
- MR_runqueue_head = tmp->next;
+ MR_runqueue_head = tmp->MR_ctxt_next;
}
if (MR_runqueue_tail == tmp) {
MR_runqueue_tail = prev;
}
MR_UNLOCK(MR_runqueue_lock, "MR_do_runnext (iii)");
- MR_load_context(MR_ENGINE(this_context));
- MR_GOTO(MR_ENGINE(this_context)->resume);
+ MR_load_context(MR_ENGINE(MR_eng_this_context));
+ MR_GOTO(MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume);
}
#else /* !MR_THREAD_SAFE */
{
@@ -362,20 +364,39 @@
MR_check_pending_contexts(TRUE); /* block */
}
- MR_ENGINE(this_context) = MR_runqueue_head;
- MR_runqueue_head = MR_runqueue_head->next;
+ MR_ENGINE(MR_eng_this_context) = MR_runqueue_head;
+ MR_runqueue_head = MR_runqueue_head->MR_ctxt_next;
if (MR_runqueue_head == NULL) {
MR_runqueue_tail = NULL;
}
- MR_load_context(MR_ENGINE(this_context));
- MR_GOTO(MR_ENGINE(this_context)->resume);
+ MR_load_context(MR_ENGINE(MR_eng_this_context));
+ MR_GOTO(MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume);
}
#endif
MR_END_MODULE
+
+/* forward decls to suppress gcc warnings */
+void mercury_sys_init_scheduler_wrapper_init(void);
+void mercury_sys_init_scheduler_wrapper_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_scheduler_wrapper_write_out_proc_statics(FILE *fp);
+#endif
-void mercury_sys_init_scheduler_wrapper(void); /* suppress gcc warning */
-void mercury_sys_init_scheduler_wrapper(void) {
+void mercury_sys_init_scheduler_wrapper_init(void)
+{
scheduler_module();
}
+
+void mercury_sys_init_scheduler_wrapper_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_scheduler_wrapper_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
Index: runtime/mercury_context.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_context.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_context.h
--- runtime/mercury_context.h 2000/12/04 18:28:37 1.16
+++ runtime/mercury_context.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-2000 The University of Melbourne.
+** Copyright (C) 1997-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -67,7 +67,7 @@
*/
typedef struct MR_Context_Struct MR_Context;
struct MR_Context_Struct {
- MR_Context *next;
+ MR_Context *MR_ctxt_next;
/*
** if this context is in the free-list `next' will point
** to the next free context. If this context is suspended
@@ -77,14 +77,14 @@
** context in the runqueue.
*/
- MR_Code *resume;
+ MR_Code *MR_ctxt_resume;
/*
** a pointer to the code at which execution should resume when
** this context is next scheduled.
*/
#ifdef MR_THREAD_SAFE
- MercuryThread owner_thread;
+ MercuryThread MR_ctxt_owner_thread;
/*
** The owner_thread field is used to ensure that when we
** enter a mercury engine from C, we return to the same
@@ -92,45 +92,45 @@
*/
#endif
- MR_Code *context_succip;
+ MR_Code *MR_ctxt_succip;
/* succip for this context */
- MR_MemoryZone *detstack_zone;
+ MR_MemoryZone *MR_ctxt_detstack_zone;
/* pointer to the detstack_zone for this context */
- MR_Word *context_sp;
+ MR_Word *MR_ctxt_sp;
/* saved stack pointer for this context */
- MR_MemoryZone *nondetstack_zone;
+ MR_MemoryZone *MR_ctxt_nondetstack_zone;
/* pointer to the nondetstack_zone for this context */
- MR_Word *context_maxfr;
+ MR_Word *MR_ctxt_maxfr;
/* saved maxfr pointer for this context */
- MR_Word *context_curfr;
+ MR_Word *MR_ctxt_curfr;
/* saved curfr pointer for this context */
#ifdef MR_USE_MINIMAL_MODEL
- MR_MemoryZone *generatorstack_zone;
- /* pointer to the generatorstack_zone for this context */
- MR_Integer context_gen_next;
+ MR_MemoryZone *MR_ctxt_genstack_zone;
+ /* pointer to the genstack_zone for this context */
+ MR_Integer MR_ctxt_gen_next;
/* saved generator stack index for this context */
- MR_MemoryZone *cutstack_zone;
+ MR_MemoryZone *MR_ctxt_cutstack_zone;
/* pointer to the cutstack_zone for this context */
- MR_Integer context_cut_next;
+ MR_Integer MR_ctxt_cut_next;
/* saved cut stack index for this context */
#endif
#ifdef MR_USE_TRAIL
- MR_MemoryZone *trail_zone;
+ MR_MemoryZone *MR_ctxt_trail_zone;
/* pointer to the MR_trail_zone for this context */
- MR_TrailEntry *context_trail_ptr;
+ MR_TrailEntry *MR_ctxt_trail_ptr;
/* saved MR_trail_ptr for this context */
- MR_ChoicepointId context_ticket_counter;
+ MR_ChoicepointId MR_ctxt_ticket_counter;
/* saved MR_ticket_counter for this context */
- MR_ChoicepointId context_ticket_high_water;
+ MR_ChoicepointId MR_ctxt_ticket_high_water;
/* saved MR_ticket_high_water for this context */
#endif
- MR_Word *context_hp;
+ MR_Word *MR_ctxt_hp;
/* saved hp for this context */
- MR_Word *min_hp_rec;
+ MR_Word *MR_ctxt_min_hp_rec;
/*
** this pointer marks the minimum value of MR_hp to which we can
** truncate the heap on backtracking. See comments before the
@@ -258,9 +258,9 @@
fork_new_context_i--) { \
*(f_n_c_context->context_sp) = \
MR_stackvar(fork_new_context_i); \
- f_n_c_context->context_sp++; \
+ f_n_c_context->MR_ctxt_sp++; \
} \
- f_n_c_context->resume = (child); \
+ f_n_c_context->MR_ctxt_resume = (child); \
MR_schedule(f_n_c_context); \
MR_GOTO(parent); \
} while (0)
@@ -269,18 +269,18 @@
/*
** To figure out the maximum amount of heap we can reclaim on backtracking,
- ** we compare MR_hp with the context_hp.
+ ** we compare MR_hp with the MR_ctxt_hp.
**
- ** If context_hp == NULL then this is the first time this context has been
+ ** If MR_ctxt_hp == NULL then this is the first time this context has been
** scheduled, so the furthest back down the heap we can reclaim is to the
** current value of MR_hp.
**
- ** If MR_hp > context_hp, another context has allocated data on the heap
+ ** If MR_hp > MR_ctxt_hp, another context has allocated data on the heap
** since we were last scheduled, so the furthest back that we can reclaim is
** to the current value of MR_hp, so we set MR_min_hp_rec and the
** field of the same name in our context structure.
**
- ** If MR_hp < context_hp, then another context has truncated the heap on
+ ** If MR_hp < MR_ctxt_hp, then another context has truncated the heap on
** failure. For this to happen, it must be the case that last time we were
** that other context was the last one to allocate data on the heap, and we
** scheduled, did not allocate any heap during that period of execution.
@@ -290,27 +290,25 @@
** that we held, and we are now contiguous with our older data, so this
** algorithm will lead to holes in the heap, though GC will reclaim these.
**
- ** If hp == context_hp then no other process has allocated any heap since we
+ ** If hp == MR_ctxt_hp then no other process has allocated any heap since we
** were last scheduled, so we can proceed as if we had not stopped, and the
** furthest back that we can backtrack is the same as it was last time we
** were executing.
*/
- #define MR_set_min_heap_reclamation_point(ctxt) do { \
- if (MR_hp != (ctxt)->context_hp \
- || (ctxt)->context_hp == NULL) \
- { \
+ #define MR_set_min_heap_reclamation_point(ctxt) \
+ do { \
+ if (MR_hp != (ctxt)->MR_ctxt_hp \
+ || (ctxt)->MR_ctxt_hp == NULL) { \
MR_min_hp_rec = MR_hp; \
(ctxt)->min_hp_rec = MR_hp; \
- } \
- else \
- { \
+ } else { \
MR_min_hp_rec = (ctxt)->min_hp_rec; \
} \
} while (0)
#define MR_save_hp_in_context(ctxt) \
do { \
- (ctxt)->context_hp = MR_hp; \
+ (ctxt)->MR_ctxt_hp = MR_hp; \
(ctxt)->min_hp_rec = MR_min_hp_rec; \
} while (0)
@@ -337,36 +335,39 @@
#define MR_load_context(cptr) \
do { \
MR_Context *load_context_c; \
+ \
load_context_c = (cptr); \
- MR_succip = load_context_c->context_succip; \
- MR_sp = load_context_c->context_sp; \
- MR_maxfr = load_context_c->context_maxfr; \
- MR_curfr = load_context_c->context_curfr; \
+ MR_succip = load_context_c->MR_ctxt_succip; \
+ MR_sp = load_context_c->MR_ctxt_sp; \
+ MR_maxfr = load_context_c->MR_ctxt_maxfr; \
+ MR_curfr = load_context_c->MR_ctxt_curfr; \
MR_IF_USE_MINIMAL_MODEL( \
- MR_gen_next = load_context_c->context_gen_next; \
- MR_cut_next = load_context_c->context_cut_next; \
+ MR_gen_next = load_context_c->MR_ctxt_gen_next; \
+ MR_cut_next = load_context_c->MR_ctxt_cut_next; \
) \
MR_IF_USE_TRAIL( \
- MR_trail_zone = load_context_c->trail_zone; \
- MR_trail_ptr = load_context_c->context_trail_ptr; \
+ MR_trail_zone = load_context_c->MR_ctxt_trail_zone;\
+ MR_trail_ptr = load_context_c->MR_ctxt_trail_ptr;\
MR_ticket_counter = \
- load_context_c->context_ticket_counter; \
+ load_context_c->MR_ctxt_ticket_counter; \
MR_ticket_high_water = \
- load_context_c->context_ticket_high_water; \
+ load_context_c->MR_ctxt_ticket_high_water;\
) \
- MR_ENGINE(context).detstack_zone = \
- load_context_c->detstack_zone; \
- MR_ENGINE(context).nondetstack_zone = \
- load_context_c->nondetstack_zone; \
+ MR_ENGINE(MR_eng_context).MR_ctxt_detstack_zone = \
+ load_context_c->MR_ctxt_detstack_zone; \
+ MR_ENGINE(MR_eng_context).MR_ctxt_nondetstack_zone = \
+ load_context_c->MR_ctxt_nondetstack_zone;\
MR_IF_USE_MINIMAL_MODEL( \
- MR_ENGINE(context).generatorstack_zone = \
- load_context_c->generatorstack_zone; \
- MR_ENGINE(context).cutstack_zone = \
- load_context_c->cutstack_zone; \
+ MR_ENGINE(MR_eng_context).MR_ctxt_genstack_zone =\
+ load_context_c->MR_ctxt_genstack_zone; \
+ MR_ENGINE(MR_eng_context).MR_ctxt_cutstack_zone =\
+ load_context_c->MR_ctxt_cutstack_zone; \
MR_gen_stack = (MR_GeneratorStackFrame *) \
- MR_ENGINE(context).generatorstack_zone; \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_genstack_zone; \
MR_cut_stack = (MR_CutStackFrame *) \
- MR_ENGINE(context).cutstack_zone; \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_cutstack_zone; \
) \
MR_set_min_heap_reclamation_point(load_context_c); \
} while (0)
@@ -374,36 +375,43 @@
#define MR_save_context(cptr) \
do { \
MR_Context *save_context_c; \
+ \
save_context_c = (cptr); \
- save_context_c->context_succip = MR_succip; \
- save_context_c->context_sp = MR_sp; \
- save_context_c->context_maxfr = MR_maxfr; \
- save_context_c->context_curfr = MR_curfr; \
+ save_context_c->MR_ctxt_succip = MR_succip; \
+ save_context_c->MR_ctxt_sp = MR_sp; \
+ save_context_c->MR_ctxt_maxfr = MR_maxfr; \
+ save_context_c->MR_ctxt_curfr = MR_curfr; \
MR_IF_USE_MINIMAL_MODEL( \
- save_context_c->context_gen_next = MR_gen_next; \
- save_context_c->context_cut_next = MR_cut_next; \
+ save_context_c->MR_ctxt_gen_next = MR_gen_next; \
+ save_context_c->MR_ctxt_cut_next = MR_cut_next; \
) \
MR_IF_USE_TRAIL( \
- save_context_c->trail_zone = MR_trail_zone; \
- save_context_c->context_trail_ptr = MR_trail_ptr; \
- save_context_c->context_ticket_counter = \
+ save_context_c->MR_ctxt_trail_zone = MR_trail_zone;\
+ save_context_c->MR_ctxt_trail_ptr = MR_trail_ptr;\
+ save_context_c->MR_ctxt_ticket_counter = \
MR_ticket_counter; \
- save_context_c->context_ticket_high_water = \
+ save_context_c->MR_ctxt_ticket_high_water = \
MR_ticket_high_water; \
) \
- save_context_c->detstack_zone = \
- MR_ENGINE(context).detstack_zone; \
- save_context_c->nondetstack_zone = \
- MR_ENGINE(context).nondetstack_zone; \
+ save_context_c->MR_ctxt_detstack_zone = \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_detstack_zone; \
+ save_context_c->MR_ctxt_nondetstack_zone = \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_nondetstack_zone; \
MR_IF_USE_MINIMAL_MODEL( \
- save_context_c->generatorstack_zone = \
- MR_ENGINE(context).generatorstack_zone; \
- save_context_c->cutstack_zone = \
- MR_ENGINE(context).cutstack_zone; \
- assert(MR_gen_stack == (MR_GeneratorStackFrame *) \
- MR_ENGINE(context).generatorstack_zone);\
+ save_context_c->MR_ctxt_genstack_zone = \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_genstack_zone; \
+ save_context_c->MR_ctxt_cutstack_zone = \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_cutstack_zone; \
+ assert(MR_gen_stack == (MR_GeneratorStackFrame *)\
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_genstack_zone); \
assert(MR_cut_stack == (MR_CutStackFrame *) \
- MR_ENGINE(context).cutstack_zone); \
+ MR_ENGINE(MR_eng_context). \
+ MR_ctxt_cutstack_zone); \
) \
MR_save_hp_in_context(save_context_c); \
} while (0)
@@ -440,7 +448,7 @@
assert(st->count > 0); \
MR_UNLOCK(&(st->lock), "terminate ii"); \
} \
- MR_destroy_context(MR_ENGINE(this_context)); \
+ MR_destroy_context(MR_ENGINE(MR_eng_this_context)); \
MR_runnext(); \
} while (0)
@@ -454,9 +462,9 @@
MR_GOTO((where_to)); \
} \
assert(st->count > 0); \
- MR_save_context(MR_ENGINE(this_context)); \
- MR_ENGINE(this_context)->resume = (where_to); \
- st->parent = MR_ENGINE(this_context); \
+ MR_save_context(MR_ENGINE(MR_eng_this_context)); \
+ MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume = (where_to);\
+ st->parent = MR_ENGINE(MR_eng_this_context); \
MR_UNLOCK(&(st->lock), "continue ii"); \
MR_runnext(); \
} while (0)
Index: runtime/mercury_debug.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_debug.c,v
retrieving revision 1.4
diff -u -b -r1.4 mercury_debug.c
--- runtime/mercury_debug.c 2001/01/11 07:55:35 1.4
+++ runtime/mercury_debug.c 2001/05/12 15:27:16
@@ -98,7 +98,13 @@
{
printf("\ncalling "); MR_printlabel(stdout, proc);
printf("continuation "); MR_printlabel(stdout, succ_cont);
+ if (MR_sregdebug) {
MR_printregs("registers at call");
+ }
+
+#ifdef MR_DEEP_PROFILING
+ MR_print_deep_prof_vars(stdout);
+#endif
}
void
@@ -108,14 +114,26 @@
printf("\ntail calling "); MR_printlabel(stdout, proc);
printf("continuation "); MR_printlabel(stdout, MR_succip);
+ if (MR_sregdebug) {
MR_printregs("registers at tailcall");
+ }
+
+#ifdef MR_DEEP_PROFILING
+ MR_print_deep_prof_vars(stdout);
+#endif
}
void
MR_proceed_msg(void)
{
printf("\nreturning from determinate procedure\n");
+ if (MR_sregdebug) {
MR_printregs("registers at proceed");
+ }
+
+#ifdef MR_DEEP_PROFILING
+ MR_print_deep_prof_vars(stdout);
+#endif
}
void
@@ -178,9 +196,11 @@
for(i=1; i<=8; i++) {
x = (MR_Integer) MR_get_reg(i);
#ifndef CONSERVATIVE_GC
- if ((MR_Integer) MR_ENGINE(heap_zone)->min <= x
- && x < (MR_Integer) MR_ENGINE(heap_zone)->top) {
- x -= (MR_Integer) MR_ENGINE(heap_zone)->min;
+ if ((MR_Integer) MR_ENGINE(MR_eng_heap_zone)->min <= x
+ && x < (MR_Integer)
+ MR_ENGINE(MR_eng_heap_zone)->top)
+ {
+ x -= (MR_Integer) MR_ENGINE(MR_eng_heap_zone)->min;
}
#endif
printf("%8lx ", (long) x);
@@ -214,7 +234,7 @@
#ifndef CONSERVATIVE_GC
printf("ptr %p, offset %3ld words\n",
(const void *) h,
- (long) (MR_Integer) (h - MR_ENGINE(heap_zone)->min));
+ (long) (MR_Integer) (h - MR_ENGINE(MR_eng_heap_zone)->min));
#else
printf("ptr %p\n",
(const void *) h);
@@ -228,7 +248,8 @@
printf("frame at ptr %p, offset %3ld words\n",
(const void *) fr,
- (long) (MR_Integer) (fr - MR_CONTEXT(nondetstack_zone)->min));
+ (long) (MR_Integer)
+ (fr - MR_CONTEXT(MR_ctxt_nondetstack_zone)->min));
printf("\t succip "); MR_printlabel(stdout, MR_succip_slot(fr));
printf("\t redoip "); MR_printlabel(stdout, MR_redoip_slot(fr));
printf("\t succfr "); MR_printnondstack(MR_succfr_slot(fr));
@@ -247,7 +268,7 @@
MR_Word *fr;
printf("\nnondstack dump\n");
- for (fr = MR_maxfr; fr > MR_CONTEXT(nondetstack_zone)->min;
+ for (fr = MR_maxfr; fr > MR_CONTEXT(MR_ctxt_nondetstack_zone)->min;
fr = MR_prevfr_slot(fr)) {
MR_dumpframe(fr);
}
@@ -276,6 +297,20 @@
printf("%-9s", "sp:"); MR_printdetstack(MR_sp);
MR_print_ordinary_regs();
+
+ if (MR_watch_addr != NULL) {
+ printf("watch addr %p: %lx %ld\n", MR_watch_addr,
+ (long) *MR_watch_addr, (long) *MR_watch_addr);
+ }
+
+ if (MR_watch_csd_addr != NULL) {
+ if (MR_watch_csd_ignore == 0) {
+ MR_print_deep_prof_var(stdout, "watch_csd",
+ (MR_CallSiteDynamic *) MR_watch_csd_addr);
+ } else {
+ MR_watch_csd_ignore--;
+ }
+ }
}
static void
@@ -289,20 +324,24 @@
value = (MR_Integer) MR_get_reg(i+1);
#ifndef CONSERVATIVE_GC
- if ((MR_Integer) MR_ENGINE(heap_zone)->min <= value &&
- value < (MR_Integer) MR_ENGINE(heap_zone)->top) {
+ if ((MR_Integer) MR_ENGINE(MR_eng_heap_zone)->min <= value
+ && value < (MR_Integer)
+ MR_ENGINE(MR_eng_heap_zone)->top)
+ {
printf("(heap) ");
}
#endif
- printf("%ld\n", (long) value);
+ printf("%ld %lx\n", (long) value, (long) value);
}
- if (MR_sp >= &MR_CONTEXT(detstack_zone)->min[300]) {
+#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) */
@@ -310,10 +349,10 @@
static void
MR_printdetslot_as_label(const MR_Integer offset)
{
- MR_printdetstackptr(&MR_CONTEXT(detstack_zone)->min[offset]);
+ MR_printdetstackptr(&MR_CONTEXT(MR_ctxt_detstack_zone)->min[offset]);
printf(" ");
MR_printlabel(stdout,
- (MR_Code *) (MR_CONTEXT(detstack_zone)->min[offset]));
+ (MR_Code *) (MR_CONTEXT(MR_ctxt_detstack_zone)->min[offset]));
}
void
@@ -326,7 +365,8 @@
MR_print_detstackptr(FILE *fp, const MR_Word *s)
{
fprintf(fp, "det %3ld (%p)",
- (long) (MR_Integer) (s - MR_CONTEXT(detstack_zone)->min),
+ (long) (MR_Integer)
+ (s - MR_CONTEXT(MR_ctxt_detstack_zone)->min),
(const void *) s);
}
@@ -335,7 +375,8 @@
{
printf("ptr %p, offset %3ld words\n",
(const void *) s,
- (long) (MR_Integer) (s - MR_CONTEXT(detstack_zone)->min));
+ (long) (MR_Integer)
+ (s - MR_CONTEXT(MR_ctxt_detstack_zone)->min));
}
void
@@ -348,7 +389,8 @@
MR_print_nondstackptr(FILE *fp, const MR_Word *s)
{
fprintf(fp, "non %3ld (%p)",
- (long) (MR_Integer) (s - MR_CONTEXT(nondetstack_zone)->min),
+ (long) (MR_Integer)
+ (s - MR_CONTEXT(MR_ctxt_nondetstack_zone)->min),
(const void *) s);
}
@@ -357,7 +399,8 @@
{
printf("ptr %p, offset %3ld words\n",
(const void *) s,
- (long) (MR_Integer) (s - MR_CONTEXT(nondetstack_zone)->min));
+ (long) (MR_Integer)
+ (s - MR_CONTEXT(MR_ctxt_nondetstack_zone)->min));
}
void
@@ -368,7 +411,7 @@
(long) s, (const void *) s);
#else
fprintf(fp, "heap %3ld (%p)",
- (long) (MR_Integer) (s - MR_ENGINE(heap_zone)->min),
+ (long) (MR_Integer) (s - MR_ENGINE(MR_eng_heap_zone)->min),
(const void *) s);
#endif
}
@@ -408,4 +451,68 @@
{
MR_print_label(fp, w);
fprintf(fp, "\n");
+}
+
+void
+MR_print_deep_prof_var(FILE *fp, const char *name, MR_CallSiteDynamic *csd)
+{
+#ifdef MR_DEEP_PROFILING
+ fprintf(fp, "%s: %p", name, csd);
+
+ if (csd == NULL) {
+ fprintf(fp, "\n");
+ } else {
+ fprintf(fp, ", depth %ld,",
+ csd->MR_csd_depth_count);
+
+#ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ fprintf(fp, " calls %d,",
+ csd->MR_csd_own.MR_own_calls);
+#endif
+ fprintf(fp, " exits %d, fails %d, redos %d\n",
+ csd->MR_csd_own.MR_own_exits,
+ csd->MR_csd_own.MR_own_fails,
+ csd->MR_csd_own.MR_own_redos);
+
+ fprintf(fp, " pd: %p", csd->MR_csd_callee_ptr);
+ if (csd->MR_csd_callee_ptr == NULL) {
+ fprintf(fp, "\n");
+ } else if (csd->MR_csd_callee_ptr->MR_pd_proc_static == NULL) {
+ fprintf(fp, ", ps is NULL\n");
+ } else {
+ MR_ProcStatic *ps;
+ MR_Proc_Id *proc_id;
+
+ ps = csd->MR_csd_callee_ptr->MR_pd_proc_static;
+ fprintf(fp, ", ps: %p\n", ps);
+ proc_id = &ps->MR_ps_proc_id;
+ if (MR_PROC_ID_COMPILER_GENERATED(*proc_id)) {
+ fprintf(fp, " %s:%s %s/%d-%d\n ",
+ proc_id->MR_proc_comp.
+ MR_comp_type_module,
+ proc_id->MR_proc_comp.
+ MR_comp_type_name,
+ proc_id->MR_proc_comp.
+ MR_comp_pred_name,
+ proc_id->MR_proc_comp.MR_comp_arity,
+ proc_id->MR_proc_comp.MR_comp_mode);
+ } else {
+ fprintf(fp, " %s:%s/%d-%d\n ",
+ proc_id->MR_proc_user.
+ MR_user_decl_module,
+ proc_id->MR_proc_user.MR_user_name,
+ proc_id->MR_proc_user.MR_user_arity,
+ proc_id->MR_proc_user.MR_user_mode);
+ }
+
+#ifdef MR_USE_ACTIVATION_COUNTS
+ fprintf(fp, "active %d, ",
+ ps->MR_ps_activation_count);
+#endif
+ fprintf(fp, "outermost %p, array %d\n",
+ ps->MR_ps_outermost_activation_ptr,
+ ps->MR_ps_num_call_sites);
+ }
+ }
+#endif
}
Index: runtime/mercury_debug.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_debug.h,v
retrieving revision 1.11
diff -u -b -r1.11 mercury_debug.h
--- runtime/mercury_debug.h 2000/12/04 18:28:37 1.11
+++ runtime/mercury_debug.h 2001/05/12 15:27:16
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1995-2000 The University of Melbourne.
+** Copyright (C) 1995-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -9,8 +9,9 @@
#ifndef MERCURY_DEBUG_H
#define MERCURY_DEBUG_H
-#include "mercury_types.h" /* for `MR_Word' and `MR_Code' */
-#include <stdio.h> /* for `FILE' */
+#include "mercury_types.h" /* for MR_Word and MR_Code */
+#include "mercury_deep_profiling.h" /* for MR_CallSiteDynamic */
+#include <stdio.h> /* for FILE */
/*---------------------------------------------------------------------------*/
@@ -94,18 +95,19 @@
(MR_save_transient_registers(), MR_printframe(msg)))
#define MR_debugsucceed() \
- MR_IF (MR_nondstackdebug, \
+ MR_IF (MR_calldebug, \
(MR_save_transient_registers(), MR_succeed_msg()))
#define MR_debugsucceeddiscard() \
- MR_IF (MR_nondstackdebug, \
+ MR_IF (MR_calldebug, \
(MR_save_transient_registers(), MR_succeeddiscard_msg()))
#define MR_debugfail() \
- IF (MR_nondstackdebug, (MR_save_transient_registers(), MR_fail_msg()))
+ MR_IF (MR_calldebug, \
+ (MR_save_transient_registers(), MR_fail_msg()))
#define MR_debugredo() \
- MR_IF (MR_nondstackdebug, \
+ MR_IF (MR_calldebug, \
(MR_save_transient_registers(), MR_redo_msg()))
#define MR_debugcall(proc, succ_cont) \
@@ -133,6 +135,14 @@
#endif /* MR_LOWLEVEL_DEBUG */
+#define MR_print_deep_prof_vars(fp) \
+ do { \
+ MR_print_deep_prof_var(stdout, "current_call_site_dynamic", \
+ MR_current_call_site_dynamic); \
+ MR_print_deep_prof_var(stdout, "next_call_site_dynamic", \
+ MR_next_call_site_dynamic); \
+ } while (0)
+
/*---------------------------------------------------------------------------*/
#ifdef MR_LOWLEVEL_DEBUG
@@ -141,7 +151,8 @@
extern void MR_succeeddiscard_msg(void);
extern void MR_fail_msg(void);
extern void MR_redo_msg(void);
-extern void MR_call_msg(/* const */ MR_Code *proc, /* const */ MR_Code *succcont);
+extern void MR_call_msg(/* const */ MR_Code *proc,
+ /* const */ MR_Code *succcont);
extern void MR_tailcall_msg(/* const */ MR_Code *proc);
extern void MR_proceed_msg(void);
extern void MR_cr1_msg(MR_Word val0, const MR_Word *addr);
@@ -176,6 +187,8 @@
extern void MR_print_heapptr(FILE *fp, const MR_Word *s);
extern void MR_print_label(FILE *fp, /* const */ MR_Code *w);
extern void MR_printlabel(FILE *fp, /* const */ MR_Code *w);
+extern void MR_print_deep_prof_var(FILE *fp, const char *name,
+ MR_CallSiteDynamic *csd);
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_deep_call_port_body.h
===================================================================
RCS file: mercury_deep_call_port_body.h
diff -N mercury_deep_call_port_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_call_port_body.h Sun May 13 01:27:16 2001
@@ -0,0 +1,144 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The implementation of {det,semi,non}_call_port_code_{ac,sr}.
+**
+** The code including this file should define the following macros:
+**
+** MR_PROCNAME: The name of the procedure whose body this is.
+** MR_VERSION_AC or MR_VERSION_SR:
+** Says whether the procedure whose body this is
+** is intended for use with or without
+** MR_USE_ACTIVATION_COUNTS.
+** MR_NEED_NEW_OUTERMOST: Says whether we need to know the new value of
+** the outermost activation pointer. Should be
+** true only for non_call_port_code_*.
+**
+** The code including this file should have the following variables in scope:
+**
+** ProcStatic: The proc_static of the procedure whose call
+** port we are at.
+** MiddleCSD: The id of the current csd.
+** TopCSD: The id of the parent's csd.
+** OldOutermostActivationPtr: The id of the outermost activation of the
+** current user procedure before the call.
+** Needed only with MR_VERSION_SR.
+** NewOutermostActivationPtr: The id of the outermost activation of the
+** current user procedure after the call.
+** Needed only with MR_NEED_NEW_OUTERMOST.
+*/
+
+#ifdef MR_DEEP_PROFILING
+{
+ MR_CallSiteDynamic *csd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+
+ #ifdef MR_DEEP_PROFILING_LOWLEVEL_DEBUG
+ MR_print_deep_prof_vars(stdout);
+ #endif
+
+ TopCSD = (MR_Word) MR_current_call_site_dynamic;
+ MiddleCSD = (MR_Word) MR_next_call_site_dynamic;
+ csd = MR_next_call_site_dynamic;
+ MR_current_call_site_dynamic = csd;
+ #ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ csd->MR_csd_own.MR_own_calls++;
+ #else
+ /* calls are computed from the other counts */
+ #endif
+ #endif
+
+ #ifdef MR_DEEP_PROFILING_LOWLEVEL_DEBUG
+ /* After we copy it, MR_next_call_site_dynamic is not meaningful; */
+ /* zeroing it makes debugging output less cluttered. */
+ MR_next_call_site_dynamic = NULL;
+ #endif
+
+ ps = (MR_ProcStatic *) ProcStatic;
+ #ifdef MR_VERSION_SR
+ OldOutermostActivationPtr =
+ (MR_Word) ps->MR_ps_outermost_activation_ptr;
+ #endif
+
+ #if defined(MR_VERSION_AC)
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ MR_deep_assert(ps->MR_ps_activation_count == 0
+ || ps->MR_ps_outermost_activation_ptr != NULL);
+
+ #ifdef MR_DEEP_PROFILING_STATISTICS
+ if (csd->MR_csd_callee_ptr != NULL) {
+ MR_deep_prof_call_old++;
+ } else if (ps->MR_ps_activation_count > 0) {
+ MR_deep_prof_call_rec++;
+ } else {
+ MR_deep_prof_call_new++;
+ }
+ #endif
+
+ if (csd->MR_csd_callee_ptr != NULL) {
+ if (ps->MR_ps_activation_count == 0) {
+ ps->MR_ps_outermost_activation_ptr =
+ 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;
+
+ MR_new_proc_dynamic(pd, ps);
+ csd->MR_csd_callee_ptr = pd;
+ ps->MR_ps_outermost_activation_ptr = pd;
+ }
+
+ ps->MR_ps_activation_count++;
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS not enabled");
+ #endif
+ #elif defined(MR_VERSION_SR)
+ #ifndef MR_USE_ACTIVATION_COUNTS
+ #ifdef MR_DEEP_PROFILING_STATISTICS
+ if (csd->MR_csd_callee_ptr != NULL) {
+ MR_deep_prof_call_old++;
+ } else if (ps->MR_ps_outermost_activation_ptr != NULL) {
+ MR_deep_prof_call_rec++;
+ } else {
+ MR_deep_prof_call_new++;
+ }
+ #endif
+
+ if (csd->MR_csd_callee_ptr != NULL) {
+ ps->MR_ps_outermost_activation_ptr = csd->MR_csd_callee_ptr;
+ } else if (ps->MR_ps_outermost_activation_ptr != NULL) {
+ csd->MR_csd_callee_ptr = ps->MR_ps_outermost_activation_ptr;
+ } else {
+ MR_ProcDynamic *pd;
+
+ MR_new_proc_dynamic(pd, ps);
+ csd->MR_csd_callee_ptr = pd;
+ ps->MR_ps_outermost_activation_ptr = csd->MR_csd_callee_ptr;
+ }
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS enabled");
+ #endif
+ #else
+ #error "mercury_deep_call_port_body.h: neither MR_VERSION_AC nor MR_VERSION_SR"
+ #endif
+
+ #ifdef MR_NEED_NEW_OUTERMOST
+ NewOutermostActivationPtr =
+ (MR_Word) ps->MR_ps_outermost_activation_ptr;
+ #endif
+
+ MR_leave_instrumentation();
+}
+#else
+ MR_fatal_error(MR_PROCNAME ": deep profiling not enabled");
+#endif
Index: runtime/mercury_deep_copy.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.c,v
retrieving revision 1.23
diff -u -b -r1.23 mercury_deep_copy.c
--- runtime/mercury_deep_copy.c 2000/11/25 10:42:01 1.23
+++ runtime/mercury_deep_copy.c 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-2000 The University of Melbourne.
+** Copyright (C) 1997-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -64,8 +64,8 @@
#undef in_traverse_range(X)
#define in_traverse_range(X) \
- ((X) >= MR_ENGINE(solutions_heap_zone)->min && \
- (X) <= MR_ENGINE(solutions_heap_zone)->hardmax)
+ ((X) >= MR_ENGINE(MR_eng_solutions_heap_zone)->min && \
+ (X) <= MR_ENGINE(MR_eng_solutions_heap_zone)->hardmax)
#undef maybeconst
#define maybeconst
@@ -128,24 +128,24 @@
MR_restore_transient_hp(); /* Because we play with MR_hp */
- if (lower_limit < MR_ENGINE(heap_zone)->bottom ||
- lower_limit > MR_ENGINE(heap_zone)->top) {
- lower_limit = MR_ENGINE(heap_zone)->bottom;
+ if (lower_limit < MR_ENGINE(MR_eng_heap_zone)->bottom ||
+ lower_limit > MR_ENGINE(MR_eng_heap_zone)->top) {
+ lower_limit = MR_ENGINE(MR_eng_heap_zone)->bottom;
}
/* temporarily swap the heap with the global heap */
- SWAP(MR_ENGINE(heap_zone), MR_ENGINE(global_heap_zone),
+ SWAP(MR_ENGINE(MR_eng_heap_zone), MR_ENGINE(MR_eng_global_heap_zone),
MR_MemoryZone *);
SWAP(MR_hp, MR_global_hp, MR_Word *);
/* copy values from the heap to the global heap */
MR_save_transient_hp();
result = MR_deep_copy(&term, type_info, lower_limit,
- MR_ENGINE(global_heap_zone)->top);
+ MR_ENGINE(MR_eng_global_heap_zone)->top);
MR_restore_transient_hp();
/* swap the heap and global heap back again */
- SWAP(MR_ENGINE(heap_zone), MR_ENGINE(global_heap_zone),
+ SWAP(MR_ENGINE(MR_eng_heap_zone), MR_ENGINE(MR_eng_global_heap_zone),
MR_MemoryZone *);
SWAP(MR_hp, MR_global_hp, MR_Word *);
Index: runtime/mercury_deep_leave_port_body.h
===================================================================
RCS file: mercury_deep_leave_port_body.h
diff -N mercury_deep_leave_port_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_leave_port_body.h Sun May 13 01:27:16 2001
@@ -0,0 +1,87 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The implementation of {det,semi,non}_{exit,fail}_port_code_{ac,sr}.
+**
+** The code including this file should define the following macros:
+**
+** MR_PROCNAME: The name of the procedure whose body this is.
+** MR_FAIL_PORT or MR_EXIT_PORT:
+** Says which field to increment and whether the
+** procedure is has detism det or failure.
+** MR_VERSION_AC or MR_VERSION_SR:
+** Says whether the procedure whose body this is
+** is intended for use with or without
+** MR_USE_ACTIVATION_COUNTS.
+**
+** The code including this file should have the following variables in scope:
+**
+** MiddleCSD: The id of the current csd.
+** TopCSD: The id of the parent's csd.
+** OldOutermostActivationPtr: The id of the outermost activation of the
+** current user procedure before the current call
+** to it. Needed only with MR_VERSION_SR.
+*/
+
+#ifdef MR_DEEP_PROFILING
+{
+ MR_CallSiteDynamic *csd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+
+ csd = (MR_CallSiteDynamic *) MiddleCSD;
+ MR_deep_assert(csd == MR_current_call_site_dynamic);
+
+ #ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ /* increment exit/fail count */
+ #if defined(MR_FAIL_PORT)
+ csd->MR_csd_own.MR_own_fails++;
+ #elif defined(MR_EXIT_PORT)
+ csd->MR_csd_own.MR_own_exits++;
+ #else
+ #error "mercury_deep_leave_port_body.h: neither MR_FAIL_PORT nor MR_EXIT_PORT"
+ #endif
+ #endif
+
+ MR_deep_assert(csd->MR_csd_callee_ptr != NULL);
+ ps = csd->MR_csd_callee_ptr->MR_pd_proc_static;
+ MR_deep_assert(ps != NULL);
+
+ #if defined(MR_VERSION_AC)
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ /* decrement activation count */
+ ps->MR_ps_activation_count--;
+ MR_deep_assert(ps->MR_ps_activation_count >= 0);
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS not enabled");
+ #endif
+ #elif defined(MR_VERSION_SR)
+ #ifndef MR_USE_ACTIVATION_COUNTS
+ /* set outermost activation pointer */
+ ps->MR_ps_outermost_activation_ptr =
+ (MR_ProcDynamic *) OldOutermostActivationPtr;
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS enabled");
+ #endif
+ #else
+ #error "mercury_deep_leave_port_body.h: neither MR_VERSION_AC nor MR_VERSION_SR"
+ #endif
+
+ /* set current csd */
+ MR_current_call_site_dynamic = (MR_CallSiteDynamic *) TopCSD;
+
+ MR_leave_instrumentation();
+
+ /*
+ ** For MR_FAIL_PORT code, the failure we should execute here
+ ** is handled by code inserted by the compiler.
+ */
+}
+#else
+ MR_fatal_error(MR_PROCNAME ": deep profiling not enabled");
+#endif
Index: runtime/mercury_deep_profiling.c
===================================================================
RCS file: mercury_deep_profiling.c
diff -N mercury_deep_profiling.c
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_profiling.c Sun May 13 01:27:16 2001
@@ -0,0 +1,989 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** Deep profiling module
+**
+** Authors: conway, zs
+*/
+
+#include "mercury_imp.h"
+#include "mercury_ho_call.h"
+#include "mercury_stack_layout.h"
+#include "mercury_prof_time.h"
+#include "mercury_deep_profiling.h"
+
+#ifdef MR_DEEP_PROFILING
+
+#include <stdio.h>
+
+MR_CallSiteStatic MR_main_parent_call_site_statics[1] =
+{
+ { MR_callback, NULL, NULL, "Mercury runtime", 0, "" }
+};
+
+MR_User_ProcStatic MR_main_parent_proc_static =
+{
+ { MR_PREDICATE, "Mercury runtime", "Mercury runtime",
+ "Mercury runtime", 0, 0 },
+ "Mercury runtime",
+ 1,
+ &MR_main_parent_call_site_statics[0],
+#ifdef MR_USE_ACTIVATION_COUNTS
+ 0,
+#endif
+ NULL
+};
+
+MR_CallSiteDynamic *MR_main_parent_call_site_dynamics[1] =
+{
+ NULL
+};
+
+MR_ProcDynamic MR_main_parent_proc_dynamic =
+{
+ (MR_ProcStatic *) &MR_main_parent_proc_static,
+ &MR_main_parent_call_site_dynamics[0]
+};
+
+MR_CallSiteDynamic MR_main_grandparent_call_site_dynamic =
+{
+ &MR_main_parent_proc_dynamic,
+ {
+#ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ 0,
+ #else
+ /* the call count is computed from the other counts */
+ #endif
+ 0, 0, 0,
+#endif
+#ifdef MR_DEEP_PROFILING_TIMING
+ 0,
+#endif
+#ifdef MR_DEEP_PROFILING_MEMORY
+ 0, 0
+#endif
+ },
+ 0
+};
+
+MR_CallSiteDynamic *MR_current_call_site_dynamic =
+ &MR_main_grandparent_call_site_dynamic;
+MR_CallSiteDynamic *MR_next_call_site_dynamic = NULL;
+MR_CallSiteDynList **MR_current_callback_site =
+ (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;
+
+#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_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;
+int MR_deep_prof_prep_special_old = 0;
+int MR_deep_prof_prep_ho_new = 0;
+int MR_deep_prof_prep_ho_old = 0;
+
+int MR_deep_prof_call_old = 0;
+int MR_deep_prof_call_rec = 0;
+int MR_deep_prof_call_new = 0;
+
+#endif /* MR_DEEP_PROFILING_STATISTICS */
+
+void
+MR_deep_assert_failed(const char *cond, const char *filename, int linenumber)
+{
+ char buf[1024];
+
+ sprintf(buf, "Deep profiling assertion failed, %s:%d\n%s\n",
+ filename, linenumber, cond);
+ MR_fatal_error(buf);
+}
+
+void
+MR_setup_callback(void *entry)
+{
+ MR_CallSiteDynList *csd_list;
+ MR_CallSiteDynamic *csd;
+
+ MR_enter_instrumentation();
+ csd_list = *MR_current_callback_site;
+ while (csd_list != NULL)
+ {
+ if (csd_list->MR_csdlist_key == entry) {
+ MR_next_call_site_dynamic =
+ csd_list->MR_csdlist_call_site;
+ MR_leave_instrumentation();
+ return;
+ }
+
+ csd_list = csd_list->MR_csdlist_next;
+ }
+
+ MR_new_call_site_dynamic(csd);
+
+ csd_list = MR_PROFILING_MALLOC(MR_CallSiteDynList);
+ csd_list->MR_csdlist_key = entry;
+ csd_list->MR_csdlist_call_site = csd;
+ csd_list->MR_csdlist_next = *MR_current_callback_site;
+ *MR_current_callback_site = csd_list;
+
+ MR_next_call_site_dynamic = csd;
+ MR_leave_instrumentation();
+}
+
+#ifdef MR_DEEP_PROFILING_STATISTICS
+
+int MR_deep_prof_search_len;
+
+void
+MR_deep_profile_update_special_history(MR_TypeCtorInfo type_ctor_info)
+{
+ if (MR_deep_prof_search_len < MR_MAX_CLOSURE_LIST_LENGTH) {
+ MR_dictionary_search_lengths[MR_deep_prof_search_len]++;
+ }
+}
+
+void
+MR_deep_profile_update_closure_history(MR_Closure *closure)
+{
+ if (MR_deep_prof_search_len < MR_MAX_CLOSURE_LIST_LENGTH) {
+ MR_closure_search_lengths[MR_deep_prof_search_len]++;
+ }
+}
+
+#endif /* MR_DEEP_PROFILING_STATISTICS */
+
+/*----------------------------------------------------------------------------*/
+
+/*
+** Functions for writing out the data at the end of the execution.
+*/
+
+static void MR_write_out_id_string(FILE *fp);
+
+static void MR_write_out_call_site_static(FILE *fp,
+ const MR_CallSiteStatic *ptr);
+static void MR_write_out_call_site_dynamic(FILE *fp,
+ const MR_CallSiteDynamic *ptr);
+
+static void MR_write_out_proc_dynamic(FILE *fp, const MR_ProcDynamic *ptr);
+static void MR_write_out_ho_call_site_ptrs(FILE *fp,
+ const MR_ProcDynamic *ptr,
+ const MR_CallSiteDynList *dynlist);
+static void MR_write_out_ho_call_site_nodes(FILE *fp,
+ MR_CallSiteDynList *dynlist);
+
+typedef enum node_kind {
+ kind_csd, kind_pd, kind_css, kind_ps
+} MR_NodeKind;
+
+/* must correspond to fixed_size_int_bytes in deep/deep.io.m */
+#define MR_FIXED_SIZE_INT_BYTES 4
+
+static void MR_write_csd_ptr(FILE *fp, const MR_CallSiteDynamic *ptr);
+static void MR_write_ptr(FILE *fp, MR_NodeKind kind, const int node_id);
+static void MR_write_kind(FILE *fp, MR_CallSite_Kind kind);
+static void MR_write_byte(FILE *fp, const char byte);
+static void MR_write_num(FILE *fp, unsigned long num);
+static void MR_write_fixed_size_int(FILE *fp, unsigned long num);
+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....
+*/
+typedef struct MR_Profiling_Hash_Node_Struct {
+ const void *item;
+ int id;
+ bool written;
+ struct MR_Profiling_Hash_Node_Struct *next;
+} MR_ProfilingHashNode;
+
+typedef struct {
+ int last_id;
+ int length;
+ MR_ProfilingHashNode **nodes;
+} MR_ProfilingHashTable;
+
+static MR_ProfilingHashTable *MR_create_hash_table(int size);
+static bool MR_hash_table_insert(
+ MR_ProfilingHashTable *table,
+ const void *ptr,
+ int *id, bool *already_written,
+ bool init_written);
+static void MR_hash_table_flag_written(
+ MR_ProfilingHashTable *table,
+ const void *ptr);
+
+static MR_ProfilingHashTable *MR_call_site_dynamic_table;
+static MR_ProfilingHashTable *MR_call_site_static_table;
+static MR_ProfilingHashTable *MR_proc_dynamic_table;
+static MR_ProfilingHashTable *MR_proc_static_table;
+
+/*----------------------------------------------------------------------------*/
+/*----------------------------------------------------------------------------*/
+
+/*
+** A convenient prime for the size of the node hash tables.
+** The compiler contains nearly 10,000 preds, so a width of 10007
+** (requiring about 40K of storage - not onerous compared to the
+** size of the tree) will yield chain lengths of about 1 for the
+** MR_needed_proc_statics table. For the MR_seen_nodes table, which
+** stores all the MR_ProcDynamic nodes that have been seen, the average
+** chain length will be longer - a typical run of the compiler can have
+** as many as 50,000 nodes, so we don't want the table any narrower than this.
+*/
+
+static const int MR_hash_table_size = 10007;
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+static FILE *debug_fp;
+#endif
+
+void
+MR_write_out_profiling_tree(void)
+{
+ int i;
+ MR_ProfilingHashNode *n;
+ MR_Proc_Id *pid;
+ int root_pd_id;
+ FILE *fp;
+
+ fp = fopen("Deep.data", "w+");
+ if (fp == NULL) {
+ MR_fatal_error("Cannot open Deep.data");
+ }
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ debug_fp = fopen("Deep.debug", "w");
+ if (debug_fp == NULL) {
+ debug_fp = stderr;
+ }
+#endif
+
+ MR_write_out_id_string(fp);
+ MR_write_fixed_size_int(fp, 0);
+ MR_write_fixed_size_int(fp, 0);
+ MR_write_fixed_size_int(fp, 0);
+ MR_write_fixed_size_int(fp, 0);
+
+ MR_write_num(fp, MR_quanta_inside_deep_profiling_code);
+ MR_write_num(fp, MR_quanta_outside_deep_profiling_code);
+
+ MR_call_site_dynamic_table = MR_create_hash_table(MR_hash_table_size);
+ MR_call_site_static_table = MR_create_hash_table(MR_hash_table_size);
+ MR_proc_dynamic_table = MR_create_hash_table(MR_hash_table_size);
+ MR_proc_static_table = MR_create_hash_table(MR_hash_table_size);
+
+ if (MR_hash_table_insert(MR_proc_dynamic_table,
+ &MR_main_parent_proc_dynamic, &root_pd_id, NULL, FALSE))
+ {
+ MR_fatal_error(
+ "MR_write_out_profiling_tree: root seen before");
+ }
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "root = %p, %d\n",
+ &MR_main_parent_proc_dynamic, root_pd_id);
+#endif
+
+ MR_write_byte(fp, MR_deep_token_root);
+ MR_write_ptr(fp, kind_pd, root_pd_id);
+
+ MR_write_out_proc_dynamic(fp, &MR_main_parent_proc_dynamic);
+
+ MR_write_out_proc_static(fp,
+ (MR_ProcStatic *) &MR_main_parent_proc_static);
+ MR_deep_assert(MR_address_of_write_out_proc_statics != NULL);
+ (*MR_address_of_write_out_proc_statics)(fp);
+
+ rewind(fp);
+ 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);
+
+#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",
+ MR_deep_prof_prep_normal_new);
+ fprintf(stderr, "MR_deep_prof_prep_normal_old: %d\n",
+ MR_deep_prof_prep_normal_old);
+ fprintf(stderr, "MR_deep_prof_prep_special_new: %d\n",
+ MR_deep_prof_prep_special_new);
+ fprintf(stderr, "MR_deep_prof_prep_special_old: %d\n",
+ MR_deep_prof_prep_special_old);
+ fprintf(stderr, "MR_deep_prof_prep_ho_new: %d\n",
+ MR_deep_prof_prep_ho_new);
+ fprintf(stderr, "MR_deep_prof_prep_ho_old: %d\n",
+ 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",
+ MR_deep_prof_call_new);
+#endif
+}
+
+static void
+MR_write_out_id_string(FILE *fp)
+{
+ /* This string must match id_string deep/deep.io.m */
+ const char *id_string = "Mercury deep profiler data";
+ int i;
+
+ for (i = 0; id_string[i] != '\0'; i++) {
+ putc(id_string[i], fp);
+ }
+}
+
+void
+MR_write_out_proc_static(FILE *fp, const MR_ProcStatic *ptr)
+{
+ int ps_id;
+ int css_id;
+ bool already_written;
+ int i;
+
+ if (ptr == NULL) {
+ MR_fatal_error("MR_write_out_proc_static: null ps");
+ }
+
+ (void) MR_hash_table_insert(MR_proc_static_table, ptr,
+ &ps_id, &already_written, TRUE);
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "proc_static %p/%d\n", ptr, ps_id);
+ fprintf(debug_fp, " filename \"%s\", %d call sites\n",
+ ptr->MR_ps_file_name, ptr->MR_ps_num_call_sites);
+#endif
+
+ if (already_written) {
+ MR_fatal_error("MR_write_out_proc_static: seen ps");
+ }
+
+ MR_hash_table_flag_written(MR_proc_static_table, ptr);
+
+ MR_write_byte(fp, MR_deep_token_proc_static);
+ MR_write_ptr(fp, kind_ps, ps_id);
+
+ if (MR_PROC_ID_COMPILER_GENERATED(ptr->MR_ps_proc_id)) {
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, " compiler %s/%s/%s/%s/%d/%d\n",
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_type_name,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_type_module,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_def_module,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_pred_name,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_arity,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_mode);
+#endif
+
+ MR_write_byte(fp, MR_deep_token_isa_compiler_generated);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_type_name);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_type_module);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_def_module);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_pred_name);
+ MR_write_num(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_arity);
+ MR_write_num(fp,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_mode);
+ } else {
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, " user %d/%s/%s/%s/%d/%d\n",
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_pred_or_func,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_decl_module,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_def_module,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_name,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_arity,
+ ptr->MR_ps_proc_id.MR_proc_comp.MR_comp_mode);
+#endif
+
+ if (ptr->MR_ps_proc_id.MR_proc_user.MR_user_pred_or_func
+ == MR_PREDICATE)
+ {
+ MR_write_byte(fp, MR_deep_token_isa_predicate);
+ } else {
+ MR_write_byte(fp, MR_deep_token_isa_function);
+ }
+
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_decl_module);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_def_module);
+ MR_write_string(fp,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_name);
+ MR_write_num(fp,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_arity);
+ MR_write_num(fp,
+ ptr->MR_ps_proc_id.MR_proc_user.MR_user_mode);
+ }
+
+ MR_write_string(fp, ptr->MR_ps_file_name);
+ MR_write_num(fp, ptr->MR_ps_num_call_sites);
+
+ for (i = 0; i < ptr->MR_ps_num_call_sites; i++) {
+ (void) MR_hash_table_insert(MR_call_site_static_table,
+ &ptr->MR_ps_call_sites[i], &css_id, NULL, FALSE);
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp,
+ "call site id %d in proc_static %p/%d -> %d\n",
+ i, ptr, ps_id, css_id);
+#endif
+
+ MR_write_ptr(fp, kind_css, css_id);
+ }
+
+ for (i = 0; i < ptr->MR_ps_num_call_sites; i++) {
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "in proc_static %p/%d, call site %d\n",
+ ptr, ps_id, i);
+#endif
+
+ MR_write_out_call_site_static(fp, &ptr->MR_ps_call_sites[i]);
+ }
+}
+
+static void
+MR_write_out_call_site_static(FILE *fp, const MR_CallSiteStatic *ptr)
+{
+ int css_id;
+ int ps_id;
+ bool already_written;
+
+ if (ptr == NULL) {
+ MR_fatal_error("MR_write_out_call_site_static: null css");
+ }
+
+ (void) MR_hash_table_insert(MR_call_site_static_table, ptr,
+ &css_id, &already_written, TRUE);
+
+ if (already_written) {
+ MR_fatal_error("MR_write_out_call_site_static: seen css");
+ }
+
+ MR_hash_table_flag_written(MR_call_site_static_table, ptr);
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "call_site_static %p/%d\n", ptr, css_id);
+ fprintf(debug_fp,
+ " filename \"%s\", linenum %d, goal path %s, kind %d\n",
+ ptr->MR_css_file_name, ptr->MR_css_line_number,
+ ptr->MR_css_goal_path, ptr->MR_css_kind);
+#endif
+
+ MR_write_byte(fp, MR_deep_token_call_site_static);
+ MR_write_ptr(fp, kind_css, css_id);
+ MR_write_kind(fp, ptr->MR_css_kind);
+ if (ptr->MR_css_kind == MR_normal_call) {
+ (void) MR_hash_table_insert(MR_proc_static_table,
+ ptr->MR_css_callee_ptr_if_known, &ps_id, NULL, FALSE);
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, " callee %p/%d\n",
+ ptr->MR_css_callee_ptr_if_known, ps_id);
+#endif
+ MR_write_num(fp, ps_id);
+ if (ptr->MR_css_type_subst_if_known != NULL) {
+ MR_write_string(fp,
+ ptr->MR_css_type_subst_if_known);
+ } else {
+ MR_write_string(fp, "");
+ }
+ }
+ /* XXX MR_css_file_name */
+ MR_write_num(fp, ptr->MR_css_line_number);
+ MR_write_string(fp, ptr->MR_css_goal_path);
+}
+
+static void
+MR_write_out_call_site_dynamic(FILE *fp, const MR_CallSiteDynamic *ptr)
+{
+ int bitmask = 0;
+ int csd_id;
+ int pd_id;
+
+ if (ptr == NULL) {
+ return;
+ }
+
+#ifdef MR_DEEP_PROFILING_STATISTICS
+ MR_amount_of_memory += sizeof(MR_CallSiteDynamic);
+#endif
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "call_site_dynamic %p: callee proc_dynamic %p\n",
+ ptr, ptr->MR_csd_callee_ptr);
+#endif
+
+ MR_write_byte(fp, MR_deep_token_call_site_dynamic);
+ if (! MR_hash_table_insert(MR_call_site_dynamic_table, ptr,
+ &csd_id, NULL, TRUE))
+ {
+ MR_fatal_error(
+ "MR_write_out_call_site_dynamic: insert succeeded");
+ }
+
+ MR_write_ptr(fp, kind_csd, csd_id);
+ if (ptr->MR_csd_callee_ptr == NULL) {
+ pd_id = 0;
+ } else {
+ (void) MR_hash_table_insert(MR_proc_dynamic_table,
+ ptr->MR_csd_callee_ptr, &pd_id, NULL, FALSE);
+ }
+
+ MR_write_ptr(fp, kind_pd, pd_id);
+
+#ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ if (ptr->MR_csd_own.MR_own_calls != 0)
+ bitmask |= 0x0001;
+ #endif
+ if (ptr->MR_csd_own.MR_own_exits != 0)
+ bitmask |= 0x0002;
+ if (ptr->MR_csd_own.MR_own_fails != 0)
+ bitmask |= 0x0004;
+ if (ptr->MR_csd_own.MR_own_redos != 0)
+ bitmask |= 0x0008;
+#endif
+#ifdef MR_DEEP_PROFILING_TIMING
+ if (ptr->MR_csd_own.MR_own_quanta != 0)
+ bitmask |= 0x0010;
+#endif
+#ifdef MR_DEEP_PROFILING_MEMORY
+ if (ptr->MR_csd_own.MR_own_allocs != 0)
+ bitmask |= 0x0020;
+ if (ptr->MR_csd_own.MR_own_words != 0)
+ bitmask |= 0x0040;
+#endif
+
+ MR_write_num(fp, bitmask);
+
+#ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ if (ptr->MR_csd_own.MR_own_calls != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_calls);
+ #endif
+ if (ptr->MR_csd_own.MR_own_exits != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_exits);
+ if (ptr->MR_csd_own.MR_own_fails != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_fails);
+ if (ptr->MR_csd_own.MR_own_redos != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_redos);
+#endif
+
+#ifdef MR_DEEP_PROFILING_TIMING
+ if (ptr->MR_csd_own.MR_own_quanta != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_quanta);
+#endif
+
+#ifdef MR_DEEP_PROFILING_MEMORY
+ if (ptr->MR_csd_own.MR_own_allocs != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_allocs);
+ if (ptr->MR_csd_own.MR_own_words != 0)
+ MR_write_num(fp, ptr->MR_csd_own.MR_own_words);
+#endif
+
+ MR_write_out_proc_dynamic(fp, ptr->MR_csd_callee_ptr);
+}
+
+static void
+MR_write_out_proc_dynamic(FILE *fp, const MR_ProcDynamic *ptr)
+{
+ int i;
+ int pd_id;
+ int ps_id;
+ bool already_written;
+
+ /*
+ ** This shouldn't really happen except that we don't have correct
+ ** handling of nondet pragma_foreign_code yet.
+ */
+
+ if (ptr == NULL) {
+ return;
+ }
+
+ if (! MR_hash_table_insert(MR_proc_dynamic_table, ptr,
+ &pd_id, &already_written, TRUE))
+ {
+ MR_fatal_error("MR_write_out_proc_dynamic: unseen pd");
+ }
+
+ if (already_written) {
+ return;
+ }
+
+ MR_hash_table_flag_written(MR_proc_dynamic_table, ptr);
+ (void) MR_hash_table_insert(MR_proc_static_table,
+ 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*) *
+ ptr->MR_pd_proc_static->MR_ps_num_call_sites;
+#endif
+
+ MR_write_byte(fp, MR_deep_token_proc_dynamic);
+ MR_write_ptr(fp, kind_pd, pd_id);
+ MR_write_ptr(fp, kind_ps, ps_id);
+ MR_write_num(fp, ptr->MR_pd_proc_static->MR_ps_num_call_sites);
+
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, "proc_dynamic %p/%d, proc_static %p/%d\n",
+ ptr, pd_id, ptr->MR_pd_proc_static, ps_id);
+#endif
+
+ for (i = 0; i < ptr->MR_pd_proc_static->MR_ps_num_call_sites; i++) {
+ MR_write_kind(fp, ptr->MR_pd_proc_static->
+ MR_ps_call_sites[i].MR_css_kind);
+ switch (ptr->MR_pd_proc_static->
+ MR_ps_call_sites[i].MR_css_kind)
+ {
+ case MR_normal_call:
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, " normal call from pd %p to pd %p\n",
+ ptr, ptr->MR_pd_call_site_ptr_ptrs[i]);
+#endif
+ MR_write_csd_ptr(fp,
+ ptr->MR_pd_call_site_ptr_ptrs[i]);
+ break;
+
+ case MR_special_call:
+ case MR_higher_order_call:
+ case MR_method_call:
+ case MR_callback:
+ MR_write_out_ho_call_site_ptrs(fp, ptr,
+ (MR_CallSiteDynList *)
+ ptr->MR_pd_call_site_ptr_ptrs[i]);
+ break;
+ }
+ }
+
+ for (i = 0; i < ptr->MR_pd_proc_static->MR_ps_num_call_sites; i++) {
+ switch (ptr->MR_pd_proc_static->
+ MR_ps_call_sites[i].MR_css_kind)
+ {
+ case MR_normal_call:
+ MR_write_out_call_site_dynamic(fp,
+ ptr->MR_pd_call_site_ptr_ptrs[i]);
+ break;
+
+ case MR_special_call:
+ case MR_higher_order_call:
+ case MR_method_call:
+ case MR_callback:
+ MR_write_out_ho_call_site_nodes(fp,
+ (MR_CallSiteDynList *)
+ ptr->MR_pd_call_site_ptr_ptrs[i]);
+ break;
+ }
+ }
+}
+
+static void
+MR_write_out_ho_call_site_ptrs(FILE *fp, const MR_ProcDynamic *ptr,
+ const MR_CallSiteDynList *dynlist)
+{
+ while (dynlist != NULL) {
+#ifdef MR_DEEP_PROFILING_STATISTICS
+ MR_amount_of_memory += sizeof(MR_CallSiteDynList);
+#endif
+#ifdef MR_DEEP_PROFILING_DEBUG
+ fprintf(debug_fp, " multi call from pd %p to pd %p\n",
+ ptr, dynlist->MR_csdlist_call_site);
+#endif
+ MR_write_csd_ptr(fp, dynlist->MR_csdlist_call_site);
+ dynlist = dynlist->MR_csdlist_next;
+ }
+ MR_write_byte(fp, MR_deep_token_end);
+}
+
+static void
+MR_write_out_ho_call_site_nodes(FILE *fp, MR_CallSiteDynList *dynlist)
+{
+ while (dynlist != NULL) {
+ MR_write_out_call_site_dynamic(fp,
+ dynlist->MR_csdlist_call_site);
+ dynlist = dynlist->MR_csdlist_next;
+ }
+}
+
+static void
+MR_write_csd_ptr(FILE *fp, const MR_CallSiteDynamic *ptr)
+{
+ int csd_id;
+
+ if (ptr == NULL) {
+ csd_id = 0;
+ } else {
+ (void) MR_hash_table_insert(MR_call_site_dynamic_table, ptr,
+ &csd_id, NULL, FALSE);
+ }
+
+ MR_write_ptr(fp, kind_csd, csd_id);
+}
+
+static void
+MR_write_ptr(FILE *fp, MR_NodeKind kind, int node_id)
+{
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "ptr: %d\n", node_id);
+#endif
+
+ /* MR_write_byte(fp, (int) kind); */
+ MR_write_num(fp, node_id);
+}
+
+static void
+MR_write_kind(FILE *fp, MR_CallSite_Kind kind)
+{
+ int byte;
+
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "call_site_kind: %d\n", (int) kind);
+#endif
+
+ /* convert from a MR_CallSite_Kind to an MR_Profiling_Encoding_Token */
+ byte = (int) kind +
+ ((int) MR_deep_token_normal_call - (int) MR_normal_call);
+ if (byte < MR_deep_token_normal_call || byte > MR_deep_token_callback)
+ {
+ MR_fatal_error("MR_write_kind: bad kind %d %d\n",
+ (int) kind, byte);
+ }
+
+ MR_write_byte(fp, byte);
+}
+
+static void
+MR_write_byte(FILE *fp, const char byte)
+{
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "byte: %d\n", (int) byte);
+#endif
+ putc(byte, fp);
+}
+
+static void
+MR_write_num(FILE *fp, unsigned long num)
+{
+ unsigned char pieces[sizeof(unsigned long) * 8 / 7 + 1];
+ int i;
+
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "num: %ld\n", num);
+#endif
+
+ MR_deep_assert((int) num >= 0);
+
+ i = 0;
+ do {
+ pieces[i] = num & 0x7f;
+ num = num >> 7;
+ i++;
+ } while (num != 0);
+
+ i--;
+
+ while (i > 0) {
+ putc(pieces[i--] | 0x80, fp);
+ }
+ putc(pieces[0], fp);
+}
+
+static void
+MR_write_fixed_size_int(FILE *fp, unsigned long num)
+{
+ int i;
+
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "fixed_size_int: %ld\n", num);
+#endif
+
+ MR_deep_assert((int) num >= 0);
+
+ for (i = 0; i < MR_FIXED_SIZE_INT_BYTES; i++) {
+ putc(num & ((1 << 8) - 1), fp);
+ num = num >> 8;
+ }
+}
+
+static void
+MR_write_string(FILE *fp, const char *ptr)
+{
+ int i, len;
+
+#ifdef MR_DEEP_PROFILING_DETAIL_DEBUG
+ fprintf(debug_fp, "string: <%s>\n", ptr);
+#endif
+
+ len = strlen(ptr);
+ MR_write_num(fp, len);
+ for (i = 0; i < len; i++) {
+ putc(ptr[i], fp);
+ }
+}
+
+/*----------------------------------------------------------------------------*/
+
+static MR_ProfilingHashTable *
+MR_create_hash_table(int size)
+{
+ MR_ProfilingHashTable *ptr;
+ ptr = MR_NEW(MR_ProfilingHashTable);
+ ptr->length = size;
+ ptr->last_id = 0;
+ ptr->nodes = MR_NEW_ARRAY(MR_ProfilingHashNode *, size);
+
+ return ptr;
+}
+
+static bool
+MR_hash_table_insert(MR_ProfilingHashTable *table, const void *ptr,
+ int *id, bool *already_written, bool init_written)
+{
+ int hash;
+ MR_ProfilingHashNode *node;
+
+ if (ptr == NULL) {
+ MR_fatal_error("NULL ptr in MR_hash_table_insert");
+ }
+
+ hash = ((unsigned int) ptr >> 2) % table->length;
+
+ node = table->nodes[hash];
+ while (node != NULL) {
+ if (node->item == ptr) {
+ *id = node->id;
+ if (already_written != NULL) {
+ *already_written = node->written;
+ }
+ return TRUE;
+ }
+ node = node->next;
+ }
+
+ node = MR_NEW(MR_ProfilingHashNode);
+ node->item = ptr;
+ node->id = ++table->last_id;
+ node->written = init_written;
+ node->next = table->nodes[hash];
+ table->nodes[hash] = node;
+
+ *id = node->id;
+ if (already_written != NULL) {
+ *already_written = FALSE;
+ }
+
+ return FALSE;
+}
+
+static void
+MR_hash_table_flag_written(MR_ProfilingHashTable *table, const void *ptr)
+{
+ int hash;
+ MR_ProfilingHashNode *node;
+
+ if (ptr == NULL) {
+ MR_fatal_error("NULL ptr in MR_hash_table_flag_written");
+ }
+
+ hash = ((unsigned int) ptr >> 2) % table->length;
+
+ node = table->nodes[hash];
+ while (node != NULL) {
+ if (node->item == ptr) {
+ node->written = TRUE;
+ return;
+ }
+ node = node->next;
+ }
+
+ MR_fatal_error("MR_hash_table_flag_written: did not find node");
+}
+
+void
+MR_deep_prof_init(void)
+{
+#ifdef MR_DEEP_PROFILING_TIMING
+ MR_init_time_profile_method();
+#endif
+}
+
+static void MR_deep_tick_handler(int signum);
+
+void
+MR_deep_prof_turn_on_time_profiling(void)
+{
+#ifdef MR_DEEP_PROFILING_TIMING
+ MR_turn_on_time_profiling(MR_deep_tick_handler);
+#endif
+}
+
+void
+MR_deep_prof_turn_off_time_profiling(void)
+{
+#ifdef MR_DEEP_PROFILING_TIMING
+ MR_turn_off_time_profiling();
+#endif
+}
+
+#ifdef MR_DEEP_PROFILING_TIMING
+
+static void
+MR_deep_tick_handler(/* unused */ int signum)
+{
+ if (MR_inside_deep_profiling_code) {
+ MR_quanta_inside_deep_profiling_code++;
+ } else {
+ MR_quanta_outside_deep_profiling_code++;
+ MR_current_call_site_dynamic->MR_csd_own.MR_own_quanta++;
+ }
+}
+
+#endif
+
+#endif /* MR_DEEP_PROFILING */
Index: runtime/mercury_deep_profiling.h
===================================================================
RCS file: mercury_deep_profiling.h
diff -N mercury_deep_profiling.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_profiling.h Sun May 13 12:37:30 2001
@@ -0,0 +1,370 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_deep_profiling.h -- definitions for deep profiling.
+*/
+
+#ifndef MERCURY_DEEP_PROFILING_H
+#define MERCURY_DEEP_PROFILING_H
+
+#include "mercury_stack_layout.h"
+#include "mercury_ho_call.h"
+#include <stdio.h>
+
+typedef enum {
+ MR_normal_call,
+ MR_special_call,
+ MR_higher_order_call,
+ MR_method_call,
+ MR_callback
+} MR_CallSite_Kind;
+
+typedef struct MR_CallSiteStatic_Struct MR_CallSiteStatic;
+typedef struct MR_CallSiteDynamic_Struct MR_CallSiteDynamic;
+typedef struct MR_User_ProcStatic_Struct MR_User_ProcStatic;
+typedef struct MR_Compiler_ProcStatic_Struct MR_Compiler_ProcStatic;
+typedef struct MR_ProcStatic_Struct MR_ProcStatic;
+typedef struct MR_ProcDynamic_Struct MR_ProcDynamic;
+typedef struct MR_ProfilingMetrics_Struct MR_ProfilingMetrics;
+
+typedef struct MR_CallSiteDynList_Struct MR_CallSiteDynList;
+
+struct MR_ProfilingMetrics_Struct {
+#ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ unsigned MR_own_calls;
+ #else
+ /* calls are computed from the other fields */
+ #endif
+ unsigned MR_own_exits;
+ unsigned MR_own_fails;
+ unsigned MR_own_redos;
+#endif
+#ifdef MR_DEEP_PROFILING_TIMING
+ unsigned MR_own_quanta;
+#endif
+#ifdef MR_DEEP_PROFILING_MEMORY
+ unsigned MR_own_allocs;
+ unsigned MR_own_words;
+#endif
+};
+
+struct MR_CallSiteStatic_Struct {
+ MR_CallSite_Kind MR_css_kind;
+ MR_ProcStatic *MR_css_callee_ptr_if_known;
+ MR_ConstString MR_css_type_subst_if_known;
+ MR_ConstString MR_css_file_name;
+ int MR_css_line_number;
+ MR_ConstString MR_css_goal_path;
+};
+
+struct MR_ProcStatic_Struct {
+ MR_Proc_Id MR_ps_proc_id;
+ MR_ConstString MR_ps_file_name;
+ int MR_ps_num_call_sites;
+ const MR_CallSiteStatic *MR_ps_call_sites;
+#ifdef MR_USE_ACTIVATION_COUNTS
+ int MR_ps_activation_count;
+#endif
+ MR_ProcDynamic *MR_ps_outermost_activation_ptr;
+};
+
+struct MR_User_ProcStatic_Struct {
+ MR_User_Proc_Id MR_ps_proc_id;
+ MR_ConstString MR_ps_file_name;
+ int MR_ps_num_call_sites;
+ const MR_CallSiteStatic *MR_ps_call_sites;
+#ifdef MR_USE_ACTIVATION_COUNTS
+ int MR_ps_activation_count;
+#endif
+ MR_ProcDynamic *MR_ps_outermost_activation_ptr;
+};
+
+struct MR_Compiler_ProcStatic_Struct {
+ MR_Compiler_Proc_Id MR_ps_proc_id;
+ MR_ConstString MR_ps_file_name;
+ int MR_ps_num_call_sites;
+ const MR_CallSiteStatic *MR_ps_call_sites;
+#ifdef MR_USE_ACTIVATION_COUNTS
+ int MR_ps_activation_count;
+#endif
+ MR_ProcDynamic *MR_ps_outermost_activation_ptr;
+};
+
+struct MR_CallSiteDynamic_Struct {
+ MR_ProcDynamic *MR_csd_callee_ptr;
+ MR_ProfilingMetrics MR_csd_own;
+ unsigned long MR_csd_depth_count;
+};
+
+struct MR_ProcDynamic_Struct {
+ MR_ProcStatic *MR_pd_proc_static;
+ MR_CallSiteDynamic **MR_pd_call_site_ptr_ptrs;
+};
+
+struct MR_CallSiteDynList_Struct {
+ MR_CallSiteDynamic *MR_csdlist_call_site;
+ const void *MR_csdlist_key;
+ MR_CallSiteDynList *MR_csdlist_next;
+};
+
+typedef enum {
+ MR_deep_token_end = 0,
+ MR_deep_token_root,
+ MR_deep_token_call_site_static,
+ MR_deep_token_call_site_dynamic,
+ MR_deep_token_proc_static,
+ MR_deep_token_proc_dynamic,
+ MR_deep_token_normal_call,
+ MR_deep_token_special_call,
+ MR_deep_token_higher_order_call,
+ MR_deep_token_method_call,
+ MR_deep_token_callback,
+ MR_deep_token_isa_predicate,
+ MR_deep_token_isa_function,
+ MR_deep_token_isa_compiler_generated
+} MR_Profile_Encoding_Token;
+
+#define MR_enter_instrumentation() \
+ do { MR_inside_deep_profiling_code = TRUE; } while (0)
+#define MR_leave_instrumentation() \
+ do { MR_inside_deep_profiling_code = FALSE; } while (0)
+
+#ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
+ #define MR_init_own_call_port(csd) \
+ do { \
+ (csd)->MR_csd_own.MR_own_calls = 0; \
+ } while (0)
+#else
+ #define MR_init_own_call_port(csd) \
+ ((void) 0)
+#endif
+
+#ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ #define MR_init_own_ports(csd) \
+ do { \
+ MR_init_own_call_port(csd); \
+ (csd)->MR_csd_own.MR_own_exits = 0; \
+ (csd)->MR_csd_own.MR_own_fails = 0; \
+ (csd)->MR_csd_own.MR_own_redos = 0; \
+ } while (0)
+#else
+ #define MR_init_own_ports(csd) \
+ ((void) 0)
+#endif
+
+#ifdef MR_DEEP_PROFILING_TIMING
+ #define MR_init_own_quanta(csd) \
+ do { \
+ (csd)->MR_csd_own.MR_own_quanta = 0; \
+ } while (0)
+#else
+ #define MR_init_own_quanta(csd) \
+ ((void) 0)
+#endif
+
+#ifdef MR_DEEP_PROFILING_MEMORY
+ #define MR_init_own_memory(csd) \
+ do { \
+ (csd)->MR_csd_own.MR_own_allocs = 0; \
+ (csd)->MR_csd_own.MR_own_words = 0; \
+ } while (0)
+#else
+ #define MR_init_own_memory(csd) \
+ ((void) 0)
+#endif
+
+#ifdef MR_DEEP_PROFILING_TAIL_RECURSION
+ #define MR_init_depth_count(csd) \
+ do { \
+ (csd)->MR_csd_depth_count = 0; \
+ } while (0)
+#else
+ #define MR_init_depth_count(csd) \
+ ((void) 0)
+#endif
+
+#define MR_new_call_site_dynamic(newcsd) \
+ do { \
+ newcsd = MR_PROFILING_MALLOC(MR_CallSiteDynamic); \
+ \
+ newcsd->MR_csd_callee_ptr = NULL; \
+ MR_init_own_ports(newcsd); \
+ MR_init_own_quanta(newcsd); \
+ MR_init_own_memory(newcsd); \
+ MR_init_depth_count(newcsd); \
+ } while (0)
+
+#define MR_new_proc_dynamic(pd, ps) \
+ 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 = \
+ MR_PROFILING_MALLOC_ARRAY(MR_CallSiteDynamic *, \
+ (ps)->MR_ps_num_call_sites); \
+ \
+ for (i = 0; i < (ps)->MR_ps_num_call_sites; i++) { \
+ (pd)->MR_pd_call_site_ptr_ptrs[i] = NULL; \
+ } \
+ } while (0)
+
+#ifdef MR_DEEP_PROFILING_STATISTICS
+ extern int MR_deep_prof_search_len;
+ extern void MR_deep_profile_update_special_history(MR_TypeCtorInfo);
+ extern void MR_deep_profile_update_closure_history(MR_Closure *);
+
+ #define MR_maybe_init_search_len() \
+ do { MR_deep_prof_search_len = 0; } while(0)
+ #define MR_maybe_increment_search_len() \
+ do { MR_deep_prof_search_len++; } while (0)
+ #define MR_maybe_deep_profile_update_special_history(typectorinfo) \
+ 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)
+ #define MR_maybe_increment_search_len() \
+ ((void) 0)
+ #define MR_maybe_deep_profile_update_special_history(typeinfo) \
+ ((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) \
+ if (prev != NULL) { \
+ 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; \
+ }
+#else
+ #define MR_maybe_update_prev(csdlist, prev) \
+ ((void) 0)
+ #define MR_maybe_move_to_front(csdlist, prev, pd, csn) \
+ ((void) 0)
+#endif
+
+#define MR_search_csdlist(csdlist, prev, pd, csn, void_key) \
+ do { \
+ (csdlist) = (MR_CallSiteDynList *) (pd)-> \
+ MR_pd_call_site_ptr_ptrs[(csn)]; \
+ MR_maybe_init_search_len(); \
+ while ((csdlist) != NULL) { \
+ MR_maybe_increment_search_len(); \
+ if ((csdlist)->MR_csdlist_key == (void_key)) { \
+ MR_maybe_move_to_front((csdlist), (prev),\
+ (pd), (csn)); \
+ break; \
+ } \
+ MR_maybe_update_prev((csdlist), (prev)); \
+ (csdlist) = (csdlist)->MR_csdlist_next; \
+ } \
+ } while (0)
+
+#define MR_make_and_link_csdlist(csdlist, newcsd, pd, csn, void_key) \
+ do { \
+ (csdlist) = MR_PROFILING_MALLOC(MR_CallSiteDynList); \
+ (csdlist)->MR_csdlist_key = (void_key); \
+ (csdlist)->MR_csdlist_call_site = (newcsd); \
+ (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)
+
+#define MR_make_and_link_csdlist_callback(csdlist, newcsd, void_key) \
+ do { \
+ (csdlist) = MR_PROFILING_MALLOC(MR_CallSiteDynList); \
+ (csdlist)->MR_csdlist_key = (void_key); \
+ (csdlist)->MR_csdlist_call_site = (newcsd); \
+ (csdlist)->MR_csdlist_next = *MR_current_callback_site; \
+ *MR_current_callback_site = (csdlist); \
+ } while (0)
+
+#ifdef MR_DEEP_CHECKS
+ #define MR_deep_assert(cond) \
+ do { \
+ if (!(cond)) { \
+ MR_deep_assert_failed(MR_STRINGIFY(cond), \
+ __FILE__, __LINE__); \
+ } \
+ } while (0)
+#else
+ #define MR_deep_assert(cond) \
+ ((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;
+
+#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;
+extern int MR_deep_prof_prep_special_old;
+extern int MR_deep_prof_prep_ho_new;
+extern int MR_deep_prof_prep_ho_old;
+
+extern int MR_deep_prof_call_old;
+extern int MR_deep_prof_call_rec;
+extern int MR_deep_prof_call_new;
+
+#endif /* MR_DEEP_PROFILING_STATISTICS */
+
+extern void MR_deep_assert_failed(const char *cond,
+ const char *filename, int linenumber);
+extern void MR_setup_callback(void *entry);
+extern void MR_write_out_proc_static(FILE *fp, const MR_ProcStatic *ptr);
+extern void MR_write_out_profiling_tree(void);
+
+extern void MR_deep_prof_init(void);
+
+extern void MR_deep_prof_turn_on_time_profiling(void);
+extern void MR_deep_prof_turn_off_time_profiling(void);
+
+#define MR_PROFILING_MALLOC(type) MR_NEW(type)
+#define MR_PROFILING_MALLOC_ARRAY(type, nelems) MR_NEW_ARRAY(type, nelems)
+
+#endif /* not MERCURY_DEEP_PROFILING_H */
Index: runtime/mercury_deep_profiling_hand.h
===================================================================
RCS file: mercury_deep_profiling_hand.h
diff -N mercury_deep_profiling_hand.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_profiling_hand.h Thu May 3 17:54:44 2001
@@ -0,0 +1,443 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_deep_profiling_hand.h -- definitions for deep profiling
+** for use in hand-written procedures.
+*/
+
+#ifndef MERCURY_DEEP_PROFILING_HAND_H
+#define MERCURY_DEEP_PROFILING_HAND_H
+
+#include "mercury_std.h"
+#include "mercury_deep_profiling.h"
+
+#define MR_proc_static_user_builtin_name(name, arity, mode) \
+ MR_PASTE6(mercury_data__proc_static__mercury__, \
+ name, _, arity, _, mode)
+#define MR_call_sites_user_builtin_name(name, arity, mode) \
+ MR_PASTE6(mercury_data__proc_static_call_sites__mercury__, \
+ name, _, arity, _, mode)
+
+#define MR_proc_static_user_name(module, name, arity, mode) \
+ MR_PASTE8(mercury_data__proc_static__mercury__, \
+ module, __, name, _, arity, _, mode)
+#define MR_call_sites_user_name(module, name, arity, mode) \
+ MR_PASTE8(mercury_data__proc_static_call_sites__mercury__, \
+ module, __, name, _, arity, _, mode)
+
+#define MR_proc_static_compiler_name(module, name, type, arity, mode) \
+ MR_PASTE10(mercury_data__proc_static__mercury__, \
+ name, _, module, __, type, _, arity, _, mode)
+#define MR_call_sites_compiler_name(module, name, type, arity, mode) \
+ MR_PASTE10(mercury_data__proc_static_call_sites__mercury__, \
+ name, _, module, __, type, _, arity, _, mode)
+
+#ifdef MR_USE_ACTIVATION_COUNTS
+ #define MR_maybe_activation_count_field 0,
+#else
+ #define MR_maybe_activation_count_field
+#endif
+
+#define MR_proc_static_user_builtin_empty(name, arity, mode, file) \
+ MR_User_ProcStatic \
+ MR_proc_static_user_builtin_name(name, arity, mode) = { \
+ { \
+ MR_PREDICATE, \
+ "builtin", \
+ "builtin", \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 0, \
+ NULL, \
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+#define MR_proc_static_compiler_empty(module, name, type, arity, mode, file) \
+ MR_Compiler_ProcStatic \
+ MR_proc_static_compiler_name(module, name, type, arity, mode) = { \
+ { \
+ MR_STRINGIFY(type), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 0, \
+ NULL, \
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+#define MR_proc_static_user_empty(module, name, arity, mode, file) \
+ MR_User_ProcStatic \
+ MR_proc_static_user_name(module, name, arity, mode) = { \
+ { \
+ MR_PREDICATE, \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 0, \
+ NULL, \
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+#define MR_proc_static_user_plain(module, name, arity, mode, cmodule, cname, carity, cmode, file, line)\
+ static const MR_CallSiteStatic \
+ MR_call_sites_user_name(module, name, arity, mode)[] = { \
+ { MR_normal_call, (MR_ProcStatic *) \
+ &MR_proc_static_user_name(cmodule, cname, carity, cmode),\
+ NULL, "", line, "" } \
+ }; \
+ \
+ MR_User_ProcStatic \
+ MR_proc_static_user_name(module, name, arity, mode) = { \
+ { \
+ MR_PREDICATE, \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 1, \
+ MR_call_sites_user_name(module, name, arity, mode), \
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+#define MR_proc_static_compiler_plain(module, name, type, arity, mode, cmodule, cname, carity, cmode, file, line)\
+ static const MR_CallSiteStatic \
+ MR_call_sites_compiler_name(module, name, type, arity, mode)[] = {\
+ { MR_normal_call, (MR_ProcStatic *) \
+ &MR_proc_static_user_name(cmodule, cname, carity, cmode),\
+ NULL, "", line, "" } \
+ }; \
+ \
+ MR_Compiler_ProcStatic \
+ MR_proc_static_compiler_name(module, name, type, arity, mode) = {\
+ { \
+ MR_STRINGIFY(type), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 1, \
+ MR_call_sites_compiler_name(module, name, type, arity, mode),\
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+#define MR_proc_static_user_ho(module, name, arity, mode, file, line) \
+ static const MR_CallSiteStatic \
+ MR_call_sites_user_name(module, name, arity, mode)[] = { \
+ { MR_higher_order_call, NULL, \
+ NULL, "", line, "" } \
+ }; \
+ \
+ MR_User_ProcStatic \
+ MR_proc_static_user_name(module, name, arity, mode) = { \
+ { \
+ MR_PREDICATE, \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(module), \
+ MR_STRINGIFY(name), \
+ arity, \
+ mode, \
+ }, \
+ file, \
+ 1, \
+ MR_call_sites_user_name(module, name, arity, mode), \
+ MR_maybe_activation_count_field \
+ NULL \
+ }
+
+/*****************************************************************************/
+
+#define MR_deep_det_call_ac(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__det_call_port_code_ac_3_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_stackvar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_stackvar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ (void) 0
+
+#define MR_deep_det_exit_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__det_exit_port_code_ac_2_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#define MR_deep_det_call_sr(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__det_call_port_code_sr_4_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_stackvar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_stackvar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ MR_stackvar(first_slot+2) = MR_r3; /* OldActivationPtr */ \
+ (void) 0
+
+#define MR_deep_det_exit_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_r3 = MR_stackvar(first_slot+2); /* OldActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__det_exit_port_code_sr_3_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#define MR_deep_semi_call_ac(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_call_port_code_ac_3_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_stackvar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_stackvar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ (void) 0
+
+#define MR_deep_semi_exit_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_exit_port_code_ac_2_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_semi_fail_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_fail_port_code_ac_2_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#define MR_deep_semi_call_sr(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_call_port_code_sr_4_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_stackvar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_stackvar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ MR_stackvar(first_slot+2) = MR_r3; /* OldActivationPtr */ \
+ (void) 0
+
+#define MR_deep_semi_exit_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_r3 = MR_stackvar(first_slot+2); /* OldActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_exit_port_code_sr_3_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_semi_fail_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_stackvar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_stackvar(first_slot+1); /* MiddleCSD */ \
+ MR_r3 = MR_stackvar(first_slot+2); /* OldActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__semi_fail_port_code_sr_3_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#define MR_deep_non_call_ac(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_call_port_code_ac_4_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_framevar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_framevar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ MR_framevar(first_slot+3) = MR_r3; /* NewActivationPtr */ \
+ (void) 0
+
+#define MR_deep_non_exit_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_exit_port_code_ac_2_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_non_redo_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_r2 = MR_framevar(first_slot+2); /* NewActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_redo_port_code_ac_2_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_non_fail_ac(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_fail_port_code_ac_2_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#define MR_deep_non_call_sr(proclabel, procstatic, first_slot, label) \
+ MR_r1 = (MR_Word) (MR_Word *) &procstatic; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_call_port_code_sr_5_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel)); \
+ MR_framevar(first_slot) = MR_r1; /* TopCSD */ \
+ MR_framevar(first_slot+1) = MR_r2; /* MiddleCSD */ \
+ MR_framevar(first_slot+3) = MR_r3; /* OldActivationPtr */ \
+ MR_framevar(first_slot+4) = MR_r4; /* NewActivationPtr */ \
+ (void) 0
+
+#define MR_deep_non_exit_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_r3 = MR_framevar(first_slot+2); /* OldActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_exit_port_code_sr_3_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_non_redo_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_r2 = MR_framevar(first_slot+3); /* NewActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_redo_port_code_sr_2_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_non_fail_sr(proclabel, first_slot, label) \
+ MR_r1 = MR_framevar(first_slot); /* TopCSD */ \
+ MR_r2 = MR_framevar(first_slot+1); /* MiddleCSD */ \
+ MR_r3 = MR_framevar(first_slot+2); /* OldActivationPtr */ \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__non_fail_port_code_sr_3_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+/*****************************************************************************/
+
+#ifdef MR_USE_ACTIVATION_COUNTS
+ #define MR_deep_det_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_det_call_ac(proclabel, procstatic, first_slot, label)
+ #define MR_deep_det_exit(proclabel, first_slot, label) \
+ MR_deep_det_exit_ac(proclabel, first_slot, label)
+
+ #define MR_deep_semi_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_semi_call_ac(proclabel, procstatic, first_slot, label)
+ #define MR_deep_semi_exit(proclabel, first_slot, label) \
+ MR_deep_semi_exit_ac(proclabel, first_slot, label)
+ #define MR_deep_semi_fail(proclabel, first_slot, label) \
+ MR_deep_semi_fail_ac(proclabel, first_slot, label)
+
+ #define MR_deep_non_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_non_call_ac(proclabel, procstatic, first_slot, label)
+ #define MR_deep_non_exit(proclabel, first_slot, label) \
+ MR_deep_non_exit_ac(proclabel, first_slot, label)
+ #define MR_deep_non_redo(proclabel, first_slot, label) \
+ MR_deep_non_redo_ac(proclabel, first_slot, label)
+ #define MR_deep_non_fail(proclabel, first_slot, label) \
+ MR_deep_non_fail_ac(proclabel, first_slot, label)
+#else
+ #define MR_deep_det_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_det_call_sr(proclabel, procstatic, first_slot, label)
+ #define MR_deep_det_exit(proclabel, first_slot, label) \
+ MR_deep_det_exit_sr(proclabel, first_slot, label)
+
+ #define MR_deep_semi_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_semi_call_sr(proclabel, procstatic, first_slot, label)
+ #define MR_deep_semi_exit(proclabel, first_slot, label) \
+ MR_deep_semi_exit_sr(proclabel, first_slot, label)
+ #define MR_deep_semi_fail(proclabel, first_slot, label) \
+ MR_deep_semi_fail_sr(proclabel, first_slot, label)
+
+ #define MR_deep_non_call(proclabel, procstatic, first_slot, label) \
+ MR_deep_non_call_sr(proclabel, procstatic, first_slot, label)
+ #define MR_deep_non_exit(proclabel, first_slot, label) \
+ MR_deep_non_exit_sr(proclabel, first_slot, label)
+ #define MR_deep_non_redo(proclabel, first_slot, label) \
+ MR_deep_non_redo_sr(proclabel, first_slot, label)
+ #define MR_deep_non_fail(proclabel, first_slot, label) \
+ MR_deep_non_fail_sr(proclabel, first_slot, label)
+#endif
+
+/*****************************************************************************/
+
+/*
+** MR_deep_prepare_normal_call and MR_deep_prepare_ho_call are for use
+** only from procedures that live on the det stack. For procedures that live
+** on the nondet stack, you will need variants that get MiddleCSD from the
+** appropriate framevar.
+*/
+
+#define MR_deep_prepare_normal_call(proclabel, first_slot, label, site) \
+ MR_r1 = MR_stackvar(first_slot+1); \
+ MR_r2 = site; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__prepare_for_normal_call_2_0),\
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#define MR_deep_prepare_ho_call(proclabel, first_slot, label, site, closure) \
+ MR_r1 = MR_stackvar(first_slot+1); \
+ MR_r2 = site; \
+ MR_r3 = closure; \
+ MR_call_localret(MR_ENTRY( \
+ mercury__profiling_builtin__prepare_for_ho_call_3_0), \
+ label, MR_ENTRY(proclabel)); \
+ MR_define_label(label); \
+ MR_update_prof_current_proc(MR_LABEL(proclabel))
+
+#endif /* MERCURY_DEEP_PROFILING_HAND_H */
Index: runtime/mercury_deep_redo_port_body.h
===================================================================
RCS file: mercury_deep_redo_port_body.h
diff -N mercury_deep_redo_port_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_deep_redo_port_body.h Sun May 13 01:27:16 2001
@@ -0,0 +1,70 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The implementation of non_redo_port_code_{ac,sr}.
+**
+** The code including this file should define the following macros:
+**
+** MR_PROCNAME: The name of the procedure whose body this is.
+** MR_VERSION_AC or MR_VERSION_SR:
+** Says whether the procedure whose body this is
+** is intended for use with or without
+** MR_USE_ACTIVATION_COUNTS.
+**
+** The code including this file should have the following variables in scope:
+**
+** MiddleCSD: The id of the current csd.
+** NewOutermostActivationPtr: The id of the outermost activation of the
+** procedure being backtracked into after the
+** current call to it.
+*/
+
+#ifdef MR_DEEP_PROFILING
+{
+ MR_CallSiteDynamic *csd;
+ MR_ProcDynamic *pd;
+ MR_ProcStatic *ps;
+
+ MR_enter_instrumentation();
+ csd = (MR_CallSiteDynamic *) MiddleCSD;
+ MR_current_call_site_dynamic = csd;
+
+ #ifdef MR_DEEP_PROFILING_PORT_COUNTS
+ csd->MR_csd_own.MR_own_redos++;
+ #endif
+
+ pd = csd->MR_csd_callee_ptr;
+ MR_deep_assert(pd != NULL);
+ ps = pd->MR_pd_proc_static;
+ MR_deep_assert(ps != NULL);
+
+ #if defined(MR_VERSION_AC)
+ #ifdef MR_USE_ACTIVATION_COUNTS
+ /* increment activation count */
+ ps->MR_ps_activation_count++;
+ ps->MR_ps_outermost_activation_ptr =
+ (MR_ProcDynamic *) NewOutermostActivationPtr;
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS not enabled");
+ #endif
+ #elif defined(MR_VERSION_SR)
+ #ifndef MR_USE_ACTIVATION_COUNTS
+ /* set outermost activation pointer */
+ ps->MR_ps_outermost_activation_ptr =
+ (MR_ProcDynamic *) NewOutermostActivationPtr;
+ #else
+ MR_fatal_error(MR_PROCNAME ": MR_USE_ACTIVATION_COUNTS enabled");
+ #endif
+ #else
+ #error "mercury_deep_redo_port_body.h: neither MR_VERSION_AC nor MR_VERSION_SR"
+ #endif
+
+ MR_leave_instrumentation();
+}
+#else
+ MR_fatal_error(MR_PROCNAME ": deep profiling not enabled");
+#endif
Index: runtime/mercury_engine.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.c,v
retrieving revision 1.33
diff -u -b -r1.33 mercury_engine.c
--- runtime/mercury_engine.c 2001/01/13 09:38:57 1.33
+++ runtime/mercury_engine.c 2001/05/03 06:41:39
@@ -75,45 +75,45 @@
*/
#ifndef CONSERVATIVE_GC
- eng->heap_zone = MR_create_zone("heap", 1, MR_heap_size,
+ eng->MR_eng_heap_zone = MR_create_zone("heap", 1, MR_heap_size,
MR_next_offset(), MR_heap_zone_size,
MR_default_handler);
- eng->e_hp = eng->heap_zone->min;
+ eng->MR_eng_hp = eng->heap_zone->min;
#ifdef NATIVE_GC
- eng->heap_zone2 = MR_create_zone("heap2", 1, MR_heap_size,
+ eng->MR_eng_heap_zone2 = MR_create_zone("heap2", 1, MR_heap_size,
MR_next_offset(), MR_heap_zone_size,
MR_default_handler);
#ifdef MR_DEBUG_AGC_PRINT_VARS
- eng->debug_heap_zone = MR_create_zone("debug_heap", 1,
+ eng->MR_eng_debug_heap_zone = MR_create_zone("debug_heap", 1,
MR_debug_heap_size, MR_next_offset(),
MR_debug_heap_zone_size, MR_default_handler);
#endif
#endif
- eng->solutions_heap_zone = MR_create_zone("solutions_heap", 1,
+ eng->MR_eng_solutions_heap_zone = MR_create_zone("solutions_heap", 1,
MR_solutions_heap_size, MR_next_offset(),
MR_solutions_heap_zone_size, MR_default_handler);
- eng->e_sol_hp = eng->solutions_heap_zone->min;
+ eng->MR_eng_sol_hp = eng->solutions_heap_zone->min;
- eng->global_heap_zone = MR_create_zone("global_heap", 1,
+ eng->MR_eng_global_heap_zone = MR_create_zone("global_heap", 1,
MR_global_heap_size, MR_next_offset(),
MR_global_heap_zone_size, MR_default_handler);
- eng->e_global_hp = eng->global_heap_zone->min;
+ eng->MR_eng_global_hp = eng->global_heap_zone->min;
#endif
#ifdef MR_THREAD_SAFE
- eng->owner_thread = pthread_self();
- eng->c_depth = 0;
- eng->saved_owners = NULL;
+ eng->MR_eng_owner_thread = pthread_self();
+ eng->MR_eng_c_depth = 0;
+ eng->MR_eng_saved_owners = NULL;
#endif
/*
** Finally, allocate an initialize context (Mercury thread)
** in the engine and initialize the per-context stuff.
*/
- eng->this_context = MR_create_context();
+ eng->MR_eng_this_context = MR_create_context();
}
/*---------------------------------------------------------------------------*/
@@ -124,7 +124,7 @@
** XXX there are lots of other resources in MercuryEngine that
** might need to be finalized.
*/
- MR_destroy_context(eng->this_context);
+ MR_destroy_context(eng->MR_eng_this_context);
}
/*---------------------------------------------------------------------------*/
@@ -212,20 +212,20 @@
jmp_buf curr_jmp_buf;
jmp_buf * volatile prev_jmp_buf;
-#if defined(PROFILE_TIME)
+#if defined(MR_MPROF_PROFILE_TIME)
MR_Code * volatile prev_proc;
#endif
/*
- ** Preserve the value of MR_ENGINE(e_jmp_buf) on the C stack.
+ ** Preserve the value of MR_ENGINE(MR_eng_jmp_buf) on the C stack.
** This is so "C calls Mercury which calls C which calls Mercury" etc.
** will work.
*/
MR_restore_transient_registers();
- prev_jmp_buf = MR_ENGINE(e_jmp_buf);
- MR_ENGINE(e_jmp_buf) = &curr_jmp_buf;
+ prev_jmp_buf = MR_ENGINE(MR_eng_jmp_buf);
+ MR_ENGINE(MR_eng_jmp_buf) = &curr_jmp_buf;
/*
** Create an exception handler frame on the nondet stack
@@ -250,7 +250,7 @@
#ifdef MR_DEBUG_JMPBUFS
printf("engine caught jmp %p %p\n",
- prev_jmp_buf, MR_ENGINE(e_jmp_buf));
+ prev_jmp_buf, MR_ENGINE(MR_eng_jmp_buf));
#endif
MR_debugmsg0("...caught longjmp\n");
@@ -259,11 +259,11 @@
** set MR_prof_current_proc to be the caller proc again
** (if time profiling is enabled),
** restore the registers (since longjmp may clobber them),
- ** and restore the saved value of MR_ENGINE(e_jmp_buf).
+ ** and restore the saved value of MR_ENGINE(MR_eng_jmp_buf).
*/
MR_update_prof_current_proc(prev_proc);
MR_restore_registers();
- MR_ENGINE(e_jmp_buf) = prev_jmp_buf;
+ MR_ENGINE(MR_eng_jmp_buf) = prev_jmp_buf;
if (catch_exceptions) {
/*
** Figure out whether or not we got an exception.
@@ -272,7 +272,7 @@
** done, so all we have to do here is to return the
** exception.
*/
- exception = MR_ENGINE(e_exception);
+ exception = MR_ENGINE(MR_eng_exception);
if (exception != NULL) {
return exception;
}
@@ -294,7 +294,7 @@
}
- MR_ENGINE(e_jmp_buf) = &curr_jmp_buf;
+ MR_ENGINE(MR_eng_jmp_buf) = &curr_jmp_buf;
/*
** If call profiling is enabled, and this is a case of
@@ -302,8 +302,8 @@
** then we record the Mercury caller / Mercury callee pair
** in the table of call counts, if possible.
*/
-#ifdef PROFILE_CALLS
- #ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_CALLS
+ #ifdef MR_MPROF_PROFILE_TIME
if (MR_prof_current_proc != NULL) {
MR_PROFILE(entry_point, MR_prof_current_proc);
}
@@ -314,7 +314,7 @@
** we don't know who the caller is.
*/
#endif
-#endif /* PROFILE_CALLS */
+#endif /* MR_MPROF_PROFILE_CALLS */
/*
** If time profiling is enabled, then we need to
@@ -333,7 +333,7 @@
** have any local variables and this code needs the
** `prev_proc' local variable.
*/
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
prev_proc = MR_prof_current_proc;
MR_set_prof_current_proc(entry_point);
#endif
@@ -431,17 +431,19 @@
** owned by this thread.
*/
#ifdef MR_THREAD_SAFE
- MR_ENGINE(c_depth)++;
+ MR_ENGINE(MR_eng_c_depth)++;
{
MercuryThreadList *new_element;
new_element = MR_GC_NEW(MercuryThreadList);
- new_element->thread = MR_ENGINE(this_context)->owner_thread;
- new_element->next = MR_ENGINE(saved_owners);
- MR_ENGINE(saved_owners) = new_element;
+ new_element->thread =
+ MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread;
+ new_element->next = MR_ENGINE(MR_eng_saved_owners);
+ MR_ENGINE(MR_eng_saved_owners) = new_element;
}
- MR_ENGINE(this_context)->owner_thread = MR_ENGINE(owner_thread);
+ MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread =
+ MR_ENGINE(MR_eng_owner_thread);
#endif
@@ -460,23 +462,23 @@
*/
#ifdef MR_THREAD_SAFE
- assert(MR_ENGINE(this_context)->owner_thread
- == MR_ENGINE(owner_thread));
- MR_ENGINE(c_depth)--;
+ assert(MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread
+ == MR_ENGINE(MR_eng_owner_thread));
+ MR_ENGINE(MR_eng_c_depth)--;
{
MercuryThreadList *tmp;
MercuryThread val;
- tmp = MR_ENGINE(saved_owners);
+ tmp = MR_ENGINE(MR_eng_saved_owners);
if (tmp != NULL)
{
val = tmp->thread;
- MR_ENGINE(saved_owners) = tmp->next;
+ MR_ENGINE(MR_eng_saved_owners) = tmp->next;
MR_GC_free(tmp);
} else {
val = 0;
}
- MR_ENGINE(this_context)->owner_thread = val;
+ MR_ENGINE(MR_eng_this_context)->MR_ctxt_owner_thread = val;
}
#endif
@@ -516,15 +518,15 @@
** Since longjmp() may clobber the registers, we need to
** save them first.
*/
- MR_ENGINE(e_exception) = NULL;
+ MR_ENGINE(MR_eng_exception) = NULL;
MR_save_registers();
#ifdef MR_DEBUG_JMPBUFS
- printf("engine longjmp %p\n", MR_ENGINE(e_jmp_buf));
+ printf("engine longjmp %p\n", MR_ENGINE(MR_eng_jmp_buf));
#endif
MR_debugmsg0("longjmping out...\n");
- longjmp(*(MR_ENGINE(e_jmp_buf)), 1);
+ longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1);
}} /* end call_engine_inner() */
/* with nonlocal gotos, we don't save the previous locations */
@@ -551,10 +553,10 @@
static MR_Code *
engine_done(void)
{
- MR_ENGINE(e_exception) = NULL;
+ MR_ENGINE(MR_eng_exception) = NULL;
MR_save_registers();
MR_debugmsg0("longjmping out...\n");
- longjmp(*(MR_ENGINE(e_jmp_buf)), 1);
+ longjmp(*(MR_ENGINE(MR_eng_jmp_buf)), 1);
}
static MR_Code *
@@ -695,9 +697,28 @@
MR_END_MODULE
-void mercury_sys_init_engine(void); /* suppress gcc warning */
-void mercury_sys_init_engine(void) {
+/* forward decls to suppress gcc warnings */
+void mercury_sys_init_engine_init(void);
+void mercury_sys_init_engine_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_engine_write_out_proc_statics(FILE *fp);
+#endif
+
+void mercury_sys_init_engine_init(void)
+{
special_labels_module();
}
+
+void mercury_sys_init_engine_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_engine_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_engine.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.h,v
retrieving revision 1.21
diff -u -b -r1.21 mercury_engine.h
--- runtime/mercury_engine.h 2000/12/04 18:28:39 1.21
+++ runtime/mercury_engine.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1994-2000 The University of Melbourne.
+** Copyright (C) 1994-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -49,8 +49,9 @@
#define MR_TABLEFLAG 10
#define MR_TABLEHASHFLAG 11
#define MR_TABLESTACKFLAG 12
-#define MR_DETAILFLAG 13
-#define MR_MAXFLAG 14
+#define MR_UNBUFFLAG 13
+#define MR_DETAILFLAG 14
+#define MR_MAXFLAG 15
/* MR_DETAILFLAG should be the last real flag */
#define MR_progdebug MR_debugflag[MR_PROGFLAG]
@@ -66,6 +67,7 @@
#define MR_tabledebug MR_debugflag[MR_TABLEFLAG]
#define MR_hashdebug MR_debugflag[MR_TABLEHASHFLAG]
#define MR_tablestackdebug MR_debugflag[MR_TABLESTACKFLAG]
+#define MR_unbufdebug MR_debugflag[MR_UNBUFFLAG]
#define MR_detaildebug MR_debugflag[MR_DETAILFLAG]
/*
@@ -79,7 +81,8 @@
typedef struct {
jmp_buf *mercury_env; /*
- ** used to save MR_ENGINE(e_jmp_buf )
+ ** used to save
+ ** MR_ENGINE(MR_eng_jmp_buf )
*/
jmp_buf env; /*
** used by calls to setjmp and longjmp
@@ -108,8 +111,8 @@
/*
** MR_setjmp(MR_jmp_buf *env, longjmp_label)
**
- ** Save MR_ENGINE(e_jmp_buf), save the Mercury state, call setjmp(env),
- ** then fall through.
+ ** Save MR_ENGINE(MR_eng_jmp_buf), save the Mercury state,
+ ** call setjmp(env), then fall through.
**
** When setjmp returns via a call to longjmp, control will pass to
** longjmp_label.
@@ -124,7 +127,7 @@
*/
#define MR_setjmp(setjmp_env, longjmp_label) \
do { \
- (setjmp_env)->mercury_env = MR_ENGINE(e_jmp_buf); \
+ (setjmp_env)->mercury_env = MR_ENGINE(MR_eng_jmp_buf); \
MR_save_regs_to_mem((setjmp_env)->regs); \
(setjmp_env)->saved_succip = MR_succip; \
(setjmp_env)->saved_sp = MR_sp; \
@@ -137,7 +140,7 @@
MR_IF_USE_TRAIL((setjmp_env)->saved_ticket_high_water = \
MR_ticket_high_water); \
if (setjmp((setjmp_env)->env)) { \
- MR_ENGINE(e_jmp_buf) = (setjmp_env)->mercury_env; \
+ MR_ENGINE(MR_eng_jmp_buf) = (setjmp_env)->mercury_env;\
MR_restore_regs_from_mem((setjmp_env)->regs); \
MR_succip = (setjmp_env)->saved_succip; \
MR_sp = (setjmp_env)->saved_sp; \
@@ -175,30 +178,30 @@
*/
typedef struct MR_mercury_engine_struct {
- MR_Word fake_reg[MR_MAX_FAKE_REG];
+ MR_Word MR_eng_fake_reg[MR_MAX_FAKE_REG];
/* The fake reg vector for this engine. */
#ifndef CONSERVATIVE_GC
- MR_Word *e_hp;
+ MR_Word *MR_eng_hp;
/* The heap pointer for this engine */
- MR_Word *e_sol_hp;
+ MR_Word *MR_eng_sol_hp;
/* The solutions heap pointer for this engine */
- MR_Word *e_global_hp;
+ MR_Word *MR_eng_global_hp;
/* The global heap pointer for this engine */
#endif
- MR_Context *this_context;
+ MR_Context *MR_eng_this_context;
/*
- ** this_context points to the context currently
+ ** MR_eng_this_context points to the context currently
** executing in this engine.
*/
- MR_Context context;
+ MR_Context MR_eng_context;
/*
- ** context stores all the context information
+ ** MR_eng_context stores all the context information
** for the context executing in this engine.
*/
#ifdef MR_THREAD_SAFE
- MercuryThread owner_thread;
- unsigned c_depth;
- MercuryThreadList *saved_owners;
+ MercuryThread MR_eng_owner_thread;
+ unsigned MR_eng_c_depth;
+ MercuryThreadList *MR_eng_saved_owners;
/*
** These three fields are used to ensure that when a
** thread executing C code calls the Mercury engine
@@ -218,17 +221,17 @@
** execution never returns into C in the wrong thread.
*/
#endif
- jmp_buf *e_jmp_buf;
- MR_Word *e_exception;
+ jmp_buf *MR_eng_jmp_buf;
+ MR_Word *MR_eng_exception;
#ifndef CONSERVATIVE_GC
- MR_MemoryZone *heap_zone;
- MR_MemoryZone *solutions_heap_zone;
- MR_MemoryZone *global_heap_zone;
+ MR_MemoryZone *MR_eng_heap_zone;
+ MR_MemoryZone *MR_eng_solutions_heap_zone;
+ MR_MemoryZone *MR_eng_global_heap_zone;
#endif
#ifdef NATIVE_GC
- MR_MemoryZone *heap_zone2;
+ MR_MemoryZone *MR_eng_heap_zone2;
#ifdef MR_DEBUG_AGC_PRINT_VARS
- MR_MemoryZone *debug_heap_zone;
+ MR_MemoryZone *MR_eng_debug_heap_zone;
#endif
#endif
} MercuryEngine;
@@ -272,7 +275,7 @@
#endif /* !MR_THREAD_SAFE */
-#define MR_CONTEXT(x) (MR_ENGINE(context).x)
+#define MR_CONTEXT(x) (MR_ENGINE(MR_eng_context).x)
#ifndef CONSERVATIVE_GC
#define MR_IF_NOT_CONSERVATIVE_GC(x) x
@@ -282,16 +285,20 @@
#define MR_load_engine_regs(eng) \
do { \
- MR_IF_NOT_CONSERVATIVE_GC(MR_hp = (eng)->e_hp;) \
- MR_IF_NOT_CONSERVATIVE_GC(MR_sol_hp = (eng)->e_sol_hp;) \
- MR_IF_NOT_CONSERVATIVE_GC(MR_global_hp = (eng)->e_global_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC(MR_hp = (eng)->MR_eng_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC(MR_sol_hp = \
+ (eng)->MR_eng_sol_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC(MR_global_hp = \
+ (eng)->MR_eng_global_hp;) \
} while (0)
#define MR_save_engine_regs(eng) \
do { \
- MR_IF_NOT_CONSERVATIVE_GC((eng)->e_hp = MR_hp;) \
- MR_IF_NOT_CONSERVATIVE_GC((eng)->e_sol_hp = MR_sol_hp;) \
- MR_IF_NOT_CONSERVATIVE_GC((eng)->e_global_hp = MR_global_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC((eng)->MR_eng_hp = MR_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC((eng)->MR_eng_sol_hp = \
+ MR_sol_hp;) \
+ MR_IF_NOT_CONSERVATIVE_GC((eng)->MR_eng_global_hp = \
+ MR_global_hp;) \
} while (0)
/*
Index: runtime/mercury_exception_catch_body.h
===================================================================
RCS file: mercury_exception_catch_body.h
diff -N mercury_exception_catch_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_exception_catch_body.h Thu May 3 17:56:00 2001
@@ -0,0 +1,146 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The internals of exception:builtin_catch.
+**
+** The versions of builtin_catch for the various determinisms should define
+** the following macros:
+**
+** proc_label
+** proc_static
+** model
+** excp_handler
+** handle_ticket_on_exit
+**
+** For the model_non versions, it should also define
+**
+** version_model_non
+** handle_ticket_on_fail
+*/
+
+/*
+** Framevar(1) and possibly framevar(2) are used to save the inputs and/or
+** outputs of the closure. The first framevar available for saving deep
+** profiling information is framevar(3).
+*/
+
+#define FIRST_DEEP_SLOT 3
+
+/*
+** Each procedure defines several local labels. The local label numbers are
+** allocated as follows. Note that not all procedures use all of these labels.
+*/
+
+#define CALL_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 1)
+#define CLOSURE_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 2)
+#define EXIT_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 3)
+#define REDO_REDOIP_LABEL(pl) MR_PASTE3(pl, _i, 4)
+#define REDO_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 5)
+#define FAIL_REDOIP_LABEL(pl) MR_PASTE3(pl, _i, 6)
+#define FAIL_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 7)
+
+#if defined(version_model_non) && \
+ (defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING))
+ #define excp_catch_redoip(pl) MR_LABEL(FAIL_REDOIP_LABEL(pl))
+#else
+ #define excp_catch_redoip(pl) MR_ENTRY(MR_do_fail);
+#endif
+
+/*****************************************************************************/
+
+MR_define_entry(proc_label);
+
+ /*
+ ** Create an exception handler entry on the nondet stack.
+ ** (Register MR_r3 holds the Handler closure.)
+ */
+ MR_create_exception_handler("builtin_catch/3" model,
+ excp_handler, MR_r3, excp_catch_redoip(proc_label));
+
+#if defined(version_model_non) && defined(MR_DEEP_PROFILING)
+ /*
+ ** Give the deep profiler control when execution backtracks into
+ ** the closure.
+ */
+ MR_mktempframe(MR_LABEL(REDO_REDOIP_LABEL(proc_label)));
+#endif
+
+#ifdef MR_DEEP_PROFILING
+ MR_framevar(1) = MR_r2;
+ MR_deep_non_call(proc_label, proc_static, FIRST_DEEP_SLOT,
+ CALL_PORT_RETURN_LABEL(proc_label));
+ MR_r1 = MR_framevar(1); /* The Goal to call */
+#else
+ MR_r1 = MR_r2; /* The Goal to call */
+#endif
+ MR_r2 = 0; /* Zero additional input arguments */
+ MR_r3 = 1; /* One output argument */
+ /*
+ ** Now call `Goal(Result)'.
+ */
+ MR_call(MR_ENTRY(mercury__do_call_closure),
+ MR_LABEL(CLOSURE_RETURN_LABEL(proc_label)),
+ MR_ENTRY(proc_label));
+
+MR_define_label(CLOSURE_RETURN_LABEL(proc_label));
+ MR_update_prof_current_proc(MR_LABEL(proc_label));
+
+#ifdef MR_DEEP_PROFILING
+ save_results();
+ MR_deep_non_exit(proc_static, FIRST_DEEP_SLOT,
+ EXIT_PORT_RETURN_LABEL(proc_label));
+ restore_results();
+#endif
+
+#ifdef MR_USE_TRAIL
+ handle_ticket_on_exit();
+#endif
+
+#ifdef version_model_non
+ MR_succeed();
+#else
+ MR_succeed_discard();
+#endif
+
+#if defined(version_model_non) && defined(MR_DEEP_PROFILING)
+MR_define_label(REDO_REDOIP_LABEL(proc_label));
+ MR_deep_non_redo(proc_static, FIRST_DEEP_SLOT,
+ REDO_PORT_RETURN_LABEL(proc_label));
+ /* non_redo_port_code executes *semidet* failure */
+ MR_fail();
+#endif
+
+#if defined(version_model_non) && \
+ (defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING))
+
+MR_define_label(FAIL_REDOIP_LABEL(proc_label));
+
+#ifdef MR_USE_TRAIL
+ handle_ticket_on_fail();
+#endif
+
+#ifdef MR_DEEP_PROFILING
+ MR_deep_non_fail(proc_static, FIRST_DEEP_SLOT,
+ FAIL_PORT_RETURN_LABEL(proc_label));
+ /* non_redo_port_code executes *semidet* failure */
+ MR_fail();
+#endif
+
+#endif /* defined(version_model_non) && \
+ (defined(MR_USE_TRAIL) || defined(MR_DEEP_PROFILING)) */
+
+#undef FIRST_DEEP_SLOT
+
+#undef CALL_PORT_RETURN_LABEL
+#undef CLOSURE_RETURN_LABEL
+#undef EXIT_PORT_RETURN_LABEL
+#undef REDO_REDOIP_LABEL
+#undef REDO_PORT_RETURN_LABEL
+#undef FAIL_REDOIP_LABEL
+#undef FAIL_PORT_RETURN_LABEL
+
+#undef excp_catch_redoip
Index: runtime/mercury_goto.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_goto.h,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_goto.h
--- runtime/mercury_goto.h 2001/01/18 01:19:05 1.28
+++ runtime/mercury_goto.h 2001/05/03 06:41:39
@@ -10,21 +10,20 @@
#define MERCURY_GOTO_H
#include "mercury_conf.h"
+#include "mercury_std.h" /* for MR_PASTE2 and MR_STRINGIFY */
#include "mercury_types.h" /* for `MR_Code *' */
#include "mercury_debug.h" /* for MR_debuggoto() */
#include "mercury_label.h" /* for MR_insert_{entry,internal}_label() */
#include "mercury_dummy.h" /* for MR_dummy_identify_function() */
-#define MR_paste(a,b) a##b
-#define MR_stringify(string) #string
-#define MR_entry(label) MR_paste(_entry_,label)
-#define MR_skip(label) MR_paste(skip_,label)
-
-#define MR_ENTRY_LAYOUT(label) (const MR_Proc_Layout *) (MR_Word)\
- &(MR_paste(mercury_data__proc_layout__,label))
-#define MR_INTERNAL_LAYOUT(label) (const MR_Label_Layout *) (MR_Word)\
- &(MR_paste(mercury_data__label_layout__,label))
+#define MR_entry(label) MR_PASTE2(_entry_,label)
+#define MR_skip(label) MR_PASTE2(skip_,label)
+#define MR_PROC_LAYOUT(label) (const MR_Proc_Layout *) (MR_Word) \
+ &(MR_PASTE2(mercury_data__proc_layout__,label))
+#define MR_LABEL_LAYOUT(label) (const MR_Label_Layout *) (MR_Word) \
+ &(MR_PASTE2(mercury_data__label_layout__,label))
+
/*
** Passing the name of a label to MR_insert_{internal,entry}_label
** causes that name to be included in the executable as static readonly data.
@@ -58,15 +57,15 @@
#define MR_make_label_ai(n, a, l) MR_insert_internal(n, a, NULL)
#define MR_make_label_sl(n, a, l) MR_insert_internal(n, a, \
- MR_INTERNAL_LAYOUT(l))
+ MR_LABEL_LAYOUT(l))
#define MR_make_local_ai(n, a, l) MR_insert_entry(n, a, NULL)
#define MR_make_local_sl(n, a, l) MR_insert_entry(n, a, \
- MR_ENTRY_LAYOUT(l))
+ MR_PROC_LAYOUT(l))
#define MR_make_entry_ai(n, a, l) MR_insert_entry(n, a, NULL)
#define MR_make_entry_sl(n, a, l) MR_insert_entry(n, a, \
- MR_ENTRY_LAYOUT(l))
+ MR_PROC_LAYOUT(l))
#if defined(MR_INSERT_LABELS)
#define MR_make_label(n, a, l) MR_make_label_ai(n, a, l)
@@ -74,7 +73,7 @@
#define MR_make_label(n, a, l) /* nothing */
#endif
-#if defined(MR_INSERT_LABELS) || defined(PROFILE_CALLS)
+#if defined(MR_INSERT_LABELS) || defined(MR_MPROF_PROFILE_CALLS)
#define MR_make_local(n, a, l) MR_make_local_ai(n, a, l)
#else
#define MR_make_local(n, a, l) /* nothing */
@@ -88,7 +87,7 @@
** to the MLDS back-end too, you may also need to change the
** `need_to_init_entries' predicate in compiler/mlds_to_c.m.
*/
-#if defined(MR_INSERT_LABELS) || defined(PROFILE_CALLS)
+#if defined(MR_INSERT_LABELS) || defined(MR_MPROF_PROFILE_CALLS)
#define MR_make_entry(n, a, l) MR_make_entry_ai(n, a, l)
#else
#define MR_make_entry(n, a, l) /* nothing */
@@ -275,7 +274,7 @@
*/
#ifdef __ELF__
#define MR_INLINE_ASM_ENTRY_LABEL_TYPE(label) \
- " .type _entry_" MR_stringify(label) ", at function\n"
+ " .type _entry_" MR_STRINGIFY(label) ", at function\n"
#endif
#elif defined (__sparc)
@@ -338,7 +337,7 @@
*/
#ifndef MR_CANNOT_GROK_ASM_TYPE_DIRECTIVE
#define MR_INLINE_ASM_ENTRY_LABEL_TYPE(label) \
- " .type _entry_" MR_stringify(label) ",#function\n"
+ " .type _entry_" MR_STRINGIFY(label) ",#function\n"
#endif
#endif
@@ -378,7 +377,7 @@
*/
#ifndef MR_INLINE_ASM_GLOBALIZE_LABEL
#define MR_INLINE_ASM_GLOBALIZE_LABEL(label) \
- " .globl _entry_" MR_stringify(label) "\n"
+ " .globl _entry_" MR_STRINGIFY(label) "\n"
#endif
/*
@@ -396,7 +395,7 @@
*/
#ifndef MR_INLINE_ASM_ENTRY_LABEL
#define MR_INLINE_ASM_ENTRY_LABEL(label) \
- "_entry_" MR_stringify(label) ":\n"
+ "_entry_" MR_STRINGIFY(label) ":\n"
#endif
/*
@@ -523,10 +522,10 @@
MR_MODULE_STATIC_OR_EXTERN void module_name(void) { \
MR_PRETEND_ADDRESS_IS_USED(module_name); \
MR_PRETEND_ADDRESS_IS_USED( \
- &&MR_paste(module_name,_dummy_label)); \
+ &&MR_PASTE2(module_name,_dummy_label)); \
goto *MR_dummy_identify_function( \
- &&MR_paste(module_name,_dummy_label)); \
- MR_paste(module_name,_dummy_label): \
+ &&MR_PASTE2(module_name,_dummy_label)); \
+ MR_PASTE2(module_name,_dummy_label): \
{
#else /* gcc version <= egcs 1.1.2 */
#define MR_BEGIN_MODULE(module_name) \
@@ -534,8 +533,8 @@
MR_MODULE_STATIC_OR_EXTERN void module_name(void) { \
MR_PRETEND_ADDRESS_IS_USED(module_name); \
MR_PRETEND_ADDRESS_IS_USED( \
- &&MR_paste(module_name,_dummy_label)); \
- MR_paste(module_name,_dummy_label): \
+ &&MR_PASTE2(module_name,_dummy_label)); \
+ MR_PASTE2(module_name,_dummy_label): \
{
#endif /* gcc version <= egcs 1.1.2 */
/* initialization code for module goes between MR_BEGIN_MODULE */
@@ -547,9 +546,9 @@
#if defined(USE_ASM_LABELS)
#define MR_declare_entry(label) \
- extern void label(void) __asm__("_entry_" MR_stringify(label))
+ extern void label(void) __asm__("_entry_" MR_STRINGIFY(label))
#define MR_declare_static(label) \
- static void label(void) __asm__("_entry_" MR_stringify(label))
+ static void label(void) __asm__("_entry_" MR_STRINGIFY(label))
#define MR_define_extern_entry(label) MR_declare_entry(label)
#define MR_define_entry(label) \
MR_ASM_ENTRY(label) \
@@ -570,13 +569,13 @@
*/
#define MR_init_entry(label) \
MR_PRETEND_ADDRESS_IS_USED(&&label); \
- MR_make_entry(MR_stringify(label), label, label)
+ MR_make_entry(MR_STRINGIFY(label), label, label)
#define MR_init_entry_ai(label) \
MR_PRETEND_ADDRESS_IS_USED(&&label); \
- MR_make_entry_ai(MR_stringify(label), label, label)
+ MR_make_entry_ai(MR_STRINGIFY(label), label, label)
#define MR_init_entry_sl(label) \
MR_PRETEND_ADDRESS_IS_USED(&&label); \
- MR_make_entry_sl(MR_stringify(label), label, label)
+ MR_make_entry_sl(MR_STRINGIFY(label), label, label)
#define MR_ENTRY(label) (&label)
#define MR_STATIC(label) (&label)
@@ -602,13 +601,13 @@
label: \
{
#define MR_init_entry(label) \
- MR_make_entry(MR_stringify(label), &&label, label); \
+ MR_make_entry(MR_STRINGIFY(label), &&label, label); \
MR_entry(label) = &&label
#define MR_init_entry_ai(label) \
- MR_make_entry_ai(MR_stringify(label), &&label, label); \
+ MR_make_entry_ai(MR_STRINGIFY(label), &&label, label); \
MR_entry(label) = &&label
#define MR_init_entry_sl(label) \
- MR_make_entry_sl(MR_stringify(label), &&label, label); \
+ MR_make_entry_sl(MR_STRINGIFY(label), &&label, label); \
MR_entry(label) = &&label
#define MR_ENTRY(label) (MR_entry(label))
#define MR_STATIC(label) (MR_entry(label))
@@ -626,19 +625,19 @@
label: \
{
#define MR_init_local(label) \
- MR_make_local(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_local(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_init_local_ai(label) \
- MR_make_local_ai(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_local_ai(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_init_local_sl(label) \
- MR_make_local_sl(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_local_sl(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_define_label(label) MR_define_local(label)
#define MR_declare_label(label) /* no declaration required */
#define MR_init_label(label) \
- MR_make_label(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_label(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_init_label_ai(label) \
- MR_make_label_ai(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_label_ai(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_init_label_sl(label) \
- MR_make_label_sl(MR_stringify(label), &&MR_entry(label), label)
+ MR_make_label_sl(MR_STRINGIFY(label), &&MR_entry(label), label)
#define MR_LOCAL(label) (&&MR_entry(label))
#define MR_LABEL(label) (&&MR_entry(label))
@@ -682,11 +681,11 @@
MR_GOTO_LABEL(label); \
} \
static MR_Code* label(void) {
- #define MR_init_entry(label) MR_make_entry(MR_stringify(label), \
+ #define MR_init_entry(label) MR_make_entry(MR_STRINGIFY(label), \
label, label)
- #define MR_init_entry_ai(label) MR_make_entry_ai(MR_stringify(label), \
+ #define MR_init_entry_ai(label) MR_make_entry_ai(MR_STRINGIFY(label), \
label, label)
- #define MR_init_entry_sl(label) MR_make_entry_sl(MR_stringify(label), \
+ #define MR_init_entry_sl(label) MR_make_entry_sl(MR_STRINGIFY(label), \
label, label)
#define MR_declare_local(label) static MR_Code *label(void)
@@ -694,11 +693,11 @@
MR_GOTO_LABEL(label); \
} \
static MR_Code* label(void) {
- #define MR_init_local(label) MR_make_local(MR_stringify(label), \
+ #define MR_init_local(label) MR_make_local(MR_STRINGIFY(label), \
label, label)
- #define MR_init_local_ai(label) MR_make_local_ai(MR_stringify(label), \
+ #define MR_init_local_ai(label) MR_make_local_ai(MR_STRINGIFY(label), \
label, label)
- #define MR_init_local_sl(label) MR_make_local_sl(MR_stringify(label), \
+ #define MR_init_local_sl(label) MR_make_local_sl(MR_STRINGIFY(label), \
label, label)
#define MR_declare_label(label) static MR_Code *label(void)
@@ -706,11 +705,11 @@
MR_GOTO_LABEL(label); \
} \
static MR_Code* label(void) {
- #define MR_init_label(label) MR_make_label(MR_stringify(label), \
+ #define MR_init_label(label) MR_make_label(MR_STRINGIFY(label), \
label, label)
- #define MR_init_label_ai(label) MR_make_label_ai(MR_stringify(label), \
+ #define MR_init_label_ai(label) MR_make_label_ai(MR_STRINGIFY(label), \
label, label)
- #define MR_init_label_sl(label) MR_make_label_sl(MR_stringify(label), \
+ #define MR_init_label_sl(label) MR_make_label_sl(MR_STRINGIFY(label), \
label, label)
#define MR_ENTRY(label) ((MR_Code *) (label))
Index: runtime/mercury_grade.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_grade.h,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_grade.h
--- runtime/mercury_grade.h 2000/12/03 02:22:52 1.30
+++ runtime/mercury_grade.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-2000 The University of Melbourne.
+** Copyright (C) 1997-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -106,15 +106,26 @@
#define MR_GRADE_PART_4 MR_GRADE_PART_3
#endif
-#ifdef PROFILE_TIME
- #ifdef PROFILE_CALLS
- #ifdef PROFILE_MEMORY
+#ifdef MR_DEEP_PROFILING
+ #define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _profdeep)
+ #if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
+ /*
+ ** Deep profiling is completely separate from the other profiling
+ ** alternatives, and there is no point in allowing their combination.
+ */
+ #error "Invalid combination of profiling options"
+ #endif
+#else
+ #ifdef MR_MPROF_PROFILE_TIME
+ #ifdef MR_MPROF_PROFILE_CALLS
+ #ifdef MR_MPROF_PROFILE_MEMORY
#define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _profall)
#else
#define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _prof)
#endif
#else
- #ifdef PROFILE_MEMORY
+ #ifdef MR_MPROF_PROFILE_MEMORY
/*
** Memory profiling interferes with time profiling,
** so there's no point in allowing this.
@@ -125,15 +136,15 @@
#define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _proftime)
#endif
#endif
-#else
- #ifdef PROFILE_CALLS
- #ifdef PROFILE_MEMORY
+ #else
+ #ifdef MR_MPROF_PROFILE_CALLS
+ #ifdef MR_MPROF_PROFILE_MEMORY
#define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _memprof)
#else
#define MR_GRADE_PART_5 MR_PASTE2(MR_GRADE_PART_4, _profcalls)
#endif
#else
- #ifdef PROFILE_MEMORY
+ #ifdef MR_MPROF_PROFILE_MEMORY
/*
** Call-graph memory profiling requires call profiling,
** and call profiling is reasonably cheap, so there's
@@ -144,6 +155,7 @@
#define MR_GRADE_PART_5 MR_GRADE_PART_4
#endif
#endif
+ #endif
#endif
#ifdef MR_USE_TRAIL
@@ -275,15 +287,15 @@
#define MR_GRADE_OPT_PART_4 MR_GRADE_OPT_PART_3
#endif
-#ifdef PROFILE_TIME
- #ifdef PROFILE_CALLS
- #ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_TIME
+ #ifdef MR_MPROF_PROFILE_CALLS
+ #ifdef MR_MPROF_PROFILE_MEMORY
#define MR_GRADE_OPT_PART_5 MR_GRADE_OPT_PART_4 ".profall"
#else
#define MR_GRADE_OPT_PART_5 MR_GRADE_OPT_PART_4 ".prof"
#endif
#else
- #ifdef PROFILE_MEMORY
+ #ifdef MR_MPROF_PROFILE_MEMORY
/*
** Memory profiling interferes with time profiling,
** so there's no point in allowing this.
@@ -295,14 +307,14 @@
#endif
#endif
#else
- #ifdef PROFILE_CALLS
- #ifdef PROFILE_MEMORY
+ #ifdef MR_MPROF_PROFILE_CALLS
+ #ifdef MR_MPROF_PROFILE_MEMORY
#define MR_GRADE_OPT_PART_5 MR_GRADE_OPT_PART_4 ".memprof"
#else
#define MR_GRADE_OPT_PART_5 MR_GRADE_OPT_PART_4 ".profcalls"
#endif
#else
- #ifdef PROFILE_MEMORY
+ #ifdef MR_MPROF_PROFILE_MEMORY
/*
** Call-graph memory profiling requires call profiling,
** and call profiling is reasonably cheap, so there's
Index: runtime/mercury_hand_compare_body.h
===================================================================
RCS file: mercury_hand_compare_body.h
diff -N mercury_hand_compare_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_hand_compare_body.h Thu May 3 17:56:00 2001
@@ -0,0 +1,76 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The internals of hand-written comparison routines.
+**
+** The versions of builtin_catch for the various determinisms should define
+** the following macros:
+**
+** proc_label
+** proc_static
+** body_code
+*/
+
+/*
+** Stackvar(1) and possibly stackvar(2) are used to save the inputs and/or
+** outputs of the comparison code. The first framevar available
+** for saving deep profiling information is stackvar(3).
+*/
+
+#define FIRST_DEEP_SLOT 3
+
+/*
+** Each procedure defines several local labels. The local label numbers are
+** allocated as follows.
+*/
+
+#define CALL_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 1)
+#define EXIT_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 2)
+
+/*****************************************************************************/
+
+MR_define_entry(proc_label);
+
+#ifdef MR_DEEP_PROFILING
+
+ MR_incr_sp_push_msg(6, name);
+ MR_stackvar(6) = (MR_Word) MR_succip;
+ MR_stackvar(1) = MR_r1;
+ MR_stackvar(2) = MR_r2;
+
+ MR_deep_det_call(proc_label, proc_static, FIRST_DEEP_SLOT,
+ CALL_PORT_RETURN_LABEL(proc_label));
+
+ MR_r1 = MR_stackvar(1);
+ MR_r2 = MR_stackvar(2);
+
+ MR_save_transient_registers();
+ body_code;
+ MR_restore_transient_registers();
+ MR_stackvar(1) = MR_r1;
+
+ MR_deep_det_exit(proc_label, FIRST_DEEP_SLOT,
+ EXIT_PORT_RETURN_LABEL(proc_label));
+
+ MR_r1 = MR_stackvar(1);
+ MR_succip = (MR_Code *) MR_stackvar(6);
+ MR_decr_sp_pop_msg(6);
+ MR_proceed();
+
+#else
+
+ body_code;
+ MR_proceed();
+
+#endif
+
+/*****************************************************************************/
+
+#undef CALL_PORT_RETURN_LABEL
+#undef EXIT_PORT_RETURN_LABEL
+
+#undef FIRST_DEEP_SLOT
Index: runtime/mercury_hand_unify_body.h
===================================================================
RCS file: mercury_hand_unify_body.h
diff -N mercury_hand_unify_body.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_hand_unify_body.h Thu May 3 17:56:00 2001
@@ -0,0 +1,95 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** The internals of hand-written unification and comparison routines.
+**
+** The versions of builtin_catch for the various determinisms should define
+** the following macros:
+**
+** proc_label
+** proc_static
+** body_code
+**
+** It should also define may_need_fail_action for the model_non versions.
+*/
+
+/*
+** Stackvar(1) and possibly stackvar(2) are used to save the inputs
+** of the unification code. The first framevar available for saving
+** deep profiling information is stackvar(3).
+*/
+
+#define FIRST_DEEP_SLOT 3
+
+/*
+** Each procedure defines several local labels. The local label numbers are
+** allocated as follows.
+*/
+
+#define CALL_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 1)
+#define EXIT_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 2)
+#define FAIL_LABEL(pl) MR_PASTE3(pl, _i, 3)
+#define FAIL_PORT_RETURN_LABEL(pl) MR_PASTE3(pl, _i, 4)
+
+/*****************************************************************************/
+
+MR_define_entry(proc_label);
+
+#ifdef MR_DEEP_PROFILING
+
+ MR_incr_sp_push_msg(6, name);
+ MR_stackvar(6) = (MR_Word) MR_succip;
+ MR_stackvar(1) = MR_r1;
+ MR_stackvar(2) = MR_r2;
+
+ MR_deep_semi_call(proc_label, proc_static, FIRST_DEEP_SLOT,
+ CALL_PORT_RETURN_LABEL(proc_label));
+
+ MR_r1 = MR_stackvar(1);
+ MR_r2 = MR_stackvar(2);
+
+ MR_save_transient_registers();
+ body_code;
+ MR_restore_transient_registers();
+
+ if (! MR_r1) {
+ MR_GOTO_LABEL(FAIL_LABEL(proc_label));
+ }
+
+ MR_deep_semi_exit(proc_label, FIRST_DEEP_SLOT,
+ EXIT_PORT_RETURN_LABEL(proc_label));
+
+ MR_r1 = 1;
+ MR_succip = (MR_Code *) MR_stackvar(6);
+ MR_decr_sp_pop_msg(6);
+ MR_proceed();
+
+MR_define_label(FAIL_LABEL(proc_label));
+
+ MR_deep_semi_fail(proc_label, FIRST_DEEP_SLOT,
+ FAIL_PORT_RETURN_LABEL(proc_label));
+
+ MR_r1 = 0;
+ MR_succip = (MR_Code *) MR_stackvar(6);
+ MR_decr_sp_pop_msg(6);
+ MR_proceed();
+
+#else
+
+ body_code;
+ MR_proceed();
+
+#endif
+
+/*****************************************************************************/
+
+#undef CALL_PORT_RETURN_LABEL
+#undef EXIT_PORT_RETURN_LABEL
+#undef FAIL_LABEL
+#undef FAIL_PORT_RETURN_LABEL
+
+#undef FIRST_DEEP_SLOT
Index: runtime/mercury_heap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_heap.h,v
retrieving revision 1.21
diff -u -b -r1.21 mercury_heap.h
--- runtime/mercury_heap.h 2001/04/08 07:12:20 1.21
+++ runtime/mercury_heap.h 2001/05/03 06:41:39
@@ -12,6 +12,7 @@
#include "mercury_types.h" /* for `MR_Word' */
#include "mercury_context.h" /* for min_heap_reclamation_point() */
#include "mercury_heap_profile.h" /* for MR_record_allocation() */
+#include "mercury_deep_profiling.h" /* for MR_current_call_site_dynamic */
#include "mercury_std.h" /* for MR_EXTERN_INLINE */
#ifdef MR_HIGHLEVEL_CODE
#include "mercury.h" /* for MR_new_object() */
@@ -141,7 +142,15 @@
#endif /* not CONSERVATIVE_GC */
-#ifdef PROFILE_MEMORY
+#if defined (MR_DEEP_PROFILING) && defined(MR_DEEP_PROFILING_MEMORY)
+ #define MR_maybe_record_allocation(count, proclabel, type) \
+ ( \
+ MR_current_call_site_dynamic->MR_csd_own.MR_own_allocs \
+ += 1, \
+ MR_current_call_site_dynamic->MR_csd_own.MR_own_words \
+ += (count) \
+ )
+#elif defined(MR_MPROF_PROFILE_MEMORY)
#define MR_maybe_record_allocation(count, proclabel, type) \
MR_record_allocation((count), MR_ENTRY(proclabel), \
MR_STRINGIFY(proclabel), (type))
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.43
diff -u -b -r1.43 mercury_ho_call.c
--- runtime/mercury_ho_call.c 2001/01/13 09:38:58 1.43
+++ runtime/mercury_ho_call.c 2001/05/03 06:41:39
@@ -254,19 +254,19 @@
*/
MR_define_entry(mercury__compare_3_0);
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
{
MR_tailcall(MR_ENTRY(mercury__compare_3_3), MR_LABEL(mercury__compare_3_0));
}
#endif
MR_define_entry(mercury__compare_3_1);
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
{
MR_tailcall(MR_ENTRY(mercury__compare_3_3), MR_LABEL(mercury__compare_3_1));
}
#endif
MR_define_entry(mercury__compare_3_2);
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
{
MR_tailcall(MR_ENTRY(mercury__compare_3_3), MR_LABEL(mercury__compare_3_2));
}
@@ -410,9 +410,29 @@
** in the list of initialization functions that get called.
** So for MR_HIGHLEVEL_CODE it just does nothing.
*/
-void mercury_sys_init_call(void); /* suppress gcc warning */
-void mercury_sys_init_call(void) {
+
+/* forward decls to suppress gcc warnings */
+void mercury_sys_init_call_init(void);
+void mercury_sys_init_call_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_call_write_out_proc_statics(FILE *fp);
+#endif
+
+void mercury_sys_init_call_init(void)
+{
#ifndef MR_HIGHLEVEL_CODE
call_module();
#endif /* not MR_HIGHLEVEL_CODE */
}
+
+void mercury_sys_init_call_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_call_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
Index: runtime/mercury_label.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_label.c,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_label.c
--- runtime/mercury_label.c 2001/01/18 01:19:06 1.20
+++ runtime/mercury_label.c 2001/05/03 06:41:39
@@ -92,7 +92,7 @@
{
MR_do_init_label_tables();
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
if (MR_profiling) {
MR_prof_output_addr_decl(name, addr);
}
Index: runtime/mercury_label.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_label.h,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_label.h
--- runtime/mercury_label.h 2001/01/18 01:19:06 1.8
+++ runtime/mercury_label.h 2001/05/03 06:41:39
@@ -23,7 +23,7 @@
#define MR_NEED_ENTRY_LABEL_ARRAY
#endif
-#if defined(MR_NEED_ENTRY_LABEL_ARRAY) || defined(PROFILE_CALLS)
+#if defined(MR_NEED_ENTRY_LABEL_ARRAY) || defined(MR_MPROF_PROFILE_CALLS)
#define MR_NEED_ENTRY_LABEL_INFO
#endif
Index: runtime/mercury_overflow.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_overflow.h,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_overflow.h
--- runtime/mercury_overflow.h 2000/12/04 18:28:40 1.6
+++ runtime/mercury_overflow.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1995-1998,2000 The University of Melbourne.
+** Copyright (C) 1995-1998,2000-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -26,29 +26,29 @@
#define MR_heap_overflow_check() \
( \
- MR_IF (MR_hp >= MR_ENGINE(MR_heap_zone)->top,( \
+ MR_IF (MR_hp >= MR_ENGINE(MR_eng_heap_zone)->top,( \
MR_fatal_error("heap overflow") \
)), \
- MR_IF (MR_hp > MR_ENGINE(MR_heap_zone)->max,( \
- MR_ENGINE(heap_zone)->max = MR_hp \
+ MR_IF (MR_hp > MR_ENGINE(MR_eng_heap_zone)->max,( \
+ MR_ENGINE(MR_eng_heap_zone)->max = MR_hp \
)), \
(void)0 \
)
#define MR_detstack_overflow_check() \
( \
- MR_IF (MR_sp >= MR_CONTEXT(MR_detstack_zone)->top,( \
+ MR_IF (MR_sp >= MR_CONTEXT(MR_ctxt_detstack_zone)->top,(\
MR_fatal_error("stack overflow") \
)), \
- MR_IF (MR_sp > MR_CONTEXT(MR_detstack_zone)->max,( \
- MR_CONTEXT(detstack_zone)->max = MR_sp \
+ MR_IF (MR_sp > MR_CONTEXT(MR_ctxt_detstack_zone)->max,( \
+ MR_CONTEXT(MR_ctxt_detstack_zone)->max = MR_sp \
)), \
(void)0 \
)
#define MR_detstack_underflow_check() \
( \
- MR_IF (MR_sp < MR_CONTEXT(MR_detstack_zone)->min,( \
+ MR_IF (MR_sp < MR_CONTEXT(MR_ctxt_detstack_zone)->min,( \
MR_fatal_error("stack underflow") \
)), \
(void)0 \
@@ -56,18 +56,18 @@
#define MR_nondstack_overflow_check() \
( \
- MR_IF (MR_maxfr >= MR_CONTEXT(MR_nondetstack_zone)->top,( \
+ MR_IF (MR_maxfr >= MR_CONTEXT(MR_ctxt_nondetstack_zone)->top,( \
MR_fatal_error("nondetstack overflow") \
)), \
- MR_IF (MR_maxfr > MR_CONTEXT(MR_nondetstack_zone)->max,( \
- MR_CONTEXT(nondetstack_zone)->max = MR_maxfr \
+ MR_IF (MR_maxfr > MR_CONTEXT(MR_ctxt_nondetstack_zone)->max,( \
+ MR_CONTEXT(MR_ctxt_nondetstack_zone)->max = MR_maxfr\
)), \
(void)0 \
)
#define MR_nondstack_underflow_check() \
( \
- MR_IF (MR_maxfr < MR_CONTEXT(MR_nondetstack_zone)->min,( \
+ MR_IF (MR_maxfr < MR_CONTEXT(MR_ctxt_nondetstack_zone)->min,( \
MR_fatal_error("nondetstack underflow") \
)), \
(void)0 \
Index: runtime/mercury_prof.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_prof.c,v
retrieving revision 1.15
diff -u -b -r1.15 mercury_prof.c
--- runtime/mercury_prof.c 2001/02/28 13:16:41 1.15
+++ runtime/mercury_prof.c 2001/05/03 06:41:39
@@ -22,6 +22,7 @@
#include "mercury_prof.h"
#include "mercury_heap_profile.h" /* for MR_prof_output_mem_tables() */
+#include "mercury_prof_time.h" /* for MR_turn_on_time_profiling() */
#include "mercury_prof_mem.h" /* for prof_malloc() */
#include "mercury_signal.h"
@@ -30,31 +31,11 @@
#include <signal.h> /* for SIGINT */
-#if defined(PROFILE_TIME)
-
-#ifdef HAVE_SYS_TIME
-#include <sys/time.h>
-#endif
-
-#if !defined(MR_CLOCK_TICKS_PER_SECOND) \
- || !defined(HAVE_SETITIMER)
- #error "Time profiling not supported on this system"
-#endif
-
-static int MR_itimer_sig;
-static int MR_itimer_type;
-static const char * MR_time_method;
-
-#endif /* PROFILE_TIME */
-
/*
** XXX Ought to make these command line options
*/
#define CALL_TABLE_SIZE 4096
#define TIME_TABLE_SIZE 4096
-#define MR_CLOCK_TICKS_PER_PROF_SIG 5
-
-#define MR_USEC_PER_SEC 1000000
/*
** profiling node information
@@ -93,7 +74,7 @@
MR_Code * volatile MR_prof_current_proc;
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
MR_Code * MR_prof_ho_caller_proc;
#endif
@@ -103,15 +84,13 @@
*/
static volatile int in_profiling_code = FALSE;
-
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
static FILE *MR_prof_decl_fptr = NULL;
static prof_call_node *addr_pair_table[CALL_TABLE_SIZE] = {NULL};
#endif
-#ifdef PROFILE_TIME
- static bool time_profiling_on = FALSE;
+#ifdef MR_MPROF_PROFILE_TIME
static prof_time_node *addr_table[TIME_TABLE_SIZE] = {NULL};
#endif
@@ -119,64 +98,37 @@
** Local function declarations
*/
-#ifdef PROFILE_TIME
- static void prof_init_time_profile_method(void);
- static void prof_time_profile(int);
+#ifdef MR_MPROF_PROFILE_TIME
+ static void prof_handle_tick(int);
static void prof_output_addr_table(void);
static void print_time_node(FILE *fptr, prof_time_node *node);
#endif
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
static void print_addr_pair_node(FILE *fptr, prof_call_node *node);
static void prof_output_addr_pair_table(void);
#endif
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
static void prof_output_mem_tables(void);
static void print_memory_node(FILE *words_fptr, FILE *cells_fptr,
MR_memprof_record *node);
#endif
-#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
static void prof_handle_sigint(void);
#endif
/* ======================================================================== */
-#ifndef HAVE_STRERROR
-
-/*
-** Apparently SunOS 4.1.3 doesn't have strerror()
-** (!%^&!^% non-ANSI systems, grumble...)
-**
-** This code should perhaps go somewhere other than in prof.c.
-*/
-
-extern int sys_nerr;
-extern char *sys_errlist[];
-
-char *
-strerror(int errnum)
-{
- if (errnum >= 0 && errnum < sys_nerr && sys_errlist[errnum] != NULL) {
- return sys_errlist[errnum];
- } else {
- static char buf[30];
- sprintf(buf, "Error %d", errnum);
- return buf;
- }
-}
-
-#endif
-
-/* ======================================================================== */
-
/* utility routines for opening and closing files */
-#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
static FILE *
-checked_fopen(const char *filename, const char *message, const char *mode)
+MR_checked_fopen(const char *filename, const char *message, const char *mode)
{
FILE *file;
@@ -191,7 +143,7 @@
}
static void
-checked_fclose(FILE *file, const char *filename)
+MR_checked_fclose(FILE *file, const char *filename)
{
errno = 0;
if (fclose(file) != 0) {
@@ -203,7 +155,7 @@
}
static void
-checked_atexit(void (*func)(void))
+MR_checked_atexit(void (*func)(void))
{
errno = 0;
if (atexit(func) != 0) {
@@ -214,94 +166,13 @@
}
}
-#endif /* PROFILE_TIME or PROFILE_CALLS or PROFILE_MEMORY */
+#endif /* MR_MPROF_PROFILE_TIME or MR_MPROF_PROFILE_CALLS or MR_MPROF_PROFILE_MEMORY */
/* ======================================================================== */
-
-#ifdef PROFILE_TIME
-
-static void
-checked_setitimer(int which, struct itimerval *value)
-{
- errno = 0;
- if (setitimer(which, value, NULL) != 0) {
- perror("Mercury runtime: cannot set timer for profiling");
- exit(1);
- }
-}
-/*
-** prof_turn_on_time_profiling:
-** Sets up the profiling timer and starts it up.
-** At the moment it is after every MR_CLOCK_TICKS_PER_PROF_SIG
-** ticks of the clock.
-**
-** WARNING: SYSTEM SPECIFIC CODE.
-** This code is not very portable, because it uses setitimer(),
-** which is not part of POSIX.1 or ANSI C.
-*/
-
-void
-MR_prof_turn_on_time_profiling(void)
-{
- FILE *fptr;
- struct itimerval itime;
- const long prof_sig_interval_in_usecs = MR_CLOCK_TICKS_PER_PROF_SIG *
- (MR_USEC_PER_SEC / MR_CLOCK_TICKS_PER_SECOND);
-
- time_profiling_on = TRUE;
-
- itime.it_value.tv_sec = 0;
- itime.it_value.tv_usec = prof_sig_interval_in_usecs;
- itime.it_interval.tv_sec = 0;
- itime.it_interval.tv_usec = prof_sig_interval_in_usecs;
-
- MR_setup_signal(MR_itimer_sig, prof_time_profile, FALSE,
- "Mercury runtime: cannot install signal handler");
- checked_setitimer(MR_itimer_type, &itime);
-}
+#ifdef MR_MPROF_PROFILE_CALLS
/*
-** prof_init_time_profile_method:
-** initializes MR_itimer_type and MR_itimer_sig
-** based on the setting of MR_time_profile_method.
-*/
-static void
-prof_init_time_profile_method(void)
-{
- switch (MR_time_profile_method) {
-#if defined(ITIMER_REAL) && defined(SIGALRM)
- case MR_profile_real_time:
- MR_itimer_type = ITIMER_REAL;
- MR_itimer_sig = SIGALRM;
- MR_time_method = "real-time";
- break;
-#endif
-#if defined(ITIMER_VIRTUAL) && defined(SIGVTALRM)
- case MR_profile_user_time:
- MR_itimer_type = ITIMER_VIRTUAL;
- MR_itimer_sig = SIGVTALRM;
- MR_time_method = "user-time";
- break;
-#endif
-#if defined(ITIMER_VIRTUAL) && defined(SIGVTALRM)
- case MR_profile_user_plus_system_time:
- MR_itimer_type = ITIMER_PROF;
- MR_itimer_sig = SIGPROF;
- MR_time_method = "user-plus-system-time";
- break;
-#endif
- default:
- MR_fatal_error("invalid time profile method");
- }
-}
-#endif /* PROFILE_TIME */
-
-/* ======================================================================== */
-
-#ifdef PROFILE_CALLS
-
-/*
** prof_call_profile:
** Saves the callee, caller pair into a hash table. If the
** address pair already exists then it increments a count.
@@ -346,21 +217,21 @@
return;
}
-#endif /* PROFILE_CALLS */
+#endif /* MR_MPROF_PROFILE_CALLS */
/* ======================================================================== */
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
/*
-** prof_time_profile:
+** prof_handle_tick:
** Signal handler to be called whenever a profiling signal is
** received. Saves the current code address into a hash table.
** If the address already exists, it increments its count.
*/
static void
-prof_time_profile(int signum)
+prof_handle_tick(int signum)
{
prof_time_node *node, **node_addr, *new_node;
int hash_value;
@@ -397,37 +268,14 @@
*node_addr = new_node;
in_profiling_code = FALSE;
- return;
-} /* end prof_time_profile() */
-
-/* ======================================================================== */
-
-/*
-** prof_turn_off_time_profiling:
-** Turns off the time profiling.
-*/
-
-void
-MR_prof_turn_off_time_profiling(void)
-{
- struct itimerval itime;
-
- if (time_profiling_on == FALSE)
return;
-
- itime.it_value.tv_sec = 0;
- itime.it_value.tv_usec = 0;
- itime.it_interval.tv_sec = 0;
- itime.it_interval.tv_usec = 0;
-
- checked_setitimer(MR_itimer_type, &itime);
-}
+} /* end prof_handle_tick() */
-#endif /* PROFILE_TIME */
+#endif /* MR_MPROF_PROFILE_TIME */
/* ======================================================================== */
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
/*
** prof_output_addr_pair_table :
@@ -441,13 +289,13 @@
FILE *fptr;
int i;
- fptr = checked_fopen("Prof.CallPair", "create", "w");
+ fptr = MR_checked_fopen("Prof.CallPair", "create", "w");
for (i = 0; i < CALL_TABLE_SIZE ; i++) {
print_addr_pair_node(fptr, addr_pair_table[i]);
}
- checked_fclose(fptr, "Prof.CallPair");
+ MR_checked_fclose(fptr, "Prof.CallPair");
}
static void
@@ -461,11 +309,11 @@
}
}
-#endif /* PROFILE_CALLS */
+#endif /* MR_MPROF_PROFILE_CALLS */
/* ======================================================================== */
-#if defined(PROFILE_CALLS)
+#if defined(MR_MPROF_PROFILE_CALLS)
/*
** prof_output_addr_decl:
@@ -478,16 +326,17 @@
MR_prof_output_addr_decl(const char *name, const MR_Code *address)
{
if (!MR_prof_decl_fptr) {
- MR_prof_decl_fptr = checked_fopen("Prof.Decl", "create", "w");
+ MR_prof_decl_fptr =
+ MR_checked_fopen("Prof.Decl", "create", "w");
}
fprintf(MR_prof_decl_fptr, "%ld\t%s\n", (long) address, name);
}
-#endif /* PROFILE_CALLS */
+#endif /* MR_MPROF_PROFILE_CALLS */
/* ======================================================================== */
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
/*
** prof_output_addr_table:
@@ -503,7 +352,7 @@
double scale;
double rate;
- fptr = checked_fopen("Prof.Counts", "create", "w");
+ fptr = MR_checked_fopen("Prof.Counts", "create", "w");
/*
** Write out header line indicating what we are profiling,
@@ -522,7 +371,7 @@
print_time_node(fptr, addr_table[i]);
}
- checked_fclose(fptr, "Prof.Counts");
+ MR_checked_fclose(fptr, "Prof.Counts");
}
static void
@@ -535,11 +384,11 @@
}
}
-#endif /* PROFILE_TIME */
+#endif /* MR_MPROF_PROFILE_TIME */
/* ======================================================================== */
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
/*
** prof_output_mem_tables:
@@ -554,8 +403,8 @@
FILE *cells_fptr;
int i;
- words_fptr = checked_fopen("Prof.MemoryWords", "create", "w");
- cells_fptr = checked_fopen("Prof.MemoryCells", "create", "w");
+ words_fptr = MR_checked_fopen("Prof.MemoryWords", "create", "w");
+ cells_fptr = MR_checked_fopen("Prof.MemoryCells", "create", "w");
fprintf(words_fptr, "%s %f %s\n",
"memory-words", 0.001, "kilowords");
@@ -564,8 +413,8 @@
print_memory_node(words_fptr, cells_fptr, MR_memprof_procs.root);
- checked_fclose(words_fptr, "Prof.MemoryWords");
- checked_fclose(cells_fptr, "Prof.MemoryCells");
+ MR_checked_fclose(words_fptr, "Prof.MemoryWords");
+ MR_checked_fclose(cells_fptr, "Prof.MemoryCells");
}
static void
@@ -597,19 +446,20 @@
}
}
-#endif /* PROFILE_MEMORY */
+#endif /* MR_MPROF_PROFILE_MEMORY */
/* ======================================================================== */
void
MR_prof_init(void)
{
-#ifdef PROFILE_TIME
- prof_init_time_profile_method();
+#ifdef MR_MPROF_PROFILE_TIME
+ MR_init_time_profile_method();
#endif
-#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
- checked_atexit(MR_prof_finish);
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
+ MR_checked_atexit(MR_prof_finish);
#ifdef SIGINT
MR_setup_signal(SIGINT, prof_handle_sigint, FALSE,
"Mercury runtime: cannot install signal handler");
@@ -617,11 +467,15 @@
#endif
}
-#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
static void
prof_handle_sigint(void)
{
- /* exit() will call MR_prof_finish(), which we registered with atexit(). */
+ /*
+ ** exit() will call MR_prof_finish(), which we registered
+ ** with atexit().
+ */
exit(1);
}
#endif
@@ -634,27 +488,43 @@
if (done) return;
done = TRUE;
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
prof_output_addr_pair_table();
#endif
-#ifdef PROFILE_TIME
- MR_prof_turn_off_time_profiling();
+#ifdef MR_MPROF_PROFILE_TIME
+ MR_turn_off_time_profiling();
prof_output_addr_table();
#endif
-#ifdef PROFILE_MEMORY
+#ifdef MR_MPROF_PROFILE_MEMORY
prof_output_mem_tables();
#endif
}
void MR_close_prof_decl_file(void)
{
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
if (MR_prof_decl_fptr) {
- checked_fclose(MR_prof_decl_fptr, "Prof.Decl");
+ MR_checked_fclose(MR_prof_decl_fptr, "Prof.Decl");
}
#endif
}
+
+#ifdef MR_MPROF_PROFILE_TIME
+
+void
+MR_prof_turn_on_time_profiling(void)
+{
+ MR_turn_on_time_profiling(prof_handle_tick);
+}
+
+void
+MR_prof_turn_off_time_profiling(void)
+{
+ MR_turn_off_time_profiling();
+}
+
+#endif
/* ======================================================================== */
Index: runtime/mercury_prof.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_prof.h,v
retrieving revision 1.12
diff -u -b -r1.12 mercury_prof.h
--- runtime/mercury_prof.h 2000/12/04 18:35:08 1.12
+++ runtime/mercury_prof.h 2001/05/03 06:41:39
@@ -1,12 +1,12 @@
/*
-** Copyright (C) 1995-1997,2000 The University of Melbourne.
+** Copyright (C) 1995-1997,2000-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
/*
** mercury_prof.h -- definitions for profiling.
-** (See also mercury_heap_profiling.h.)
+** (See also mercury_heap_profiling.h and mercury_deep_profiling.h.)
*/
#ifndef MERCURY_PROF_H
@@ -30,7 +30,7 @@
** being executed when a profiling interrupt occurs.
*/
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
#define MR_set_prof_current_proc(target) \
(MR_prof_current_proc = (target))
#define MR_update_prof_current_proc(target) \
@@ -45,10 +45,10 @@
** for a call to MR_do_call_closure or MR_do_call_class_method.
*/
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
extern MR_Code * MR_prof_ho_caller_proc;
#endif
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
#define MR_set_prof_ho_caller_proc(target) \
(MR_prof_ho_caller_proc = (target))
#else
@@ -59,13 +59,13 @@
** The MR_PROFILE() macro is used (by mercury_calls.h) to record each call.
*/
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
#define MR_PROFILE(callee, caller) MR_prof_call_profile((callee), (caller))
#else
#define MR_PROFILE(callee, caller) ((void)0)
#endif
-#ifdef PROFILE_CALLS
+#ifdef MR_MPROF_PROFILE_CALLS
extern void MR_prof_call_profile(MR_Code *, MR_Code *);
#endif
@@ -94,7 +94,7 @@
extern void MR_prof_finish(void);
extern void MR_close_prof_decl_file(void);
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
extern void MR_prof_turn_on_time_profiling(void);
extern void MR_prof_turn_off_time_profiling(void);
#endif
Index: runtime/mercury_prof_time.c
===================================================================
RCS file: mercury_prof_time.c
diff -N mercury_prof_time.c
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_prof_time.c Fri May 4 10:43:45 2001
@@ -0,0 +1,144 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** mercury_prof_time.c
+**
+** Author: petdr
+*/
+
+const char *MR_time_method;
+
+#include "mercury_imp.h"
+#include "mercury_signal.h"
+#include "mercury_timing.h"
+#include "mercury_prof_time.h"
+
+#include <signal.h>
+#include <errno.h>
+
+#ifdef HAVE_UNISTD_H
+ #include <unistd.h>
+#endif
+
+#ifdef HAVE_SYS_TIME
+ #include <sys/time.h>
+#endif
+
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_DEEP_PROFILING)
+
+#if !defined(MR_CLOCK_TICKS_PER_SECOND) || !defined(HAVE_SETITIMER)
+ #error "Time profiling not supported on this system"
+#endif
+
+static int MR_itimer_sig;
+static int MR_itimer_type;
+
+static bool MR_time_profiling_on = FALSE;
+
+static void MR_checked_setitimer(int which,
+ struct itimerval *value);
+
+/*
+** MR_init_time_profile_method:
+** initializes MR_itimer_type and MR_itimer_sig
+** based on the setting of MR_time_profile_method.
+*/
+
+void
+MR_init_time_profile_method(void)
+{
+ switch (MR_time_profile_method) {
+#if defined(ITIMER_REAL) && defined(SIGALRM)
+ case MR_profile_real_time:
+ MR_itimer_type = ITIMER_REAL;
+ MR_itimer_sig = SIGALRM;
+ MR_time_method = "real-time";
+ break;
+#endif
+#if defined(ITIMER_VIRTUAL) && defined(SIGVTALRM)
+ case MR_profile_user_time:
+ MR_itimer_type = ITIMER_VIRTUAL;
+ MR_itimer_sig = SIGVTALRM;
+ MR_time_method = "user-time";
+ break;
+#endif
+#if defined(ITIMER_VIRTUAL) && defined(SIGVTALRM)
+ case MR_profile_user_plus_system_time:
+ MR_itimer_type = ITIMER_PROF;
+ MR_itimer_sig = SIGPROF;
+ MR_time_method = "user-plus-system-time";
+ break;
+#endif
+ default:
+ MR_fatal_error("invalid time profile method");
+ }
+}
+
+/*
+** MR_turn_on_time_profiling:
+** Sets up the profiling timer and starts it up.
+** At the moment it is after every MR_CLOCK_TICKS_PER_PROF_SIG
+** ticks of the clock.
+**
+** WARNING: SYSTEM SPECIFIC CODE.
+** This code is not very portable, because it uses setitimer(),
+** which is not part of POSIX.1 or ANSI C.
+*/
+
+void
+MR_turn_on_time_profiling(MR_time_signal_handler handler)
+{
+ struct itimerval itime;
+ const long prof_sig_interval_in_usecs =
+ MR_CLOCK_TICKS_PER_PROF_SIG *
+ (MR_USEC_PER_SEC /
+ MR_CLOCK_TICKS_PER_SECOND);
+
+ MR_time_profiling_on = TRUE;
+
+ itime.it_value.tv_sec = 0;
+ itime.it_value.tv_usec = prof_sig_interval_in_usecs;
+ itime.it_interval.tv_sec = 0;
+ itime.it_interval.tv_usec = prof_sig_interval_in_usecs;
+
+ MR_setup_signal(MR_itimer_sig, handler, FALSE,
+ "Mercury runtime: cannot install signal handler");
+ MR_checked_setitimer(MR_itimer_type, &itime);
+}
+
+/*
+** MR_turn_off_time_profiling:
+** Turns off the time profiling.
+*/
+
+void
+MR_turn_off_time_profiling(void)
+{
+ struct itimerval itime;
+
+ if (! MR_time_profiling_on)
+ return;
+
+ itime.it_value.tv_sec = 0;
+ itime.it_value.tv_usec = 0;
+ itime.it_interval.tv_sec = 0;
+ itime.it_interval.tv_usec = 0;
+
+ MR_checked_setitimer(MR_itimer_type, &itime);
+}
+
+static void
+MR_checked_setitimer(int which, struct itimerval *value)
+{
+ errno = 0;
+ if (setitimer(which, value, NULL) != 0) {
+ perror("Mercury runtime: cannot set timer for profiling");
+ exit(1);
+ }
+}
+
+#endif /* MR_MPROF_PROFILE_TIME || MR_DEEP_PROFILING */
Index: runtime/mercury_prof_time.h
===================================================================
RCS file: mercury_prof_time.h
diff -N mercury_prof_time.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_prof_time.h Sun May 6 18:29:57 2001
@@ -0,0 +1,26 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+#ifndef MERCURY_PROF_TIME_H
+#define MERCURY_PROF_TIME_H
+
+#define MR_CLOCK_TICKS_PER_PROF_SIG 5
+#define MR_USEC_PER_SEC 1000000
+
+extern const char *MR_time_method;
+
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_DEEP_PROFILING)
+
+typedef void MR_time_signal_handler(int signum);
+
+extern void MR_turn_on_time_profiling(MR_time_signal_handler handler);
+extern void MR_turn_off_time_profiling(void);
+
+extern void MR_init_time_profile_method(void);
+
+#endif /* MR_MPROF_PROFILE_TIMING || MR_DEEP_PROFILING */
+
+#endif /* MERCURY_PROF_TIME_H */
Index: runtime/mercury_regs.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_regs.h,v
retrieving revision 1.17
diff -u -b -r1.17 mercury_regs.h
--- runtime/mercury_regs.h 2000/11/23 02:00:38 1.17
+++ runtime/mercury_regs.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1993-2000 The University of Melbourne.
+** Copyright (C) 1993-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -29,7 +29,7 @@
#define MR_LVALUE_COND(expr, x, y) (*((expr)?&(x):&(y)))
#endif
-#define MR_fake_reg (MR_ENGINE(fake_reg))
+#define MR_fake_reg (MR_ENGINE(MR_eng_fake_reg))
/*---------------------------------------------------------------------------*/
/*
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.49
diff -u -b -r1.49 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 2001/05/07 02:57:03 1.49
+++ runtime/mercury_stack_layout.h 2001/05/12 15:27:16
@@ -439,7 +439,7 @@
** unification, comparison and index procedures. The meanings of the fields
** in both forms are the same as in procedure labels. The runtime system
** can figure out which form is present by using the macro
-** MR_ENTRY_LAYOUT_COMPILER_GENERATED, which will return true only if
+** MR_PROC_LAYOUT_COMPILER_GENERATED, which will return true only if
** the procedure is of the second type.
**
** The compiler generates MR_User_Proc_Id and MR_Compiler_Proc_Id structures
@@ -474,8 +474,11 @@
MR_Compiler_Proc_Id MR_proc_comp;
} MR_Proc_Id;
-#define MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry) \
- ((MR_Unsigned) entry->MR_sle_user.MR_user_pred_or_func \
+#define MR_PROC_LAYOUT_COMPILER_GENERATED(entry) \
+ MR_PROC_ID_COMPILER_GENERATED(entry->MR_sle_proc_id)
+
+#define MR_PROC_ID_COMPILER_GENERATED(proc_id) \
+ ((MR_Unsigned) (proc_id).MR_proc_user.MR_user_pred_or_func \
> MR_FUNCTION)
/*
@@ -613,8 +616,8 @@
** The runtime system considers all proc layout structures to be of type
** MR_Proc_Layout, but must use the macros defined below to check for the
** existence of each substructure before accessing the fields of that
-** substructure. The macros are MR_ENTRY_LAYOUT_HAS_PROC_ID to check for the
-** MR_Proc_Id substructure and MR_ENTRY_LAYOUT_HAS_EXEC_TRACE to check for the
+** substructure. The macros are MR_PROC_LAYOUT_HAS_PROC_ID to check for the
+** MR_Proc_Id substructure and MR_PROC_LAYOUT_HAS_EXEC_TRACE to check for the
** MR_Exec_Trace substructure.
**
** The reason why some substructures may be missing is to save space.
@@ -673,11 +676,11 @@
MR_Exec_Trace MR_comp_exec_trace;
} MR_Proc_Layout_Compiler_Exec;
-#define MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \
+#define MR_PROC_LAYOUT_HAS_PROC_ID(entry) \
((MR_Word) entry->MR_sle_user.MR_user_pred_or_func != -1)
-#define MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) \
- (MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \
+#define MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry) \
+ (MR_PROC_LAYOUT_HAS_PROC_ID(entry) \
&& entry->MR_sle_call_label != NULL)
#define MR_sle_code_addr MR_sle_traversal.MR_trav_code_addr
@@ -714,7 +717,7 @@
** procedures the size of the frame can be deduced from the prevfr field
** and the location of the succip is fixed.
**
-** An unknown slot count should be signalled by MR_ENTRY_NO_SLOT_COUNT.
+** An unknown slot count should be signalled by MR_PROC_NO_SLOT_COUNT.
** An unknown succip location should be signalled by MR_LONG_LVAL_TYPE_UNKNOWN.
**
** For the procedure identification, we always use the same module name
@@ -729,7 +732,7 @@
** five variant types listed above.)
*/
-#define MR_ENTRY_NO_SLOT_COUNT -1
+#define MR_PROC_NO_SLOT_COUNT -1
#ifdef MR_STATIC_CODE_ADDRESSES
#define MR_MAKE_PROC_LAYOUT_ADDR(entry) MR_STATIC(entry)
@@ -780,7 +783,7 @@
** burden of initializing fields to the MR_trace of the call event either.
**
** The following macros will access the fixed slots. They can be used whenever
-** MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) is true; which set you should use
+** MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry) is true; which set you should use
** depends on the determinism of the procedure.
**
** These macros have to be kept in sync with compiler/trace.m.
Index: runtime/mercury_stack_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_trace.c,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_stack_trace.c
--- runtime/mercury_stack_trace.c 2001/01/18 01:19:07 1.41
+++ runtime/mercury_stack_trace.c 2001/05/03 06:41:39
@@ -424,7 +424,7 @@
int i, j;
proc = label->MR_sll_entry;
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(proc)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(proc)) {
return FALSE;
}
@@ -467,7 +467,7 @@
return;
}
- if (MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry)) {
+ if (MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
MR_Integer maybe_from_full =
entry->MR_sle_maybe_from_full;
if (maybe_from_full > 0) {
@@ -535,11 +535,11 @@
MR_print_proc_id_internal(FILE *fp, const MR_Proc_Layout *entry,
bool spec)
{
- if (! MR_ENTRY_LAYOUT_HAS_PROC_ID(entry)) {
+ if (! MR_PROC_LAYOUT_HAS_PROC_ID(entry)) {
MR_fatal_error("cannot print procedure id without layout");
}
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
if (spec) {
MR_fatal_error("cannot generate specifications "
"for compiler generated procedures");
Index: runtime/mercury_stacks.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stacks.h,v
retrieving revision 1.29
diff -u -b -r1.29 mercury_stacks.h
--- runtime/mercury_stacks.h 2001/02/21 05:53:43 1.29
+++ runtime/mercury_stacks.h 2001/05/03 06:41:39
@@ -23,7 +23,7 @@
/* Stack slots start numbering at 1 */
#define MR_based_stackvar(base_sp, n) ((base_sp)[-(n)])
-#define MR_stackvar(n) MR_based_stackvar(MR_sp, n)
+#define MR_stackvar(n) MR_based_stackvar(MR_sp, (n))
#define MR_incr_sp_push_msg(n, msg) \
( \
@@ -241,8 +241,8 @@
/*
** For this value, the exception will be handled by C code using
** setjmp/longjmp. If an exception occurs, then after the Mercury
- ** stacks have been unwound, `MR_longjmp(MR_ENGINE(e_jmp_buf))' will
- ** be called.
+ ** stacks have been unwound, `MR_longjmp(MR_ENGINE(MR_eng_jmp_buf))'
+ ** will be called.
*/
MR_C_LONGJMP_HANDLER
};
@@ -261,7 +261,7 @@
** (see above), but it is declared to have type `MR_Word' to ensure
** that everything remains word-aligned.
*/
- MR_Word code_model;
+ MR_Word MR_excp_code_model;
/*
** If code_model is MR_MODEL_*_HANDLER, then
@@ -269,7 +269,7 @@
** which will be a closure of the specified determinism.
** If code_model is MR_C_LONGJMP, then this field is unused.
*/
- MR_Word handler;
+ MR_Word MR_excp_handler;
/*
** The remaining fields hold stuff that must be saved in order
@@ -277,24 +277,31 @@
*/
/* the det stack pointer */
- MR_Word *stack_ptr;
+ MR_Word *MR_excp_stack_ptr;
/* the trail state */
MR_IF_USE_TRAIL(
- MR_Word trail_ptr;
- MR_Word ticket_counter;
+ MR_Word MR_excp_trail_ptr;
+ MR_Word MR_excp_ticket_counter;
)
/* the heap state */
MR_IF_NOT_CONSERVATIVE_GC(
- MR_Word *heap_ptr;
- MR_Word *solns_heap_ptr;
- MR_MemoryZone *heap_zone;
+ MR_Word *MR_excp_heap_ptr;
+ MR_Word *MR_excp_solns_heap_ptr;
+ MR_MemoryZone *MR_excp_heap_zone;
)
} MR_Exception_Handler_Frame;
+
+#ifdef MR_DEEP_PROFILING
+ #define MR_EXCEPTION_FRAMEVARS 2
+#else
+ #define MR_EXCEPTION_FRAMEVARS 0
+#endif
-#define MR_EXCEPTION_FRAMEVARS \
- (((MR_Exception_Handler_Frame *) (MR_curfr - MR_NONDET_FIXED_SIZE + 1)) - 1)
+#define MR_EXCEPTION_STRUCT \
+ (((MR_Exception_Handler_Frame *) \
+ (MR_curfr + 1 - MR_EXCEPTION_FRAMEVARS - MR_NONDET_FIXED_SIZE)) - 1)
#define MR_create_exception_handler(name, \
handler_code_model, handler_closure, redoip) \
@@ -305,28 +312,34 @@
** redoip when unwinding the nondet stack in \
** builtin_throw/1), and save the stuff we will \
** need if an exception is thrown. \
+ ** \
+ ** In deep profiling grades, we need two stack slots to save \
+ ** intermediate values in across calls to profiling routines. \
*/ \
- MR_mkpragmaframe((name), 0, \
+ MR_mkpragmaframe((name), MR_EXCEPTION_FRAMEVARS, \
MR_Exception_Handler_Frame_struct, \
MR_ENTRY(MR_exception_handler_do_fail)); \
/* record the handler's code model */ \
- MR_EXCEPTION_FRAMEVARS->code_model = (handler_code_model); \
+ MR_EXCEPTION_STRUCT->MR_excp_code_model = \
+ (handler_code_model); \
/* save the handler's closure */ \
- MR_EXCEPTION_FRAMEVARS->handler = (handler_closure); \
+ MR_EXCEPTION_STRUCT->MR_excp_handler = (handler_closure); \
/* save the det stack pointer */ \
- MR_EXCEPTION_FRAMEVARS->stack_ptr = MR_sp; \
+ MR_EXCEPTION_STRUCT->MR_excp_stack_ptr = MR_sp; \
MR_IF_NOT_CONSERVATIVE_GC( \
/* save the heap and solutions heap pointers */ \
- MR_EXCEPTION_FRAMEVARS->heap_ptr = MR_hp; \
- MR_EXCEPTION_FRAMEVARS->solns_heap_ptr = MR_sol_hp; \
- MR_EXCEPTION_FRAMEVARS->heap_zone = \
- MR_ENGINE(heap_zone); \
+ MR_EXCEPTION_STRUCT->MR_excp_heap_ptr = MR_hp; \
+ MR_EXCEPTION_STRUCT->MR_excp_solns_heap_ptr = \
+ MR_sol_hp; \
+ MR_EXCEPTION_STRUCT->MR_excp_heap_zone = \
+ MR_ENGINE(MR_eng_heap_zone); \
) \
MR_IF_USE_TRAIL( \
/* save the trail state */ \
- MR_mark_ticket_stack( \
- MR_EXCEPTION_FRAMEVARS->ticket_counter); \
- MR_store_ticket(MR_EXCEPTION_FRAMEVARS->trail_ptr); \
+ MR_mark_ticket_stack(MR_EXCEPTION_STRUCT-> \
+ MR_excp_ticket_counter); \
+ MR_store_ticket(MR_EXCEPTION_STRUCT-> \
+ MR_excp_trail_ptr); \
) \
\
/* \
Index: runtime/mercury_std.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_std.h,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_std.h
--- runtime/mercury_std.h 2001/01/10 10:57:25 1.16
+++ runtime/mercury_std.h 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1993-1995, 1997-2000 The University of Melbourne.
+** Copyright (C) 1993-1995, 1997-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -178,7 +178,7 @@
#define MR_STRINGIFY(x) MR_STRINGIFY_2(x)
#define MR_STRINGIFY_2(x) #x
-/* paste two macros together */
+/* paste some macros together */
#define MR_PASTE2(a,b) MR_PASTE2_2(a,b)
#define MR_PASTE2_2(a,b) a##b
#define MR_PASTE3(a,b,c) MR_PASTE3_2(a,b,c)
@@ -191,6 +191,12 @@
#define MR_PASTE6_2(a,b,c,d,e,f) a##b##c##d##e##f
#define MR_PASTE7(a,b,c,d,e,f,g) MR_PASTE7_2(a,b,c,d,e,f,g)
#define MR_PASTE7_2(a,b,c,d,e,f,g) a##b##c##d##e##f##g
+#define MR_PASTE8(a,b,c,d,e,f,g,h) MR_PASTE8_2(a,b,c,d,e,f,g,h)
+#define MR_PASTE8_2(a,b,c,d,e,f,g,h) a##b##c##d##e##f##g##h
+#define MR_PASTE9(a,b,c,d,e,f,g,h,i) MR_PASTE9_2(a,b,c,d,e,f,g,h,i)
+#define MR_PASTE9_2(a,b,c,d,e,f,g,h,i) a##b##c##d##e##f##g##h##i
+#define MR_PASTE10(a,b,c,d,e,f,g,h,i,j) MR_PASTE10_2(a,b,c,d,e,f,g,h,i,j)
+#define MR_PASTE10_2(a,b,c,d,e,f,g,h,i,j) a##b##c##d##e##f##g##h##i##j
/*
** MR_CHECK_EXPR_TYPE(expr, type):
Index: runtime/mercury_strerror.c
===================================================================
RCS file: mercury_strerror.c
diff -N mercury_strerror.c
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_strerror.c Thu May 3 17:56:00 2001
@@ -0,0 +1,33 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** Apparently SunOS 4.1.3 doesn't have strerror()
+** (!%^&!^% non-ANSI systems, grumble...)
+*/
+
+#include <stdio.h> /* for NULL */
+#include "mercury_conf.h" /* for (possibly) HAVE_STRERROR */
+#include "mercury_strerror.h"
+
+#ifndef HAVE_STRERROR
+
+extern int sys_nerr;
+extern char *sys_errlist[];
+
+char *
+strerror(int errnum)
+{
+ if (errnum >= 0 && errnum < sys_nerr && sys_errlist[errnum] != NULL) {
+ return sys_errlist[errnum];
+ } else {
+ static char buf[30];
+ sprintf(buf, "Error %d", errnum);
+ return buf;
+ }
+}
+
+#endif
Index: runtime/mercury_strerror.h
===================================================================
RCS file: mercury_strerror.h
diff -N mercury_strerror.h
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mercury_strerror.h Thu May 3 17:56:00 2001
@@ -0,0 +1,21 @@
+/*
+** Copyright (C) 2001 The University of Melbourne.
+** This file may only be copied under the terms of the GNU Library General
+** Public License - see the file COPYING.LIB in the Mercury distribution.
+*/
+
+/*
+** Apparently SunOS 4.1.3 doesn't have strerror()
+** (!%^&!^% non-ANSI systems, grumble...)
+*/
+
+#ifndef MERCURY_STRERROR_H
+#define MERCURY_STRERROR_H
+
+#ifndef HAVE_STRERROR
+
+extern char *strerror(int errnum);
+
+#endif /* HAVE_STRERROR */
+
+#endif /* MERCURY_STRERROR_H */
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.41
diff -u -b -r1.41 mercury_tabling.c
--- runtime/mercury_tabling.c 2001/04/29 18:21:57 1.41
+++ runtime/mercury_tabling.c 2001/05/03 06:41:39
@@ -1638,7 +1638,7 @@
MR_declare_label(mercury__table_builtin__table_nondet_resume_1_0_RedoPoint);
MR_MAKE_PROC_LAYOUT(mercury__table_builtin__table_nondet_resume_1_0,
- MR_DETISM_NON, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_DETISM_NON, MR_PROC_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
MR_PREDICATE, "table_builtin", "table_nondet_resume", 1, 0);
MR_MAKE_INTERNAL_LAYOUT_WITH_ENTRY(
mercury__table_builtin__table_nondet_resume_1_0_ChangeLoop,
@@ -2013,12 +2013,30 @@
MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc table_nondet_commit_module;
#endif
-void mercury_sys_init_table_modules(void);
- /* extra declaration to suppress gcc -Wmissing-decl warning */
-void mercury_sys_init_table_modules(void) {
+/* forward declarations to suppress gcc -Wmissing-decl warnings */
+void mercury_sys_init_table_modules_init(void);
+void mercury_sys_init_table_modules_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_table_modules_write_out_proc_statics(FILE *fp);
+#endif
+
+void mercury_sys_init_table_modules_init(void)
+{
#ifdef MR_USE_MINIMAL_MODEL
table_nondet_suspend_module();
table_nondet_resume_module();
table_nondet_commit_module();
#endif
}
+
+void mercury_sys_init_table_modules_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_table_modules_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
Index: runtime/mercury_thread.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_thread.c,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_thread.c
--- runtime/mercury_thread.c 2000/12/04 18:28:42 1.16
+++ runtime/mercury_thread.c 2001/05/03 06:41:39
@@ -1,5 +1,5 @@
/*
-** Copyright (C) 1997-2000 The University of Melbourne.
+** Copyright (C) 1997-2001 The University of Melbourne.
** This file may only be copied under the terms of the GNU Library General
** Public License - see the file COPYING.LIB in the Mercury distribution.
*/
@@ -96,12 +96,12 @@
MR_restore_registers();
#endif
MR_load_engine_regs(MR_cur_engine());
- MR_load_context(MR_ENGINE(this_context));
+ MR_load_context(MR_ENGINE(MR_eng_this_context));
MR_save_registers();
#ifdef MR_THREAD_SAFE
- MR_ENGINE(owner_thread) = pthread_self();
+ MR_ENGINE(MR_eng_owner_thread) = pthread_self();
#endif
switch (when_to_use) {
Index: runtime/mercury_trace_base.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_trace_base.c,v
retrieving revision 1.32
diff -u -b -r1.32 mercury_trace_base.c
--- runtime/mercury_trace_base.c 2001/01/18 01:19:08 1.32
+++ runtime/mercury_trace_base.c 2001/05/03 06:41:39
@@ -400,7 +400,26 @@
MR_END_MODULE
-void mercury_sys_init_trace(void); /* suppress gcc warning */
-void mercury_sys_init_trace(void) {
+/* forward decls to suppress gcc warnings */
+void mercury_sys_init_trace_init(void);
+void mercury_sys_init_trace_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_trace_write_out_proc_statics(FILE *fp);
+#endif
+
+void mercury_sys_init_trace_init(void)
+{
MR_trace_labels_module();
}
+
+void mercury_sys_init_trace_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_trace_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.88
diff -u -b -r1.88 mercury_wrapper.c
--- runtime/mercury_wrapper.c 2001/04/16 09:50:27 1.88
+++ runtime/mercury_wrapper.c 2001/05/12 15:27:16
@@ -29,6 +29,10 @@
#include "mercury_imp.h"
+#ifdef MR_DEEP_PROFILING
+#include "mercury_deep_profiling.h"
+#endif
+
#include <stdio.h>
#include <string.h>
@@ -42,9 +46,9 @@
#include "mercury_dummy.h"
#include "mercury_stack_layout.h"
#include "mercury_trace_base.h"
+#include "mercury_deep_profiling.h"
#include "mercury_memory.h" /* for MR_copy_string() */
#include "mercury_memory_handlers.h" /* for MR_default_handler */
-#include "mercury_memory_zones.h" /* for MR_default_handler */
/* global variables concerned with testing (i.e. not with the engine) */
@@ -89,6 +93,9 @@
/* other options */
bool MR_check_space = FALSE;
+MR_Word *MR_watch_addr = NULL;
+MR_Word *MR_watch_csd_addr = NULL;
+int MR_watch_csd_ignore = 0;
static bool benchmark_all_solns = FALSE;
static bool use_own_timer = FALSE;
@@ -111,6 +118,8 @@
int mercury_exit_status = 0;
bool MR_profiling = TRUE;
+bool MR_print_deep_profiling_statistics = FALSE;
+bool MR_deep_profiling_save_results = TRUE;
#ifdef MR_TYPE_CTOR_STATS
@@ -171,11 +180,14 @@
void (*MR_address_of_init_modules)(void);
void (*MR_address_of_init_modules_type_tables)(void);
void (*MR_address_of_init_modules_debugger)(void);
+#ifdef MR_DEEP_PROFILING
+void (*MR_address_of_write_out_proc_statics)(FILE *fp);
+#endif
int (*MR_address_of_do_load_aditi_rl_code)(void);
-char * (*MR_address_of_trace_getline)(const char *, FILE *, FILE *);
-char * (*MR_address_of_trace_get_command)(const char *, FILE *, FILE *);
+char *(*MR_address_of_trace_getline)(const char *, FILE *, FILE *);
+char *(*MR_address_of_trace_get_command)(const char *, FILE *, FILE *);
#ifdef MR_USE_EXTERNAL_DEBUGGER
void (*MR_address_of_trace_init_external)(void);
@@ -289,6 +301,7 @@
#endif
#if defined(MR_LOWLEVEL_DEBUG) || defined(MR_TABLE_DEBUG)
+ if (MR_unbufdebug) {
/*
** Ensure stdio & stderr are unbuffered even if redirected.
** Using setvbuf() is more complicated than using setlinebuf(),
@@ -297,6 +310,7 @@
setvbuf(stdout, NULL, _IONBF, 0);
setvbuf(stderr, NULL, _IONBF, 0);
+ }
#endif
#ifdef CONSERVATIVE_GC
@@ -356,8 +370,21 @@
#endif /* ! MR_HIGHLEVEL_CODE */
/* initialize profiling */
- if (MR_profiling) MR_prof_init();
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
+ if (MR_profiling) {
+ MR_prof_init();
+ }
+#endif
+
+#ifdef MR_DEEP_PROFILING_TIMING
+ if (MR_deep_profiling_save_results) {
+ MR_deep_prof_init();
+ MR_deep_prof_turn_on_time_profiling();
+ }
+#endif
+
/*
** We need to call MR_save_registers(), since we're about to
** call a C->Mercury interface function, and the C->Mercury
@@ -375,11 +402,11 @@
#ifndef MR_HIGHLEVEL_CODE
#ifndef __LCC__
- MR_save_context(&(MR_ENGINE(context)));
+ MR_save_context(&(MR_ENGINE(MR_eng_context)));
#else
{
/* XXX Work around lcc bug -- lcc 4.1 miscompiles the original code */
- size_t offset = offsetof(MercuryEngine, context);
+ size_t offset = offsetof(MercuryEngine, MR_eng_context);
char *tmp = (char *) MR_cur_engine();
MR_Context *eng_context = (tmp += offset, (MR_Context *) tmp);
MR_save_context(eng_context);
@@ -706,7 +733,7 @@
int c;
int long_index;
- while ((c = MR_getopt_long(argc, argv, "acC:d:e:D:i:m:o:P:pr:tT:x",
+ while ((c = MR_getopt_long(argc, argv, "acC:d:e:D:i:m:o:P:pr:stT:x",
MR_long_opts, &long_index)) != EOF)
{
switch (c)
@@ -819,43 +846,77 @@
#ifdef CONSERVATIVE_GC
GC_quiet = FALSE;
#endif
- }
- else if (streq(MR_optarg, "b"))
+ } else if (streq(MR_optarg, "b")) {
MR_nondstackdebug = TRUE;
- else if (streq(MR_optarg, "c"))
+ } else if (streq(MR_optarg, "c")) {
MR_calldebug = TRUE;
- else if (streq(MR_optarg, "d"))
+ } else if (streq(MR_optarg, "d")) {
MR_detaildebug = TRUE;
- else if (streq(MR_optarg, "f"))
+ } else if (streq(MR_optarg, "f")) {
MR_finaldebug = TRUE;
- else if (streq(MR_optarg, "g"))
+ } else if (streq(MR_optarg, "g")) {
MR_gotodebug = TRUE;
- else if (streq(MR_optarg, "G"))
+ } else if (streq(MR_optarg, "G")) {
#ifdef CONSERVATIVE_GC
GC_quiet = FALSE;
#else
; /* ignore inapplicable option */
#endif
- else if (streq(MR_optarg, "h"))
+ } else if (streq(MR_optarg, "h")) {
MR_heapdebug = TRUE;
- else if (streq(MR_optarg, "H"))
+ } else if (streq(MR_optarg, "H")) {
MR_hashdebug = TRUE;
- else if (streq(MR_optarg, "m"))
+ } else if (MR_optarg[0] == 'I') {
+ int ignore;
+
+ if (sscanf(MR_optarg+1, "%u", &ignore) != 1) {
+ usage();
+ }
+
+ MR_watch_csd_ignore = ignore;
+ } else if (streq(MR_optarg, "m")) {
MR_memdebug = TRUE;
- else if (streq(MR_optarg, "p"))
+ } else if (streq(MR_optarg, "p")) {
MR_progdebug = TRUE;
- else if (streq(MR_optarg, "r"))
+ } else if (streq(MR_optarg, "r")) {
MR_sregdebug = TRUE;
- else if (streq(MR_optarg, "s"))
+ } else if (streq(MR_optarg, "s")) {
MR_detstackdebug = TRUE;
- else if (streq(MR_optarg, "S"))
+ } else if (streq(MR_optarg, "S")) {
MR_tablestackdebug = TRUE;
- else if (streq(MR_optarg, "t"))
+ } else if (streq(MR_optarg, "t")) {
MR_tracedebug = TRUE;
- else if (streq(MR_optarg, "T"))
+ } else if (streq(MR_optarg, "T")) {
MR_tabledebug = TRUE;
- else
+ } else if (streq(MR_optarg, "u")) {
+ MR_unbufdebug = TRUE;
+ } else if (MR_optarg[0] == 'w' || MR_optarg[0] == 'W')
+ {
+ long addr;
+
+ if (MR_optarg[1] == '0' && MR_optarg[2] == 'x')
+ {
+ if (sscanf(MR_optarg+3, "%lx", &addr)
+ != 1)
+ {
+ usage();
+ }
+ } else {
+ if (sscanf(MR_optarg+1, "%lu", &addr)
+ != 1)
+ {
usage();
+ }
+ }
+
+ if (MR_optarg[0] == 'w') {
+ MR_watch_addr = (MR_Word *) addr;
+ } else {
+ MR_watch_csd_addr = (MR_Word *) addr;
+ }
+ } else {
+ usage();
+ }
use_own_timer = FALSE;
break;
@@ -896,6 +957,14 @@
break;
+ case 's':
+ MR_deep_profiling_save_results = FALSE;
+ break;
+
+ case 'S':
+ MR_print_deep_profiling_statistics = TRUE;
+ break;
+
case 't':
use_own_timer = TRUE;
@@ -970,6 +1039,11 @@
unsigned char safety_buffer[SAFETY_BUFFER_SIZE];
#endif
+#ifdef MR_DEEP_PROFILING
+ MR_CallSiteDynList **saved_cur_callback;
+ MR_CallSiteDynamic *saved_cur_csd;
+#endif
+
static int repcounter;
#ifdef MR_MSVC_STRUCTURED_EXCEPTIONS
@@ -1017,16 +1091,25 @@
#ifdef MR_LOWLEVEL_DEBUG
#ifndef CONSERVATIVE_GC
- MR_ENGINE(heap_zone)->max = MR_ENGINE(heap_zone)->min;
+ MR_ENGINE(MR_eng_heap_zone)->max =
+ MR_ENGINE(MR_eng_heap_zone)->min;
#endif
- MR_CONTEXT(detstack_zone)->max = MR_CONTEXT(detstack_zone)->min;
- MR_CONTEXT(nondetstack_zone)->max = MR_CONTEXT(nondetstack_zone)->min;
+ MR_CONTEXT(MR_ctxt_detstack_zone)->max =
+ MR_CONTEXT(MR_ctxt_detstack_zone)->min;
+ MR_CONTEXT(MR_ctxt_nondetstack_zone)->max =
+ MR_CONTEXT(MR_ctxt_nondetstack_zone)->min;
#endif
MR_time_at_start = MR_get_user_cpu_miliseconds();
MR_time_at_last_stat = MR_time_at_start;
for (repcounter = 0; repcounter < repeats; repcounter++) {
+#ifdef MR_DEEP_PROFILING
+ saved_cur_callback = MR_current_callback_site;
+ saved_cur_csd = MR_current_call_site_dynamic;
+ MR_setup_callback(MR_program_entry_point);
+#endif
+
#ifdef MR_HIGHLEVEL_CODE
MR_do_interpreter();
#else
@@ -1034,6 +1117,11 @@
(void) MR_call_engine(MR_ENTRY(MR_do_interpreter), FALSE);
MR_debugmsg0("Returning from MR_call_engine()\n");
#endif
+
+#ifdef MR_DEEP_PROFILING
+ MR_current_call_site_dynamic = saved_cur_csd;
+ MR_current_callback_site = saved_cur_callback;
+#endif
}
if (use_own_timer) {
@@ -1058,15 +1146,15 @@
printf("\n");
#ifndef CONSERVATIVE_GC
printf("max heap used: %6ld words\n",
- (long) (MR_ENGINE(heap_zone)->max
- - MR_ENGINE(heap_zone)->min));
+ (long) (MR_ENGINE(MR_eng_heap_zone)->max
+ - MR_ENGINE(MR_eng_heap_zone)->min));
#endif
printf("max detstack used: %6ld words\n",
- (long)(MR_CONTEXT(detstack_zone)->max
- - MR_CONTEXT(detstack_zone)->min));
+ (long)(MR_CONTEXT(MR_ctxt_detstack_zone)->max
+ - MR_CONTEXT(MR_ctxt_detstack_zone)->min));
printf("max nondstack used: %6ld words\n",
- (long) (MR_CONTEXT(nondetstack_zone)->max
- - MR_CONTEXT(nondetstack_zone)->min));
+ (long) (MR_CONTEXT(MR_ctxt_nondetstack_zone)->max
+ - MR_CONTEXT(MR_ctxt_nondetstack_zone)->min));
}
#endif
@@ -1272,15 +1360,19 @@
static void
MR_do_interpreter(void)
{
- #ifdef PROFILE_TIME
- if (MR_profiling) MR_prof_turn_on_time_profiling();
+ #ifdef MR_MPROF_PROFILE_TIME
+ if (MR_profiling) {
+ MR_prof_turn_on_time_profiling();
+ }
#endif
/* call the Mercury predicate main/2 */
(*MR_program_entry_point)();
- #ifdef PROFILE_TIME
- if (MR_profiling) MR_prof_turn_off_time_profiling();
+ #ifdef MR_MPROF_PROFILE_TIME
+ if (MR_profiling) {
+ MR_prof_turn_off_time_profiling();
+ }
#endif
}
@@ -1314,7 +1406,7 @@
MR_fatal_error("no program entry point supplied");
}
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
MR_set_prof_current_proc(MR_program_entry_point);
if (MR_profiling) {
MR_prof_turn_on_time_profiling();
@@ -1353,7 +1445,7 @@
MR_define_label(all_done);
-#ifdef PROFILE_TIME
+#ifdef MR_MPROF_PROFILE_TIME
if (MR_profiling) {
MR_prof_turn_off_time_profiling();
}
@@ -1408,9 +1500,19 @@
MR_trace_final();
+#if defined(MR_MPROF_PROFILE_TIME) || defined(MR_MPROF_PROFILE_CALLS) \
+ || defined(MR_MPROF_PROFILE_MEMORY)
if (MR_profiling) {
MR_prof_finish();
}
+#endif
+
+#ifdef MR_DEEP_PROFILING
+ MR_deep_prof_turn_off_time_profiling();
+ if (MR_deep_profiling_save_results) {
+ MR_write_out_profiling_tree();
+ }
+#endif
#ifndef MR_HIGHLEVEL_CODE
#ifdef MR_THREAD_SAFE
@@ -1447,9 +1549,32 @@
}
/*---------------------------------------------------------------------------*/
-void mercury_sys_init_wrapper(void); /* suppress gcc warning */
-void mercury_sys_init_wrapper(void) {
+
+/* forward decls to suppress gcc warnings */
+void mercury_sys_init_wrapper_init(void);
+void mercury_sys_init_wrapper_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_wrapper_write_out_proc_statics(FILE *fp);
+#endif
+
+void
+mercury_sys_init_wrapper_init(void)
+{
#ifndef MR_HIGHLEVEL_CODE
interpreter_module();
#endif
}
+
+void
+mercury_sys_init_wrapper_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void
+mercury_sys_init_wrapper_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.42
diff -u -b -r1.42 mercury_wrapper.h
--- runtime/mercury_wrapper.h 2001/01/18 01:19:10 1.42
+++ runtime/mercury_wrapper.h 2001/05/12 15:27:16
@@ -18,6 +18,7 @@
#include "mercury_stack_layout.h" /* for `MR_Label_Layout' etc */
#include "mercury_trace_base.h" /* for `MR_trace_port' */
#include "mercury_stacks.h" /* for `MR_{Cut,Generator}StackFrame' */
+#include <stdio.h> /* for `FILE' */
/*
** mercury_runtime_init() does some stuff to initialize the garbage collector
@@ -86,6 +87,9 @@
extern void (*MR_address_of_init_modules)(void);
extern void (*MR_address_of_init_modules_type_tables)(void);
extern void (*MR_address_of_init_modules_debugger)(void);
+#ifdef MR_DEEP_PROFILING
+extern void (*MR_address_of_write_out_proc_statics)(FILE *fp);
+#endif
#ifdef CONSERVATIVE_GC
extern void (*MR_address_of_init_gc)(void);
@@ -195,7 +199,11 @@
/* size of the primary cache */
extern size_t MR_pcache_size;
+/* low level debugging */
extern bool MR_check_space;
+extern MR_Word *MR_watch_addr;
+extern MR_Word *MR_watch_csd_addr;
+extern int MR_watch_csd_ignore;
/* timing */
extern int MR_time_at_start;
@@ -211,6 +219,7 @@
MR_time_profile_method;
extern bool MR_profiling;
+extern bool MR_print_deep_profiling_statistics;
#ifdef MR_TYPE_CTOR_STATS
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
Index: scripts/canonical_grade.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/canonical_grade.sh-subr,v
retrieving revision 1.2
diff -u -b -r1.2 canonical_grade.sh-subr
--- scripts/canonical_grade.sh-subr 2001/03/18 23:10:14 1.2
+++ scripts/canonical_grade.sh-subr 2001/05/03 06:41:39
@@ -70,13 +70,14 @@
accurate) GRADE="$GRADE.agc" ;;
esac
-case $profile_time,$profile_calls,$profile_memory in
- true,true,false) GRADE="$GRADE.prof" ;;
- true,false,false) GRADE="$GRADE.proftime" ;;
- false,true,false) GRADE="$GRADE.profcalls" ;;
- true,true,true) GRADE="$GRADE.profall" ;;
- false,true,true) GRADE="$GRADE.memprof" ;;
- false,false,false) ;;
+case $profile_time,$profile_calls,$profile_memory,$profile_deep in
+ true,true,false,false) GRADE="$GRADE.prof" ;;
+ true,false,false,false) GRADE="$GRADE.proftime" ;;
+ false,true,false,false) GRADE="$GRADE.profcalls" ;;
+ true,true,true,false) GRADE="$GRADE.profall" ;;
+ false,true,true,false) GRADE="$GRADE.memprof" ;;
+ false,false,false,true) GRADE="$GRADE.profdeep" ;;
+ false,false,false,false) ;;
*) progname=`basename $0`
echo "$progname: error: invalid combination of profiling options." 1>&2
exit 1
Index: scripts/init_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/init_grade_options.sh-subr,v
retrieving revision 1.17
diff -u -b -r1.17 init_grade_options.sh-subr
--- scripts/init_grade_options.sh-subr 2001/03/18 23:10:14 1.17
+++ scripts/init_grade_options.sh-subr 2001/05/03 06:41:39
@@ -35,6 +35,7 @@
--profile-calls
--profile-time
--profile-memory
+ --profile-deep
--use-trail
--reserve-tag
--use-minimal-model
@@ -44,7 +45,6 @@
See the documentation in the \"Invocation\" section
of the Mercury User's Guide."
-# --profile-deep is not yet documented because it is not yet implemented
# --gcc-nested-functions is not yet documented because it is not yet stable
# --high-level-data is not yet documented because it is not yet implemented
# --high-level is not yet documented because --high-level-data is
Index: scripts/mdprof.in
===================================================================
RCS file: mdprof.in
diff -N mdprof.in
--- /dev/null Fri Dec 1 02:25:58 2000
+++ mdprof.in Thu May 17 16:41:43 2001
@@ -0,0 +1,8 @@
+#!/bin/sh
+# This should set up PATH to include the directory containing the installed
+# 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.
+PATH=@PREFIX@/bin:$PATH
+export PATH
+exec mdprof_cgi "$@"
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/mgnuc.in,v
retrieving revision 1.80
diff -u -b -r1.80 mgnuc.in
--- scripts/mgnuc.in 2001/04/10 15:37:36 1.80
+++ scripts/mgnuc.in 2001/05/03 06:41:39
@@ -86,6 +86,8 @@
assemble=false
c_debug=false
c_optimize=true
+use_activation_counts=true
+preserve_tail_recursion=true
# include the file `init_grade_options.sh-subr'
@INIT_GRADE_OPTIONS@
@@ -156,38 +158,40 @@
;;
--split-c-files)
- SPLIT_OPTS=-DSPLIT_C_FILES
- ;;
+ SPLIT_OPTS=-DSPLIT_C_FILES ;;
--no-split-c-files)
- SPLIT_OPTS=
- ;;
+ SPLIT_OPTS= ;;
--inline-alloc)
- INLINE_ALLOC_OPTS="-DINLINE_ALLOC -DSILENT"
- ;;
+ INLINE_ALLOC_OPTS="-DINLINE_ALLOC -DSILENT" ;;
--no-inline-alloc)
- INLINE_ALLOC_OPTS=""
- ;;
+ INLINE_ALLOC_OPTS="" ;;
-g|--c-debug)
- c_debug=true
- ;;
+ c_debug=true ;;
-g-|--no-c-debug)
- c_debug=false
- ;;
+ c_debug=false ;;
--c-optimize)
- c_optimize=true
- ;;
+ c_optimize=true ;;
--no-c-optimize)
- c_optimize=false
- ;;
+ c_optimize=false ;;
--low-level-debug)
low_level_debug=true ;;
--no-low-level-debug)
low_level_debug=false ;;
+ --use-activation-counts)
+ use_activation_counts=true ;;
+ --no-use-activation-counts)
+ use_activation_counts=false ;;
+
+ --preserve-tail-recursion)
+ preserve_tail_recursion=true ;;
+ --no-preserve-tail-recursion)
+ preserve_tail_recursion=false ;;
+
# include the file `parse_grade_options.sh-subr'
@PARSE_GRADE_OPTIONS@
@@ -301,6 +305,21 @@
false) PROF_MEMORY_OPTS="" ;;
esac
+case $use_activation_counts in
+ true) ACTIVATION_COUNT_OPT="-DMR_USE_ACTIVATION_COUNTS" ;;
+ false) ACTIVATION_COUNT_OPT="";;
+esac
+
+case $preserve_tail_recursion in
+ true) PRESERVE_TAIL_RECURSION_OPT="-DMR_DEEP_PROFILING_TAIL_RECURSION" ;;
+ false) PRESERVE_TAIL_RECURSION_OPT="";;
+esac
+
+case $profile_deep in
+ true) PROF_DEEP_OPTS="-DMR_DEEP_PROFILING $ACTIVATION_COUNT_OPT $PRESERVE_TAIL_RECURSION_OPT" ;;
+ false) PROF_DEEP_OPTS="" ;;
+esac
+
case $use_trail in
true) TRAIL_OPTS="-DMR_USE_TRAIL" ;;
false) TRAIL_OPTS="" ;;
@@ -484,8 +503,8 @@
$HLC_OPTS $HLD_OPTS $GCC_OPTS $GC_OPTS $DEFINE_OPTS \
$TRACE_OPTS $STACK_TRACE_OPTS $LLDEBUG_OPTS $C_DEBUG_OPTS \
$PROF_TIME_OPTS $PROF_CALLS_OPTS $PROF_MEMORY_OPTS \
- $INLINE_ALLOC_OPTS $TRAIL_OPTS $RESERVE_TAG_OPTS \
- $MINIMAL_MODEL_OPTS \
+ $PROF_DEEP_OPTS $INLINE_ALLOC_OPTS $TRAIL_OPTS \
+ $RESERVE_TAG_OPTS $MINIMAL_MODEL_OPTS \
$SPLIT_OPTS $THREAD_OPTS $PICREG_OPTS $ARCH_OPTS $ARG_OPTS"
case $verbose in true)
Index: scripts/parse_grade_options.sh-subr
===================================================================
RCS file: /home/mercury1/repository/mercury/scripts/parse_grade_options.sh-subr,v
retrieving revision 1.22
diff -u -b -r1.22 parse_grade_options.sh-subr
--- scripts/parse_grade_options.sh-subr 2001/03/18 23:10:14 1.22
+++ scripts/parse_grade_options.sh-subr 2001/05/03 06:41:39
@@ -98,7 +98,7 @@
profile_deep=false
;;
--deep-profiling)
- profile_time=true
+ profile_time=false
profile_calls=false
profile_memory=false
profile_deep=true
@@ -357,7 +357,7 @@
profile_deep=false
;;
profdeep)
- profile_time=true
+ profile_time=false
profile_calls=false
profile_memory=false
profile_deep=true
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.51
diff -u -b -r1.51 Mmakefile
--- tests/debugger/Mmakefile 2001/05/08 03:05:01 1.51
+++ tests/debugger/Mmakefile 2001/05/13 06:26:01
@@ -17,11 +17,17 @@
#-----------------------------------------------------------------------------#
-DEBUGGER_PROGS= \
+RETRY_PROGS = \
all_solutions \
+ browser_test \
+ mdb_command_test \
+ queens \
+ retry \
+ tabled_read
+
+NONRETRY_PROGS = \
breakpoints \
browse_pretty \
- browser_test \
debugger_regs \
exception_cmd \
exception_value \
@@ -31,15 +37,11 @@
implied_instance \
interpreter \
loopcheck \
- mdb_command_test \
multi_parameter \
output_term_dep \
polymorphic_output \
- queens \
resume_typeinfos \
- retry \
- shallow \
- tabled_read
+ shallow
# The following tests are disabled, since currently they get some spurious
@@ -58,13 +60,19 @@
GRADEFLAGS-interactive = --pic-reg
MLFLAGS-interactive = --shared
-# The debugging tests don't work in MLDS grades (hl*).
+# Debugging doesn't yet don't work in MLDS grades (hl*), and the retry command
+# doesn't and will not work in deep profiling grades (profdeep).
# Also base grades `jump' and `fast' cannot be used with
# stack layouts (which are required for tracing).
ifneq "$(findstring hl,$(GRADE))" ""
PROGS=
else
+ ifneq "$(findstring profdeep,$(GRADE))" ""
+ DEBUGGER_PROGS=$(NONRETRY_PROGS)
+ else
+ DEBUGGER_PROGS=$(NONRETRY_PROGS) $(RETRY_PROGS)
+ endif
ifneq "$(findstring asm_,$(GRADE))" ""
PROGS=$(DEBUGGER_PROGS)
else
Index: tests/debugger/runtests
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/runtests,v
retrieving revision 1.10
diff -u -b -r1.10 runtests
--- tests/debugger/runtests 2001/05/15 07:10:41 1.10
+++ tests/debugger/runtests 2001/05/15 07:17:08
@@ -17,6 +17,9 @@
. ../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
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.29
diff -u -b -r1.29 Mmakefile
--- tests/debugger/declarative/Mmakefile 2001/05/03 07:26:04 1.29
+++ tests/debugger/declarative/Mmakefile 2001/05/03 07:56:28
@@ -68,15 +68,13 @@
PROGS_2=$(DECLARATIVE_PROGS) $(NONDEBUG_DECLARATIVE_PROGS)
endif
-# Debugging does not work in MLDS (hl*) grades.
+# Debugging does not work in MLDS (hl*) and deep profiling (profdeep) grades.
# Base grades `jump' and `fast' cannot be used with
# stack layouts (which are required for tracing).
# Currently, declarative debugging does not work in `rt' grades.
# Also, declarative debugging only works in `.gc' grades.
-ifneq "$(findstring hl,$(GRADE))" ""
- PROGS=
-else
+ifeq "$(findstring hl,$(GRADE))$(findstring profdeep,$(GRADE))" ""
ifneq "$(findstring .gc,$(GRADE))" ""
ifneq "$(findstring rt,$(GRADE))" ""
PROGS=
@@ -98,6 +96,8 @@
else
PROGS=
endif
+else
+ PROGS=
endif
#-----------------------------------------------------------------------------#
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/hard_coded
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.116
diff -u -b -r1.116 Mmakefile
--- tests/hard_coded/Mmakefile 2001/05/16 17:28:40 1.116
+++ tests/hard_coded/Mmakefile 2001/05/17 05:12:50
@@ -118,12 +118,21 @@
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),
@@ -132,35 +141,48 @@
#
# factt_non does not work in the hl* grades (e.g. hlc.gc),
# because the code for nondet fact tables assumes that
-# we're using the LLDS back-end.
+# we're using the LLDS back-end. Also, fact tables and deep profiling do not
+# (yet) mix.
#
# type_tables does not work in the hl* grades because the test itself
# is a quick hack that assumes the use of the LLDS backend; it should
# be replaced by a test that exercises functionality enabled by type tables.
# However, this must wait for the implementation of that functionality.
+
ifeq "$(findstring hl,$(GRADE))" ""
-BACKEND_PROGS = copy_pred factt_non type_tables
+ ifeq "$(findstring profdeep,$(GRADE))" ""
+ BACKEND_PROGS = \
+ copy_pred \
+ factt_non \
+ type_tables
+ else
+ BACKEND_PROGS = \
+ copy_pred \
+ type_tables
+ endif
else
-BACKEND_PROGS =
+ BACKEND_PROGS =
endif
-# The MLDS back-end doesn't support nondet C in trailing grades
+# The MLDS back-end doesn't support nondet C in trailing grades.
+# We also don't support nondet C in deep profiling grades.
ifeq "$(findstring hl,$(GRADE))$(findstring .tr,$(GRADE))" "hl.tr"
-NONDET_C_PROGS =
+ NONDET_C_PROGS =
else
-NONDET_C_PROGS = \
+ NONDET_C_PROGS = \
inline_nondet_pragma_c \
nondet_c
endif
-PROGS = $(ORDINARY_PROGS) $(BACKEND_PROGS) $(NONDET_C_PROGS)
+PROGS = $(ORDINARY_PROGS) $(EXCEPTION_PROGS) $(BACKEND_PROGS) $(NONDET_C_PROGS)
# --split-c-files does not work in the hl* grades (e.g. hlc.gc),
# because it hasn't yet been implemented yet.
-ifeq "$(findstring hl,$(GRADE))" ""
-SPLIT_PROGS = split_c_files
+# The same is true for deep profiling grades.
+ifeq "$(findstring hl,$(GRADE))$(findstring profdeep,$(GRADE))" ""
+ SPLIT_PROGS = split_c_files
else
-SPLIT_PROGS =
+ SPLIT_PROGS =
endif
# we do not pass the following tests
cvs diff: Diffing tests/hard_coded/exceptions
Index: tests/hard_coded/exceptions/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/exceptions/Mmakefile,v
retrieving revision 1.7
diff -u -b -r1.7 Mmakefile
--- tests/hard_coded/exceptions/Mmakefile 2001/02/23 00:33:47 1.7
+++ tests/hard_coded/exceptions/Mmakefile 2001/05/13 02:55:22
@@ -12,8 +12,13 @@
include ../../Mmake.common
-include ../../Mmake.params
-PROGS = test_exceptions.m test_uncaught_exception.m test_exceptions_func.m \
- test_try_all.m tricky_try_store.m
+EXCEPTION_PROGS = \
+ test_exceptions.m \
+ test_exceptions_func.m \
+ test_try_all.m \
+ test_uncaught_exception.m \
+ tricky_try_store.m
+
#
# XXX the following tests are not enabled because we do not pass them yet:
# test_memo.m test_loop_check.m
@@ -24,6 +29,14 @@
# tricky_try_store.m contains a work-around for that,
# which should be deleted once that bug is fixed.
#
+
+# Deep profiling grades cannot yet handle catching exceptions.
+
+ifneq "$(findstring profdeep,$(GRADE))" ""
+ PROGS=$(EXCEPTION_PROGS)
+else
+ PROGS=
+endif
depend: $(PROGS:.m=.depend)
all: $(PROGS:.m=)
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
Index: tests/valid/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/valid/Mmakefile,v
retrieving revision 1.86
diff -u -b -r1.86 Mmakefile
--- tests/valid/Mmakefile 2001/05/16 17:46:22 1.86
+++ tests/valid/Mmakefile 2001/05/17 07:08:53
@@ -202,7 +202,8 @@
# Aditi is not yet implemented for the MLDS back-end
# (i.e. grades hl*).
-ifneq "$(findstring hl,$(GRADE))" ""
+# It will never be implemented for deep profiling grades.
+ifneq "$(findstring hl,$(GRADE))$(findstring profdeep,$(GRADE))" ""
SOURCES=$(SOURCES2)
else
SOURCES=$(SOURCES2) $(ADITI_SOURCES)
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
Index: tools/bootcheck
===================================================================
RCS file: /home/mercury1/repository/mercury/tools/bootcheck,v
retrieving revision 1.117
diff -u -b -r1.117 bootcheck
--- tools/bootcheck 2001/05/15 12:20:45 1.117
+++ tools/bootcheck 2001/05/16 09:59:49
@@ -130,6 +130,11 @@
compile_times=false
type_stats=""
+if test -d .KEEP_OBJS
+then
+ keep_objs=true
+fi
+
# If you change these, you will also need to change scripts/ml.in,
# scripts/c2init.in, Mmake.common.in, tools/binary, tools/binary_step
# and tools/linear.
@@ -200,7 +205,7 @@
-n|--no-bootcheck)
do_bootcheck=false ;;
- --no-check_namespace)
+ --no-check-namespace)
check_namespace=false ;;
-t|--no-test-suite)
@@ -354,15 +359,8 @@
then
echo "building of stage 1 successful"
else
- cd $root/library;
- mmake $mmake_opts depend
- cd $root/browser;
- mmake $mmake_opts depend
- cd $root/compiler;
- mmake $mmake_opts depend
- cd $root/profiler;
- mmake $mmake_opts depend
cd $root
+ mmake $mmake_opts depend
if mmake $mmake_opts MMAKEFLAGS=$jfactor all
then
echo "building of stage 1 successful"
@@ -372,6 +370,14 @@
fi
fi
+ # Turn off the writing out of deep profiling files, since Deep.data
+ # will be overwritten many times in each directory, and thus the time
+ # spent writing them out is wasted. If deep profiling debugging is
+ # enabled, this also avoids the writing of *huge* amounts of stuff
+ # on stderr.
+ MERCURY_OPTIONS="$MERCURY_OPTIONS -s"
+ export MERCURY_OPTIONS
+
MERCURY_COMPILER=$root/compiler/mercury_compile
export MERCURY_COMPILER
MERCURY_INT_DIR=$root/stage2/library
@@ -481,8 +487,14 @@
$LN_S $root/profiler/*.m .
cp $root/profiler/Mmake* .
cd $root/stage2
+ mkdir deep
+ cd deep
+ $LN_S $root/deep/*.m .
+ cp $root/deep/Mmake* .
+ cd $root/stage2
else
$LN_S $root/profiler .
+ $LN_S $root/deep .
fi
$LN_S $root/conf* .
$LN_S $root/aclocal.m4 .
@@ -522,7 +534,7 @@
fi
if (cd stage2 && $MMAKE $mmake_opts dep_library dep_browser \
- dep_compiler dep_profiler)
+ dep_compiler dep_profiler dep_deep)
then
echo "building of stage 2 dependencies successful"
else
@@ -654,6 +666,7 @@
$LN_S $root/scripts .
$LN_S $root/util .
$LN_S $root/profiler .
+ $LN_S $root/deep .
$LN_S $root/conf* .
$LN_S $root/aclocal.m4 .
$LN_S $root/VERSION .
@@ -795,19 +808,25 @@
/bin/rm -fr $root/stage3/* < /dev/null
/bin/rm -fr $root/stage3/.[a-zA-Z]* < /dev/null
+ if $keep_objs
+ then
+ true
+ else
case "$grade" in
*debug*)
- # These files take up a lot of disk space,
- # so we compress them. This reduces the
- # probability that running the tests will
- # run out of disk space, while still allowing
- # the original files to be reconstructed
+ # These files take up a lot of disk
+ # space, so we compress them. This
+ # reduces the probability that running
+ # the tests will run out of disk space,
+ # while still allowing the original
+ # files to be reconstructed
# relatively quickly.
gzip $root/stage2/library/*.c
gzip $root/stage2/browser/*.c
gzip $root/stage2/compiler/*.c
;;
esac
+ fi
fi
echo "finishing stage3 at `date`"
cvs diff: Diffing trace
Index: trace/mercury_trace.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.c,v
retrieving revision 1.42
diff -u -b -r1.42 mercury_trace.c
--- trace/mercury_trace.c 2001/04/12 05:20:03 1.42
+++ trace/mercury_trace.c 2001/05/03 06:41:39
@@ -516,6 +516,11 @@
MR_Retry_Result result;
#endif
+#ifdef MR_DEEP_PROFILING
+ *problem = "retry is incompatible with deep profiling.";
+ return MR_RETRY_ERROR;
+#endif
+
args = NULL;
MR_init_call_table_array();
@@ -546,7 +551,7 @@
}
level_layout = return_label_layout->MR_sll_entry;
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
*problem = "that procedure does not have debugging information";
goto report_problem;
}
@@ -1017,7 +1022,7 @@
** will be saved in a stack slot.
*/
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
return "an intervening stack frame "
"has no debugging information";
} else if (level_layout->MR_sle_maybe_maxfr > 0) {
@@ -1174,7 +1179,7 @@
label_layout = label->i_layout;
proc_layout = label_layout->MR_sll_entry;
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(proc_layout)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(proc_layout)) {
*problem = "reached label without debugging info";
return MR_RETRY_ERROR;
}
@@ -1286,7 +1291,7 @@
{
MR_TrieNode call_table;
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(level_layout)) {
/*
** The exec trace seems to have disappeared since the call
** to MR_undo_updates_of_maxfr ...
@@ -1368,4 +1373,12 @@
if (MR_call_table_ptrs != NULL) {
MR_free(MR_call_table_ptrs);
}
+}
+
+void
+MR_trace_init_modules(void)
+{
+ MR_do_init_modules();
+ MR_do_init_modules_type_tables();
+ MR_do_init_modules_debugger();
}
Index: trace/mercury_trace.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace.h,v
retrieving revision 1.22
diff -u -b -r1.22 mercury_trace.h
--- trace/mercury_trace.h 2001/03/07 08:00:00 1.22
+++ trace/mercury_trace.h 2001/05/03 06:41:39
@@ -233,4 +233,6 @@
#define MR_port_is_entry(port) ((port) == MR_PORT_CALL)
+extern void MR_trace_init_modules(void);
+
#endif /* MERCURY_TRACE_H */
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.44
diff -u -b -r1.44 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 2001/05/07 02:57:09 1.44
+++ trace/mercury_trace_declarative.c 2001/05/09 06:28:07
@@ -305,7 +305,7 @@
return MR_trace_event_internal(cmd, TRUE, event_info);
}
- if (!MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry)) {
+ if (!MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
/* XXX this should be handled better. */
MR_fatal_error("layout has no execution tracing");
}
@@ -345,7 +345,7 @@
}
}
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
/*
** Filter out events for compiler generated procedures.
*/
@@ -1055,7 +1055,7 @@
MR_trace_init_point_vars(layout, saved_regs, port);
name = MR_decl_atom_name(entry);
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
arity = entry->MR_sle_comp.MR_comp_arity;
pred_or_func = MR_PREDICATE;
} else {
@@ -1106,8 +1106,8 @@
{
MR_ConstString name;
- if (MR_ENTRY_LAYOUT_HAS_PROC_ID(entry)) {
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
+ if (MR_PROC_LAYOUT_HAS_PROC_ID(entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
MR_TRACE_USE_HP(
MR_make_aligned_string(name, "<<internal>>");
);
@@ -1166,7 +1166,7 @@
}
entry = event_info->MR_event_sll->MR_sll_entry;
- if (!MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry)) {
+ if (!MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: cannot start declarative debugging, "
"because this procedure was not\n"
@@ -1174,7 +1174,7 @@
return FALSE;
}
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
fflush(MR_mdb_out);
fprintf(MR_mdb_err, "mdb: cannot start declarative debugging "
"at compiler generated procedures.\n");
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_trace_declarative.h
--- trace/mercury_trace_declarative.h 2001/04/30 12:44:53 1.13
+++ trace/mercury_trace_declarative.h 2001/05/03 06:41:39
@@ -11,8 +11,6 @@
#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.
@@ -45,5 +43,4 @@
#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 */
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.55
diff -u -b -r1.55 mercury_trace_external.c
--- trace/mercury_trace_external.c 2001/03/18 23:10:16 1.55
+++ trace/mercury_trace_external.c 2001/05/03 06:41:39
@@ -625,7 +625,7 @@
fprintf(stderr, "\nMercury runtime: "
"REQUEST_STACK\n");
}
- MR_do_init_modules();
+ MR_trace_init_modules();
message = MR_dump_stack_from_layout(
stdout, layout,
MR_saved_sp(saved_regs),
@@ -646,7 +646,7 @@
fprintf(stderr, "\nMercury runtime: "
"REQUEST_NONDET_STACK\n");
}
- MR_do_init_modules();
+ MR_trace_init_modules();
/*
** XXX As in stack dump, we could send the
** output of this function on the socket. But
@@ -902,7 +902,7 @@
MR_Trace_Port port, MR_Unsigned seqno, MR_Unsigned depth,
const char *path)
{
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
MR_TRACE_CALL_MERCURY(
ML_DI_output_current_slots_comp(
MR_trace_event_number,
@@ -1003,7 +1003,7 @@
/* XXX get live vars from registers */
MR_Word arguments = /* XXX FIXME!!! */ 0;
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(layout->MR_sll_entry)) {
MR_TRACE_CALL_MERCURY(
result = ML_DI_found_match_comp(
MR_trace_event_number,
@@ -1288,13 +1288,13 @@
MR_print_proc_id_to_socket(const MR_Proc_Layout *entry,
const char *extra, MR_Word *base_sp, MR_Word *base_curfr)
{
- if (! MR_ENTRY_LAYOUT_HAS_PROC_ID(entry)) {
+ if (! MR_PROC_LAYOUT_HAS_PROC_ID(entry)) {
MR_fatal_error("cannot retrieve procedure id without layout");
}
if (base_sp != NULL && base_curfr != NULL) {
bool print_details = FALSE;
- if (MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry)) {
+ if (MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
MR_Integer maybe_from_full =
entry->MR_sle_maybe_from_full;
if (maybe_from_full > 0) {
@@ -1342,7 +1342,7 @@
}
}
- if (MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry)) {
+ if (MR_PROC_LAYOUT_COMPILER_GENERATED(entry)) {
MR_send_message_to_socket_format(
/* XXX Names with " may cause some problems here */
"proc(\"%s\",\"%s\",\"%s\",%ld,%ld).\n",
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.103
diff -u -b -r1.103 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2001/05/07 02:57:09 1.103
+++ trace/mercury_trace_internal.c 2001/05/11 03:32:46
@@ -1064,7 +1064,7 @@
; /* the usage message has already been printed */
} else if (word_count == 1) {
const char *msg;
- MR_do_init_modules();
+ MR_trace_init_modules();
msg = MR_dump_stack_from_layout(MR_mdb_out, layout,
MR_saved_sp(saved_regs),
MR_saved_curfr(saved_regs),
@@ -1834,7 +1834,7 @@
#endif /* MR_TRACE_HISTOGRAM */
} else if (streq(words[0], "nondet_stack")) {
if (word_count == 1) {
- MR_do_init_modules();
+ MR_trace_init_modules();
MR_dump_nondet_stack_from_layout(MR_mdb_out,
MR_saved_maxfr(saved_regs));
} else {
@@ -1845,7 +1845,7 @@
if (word_count == 1) {
bool saved_tabledebug;
- MR_do_init_modules();
+ MR_trace_init_modules();
saved_tabledebug = MR_tabledebug;
MR_tabledebug = TRUE;
MR_print_gen_stack(MR_mdb_out);
@@ -1867,6 +1867,9 @@
MR_print_tabling_regs(MR_mdb_out, saved_regs);
MR_print_succip_reg(MR_mdb_out, saved_regs);
MR_print_r_regs(MR_mdb_out, saved_regs);
+#ifdef MR_DEEP_PROFILING
+ MR_print_deep_prof_vars(MR_mdb_out);
+#endif
} else {
MR_trace_usage("developer", "all_regs");
}
Index: trace/mercury_trace_tables.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_tables.c,v
retrieving revision 1.16
diff -u -b -r1.16 mercury_trace_tables.c
--- trace/mercury_trace_tables.c 2001/01/18 03:55:27 1.16
+++ trace/mercury_trace_tables.c 2001/05/03 06:41:39
@@ -50,12 +50,13 @@
fflush(fp);
}
- MR_do_init_modules();
+ MR_trace_init_modules();
done = TRUE;
if (verbose) {
fprintf(fp, "done.\n");
if (MR_module_info_next == 0) {
- fprintf(fp, "There are no debuggable modules.");
+ fprintf(fp,
+ "There are no debuggable modules.\n");
} else if (MR_module_info_next == 1) {
fprintf(fp, "There is one debuggable module, "
"with %d procedures.\n",
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.25
diff -u -b -r1.25 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 2001/01/18 01:19:17 1.25
+++ trace/mercury_trace_vars.c 2001/05/03 06:41:39
@@ -267,7 +267,7 @@
if (level_layout != NULL) {
entry = level_layout->MR_sll_entry;
- if (! MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry)) {
+ if (! MR_PROC_LAYOUT_HAS_EXEC_TRACE(entry)) {
return "this procedure does not have "
"debugging information";
}
cvs diff: Diffing util
Index: util/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/util/Mmakefile,v
retrieving revision 1.11
diff -u -b -r1.11 Mmakefile
--- util/Mmakefile 2001/04/08 08:59:32 1.11
+++ util/Mmakefile 2001/05/03 06:41:39
@@ -24,6 +24,8 @@
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'
@@ -34,7 +36,7 @@
all: $(PROGS)
.c:
- $(MGNUC) $(GRADEFLAGS) $(ALL_MGNUCFLAGS) -o $@ $< $(GETOPT_SRC)
+ $(MGNUC) $(GRADEFLAGS) $(ALL_MGNUCFLAGS) $(GETOPT_FLAGS) -o $@ $< $(GETOPT_SRC)
tags:
ctags $(SRC)
Index: util/mdemangle.c
===================================================================
RCS file: /home/mercury1/repository/mercury/util/mdemangle.c,v
retrieving revision 1.38
diff -u -b -r1.38 mdemangle.c
--- util/mdemangle.c 2000/11/11 13:36:57 1.38
+++ util/mdemangle.c 2001/05/03 06:41:39
@@ -477,6 +477,14 @@
category = ORDINARY;
start = name_before_prefixes;
} else {
+ /*
+ ** The compiler adds a redundant mode
+ ** number to the predicate name
+ ** to avoid creating two predicates
+ ** with the same name (deep profiling
+ ** doesn't like that). It isn't used
+ ** here, so we just ignore it.
+ */
*end_of_lambda_pred_name = '\0';
start = lambda_pred_name;
}
Index: util/mkinit.c
===================================================================
RCS file: /home/mercury1/repository/mercury/util/mkinit.c,v
retrieving revision 1.76
diff -u -b -r1.76 mkinit.c
--- util/mkinit.c 2001/05/08 12:48:34 1.76
+++ util/mkinit.c 2001/05/09 06:34:05
@@ -49,6 +49,104 @@
struct String_List_struct *next;
} String_List;
+static const char if_need_to_init[] =
+ "#if defined(MR_MAY_NEED_INITIALIZATION)\n";
+
+static const char if_need_deep_prof[] =
+ "#if defined(MR_DEEP_PROFILING)\n";
+
+typedef enum
+{
+ PURPOSE_INIT = 0,
+ PURPOSE_TYPE_TABLE = 1,
+ PURPOSE_DEBUGGER = 2,
+ PURPOSE_PROC_STATIC = 3
+} Purpose;
+
+const char *main_func_name[] =
+{
+ "init_modules",
+ "init_modules_type_tables",
+ "init_modules_debugger",
+ "write_out_proc_statics"
+};
+
+const char *module_suffix[] =
+{
+ "init",
+ "init_type_tables",
+ "init_debugger",
+ "write_out_proc_statics"
+};
+
+const char *init_suffix[] =
+{
+ "",
+ "_type_tables",
+ "_debugger",
+ "write_out_proc_statics"
+};
+
+const char *bunch_function_guard[] =
+{
+ if_need_to_init,
+ NULL,
+ if_need_to_init,
+ if_need_deep_prof
+};
+
+const char *main_func_guard[] =
+{
+ NULL,
+ NULL,
+ NULL,
+ if_need_deep_prof
+};
+
+const char *main_func_body_guard[] =
+{
+ if_need_to_init,
+ NULL,
+ if_need_to_init,
+ NULL
+};
+
+const char *main_func_arg_defn[] =
+{
+ "void",
+ "void",
+ "void",
+ "FILE *fp"
+};
+
+const char *main_func_arg_decl[] =
+{
+ "void",
+ "void",
+ "void",
+ "FILE *"
+};
+
+const char *main_func_arg[] =
+{
+ "",
+ "",
+ "",
+ "fp"
+};
+
+/* --- macros--- */
+
+#define SYS_PREFIX_1 "sys_init"
+#define SYS_PREFIX_2 "mercury_sys_init"
+
+#define matches_prefix(s, prefix) \
+ (strncmp((s), (prefix), sizeof(prefix)-1) == 0)
+
+#define sys_init_prefix(s) \
+ ( matches_prefix(s, SYS_PREFIX_1) || \
+ matches_prefix(s, SYS_PREFIX_2) )
+
/* --- global variables --- */
static const char *MR_progname = NULL;
@@ -93,6 +191,11 @@
"#include \"mercury_init.h\"\n"
"#include \"mercury_grade.h\"\n"
"\n"
+ "#define MR_TRACE_ENABLED %d\n"
+ "#if MR_TRACE_ENABLED\n"
+ " #define MR_MAY_NEED_INITIALIZATION\n"
+ "#endif\n"
+ "\n"
"/*\n"
"** Work around a bug in the Solaris 2.X (X<=4) linker;\n"
"** on these machines, init_gc must be statically linked.\n"
@@ -119,8 +222,6 @@
static const char mercury_funcs[] =
"\n"
- "#define MR_TRACE_ENABLED %d\n"
- "\n"
"#ifdef MR_HIGHLEVEL_CODE\n"
" extern void MR_CALL %s(void);\n"
"#else\n"
@@ -172,6 +273,10 @@
" MR_address_of_init_modules = init_modules;\n"
" MR_address_of_init_modules_type_tables = init_modules_type_tables;\n"
" MR_address_of_init_modules_debugger = init_modules_debugger;\n"
+ "#ifdef MR_DEEP_PROFILING\n"
+ " MR_address_of_write_out_proc_statics =\n"
+ " write_out_proc_statics;\n"
+ "#endif\n"
" MR_address_of_do_load_aditi_rl_code = %s;\n"
"#ifdef CONSERVATIVE_GC\n"
" MR_address_of_init_gc = init_gc;\n"
@@ -254,10 +359,6 @@
static const char aditi_rl_data_str[] = "mercury__aditi_rl_data__";
-static const char if_need_to_init[] =
- "#if defined(MR_MAY_NEED_INITIALIZATION)\n\n"
- ;
-
/* --- function prototypes --- */
static void parse_options(int argc, char *argv[]);
static void usage(void);
@@ -266,24 +367,19 @@
static char *find_init_file(const char *base_name);
static bool file_exists(const char *filename);
static void output_headers(void);
-static int output_sub_init_functions(const char *suffix,
- bool wrap_func_in_ifdef, bool only_full_module);
-static void output_main_init_function(const char *suffix,
- bool wrap_body_in_ifdef, int num_bunches);
+static int output_sub_init_functions(Purpose purpose);
+static void output_main_init_function(Purpose purpose, int num_bunches);
static void output_aditi_load_function(void);
static void output_main(void);
static void process_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module);
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose);
static void process_c_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module);
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose);
static void process_init_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module);
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose);
static void output_init_function(const char *func_name,
int *num_bunches_ptr, int *num_calls_in_cur_bunch_ptr,
- const char *suffix, bool only_full_module);
+ Purpose purpose, bool special_module);
static void add_rl_data(char *data);
static int get_line(FILE *file, char *line, int line_max);
static void *checked_malloc(size_t size);
@@ -322,6 +418,8 @@
main(int argc, char **argv)
{
int num_bunches;
+ const char *need_main_ifdef;
+
MR_progname = argv[0];
parse_options(argc, argv);
@@ -331,17 +429,24 @@
do_path_search();
output_headers();
- num_bunches = output_sub_init_functions("",
- ! need_initialization_code, FALSE);
- output_main_init_function("",
- ! need_initialization_code, num_bunches);
+ if (need_initialization_code) {
+ need_main_ifdef = NULL;
+ } else {
+ need_main_ifdef = if_need_to_init;
+ }
+
+ num_bunches = output_sub_init_functions(PURPOSE_INIT);
+ output_main_init_function(PURPOSE_INIT, num_bunches);
- num_bunches = output_sub_init_functions("_type_tables", FALSE, TRUE);
- output_main_init_function("_type_tables", FALSE, num_bunches);
+ num_bunches = output_sub_init_functions(PURPOSE_TYPE_TABLE);
+ output_main_init_function(PURPOSE_TYPE_TABLE, num_bunches);
- num_bunches = output_sub_init_functions("_debugger", TRUE, TRUE);
- output_main_init_function("_debugger", TRUE, num_bunches);
+ num_bunches = output_sub_init_functions(PURPOSE_DEBUGGER);
+ output_main_init_function(PURPOSE_DEBUGGER, num_bunches);
+ num_bunches = output_sub_init_functions(PURPOSE_PROC_STATIC);
+ output_main_init_function(PURPOSE_PROC_STATIC, num_bunches);
+
if (aditi) {
output_aditi_load_function();
}
@@ -573,7 +678,7 @@
putc('\n', stdout);
}
- fputs(header2, stdout);
+ printf(header2, need_tracing);
if (aditi) {
fputs(aditi_header, stdout);
@@ -581,30 +686,31 @@
}
static int
-output_sub_init_functions(const char *suffix, bool wrap_func_in_ifdef,
- bool only_full_module)
+output_sub_init_functions(Purpose purpose)
{
int filenum;
int num_bunches;
int num_calls_in_cur_bunch;
- if (wrap_func_in_ifdef) {
- fputs(if_need_to_init, stdout);
+ fputs("\n", stdout);
+ if (bunch_function_guard[purpose] != NULL) {
+ fputs(bunch_function_guard[purpose], stdout);
+ fputs("\n", stdout);
}
- printf("static void init_modules%s_0(void)\n", suffix);
+ printf("static void %s_0(%s)\n",
+ main_func_name[purpose], main_func_arg_defn[purpose]);
fputs("{\n", stdout);
num_bunches = 0;
num_calls_in_cur_bunch = 0;
for (filenum = 0; filenum < num_files; filenum++) {
process_file(files[filenum],
- &num_bunches, &num_calls_in_cur_bunch,
- suffix, only_full_module);
+ &num_bunches, &num_calls_in_cur_bunch, purpose);
}
fputs("}\n", stdout);
- if (wrap_func_in_ifdef) {
+ if (bunch_function_guard[purpose] != NULL) {
fputs("\n#endif\n", stdout);
}
@@ -612,27 +718,38 @@
}
static void
-output_main_init_function(const char *suffix, bool wrap_body_in_ifdef,
- int num_bunches)
+output_main_init_function(Purpose purpose, int num_bunches)
{
int i;
+
+ fputs("\n", stdout);
+ if (main_func_guard[purpose] != NULL) {
+ fputs(main_func_guard[purpose], stdout);
+ fputs("\n", stdout);
+ }
- printf("\n\nstatic void init_modules%s(void)\n", suffix);
+ printf("\nstatic void %s(%s)\n",
+ main_func_name[purpose], main_func_arg_defn[purpose]);
fputs("{\n", stdout);
- if (wrap_body_in_ifdef) {
- fputs(if_need_to_init, stdout);
+ if (main_func_body_guard[purpose] != NULL) {
+ fputs(main_func_body_guard[purpose], stdout);
}
for (i = 0; i <= num_bunches; i++) {
- printf("\tinit_modules%s_%d();\n", suffix, i);
+ printf("\t%s_%d(%s);\n",
+ main_func_name[purpose], i, main_func_arg[purpose]);
}
- if (wrap_body_in_ifdef) {
- fputs("\n#endif\n", stdout);
+ if (main_func_body_guard[purpose] != NULL) {
+ fputs("#endif\n", stdout);
}
fputs("}\n", stdout);
+
+ if (main_func_guard[purpose] != NULL) {
+ fputs("\n#endif\n", stdout);
+ }
}
static void
@@ -646,7 +763,7 @@
aditi_load_func = "NULL";
}
- printf(mercury_funcs, need_tracing, hl_entry_point, entry_point,
+ printf(mercury_funcs, hl_entry_point, entry_point,
aditi_load_func, hl_entry_point, entry_point);
if (output_main_func) {
@@ -658,23 +775,20 @@
static void
process_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module)
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose)
{
int len = strlen(filename);
if (len >= 2 && strcmp(filename + len - 2, ".c") == 0) {
if (c_files_contain_extra_inits) {
process_init_file(filename, num_bunches_ptr,
- num_calls_in_cur_bunch_ptr,
- suffix, only_full_module);
+ num_calls_in_cur_bunch_ptr, purpose);
} else {
process_c_file(filename, num_bunches_ptr,
- num_calls_in_cur_bunch_ptr,
- suffix, only_full_module);
+ num_calls_in_cur_bunch_ptr, purpose);
}
} else if (len >= 5 && strcmp(filename + len - 5, ".init") == 0) {
process_init_file(filename, num_bunches_ptr,
- num_calls_in_cur_bunch_ptr, suffix, only_full_module);
+ num_calls_in_cur_bunch_ptr, purpose);
} else {
fprintf(stderr,
"%s: filename `%s' must end in `.c' or `.init'\n",
@@ -685,8 +799,7 @@
static void
process_c_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module)
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose)
{
char func_name[1000];
char *position;
@@ -738,10 +851,10 @@
/*
** The trailing stuff after the last `.' should just be the `c' suffix.
*/
- strcat(func_name, "__init");
+ strcat(func_name, "__");
output_init_function(func_name, num_bunches_ptr,
- num_calls_in_cur_bunch_ptr, suffix, only_full_module);
+ num_calls_in_cur_bunch_ptr, purpose, FALSE);
if (aditi) {
char *rl_data_name;
@@ -750,7 +863,7 @@
mercury_len = strlen("mercury__");
module_name_size =
- strlen(func_name) - mercury_len - strlen("__init");
+ strlen(func_name) - mercury_len - strlen("__");
rl_data_name = checked_malloc(module_name_size +
strlen(aditi_rl_data_str) + 1);
strcpy(rl_data_name, aditi_rl_data_str);
@@ -762,8 +875,7 @@
static void
process_init_file(const char *filename, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module)
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose)
{
const char * const init_str = "INIT ";
const char * const endinit_str = "ENDINIT ";
@@ -772,8 +884,8 @@
const int endinit_strlen = strlen(endinit_str);
const int aditi_init_strlen = strlen(aditi_init_str);
char line[MAXLINE];
- char * rl_data_name;
- FILE * cfile;
+ char *rl_data_name;
+ FILE *cfile;
cfile = fopen(filename, "r");
if (cfile == NULL) {
@@ -785,7 +897,10 @@
while (get_line(cfile, line, MAXLINE) > 0) {
if (strncmp(line, init_str, init_strlen) == 0) {
+ char *func_name;
+ int func_name_len;
int j;
+ bool special;
for (j = init_strlen;
MR_isalnum(line[j]) || line[j] == '_'; j++)
@@ -794,14 +909,26 @@
}
line[j] = '\0';
- output_init_function(line + init_strlen, num_bunches_ptr,
- num_calls_in_cur_bunch_ptr, suffix, only_full_module);
- } else if (aditi
- && strncmp(line, aditi_init_str, aditi_init_strlen) == 0) {
+ func_name = line + init_strlen;
+ func_name_len = strlen(func_name);
+ if (strneq(&func_name[func_name_len - 4], "init", 4))
+ {
+ func_name[func_name_len - 4] = '\0';
+ special = FALSE;
+ } else {
+ special = TRUE;
+ }
+
+ output_init_function(func_name, num_bunches_ptr,
+ num_calls_in_cur_bunch_ptr, purpose, special);
+ } else if (aditi &&
+ strncmp(line, aditi_init_str, aditi_init_strlen) == 0)
+ {
int j;
for (j = aditi_init_strlen;
- MR_isalnum(line[j]) || line[j] == '_'; j++)
+ MR_isalnum(line[j]) || line[j] == '_';
+ j++)
{
/* VOID */
}
@@ -819,12 +946,6 @@
fclose(cfile);
}
-#define SYS_PREFIX_1 "sys_init"
-#define SYS_PREFIX_2 "mercury_sys_init"
-
-#define matches_prefix(s, prefix) \
- (strncmp((s), (prefix), sizeof(prefix)-1) == 0)
-
/*
** We could in theory put all calls to e.g. <module>_init_type_tables()
** functions in a single C function in the <mainmodule>_init.c file we
@@ -838,18 +959,13 @@
static void
output_init_function(const char *func_name, int *num_bunches_ptr,
- int *num_calls_in_cur_bunch_ptr, const char *suffix,
- bool only_full_module)
+ int *num_calls_in_cur_bunch_ptr, Purpose purpose, bool special_module)
{
- if (only_full_module) {
- if (matches_prefix(func_name, SYS_PREFIX_1)
- || matches_prefix(func_name, SYS_PREFIX_2))
- {
+ if (purpose == PURPOSE_DEBUGGER) {
+ if (special_module) {
/*
- ** This is a handwritten "module" which has only
- ** one handwritten initialization function; it does not
- ** have separate initialization functions to register
- ** type_ctor_infos or module layouts.
+ ** This is a handwritten "module" which doesn't have
+ ** a module layout to register.
*/
return;
@@ -861,15 +977,20 @@
(*num_bunches_ptr)++;
*num_calls_in_cur_bunch_ptr = 0;
- printf("static void init_modules%s_%d(void)\n",
- suffix, *num_bunches_ptr);
+ printf("static void %s_%d(%s)\n",
+ main_func_name[purpose], *num_bunches_ptr,
+ main_func_arg_defn[purpose]);
printf("{\n");
}
(*num_calls_in_cur_bunch_ptr)++;
- printf("\t{ extern void %s%s(void);\n", func_name, suffix);
- printf("\t %s%s(); }\n", func_name, suffix);
+ printf("\t{ extern void %s%s%s(%s);\n",
+ func_name, special_module ? "_" : "", module_suffix[purpose],
+ main_func_arg_decl[purpose]);
+ printf("\t %s%s%s(%s); }\n",
+ func_name, special_module ? "_" : "", module_suffix[purpose],
+ main_func_arg[purpose]);
}
/*---------------------------------------------------------------------------*/
--------------------------------------------------------------------------
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