[m-rev.] diff: experimental complexity analysis
Zoltan Somogyi
zs at cs.mu.OZ.AU
Tue Feb 15 16:18:11 AEDT 2005
This has already been looked at by Julien.
For the main branch only, at least for now.
Zoltan.
Implement a mechanism to generate the information required to determine the
algorithmic complexity of selected procedures.
The basis of the mechanism is a program transformation that wraps up the body
of each selected procedure in code that detects top-level (non-recursive)
calls, and for each top-level call, records the sizes of the input arguments
and information about the cost of the call. For now, the cost information
consists only of the number of cells and words allocated during the call,
but there is provision for later adding information from a real-time clock.
compiler/complexity.m:
A new module containing the new transformation.
compiler/transform_hlds.m:
Add complexity.m to the list of submodules.
compiler/mercury_compile.m:
Invoke the new module.
compiler/notes/compiler_design.html:
Mention the new module.
compiler/options.m:
Add an option, --experimental-complexity. Its argument is a filename
that specifies the list of procedures to transform.
Add an option, --no-allow-inlining, to disallow all inlining.
This is simpler to use than specifying several options to turn off
each potential reason to inline procedures.
doc/user_guide.texi:
Document the new options. The documentation present now is only a
shell; it will be expanded later.
compiler/table_gen.m:
compiler/goal_util.m:
Move the predicate for creating renamings from table_gen.m to
goal_util.m, since complexity.m also needs it now. In the process,
make it more general by allowing outputs to have more complex modes
than simply `out'.
compiler/goal_util.m:
Fix a bug exposed by the new transformation: when renaming goals
(e.g. for quantification), rename the variables holding information
about term sizes.
compiler/handle_options.m:
Disable inlining if experimental complexity analysis is enabled.
compiler/compile_target_code.m:
Pass the --experimental-complexity option on to the linker.
library/term_size_prof_builtin.m:
Add the Mercury predicates that serve as interfaces to the primitives
needed by the experimental complexity transformation.
runtime/mercury_term_size.[ch]:
Add the implementations of the primitives needed by the experimental
complexity transformation.
runtime/mercury_wrapper.[ch]:
Add global variables holding counters of the numbers of words and cells
allocated so far.
runtime/mercury_heap.h:
Update these global variables when allocating memory.
runtime/mercury_complexity.h:
New file that contains the definition of the data structures holding
the data collected by the experimental complexity transformation.
This is separate from mercury_term_size.h, because it needs to be
#included in mercury_init.h, the header file of the mkinit-generated
<program>_init.c files.
runtime/mercury_init.h:
runtime/mercury_imp.h:
#include mercury_complexity.h.
util/mkinit.c:
Define and initialize the data structures holding complexity
information when given the -X option (mkinit doesn't have long
options).
Fix some deviations from our coding style.
scripts/parse_ml_options.sh-subr.in:
Accept the --experiment-complexity option.
scripts/c2init.in:
Pass the --experiment-complexity option on to mkinit.c.
tools/bootcheck:
Preserve the files containing the results of complexity analysis,
if they exist.
tools/makebatch:
Allow the specification of EXTRA_MLFLAGS in the generated
Mmake.stage.params files.
cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/compile_target_code.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.65
diff -u -r1.65 compile_target_code.m
--- compiler/compile_target_code.m 27 Jan 2005 03:38:06 -0000 1.65
+++ compiler/compile_target_code.m 27 Jan 2005 06:22:34 -0000
@@ -1014,16 +1014,26 @@
globals__io_lookup_bool_option(aditi, Aditi, !IO),
AditiOpt = ( Aditi = yes -> "-a" ; "" ),
+ globals__io_lookup_string_option(experimental_complexity,
+ ExperimentalComplexity, !IO),
+ ( ExperimentalComplexity = "" ->
+ ExperimentalComplexityOpt = ""
+ ;
+ ExperimentalComplexityOpt = "-X " ++ ExperimentalComplexity
+ ),
+
globals__io_lookup_string_option(mkinit_command, Mkinit, !IO),
TmpInitCFileName = InitCFileName ++ ".tmp",
MkInitCmd = string__append_list(
[Mkinit, " -g ", Grade, " ", TraceOpt, " ", ExtraInitsOpt,
- " ", NoMainOpt, " ", AditiOpt, " ", RuntimeFlags,
+ " ", NoMainOpt, " ", AditiOpt,
+ " ", ExperimentalComplexityOpt, " ", RuntimeFlags,
" -o ", quote_arg(TmpInitCFileName), " ", InitFileDirs,
" ", InitFileNames, " ", CFileNames]),
invoke_system_command(ErrorStream, verbose, MkInitCmd, MkInitOK0, !IO),
maybe_report_stats(Stats, !IO),
- ( MkInitOK0 = yes ->
+ (
+ MkInitOK0 = yes,
update_interface(InitCFileName, MkInitOK1, !IO),
(
MkInitOK1 = yes,
@@ -1059,9 +1069,11 @@
compile_c_file(ErrorStream, PIC, InitCFileName,
InitObjFileName, CompileOK, !IO),
maybe_report_stats(Stats, !IO),
- ( CompileOK = no ->
+ (
+ CompileOK = no,
Result = no
;
+ CompileOK = yes,
Result = yes(InitObjFileName)
)
;
@@ -1073,6 +1085,7 @@
Result = no
)
;
+ MkInitOK0 = no,
Result = no
).
Index: compiler/complexity.m
===================================================================
RCS file: compiler/complexity.m
diff -N compiler/complexity.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/complexity.m 26 Jan 2005 03:28:52 -0000
@@ -0,0 +1,564 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2004 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 performs a program transformation that gathers information
+% about the relationship between the sizes of a procedure's input arguments
+% and the performance cost of the procedure in terms of memory and time.
+
+%-----------------------------------------------------------------------------%
+
+:- module transform_hlds__complexity.
+
+:- interface.
+
+:- import_module hlds__hlds_module.
+:- import_module hlds__hlds_pred.
+
+:- import_module std_util, io.
+
+ % read_spec_file(FileName, MaybeNumLinesProcMap, !IO):
+ % Try to read in a complexity proc map from FileName. If successful,
+ % return the proc map and the number of entries in it. If not, return
+ % an error message.
+
+:- pred read_spec_file(string::in,
+ maybe_error(pair(int, complexity_proc_map))::out,
+ io::di, io::uo) is det.
+
+ % is_in_complexity_proc_map(ProcMap, ModuleInfo, PredId, ProcId):
+ % If PredId/ProcId in ModuleInfo is in ProcMap, return its slot number
+ % in the complexity table.
+
+:- func is_in_complexity_proc_map(complexity_proc_map, module_info,
+ pred_id, proc_id) = maybe(int).
+
+ % Return the name of the given procedure in the format required by the
+ % complexity map file.
+
+:- func complexity_proc_name(module_info, pred_id, proc_id) = string.
+
+ % Transform the given procedure if it is in the complexity map.
+
+:- pred process_proc_msg(int::in, complexity_proc_map::in,
+ pred_id::in, proc_id::in, proc_info::in, proc_info::out,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module check_hlds__mode_util.
+:- import_module check_hlds__polymorphism.
+:- import_module check_hlds__type_util.
+:- import_module hlds__code_model.
+:- import_module hlds__goal_util.
+:- import_module hlds__hlds_data.
+:- import_module hlds__hlds_goal.
+:- import_module hlds__instmap.
+:- import_module libs__globals.
+:- import_module libs__options.
+:- import_module parse_tree__error_util.
+:- import_module parse_tree__prog_data.
+:- import_module parse_tree__prog_mode.
+:- import_module parse_tree__prog_out.
+:- import_module parse_tree__prog_type.
+:- import_module parse_tree__prog_util.
+:- import_module transform_hlds__term_norm.
+:- import_module mdbcomp__prim_data.
+
+:- import_module bool, int, string, list, set, map, assoc_list.
+:- import_module varset, term, require.
+
+read_spec_file(FileName, MaybeNumLinesProcMap, !IO) :-
+ io__open_input(FileName, ResStream, !IO),
+ (
+ ResStream = error(Error),
+ MaybeNumLinesProcMap = error(io__error_message(Error))
+ ;
+ ResStream = ok(Stream),
+ read_spec_file_lines(Stream, 0, NumLines, MaybeError,
+ map__init, ProcMap, !IO),
+ (
+ MaybeError = yes(Msg),
+ MaybeNumLinesProcMap = error(Msg)
+ ;
+ MaybeError = no,
+ MaybeNumLinesProcMap = ok(NumLines - ProcMap)
+ )
+ ).
+
+:- pred read_spec_file_lines(io__input_stream::in, int::in, int::out,
+ maybe(string)::out, map(string, int)::in, map(string, int)::out,
+ io::di, io::uo) is det.
+
+read_spec_file_lines(Stream, CurLineNum, NumLines, MaybeError, !ProcMap,
+ !IO) :-
+ io__read_line(Stream, ResLine, !IO),
+ (
+ ResLine = eof,
+ NumLines = CurLineNum,
+ MaybeError = no
+ ;
+ ResLine = error(Error),
+ NumLines = CurLineNum,
+ MaybeError = yes(io__error_message(Error))
+ ;
+ ResLine = ok(Chars0),
+ list__filter(unify('\n'), Chars0, _, Chars),
+ string__from_char_list(Chars, ProcName),
+ ( map__insert(!.ProcMap, ProcName, CurLineNum, !:ProcMap) ->
+ read_spec_file_lines(Stream, CurLineNum + 1,
+ NumLines, MaybeError, !ProcMap, !IO)
+ ;
+ NumLines = CurLineNum,
+ MaybeError = yes("repeated line: " ++ ProcName)
+ )
+ ).
+
+%-----------------------------------------------------------------------------%
+
+complexity_proc_name(ModuleInfo, PredId, ProcId) = FullName :-
+ module_info_name(ModuleInfo, ModuleSymName),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ PredName = pred_info_name(PredInfo),
+ QualifiedName = qualified(ModuleSymName, PredName),
+ Arity = pred_info_orig_arity(PredInfo),
+ NameAndArity = sym_name_and_arity_to_string(QualifiedName / Arity),
+ proc_id_to_int(ProcId, ProcIdInt),
+ FullName = NameAndArity ++ "-" ++ int_to_string(ProcIdInt).
+
+is_in_complexity_proc_map(ProcMap, ModuleInfo, PredId, ProcId) = IsInMap :-
+ FullName = complexity_proc_name(ModuleInfo, PredId, ProcId),
+ ( map__search(ProcMap, FullName, ProcNum) ->
+ IsInMap = yes(ProcNum)
+ ;
+ IsInMap = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+process_proc_msg(NumProcs, ProcMap, PredId, ProcId, !ProcInfo, !ModuleInfo,
+ !IO) :-
+ IsInMap = is_in_complexity_proc_map(ProcMap, !.ModuleInfo,
+ PredId, ProcId),
+ (
+ IsInMap = yes(ProcNum),
+ FullName = complexity_proc_name(!.ModuleInfo, PredId, ProcId),
+ globals__io_lookup_bool_option(verbose, Verbose, !IO),
+ (
+ Verbose = yes,
+ pred_id_to_int(PredId, PredIdInt),
+ proc_id_to_int(ProcId, ProcIdInt),
+ Pieces = [words("% Applying complexity experiment " ++
+ "transformation to "),
+ fixed(FullName ++ ":"),
+ fixed(int_to_string(PredIdInt) ++ "/" ++
+ int_to_string(ProcIdInt))],
+ write_error_pieces_plain(Pieces, !IO)
+ ;
+ Verbose = no
+ ),
+ process_proc(NumProcs, ProcNum, FullName, PredId,
+ !ProcInfo, !ModuleInfo)
+ ;
+ IsInMap = no
+ ).
+
+% Example of transformation for model_det:
+%
+% p(In1, ..., InN, ...) :-
+% impure complexity_is_active(NumProcs, ProcNum, ProcName,
+% IsActive, Base),
+% (
+% IsActive = no,
+% impure complexity_call_proc(Slot, In1, ..., InN),
+% <original code>,
+% impure complexity_exit_proc(Slot)
+% ;
+% IsActive = yes,
+% <original code>
+% ).
+%
+% Example of transformation for model_semi:
+%
+% p(In1, ..., InN, ...) :-
+% impure complexity_is_active(NumProcs, ProcNum, ProcName,
+% IsActive, Base),
+% (
+% IsActive = no,
+% impure complexity_call_proc(Slot, In1, ..., InN),
+% (
+% <original code>,
+% impure complexity_exit_proc(Slot)
+% ;
+% impure complexity_fail_proc(Slot),
+% fail
+% )
+% ;
+% IsActive = yes,
+% <original code>
+% ).
+%
+% Example of transformation for model_non:
+%
+% p(In1, ..., InN, ...) :-
+% impure complexity_is_active(NumProcs, ProcNum, ProcName,
+% IsActive, Base),
+% (
+% IsActive = no,
+% impure complexity_call_proc(Slot, In1, ..., InN),
+% (
+% <original code>,
+% (
+% impure complexity_exit_proc(Slot)
+% ;
+% impure complexity_redo_proc(Slot),
+% fail
+% )
+% ;
+% impure complexity_fail_proc(Slot),
+% fail
+% )
+% ;
+% IsActive = yes,
+% <original code>
+% ).
+
+:- func slot_var_name = string.
+
+slot_var_name = "SlotVar".
+
+:- pred process_proc(int::in, int::in, string::in, pred_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out)
+ is det.
+
+process_proc(NumProcs, ProcNum, FullName, PredId, !ProcInfo, !ModuleInfo) :-
+ proc_info_interface_determinism(!.ProcInfo, Detism),
+ determinism_to_code_model(Detism, CodeModel),
+ proc_info_headvars(!.ProcInfo, HeadVars),
+ proc_info_argmodes(!.ProcInfo, ArgModes),
+ proc_info_varset(!.ProcInfo, VarSet),
+ proc_info_vartypes(!.ProcInfo, VarTypes),
+ proc_info_goal(!.ProcInfo, OrigGoal),
+ goal_info_get_context(OrigGoalInfo, Context),
+ % Even if the original goal doesn't use all of the headvars, the code
+ % generated by the transformation does, so we need to compute the
+ % nonlocals from the headvars rather than getting it from the
+ % nonlocals field in the original goal.
+ set__list_to_set(HeadVars, OrigNonLocals),
+ OrigGoal = _ - OrigGoalInfo,
+ goal_info_get_instmap_delta(OrigGoalInfo, OrigInstMapDelta),
+ add_goal_info_purity_feature(OrigGoalInfo, impure, ImpureOrigGoalInfo),
+
+ IsActiveVarName = "IsActive",
+ generate_new_var(IsActiveVarName, is_active_type,
+ !ProcInfo, IsActiveVar),
+
+ classify_args(HeadVars, ArgModes, !.ModuleInfo, VarSet, VarTypes,
+ VarInfos),
+ allocate_slot_numbers(VarInfos, 0, NumberedProfiledVars),
+ list__length(NumberedProfiledVars, NumProfiledVars),
+ generate_slot_goals(ProcNum, NumberedProfiledVars, NumProfiledVars,
+ Context, PredId, !ProcInfo, !ModuleInfo, SlotVar, SlotVarName,
+ SlotGoals),
+
+ IsActiveOutputArg = foreign_arg(IsActiveVar,
+ yes(IsActiveVarName - out_mode), is_active_type),
+ SlotInputArg = foreign_arg(SlotVar,
+ yes(SlotVarName - in_mode), int_type),
+
+ ProcNumStr = int_to_string(ProcNum),
+
+ IsActivePred = "complexity_is_active",
+ IsActiveStr = "\tMR_" ++ IsActivePred ++ "(" ++
+ int_to_string(NumProcs) ++ ", "
+ ++ ProcNumStr ++ ", """ ++ FullName ++ """, " ++
+ int_to_string(NumProfiledVars) ++ ", " ++
+ IsActiveVarName ++ ");\n",
+
+ generate_foreign_proc(IsActivePred, det, [IsActiveOutputArg], [],
+ "", IsActiveStr, "", [IsActiveVar], !.ModuleInfo, Context,
+ IsActiveGoal),
+
+ ExitPred = "complexity_exit_proc",
+ ExitStr = "\tMR_" ++ ExitPred ++ "(" ++
+ ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
+ generate_foreign_proc(ExitPred, det,
+ [SlotInputArg], [], "", ExitStr, "", [],
+ !.ModuleInfo, Context, ExitGoal),
+
+ FailPred = "complexity_fail_proc",
+ FailStr = "\tMR_" ++ FailPred ++ "(" ++
+ ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
+ generate_foreign_proc(FailPred, failure,
+ [SlotInputArg], [], "", FailStr, "", [],
+ !.ModuleInfo, Context, FailGoal),
+
+ RedoPred = "complexity_redo_proc",
+ RedoStr = "\tMR_" ++ RedoPred ++ "(" ++
+ ProcNumStr ++ ", " ++ slot_var_name ++ ");\n",
+ generate_foreign_proc(RedoPred, failure,
+ [SlotInputArg], [], "", RedoStr, "", [],
+ !.ModuleInfo, Context, RedoGoal0),
+
+ (
+ CodeModel = model_det,
+ TransformedGoalExpr = conj(SlotGoals ++ [OrigGoal, ExitGoal]),
+ TransformedGoal = TransformedGoalExpr - ImpureOrigGoalInfo
+ ;
+ CodeModel = model_semi,
+ OrigAfterGoal =
+ conj([OrigGoal, ExitGoal]) - ImpureOrigGoalInfo,
+ DisjGoal =
+ disj([OrigAfterGoal, FailGoal]) - ImpureOrigGoalInfo,
+ TransformedGoal =
+ conj(SlotGoals ++ [DisjGoal]) - ImpureOrigGoalInfo
+ ;
+ CodeModel = model_non,
+ RedoGoal0 = RedoGoalExpr - RedoGoalInfo0,
+ goal_info_add_feature(RedoGoalInfo0,
+ preserve_backtrack_into, RedoGoalInfo),
+ RedoGoal = RedoGoalExpr - RedoGoalInfo,
+
+ instmap_delta_init_reachable(AfterInstMapDelta),
+ goal_info_init(list_to_set([SlotVar]), AfterInstMapDelta,
+ multidet, impure, Context, AfterGoalInfo),
+ AfterGoal = disj([ExitGoal, RedoGoal]) - AfterGoalInfo,
+
+ OrigAfterGoal =
+ conj([OrigGoal, AfterGoal]) - ImpureOrigGoalInfo,
+ DisjGoal =
+ disj([OrigAfterGoal, FailGoal]) - ImpureOrigGoalInfo,
+ TransformedGoal =
+ conj(SlotGoals ++ [DisjGoal]) - ImpureOrigGoalInfo
+ ),
+
+ mercury_term_size_prof_builtin_module(TSPB),
+ SwitchArms = [
+ case(cons(qualified(TSPB, "is_inactive"), 0),
+ TransformedGoal),
+ case(cons(qualified(TSPB, "is_active"), 0),
+ OrigGoal)
+ ],
+
+ SwitchExpr = switch(IsActiveVar, cannot_fail, SwitchArms),
+ goal_info_init(OrigNonLocals, OrigInstMapDelta, Detism, impure,
+ Context, SwitchGoalInfo),
+ SwitchGoal = SwitchExpr - SwitchGoalInfo,
+
+ GoalExpr = conj([IsActiveGoal, SwitchGoal]),
+ goal_info_init(OrigNonLocals, OrigInstMapDelta, Detism, impure,
+ Context, GoalInfo),
+ Goal = GoalExpr - GoalInfo,
+
+ proc_info_set_goal(Goal, !ProcInfo),
+
+ assoc_list__values(VarInfos, Infos),
+ ComplexityInfo = complexity_proc_info(ProcNum, FullName, Infos),
+ module_info_get_complexity_proc_infos(!.ModuleInfo, ComplexityInfos0),
+ ComplexityInfos = [ComplexityInfo | ComplexityInfos0],
+ module_info_set_complexity_proc_infos(ComplexityInfos, !ModuleInfo).
+
+%-----------------------------------------------------------------------------%
+
+ % Generate a foreign_proc goal of the form:
+ %
+ % MR_ComplexityProc *proc;
+ %
+ % MR_complexity_call_proc(proc_num, slot);
+ % proc = &MR_complexity_procs[proc_num];
+ % MR_complexity_fill_size_slot(proc, slot, num_inputs, 1, size1);
+ % ...
+ % MR_complexity_fill_size_slot(proc, slot, num_inputs, N, sizeN);
+ %
+ % prefixed by the goals required to generate the typeinfos we need
+ % to compute the sizes.
+
+:- pred generate_slot_goals(int::in, assoc_list(prog_var, int)::in,
+ int::in, term__context::in, pred_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ prog_var::out, string::out, list(hlds_goal)::out) is det.
+
+generate_slot_goals(ProcNum, NumberedVars, NumProfiledVars, Context, PredId,
+ !ProcInfo, !ModuleInfo, SlotVar, SlotVarName, Goals) :-
+ SlotVarName = slot_var_name,
+ generate_new_var(SlotVarName, int_type, !ProcInfo, SlotVar),
+ ProcVarName = "proc",
+ generate_size_goals(NumberedVars, Context, NumProfiledVars,
+ ProcVarName, SlotVarName, PredId, !ProcInfo, !ModuleInfo,
+ PrefixGoals, ForeignArgs, FillCodeStr),
+ SlotVarArg = foreign_arg(SlotVar,
+ yes(SlotVarName - out_mode), int_type),
+ PredName = "complexity_call_proc",
+ DeclCodeStr = "\tMR_ComplexityProc *" ++ ProcVarName ++ ";\n",
+ PredCodeStr = "\tMR_" ++ PredName ++ "(" ++
+ int_to_string(ProcNum) ++ ", " ++ SlotVarName ++ ");\n",
+ ProcStr = "\t" ++ ProcVarName ++ " = &MR_complexity_procs[" ++
+ int_to_string(ProcNum) ++ "];\n",
+ generate_foreign_proc(PredName, det, [SlotVarArg], ForeignArgs,
+ DeclCodeStr, PredCodeStr, ProcStr ++ FillCodeStr, [SlotVar],
+ !.ModuleInfo, Context, CallGoal),
+ list__append(PrefixGoals, [CallGoal], Goals).
+
+:- pred generate_size_goals(assoc_list(prog_var, int)::in,
+ term__context::in, int::in, string::in, string::in, pred_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ list(hlds_goal)::out, list(foreign_arg)::out, string::out) is det.
+
+generate_size_goals([], _, _, _, _, _, !ProcInfo, !ModuleInfo, [], [], "").
+generate_size_goals([Var - VarSeqNum | NumberedVars], Context, NumProfiledVars,
+ ProcVarName, SlotVarName, PredId, !ProcInfo, !ModuleInfo,
+ Goals ++ RestGoals, ForeignArgs ++ RestForeignArgs,
+ CodeStr ++ RestCodeStr) :-
+ generate_size_goal(Var, VarSeqNum, Context, NumProfiledVars,
+ ProcVarName, SlotVarName, PredId, !ProcInfo, !ModuleInfo,
+ Goals, ForeignArgs, CodeStr),
+ generate_size_goals(NumberedVars, Context, NumProfiledVars,
+ ProcVarName, SlotVarName, PredId, !ProcInfo, !ModuleInfo,
+ RestGoals, RestForeignArgs, RestCodeStr).
+
+:- pred generate_size_goal(prog_var::in, int::in, term__context::in,
+ int::in, string::in, string::in, pred_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ list(hlds_goal)::out, list(foreign_arg)::out, string::out) is det.
+
+generate_size_goal(ArgVar, VarSeqNum, Context, NumProfiledVars, ProcVarName,
+ SlotVarName, PredId, !ProcInfo, !ModuleInfo, Goals,
+ ForeignArgs, CodeStr) :-
+ proc_info_vartypes(!.ProcInfo, VarTypes1),
+ map__lookup(VarTypes1, ArgVar, VarType),
+ MacroName = "MR_complexity_fill_size_slot",
+ make_type_info_var(VarType, Context, PredId, !ProcInfo, !ModuleInfo,
+ TypeInfoVar, Goals),
+ % Since we just created TypeInfoVar, it isn't in VarTypes1.
+ proc_info_vartypes(!.ProcInfo, VarTypes2),
+ map__lookup(VarTypes2, TypeInfoVar, TypeInfoType),
+ ArgName = "arg" ++ int_to_string(VarSeqNum),
+ TypeInfoArgName = "input_typeinfo" ++ int_to_string(VarSeqNum),
+ ForeignArg = foreign_arg(ArgVar,
+ yes(ArgName - in_mode), VarType),
+ ForeignTypeInfoArg = foreign_arg(TypeInfoVar,
+ yes(TypeInfoArgName - in_mode), TypeInfoType),
+ ForeignArgs = [ForeignTypeInfoArg, ForeignArg],
+ CodeStr = "\t" ++ MacroName ++ "(" ++
+ ProcVarName ++ ", " ++
+ SlotVarName ++ ", " ++
+ int_to_string(NumProfiledVars) ++ ", " ++
+ int_to_string(VarSeqNum) ++ ",\n\t\t" ++
+ "MR_term_size((MR_TypeInfo) " ++
+ TypeInfoArgName ++ ", " ++ ArgName ++ "));\n".
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_new_var(string::in, (type)::in, proc_info::in, proc_info::out,
+ prog_var::out) is det.
+
+generate_new_var(Name, Type, !ProcInfo, Var) :-
+ proc_info_varset(!.ProcInfo, VarSet0),
+ proc_info_vartypes(!.ProcInfo, VarTypes0),
+ varset__new_named_var(VarSet0, Name, Var, VarSet),
+ map__set(VarTypes0, Var, Type, VarTypes),
+ proc_info_set_varset(VarSet, !ProcInfo),
+ proc_info_set_vartypes(VarTypes, !ProcInfo).
+
+:- pred generate_foreign_proc(string::in, determinism::in,
+ list(foreign_arg)::in, list(foreign_arg)::in, string::in, string::in,
+ string::in, list(prog_var)::in, module_info::in, term__context::in,
+ hlds_goal::out) is det.
+
+generate_foreign_proc(PredName, Detism, Args, ExtraArgs,
+ PrefixCode, Code, SuffixCode, BoundVars, ModuleInfo, Context,
+ Goal) :-
+ mercury_term_size_prof_builtin_module(BuiltinModule),
+ Attrs0 = default_attributes(c),
+ set_may_call_mercury(will_not_call_mercury, Attrs0, Attrs),
+ goal_util__generate_foreign_proc(BuiltinModule, PredName, predicate,
+ only_mode, Detism, Attrs, Args, ExtraArgs,
+ PrefixCode, Code, SuffixCode, [impure],
+ ground_vars(BoundVars), ModuleInfo, Context, Goal).
+
+%-----------------------------------------------------------------------------%
+
+:- pred classify_args(list(prog_var)::in, list(mode)::in, module_info::in,
+ prog_varset::in, vartypes::in,
+ assoc_list(prog_var, complexity_arg_info)::out) is det.
+
+classify_args([], [], _, _, _, []).
+classify_args([_ | _], [], _, _, _, _) :-
+ error("classify_args: lists not same length").
+classify_args([], [_ | _], _, _, _, _) :-
+ error("classify_args: lists not same length").
+classify_args([Var | Vars], [Mode | Modes], ModuleInfo, VarSet, VarTypes,
+ [Var - complexity_arg_info(MaybeName, Kind) | VarInfos]) :-
+ classify_args(Vars, Modes, ModuleInfo, VarSet, VarTypes, VarInfos),
+ ( varset__search_name(VarSet, Var, Name) ->
+ MaybeName = yes(Name)
+ ;
+ MaybeName = no
+ ),
+ ( mode_is_fully_input(ModuleInfo, Mode) ->
+ map__lookup(VarTypes, Var, VarType),
+ ( zero_size_type(VarType, ModuleInfo) ->
+ Kind = complexity_input_fixed_size
+ ;
+ Kind = complexity_input_variable_size
+ )
+ ;
+ Kind = complexity_output
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred allocate_slot_numbers(assoc_list(prog_var, complexity_arg_info)::in,
+ int::in, assoc_list(prog_var, int)::out) is det.
+
+allocate_slot_numbers([], _, []).
+allocate_slot_numbers([Var - Info | VarInfos], Offset, NumberedProfiledVars) :-
+ Info = complexity_arg_info(_, Kind),
+ ( Kind = complexity_input_variable_size ->
+ allocate_slot_numbers(VarInfos, Offset + 1,
+ NumberedProfiledVarsTail),
+ NumberedProfiledVars =
+ [Var - Offset | NumberedProfiledVarsTail]
+ ;
+ allocate_slot_numbers(VarInfos, Offset, NumberedProfiledVars)
+ ).
+
+:- func ground_vars(list(prog_var)) = assoc_list(prog_var, inst).
+
+ground_vars(Vars) = VarsAndGround :-
+ VarsAndGround = list__map(pair_with_ground, Vars).
+
+:- func pair_with_ground(prog_var) = pair(prog_var, inst).
+
+pair_with_ground(Var) = Var - ground(shared, none).
+
+%-----------------------------------------------------------------------------%
+
+:- func is_active_type = (type).
+
+is_active_type = Type :-
+ mercury_term_size_prof_builtin_module(M),
+ construct_type(qualified(M, "complexity_is_active") - 0, [], Type).
+
+%-----------------------------------------------------------------------------%
+
+:- pred make_type_info_var((type)::in, term__context::in, pred_id::in,
+ proc_info::in, proc_info::out, module_info::in, module_info::out,
+ prog_var::out, list(hlds_goal)::out) is det.
+
+make_type_info_var(Type, Context, PredId, !ProcInfo, !ModuleInfo,
+ TypeInfoVar, TypeInfoGoals) :-
+ module_info_pred_info(!.ModuleInfo, PredId, PredInfo0),
+ create_poly_info(!.ModuleInfo, PredInfo0, !.ProcInfo, PolyInfo0),
+ polymorphism__make_type_info_var(Type, Context, TypeInfoVar,
+ TypeInfoGoals, PolyInfo0, PolyInfo),
+ poly_info_extract(PolyInfo, PredInfo0, PredInfo,
+ !ProcInfo, !:ModuleInfo),
+ require(unify(PredInfo0, PredInfo),
+ "complexity__make_type_info_var: modified pred_info").
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.102
diff -u -r1.102 goal_util.m
--- compiler/goal_util.m 15 Feb 2005 00:04:53 -0000 1.102
+++ compiler/goal_util.m 15 Feb 2005 00:09:06 -0000
@@ -6,7 +6,7 @@
% Main author: conway.
%
-% This module provides various utility procedures for maniupulating HLDS goals,
+% This module provides various utility procedures for manipulating HLDS goals,
% e.g. some functionality for renaming variables in goals.
%-----------------------------------------------------------------------------%
@@ -23,6 +23,23 @@
:- import_module assoc_list, bool, list, set, map, term.
+ % create_renaming(OutputVars, InstMapDelta, !VarTypes, !VarSet,
+ % UnifyGoals, NewVars, Renaming):
+ %
+ % This predicate is intended for use in program transformations
+ % that need to wrap up semidet goals, replacing Goal with
+ % ( Goal' -> UnifyGoals, ... ; ...), where Goal' has its output
+ % variables (OutputVars) replaced with new variables (NewVars),
+ % with the mapping from OutputVars to NewVars being Renaming.
+ % VarTypes and Varset are updated for the new variables. The final
+ % insts of NewVar are taken from the insts of the corresponding
+ % OutputVar in InstMapDelta (the initial inst is free).
+
+:- pred create_renaming(list(prog_var)::in, instmap_delta::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ list(hlds_goal)::out, list(prog_var)::out,
+ map(prog_var, prog_var)::out) is det.
+
% The predicates rename_var* take a structure and a mapping from var -> var
% and apply that translation. If a var in the input structure does not
% occur as a key in the mapping, then the variable is left unsubstituted.
@@ -274,6 +291,48 @@
%-----------------------------------------------------------------------------%
+create_renaming(OrigVars, InstMapDelta, !VarTypes, !VarSet, Unifies, NewVars,
+ Renaming) :-
+ create_renaming_2(OrigVars, InstMapDelta, !VarTypes, !VarSet,
+ [], RevUnifies, [], RevNewVars, map__init, Renaming),
+ list__reverse(RevNewVars, NewVars),
+ list__reverse(RevUnifies, Unifies).
+
+:- pred create_renaming_2(list(prog_var)::in, instmap_delta::in,
+ vartypes::in, vartypes::out, prog_varset::in, prog_varset::out,
+ list(hlds_goal)::in, list(hlds_goal)::out,
+ list(prog_var)::in, list(prog_var)::out,
+ map(prog_var, prog_var)::in, map(prog_var, prog_var)::out) is det.
+
+create_renaming_2([], _, !VarTypes, !VarSet, !RevUnifies, !RevNewVars,
+ !Renaming).
+create_renaming_2([OrigVar | OrigVars], InstMapDelta, !VarTypes, !VarSet,
+ !RevUnifies, !RevNewVars, !Renaming) :-
+ varset__new_var(!.VarSet, NewVar, !:VarSet),
+ map__lookup(!.VarTypes, OrigVar, Type),
+ map__det_insert(!.VarTypes, NewVar, Type, !:VarTypes),
+ ( instmap_delta_search_var(InstMapDelta, OrigVar, DeltaInst) ->
+ NewInst = DeltaInst
+ ;
+ error("create_renaming_2: cannot get new inst")
+ ),
+ Mode = ((NewInst -> NewInst) - (free -> NewInst)),
+ UnifyInfo = assign(OrigVar, NewVar),
+ UnifyContext = unify_context(explicit, []),
+ GoalExpr = unify(OrigVar, var(NewVar), Mode, UnifyInfo, UnifyContext),
+ set__list_to_set([OrigVar, NewVar], NonLocals),
+ instmap_delta_from_assoc_list([OrigVar - NewInst], UnifyInstMapDelta),
+ goal_info_init(NonLocals, UnifyInstMapDelta, det, pure,
+ term__context_init, GoalInfo),
+ Goal = GoalExpr - GoalInfo,
+ !:RevUnifies = [Goal | !.RevUnifies],
+ map__det_insert(!.Renaming, OrigVar, NewVar, !:Renaming),
+ !:RevNewVars = [NewVar | !.RevNewVars],
+ create_renaming_2(OrigVars, InstMapDelta, !VarTypes, !VarSet,
+ !RevUnifies, !RevNewVars, !Renaming).
+
+%-----------------------------------------------------------------------------%
+
goal_util__create_variables([], _OldVarNames, _OldVarTypes,
!Varset, !VarTypes, !Subn).
goal_util__create_variables([V | Vs], OldVarNames, OldVarTypes,
@@ -487,9 +546,9 @@
map(prog_var, prog_var)::in, unification::out) is det.
goal_util__rename_unify(
- construct(Var0, ConsId, Vars0, Modes, How0, Uniq, Size),
+ construct(Var0, ConsId, Vars0, Modes, How0, Uniq, MaybeSize0),
Must, Subn,
- construct(Var, ConsId, Vars, Modes, How, Uniq, Size)) :-
+ construct(Var, ConsId, Vars, Modes, How, Uniq, MaybeSize)) :-
goal_util__rename_var(Var0, Must, Subn, Var),
goal_util__rename_var_list(Vars0, Must, Subn, Vars),
(
@@ -502,7 +561,22 @@
;
How0 = construct_statically(_),
How = How0
- ).
+ ),
+ (
+ MaybeSize0 = no,
+ MaybeSize = no
+ ;
+ MaybeSize0 = yes(Size0),
+ (
+ Size0 = known_size(_),
+ Size = Size0
+ ;
+ Size0 = dynamic_size(SizeVar0),
+ goal_util__rename_var(SizeVar0, Must, Subn, SizeVar),
+ Size = dynamic_size(SizeVar)
+ ),
+ MaybeSize = yes(Size)
+ ).
goal_util__rename_unify(deconstruct(Var0, ConsId, Vars0, Modes, Cat, CanCGC),
Must, Subn,
deconstruct(Var, ConsId, Vars, Modes, Cat, CanCGC)) :-
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.218
diff -u -r1.218 handle_options.m
--- compiler/handle_options.m 14 Feb 2005 02:23:22 -0000 1.218
+++ compiler/handle_options.m 14 Feb 2005 05:30:06 -0000
@@ -760,6 +760,18 @@
option_implies(target_debug, strip, bool(no)),
+ % Inlining happens before the deep profiling transformation, so if
+ % we allowed inlining to happen, then we would lose all profiling
+ % information about the inlined calls.
+ option_implies(profile_deep, allow_inlining, bool(no)),
+
+ globals__io_lookup_string_option(experimental_complexity, ExpComp),
+ ( { ExpComp = "" } ->
+ { true }
+ ;
+ globals__io_set_option(allow_inlining, bool(no))
+ ),
+
% --decl-debug is an extension of --debug
option_implies(decl_debug, exec_trace, bool(yes)),
@@ -803,16 +815,13 @@
% - enabling typeinfo liveness
globals__io_lookup_bool_option(trace_optimized, TraceOptimized),
( { given_trace_level_is_none(TraceLevel) = no } ->
- ( { TraceOptimized = no } ->
+ (
+ { TraceOptimized = no },
% The following options modify the structure
% of the program, which makes it difficult to
% relate the trace to the source code (although
% it can be easily related to the transformed HLDS).
- globals__io_set_option(inline_simple, bool(no)),
- globals__io_set_option(inline_builtins, bool(no)),
- globals__io_set_option(inline_single_use, bool(no)),
- globals__io_set_option(inline_compound_threshold,
- int(0)),
+ globals__io_set_option(allow_inlining, bool(no)),
globals__io_set_option(optimize_unused_args, bool(no)),
globals__io_set_option(optimize_higher_order, bool(no)),
globals__io_set_option(type_specialization, bool(no)),
@@ -842,7 +851,7 @@
[]
)
;
- []
+ { TraceOptimized = yes }
),
% Disable hijacks if debugging is enabled. The
Index: compiler/hlds_module.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/hlds_module.m,v
retrieving revision 1.108
diff -u -r1.108 hlds_module.m
--- compiler/hlds_module.m 9 Feb 2005 04:52:04 -0000 1.108
+++ compiler/hlds_module.m 10 Feb 2005 01:13:52 -0000
@@ -123,6 +123,41 @@
---> do_aditi_compilation
; no_aditi_compilation.
+ % Maps the full names of procedures (in the sense of
+ % complexity_proc_name in complexity.m) to the number of their slot
+ % in MR_complexity_proc_table.
+
+:- type complexity_proc_map == map(string, int).
+
+:- type complexity_proc_info --->
+ complexity_proc_info(
+ complexity_proc_num :: int,
+ % The index of the procedure
+ % in the runtime system's
+ % MR_complexity_procs array.
+
+ complexity_proc_name :: string,
+ % The full name of the
+ % procedure, in the form
+ % fqn/arity-modenum, where
+ % fqn is the predicate or
+ % function's fully qualified
+ % name.
+
+ complexity_proc_args :: list(complexity_arg_info)
+ ).
+
+:- type complexity_arg_info --->
+ complexity_arg_info(
+ complexity_arg_name :: maybe(string),
+ complexity_arg_kind :: complexity_arg_kind
+ ).
+
+:- type complexity_arg_kind
+ ---> complexity_input_variable_size
+ ; complexity_input_fixed_size
+ ; complexity_output.
+
% Mercury procedures which can be called from Aditi join conditions.
% Each procedure has one input and one output argument.
% The compiler generates a constant structure containing
@@ -369,6 +404,19 @@
:- pred module_info_set_analysis_info(analysis_info::in,
module_info::in, module_info::out) is det.
+:- pred module_info_get_maybe_complexity_proc_map(module_info::in,
+ maybe(pair(int, complexity_proc_map))::out) is det.
+
+:- pred module_info_set_maybe_complexity_proc_map(
+ maybe(pair(int, complexity_proc_map))::in,
+ module_info::in, module_info::out) is det.
+
+:- pred module_info_get_complexity_proc_infos(module_info::in,
+ list(complexity_proc_info)::out) is det.
+
+:- pred module_info_set_complexity_proc_infos(list(complexity_proc_info)::in,
+ module_info::in, module_info::out) is det.
+
:- pred module_info_aditi_top_down_procs(module_info::in,
list(aditi_top_down_proc)::out) is det.
@@ -387,7 +435,7 @@
:- pred module_info_pred_info(module_info::in, pred_id::in, pred_info::out)
is det.
- % Given a pred_id and a proc_id, get the pred_info that predicate
+ % Given a pred_id and a proc_id, get the pred_info of that predicate
% and the proc_info for that mode of that predicate.
%
:- pred module_info_pred_proc_info(module_info::in, pred_id::in, proc_id::in,
@@ -604,15 +652,23 @@
% but lookups in this table
% will be much faster.
+ maybe_complexity_proc_map :: maybe(pair(int,
+ complexity_proc_map)),
+
+ complexity_proc_infos :: list(complexity_proc_info),
+ % Information about the
+ % procedures we are performing
+ % complexity experiments on.
+
analysis_info :: analysis_info,
% Information for the
% inter-module analysis
% framework.
- aditi_top_down_procs :: list(aditi_top_down_proc),
+ aditi_top_down_procs :: list(aditi_top_down_proc),
% List of top-down procedures
% which could be called from
% bottom-up Aditi procedures.
- aditi_proc_counter :: counter
+ aditi_proc_counter :: counter
).
@@ -652,11 +708,12 @@
map__init(FieldNameTable),
map__init(NoTagTypes),
- ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], [], no, 0,
+ ModuleSubInfo = module_sub(Name, Globals, no, [], [], [], [], no, 0,
[], [], StratPreds, UnusedArgInfo, ExceptionInfo,
counter__init(1), counter__init(1), ImportedModules,
IndirectlyImportedModules, no_aditi_compilation, TypeSpecInfo,
- NoTagTypes, init_analysis_info(mmc), [], counter__init(1)),
+ NoTagTypes, no, [], init_analysis_info(mmc),
+ [], counter__init(1)),
ModuleInfo = module(ModuleSubInfo, PredicateTable, Requests,
UnifyPredMap, QualifierInfo, Types, Insts, Modes, Ctors,
ClassTable, SuperClassTable, InstanceTable, AssertionTable,
@@ -738,6 +795,10 @@
module_info_type_spec_info(MI, MI ^ sub_info ^ type_spec_info).
module_info_no_tag_types(MI, MI ^ sub_info ^ no_tag_type_table).
module_info_analysis_info(MI, MI ^ sub_info ^ analysis_info).
+module_info_get_maybe_complexity_proc_map(MI,
+ MI ^ sub_info ^ maybe_complexity_proc_map).
+module_info_get_complexity_proc_infos(MI,
+ MI ^ sub_info ^ complexity_proc_infos).
module_info_aditi_top_down_procs(MI, MI ^ sub_info ^ aditi_top_down_procs).
module_info_next_aditi_top_down_proc(MI0, Proc, MI) :-
@@ -796,6 +857,10 @@
MI ^ sub_info ^ no_tag_type_table := NewVal).
module_info_set_analysis_info(NewVal, MI,
MI ^ sub_info ^ analysis_info := NewVal).
+module_info_set_maybe_complexity_proc_map(NewVal, MI,
+ MI ^ sub_info ^ maybe_complexity_proc_map := NewVal).
+module_info_set_complexity_proc_infos(NewVal, MI,
+ MI ^ sub_info ^ complexity_proc_infos := NewVal).
module_info_set_aditi_top_down_procs(MI, NewVal,
MI ^ sub_info ^ aditi_top_down_procs := NewVal).
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.119
diff -u -r1.119 inlining.m
--- compiler/inlining.m 19 Jan 2005 03:10:36 -0000 1.119
+++ compiler/inlining.m 19 Jan 2005 05:03:53 -0000
@@ -153,6 +153,7 @@
:- import_module hlds__hlds_data.
:- import_module hlds__passes_aux.
:- import_module hlds__quantification.
+:- import_module transform_hlds__complexity.
:- import_module transform_hlds__dead_proc_elim.
:- import_module transform_hlds__dependency_graph.
@@ -902,9 +903,23 @@
% fragments.
proc_info_eval_method(ProcInfo, eval_normal),
- % Don't inlining anything we have been specifically requested
+ % Don't inline anything we have been specifically requested
% not to inline.
\+ pred_info_requested_no_inlining(PredInfo),
+
+ % Don't inline any procedure whose complexity we are trying to
+ % determine, since the complexity transformation can't transform
+ % *part* of a procedure.
+ module_info_get_maybe_complexity_proc_map(ModuleInfo,
+ MaybeComplexityProcMap),
+ (
+ MaybeComplexityProcMap = no
+ ;
+ MaybeComplexityProcMap = yes(_ - ComplexityProcMap),
+ IsInComplexityMap = is_in_complexity_proc_map(
+ ComplexityProcMap, ModuleInfo, PredId, ProcId),
+ IsInComplexityMap = no
+ ),
% For the LLDS back-end,
% under no circumstances inline model_non pragma c codes.
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.244
diff -u -r1.244 llds_out.m
--- compiler/llds_out.m 21 Jan 2005 03:32:13 -0000 1.244
+++ compiler/llds_out.m 21 Jan 2005 06:26:28 -0000
@@ -19,6 +19,7 @@
:- import_module aditi_backend__rl_file.
:- import_module backend_libs__builtin_ops.
+:- import_module hlds__hlds_module.
:- import_module libs__globals.
:- import_module ll_backend__llds.
:- import_module mdbcomp__prim_data.
@@ -31,8 +32,8 @@
% labels that have layout structures. The third gives the Aditi-RL
% code for the module.
-:- pred output_llds(c_file::in, map(label, data_addr)::in, maybe(rl_file)::in,
- io::di, io::uo) is det.
+:- pred output_llds(c_file::in, list(complexity_proc_info)::in,
+ map(label, data_addr)::in, maybe(rl_file)::in, io::di, io::uo) is det.
% output_rval_decls(Rval, DeclSet0, DeclSet) outputs the declarations
% of any static constants, etc. that need to be declared before
@@ -203,9 +204,10 @@
%-----------------------------------------------------------------------------%
-output_llds(C_File, StackLayoutLabels, MaybeRLFile, !IO) :-
+output_llds(C_File, ComplexityProcs, StackLayoutLabels, MaybeRLFile, !IO) :-
globals__io_lookup_bool_option(split_c_files, SplitFiles, !IO),
- ( SplitFiles = yes ->
+ (
+ SplitFiles = yes,
C_File = c_file(ModuleName, C_HeaderInfo,
UserForeignCodes, Exports, Vars, Datas, Modules),
module_name_to_file_name(ModuleName, ".dir", yes, ObjDirName,
@@ -213,17 +215,22 @@
dir__make_directory(ObjDirName, _, !IO),
output_split_c_file_init(ModuleName, Modules, Datas,
- StackLayoutLabels, MaybeRLFile, !IO),
+ ComplexityProcs, StackLayoutLabels, MaybeRLFile, !IO),
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
- C_HeaderInfo, StackLayoutLabels, 1, Num1, !IO),
+ C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
+ 1, Num1, !IO),
output_split_c_exports(Exports, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num1, Num2, !IO),
+ C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
+ Num1, Num2, !IO),
output_split_comp_gen_c_vars(Vars, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num2, Num3, !IO),
+ C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
+ Num2, Num3, !IO),
output_split_comp_gen_c_datas(Datas, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num3, Num4, !IO),
+ C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
+ Num3, Num4, !IO),
output_split_comp_gen_c_modules(Modules, ModuleName,
- C_HeaderInfo, StackLayoutLabels, Num4, Num, !IO),
+ C_HeaderInfo, ComplexityProcs, StackLayoutLabels,
+ Num4, Num, !IO),
compile_target_code__write_num_split_c_files(ModuleName,
Num, Succeeded, !IO),
@@ -234,89 +241,99 @@
true
)
;
- output_single_c_file(C_File, no,
+ SplitFiles = no,
+ output_single_c_file(C_File, no, ComplexityProcs,
StackLayoutLabels, MaybeRLFile, !IO)
).
:- pred output_split_user_foreign_codes(list(user_foreign_code)::in,
- module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
+ module_name::in, list(foreign_decl_code)::in,
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
int::in, int::out, io::di, io::uo) is det.
-output_split_user_foreign_codes([], _, _, _, !Num, !IO).
+output_split_user_foreign_codes([], _, _, _, _, !Num, !IO).
output_split_user_foreign_codes([UserForeignCode | UserForeignCodes],
- ModuleName, C_HeaderLines, StackLayoutLabels, !Num, !IO) :-
+ ModuleName, C_HeaderLines, ComplexityProcs, StackLayoutLabels,
+ !Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [UserForeignCode],
[], [], [], []),
- output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
+ StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
output_split_user_foreign_codes(UserForeignCodes, ModuleName,
- C_HeaderLines, StackLayoutLabels, !Num, !IO).
+ C_HeaderLines, ComplexityProcs, StackLayoutLabels, !Num, !IO).
:- pred output_split_c_exports(list(foreign_export)::in, module_name::in,
- list(foreign_decl_code)::in, map(label, data_addr)::in,
- int::in, int::out, io::di, io::uo) is det.
+ list(foreign_decl_code)::in, list(complexity_proc_info)::in,
+ map(label, data_addr)::in, int::in, int::out, io::di, io::uo) is det.
-output_split_c_exports([], _, _, _, !Num, !IO).
+output_split_c_exports([], _, _, _, _, !Num, !IO).
output_split_c_exports([Export | Exports], ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO) :-
+ ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [], [Export], [], [], []),
- output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
+ StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
output_split_c_exports(Exports, ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO).
+ ComplexityProcs, StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_vars(list(comp_gen_c_var)::in,
- module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
+ module_name::in, list(foreign_decl_code)::in,
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
int::in, int::out, io::di, io::uo) is det.
-output_split_comp_gen_c_vars([], _, _, _, !Num, !IO).
+output_split_comp_gen_c_vars([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_vars([Var | Vars], ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO) :-
+ ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [], [], [Var], [], []),
- output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
+ StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
output_split_comp_gen_c_vars(Vars, ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO).
+ ComplexityProcs, StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_datas(list(comp_gen_c_data)::in,
- module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
+ module_name::in, list(foreign_decl_code)::in,
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
int::in, int::out, io::di, io::uo) is det.
-output_split_comp_gen_c_datas([], _, _, _, !Num, !IO).
+output_split_comp_gen_c_datas([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_datas([Data | Datas], ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO) :-
+ ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [Data], []),
- output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
+ StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
output_split_comp_gen_c_datas(Datas, ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO).
+ ComplexityProcs, StackLayoutLabels, !Num, !IO).
:- pred output_split_comp_gen_c_modules(list(comp_gen_c_module)::in,
- module_name::in, list(foreign_decl_code)::in, map(label, data_addr)::in,
+ module_name::in, list(foreign_decl_code)::in,
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
int::in, int::out, io::di, io::uo) is det.
-output_split_comp_gen_c_modules([], _, _, _, !Num, !IO).
+output_split_comp_gen_c_modules([], _, _, _, _, !Num, !IO).
output_split_comp_gen_c_modules([Module | Modules], ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO) :-
+ ComplexityProcs, StackLayoutLabels, !Num, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, [], [], [], [], [Module]),
- output_single_c_file(CFile, yes(!.Num), StackLayoutLabels, no, !IO),
+ output_single_c_file(CFile, yes(!.Num), ComplexityProcs,
+ StackLayoutLabels, no, !IO),
!:Num = !.Num + 1,
output_split_comp_gen_c_modules(Modules, ModuleName, C_HeaderLines,
- StackLayoutLabels, !Num, !IO).
+ ComplexityProcs, StackLayoutLabels, !Num, !IO).
:- pred output_split_c_file_init(module_name::in, list(comp_gen_c_module)::in,
- list(comp_gen_c_data)::in, map(label, data_addr)::in,
- maybe(rl_file)::in, io::di, io::uo) is det.
+ list(comp_gen_c_data)::in, list(complexity_proc_info)::in,
+ map(label, data_addr)::in, maybe(rl_file)::in, io::di, io::uo) is det.
-output_split_c_file_init(ModuleName, Modules, Datas,
+output_split_c_file_init(ModuleName, Modules, Datas, ComplexityProcs,
StackLayoutLabels, MaybeRLFile, !IO) :-
module_name_to_file_name(ModuleName, ".m", no, SourceFileName, !IO),
module_name_to_split_c_file_name(ModuleName, 0, ".c", FileName, !IO),
io__open_output(FileName, Result, !IO),
(
- Result = ok(FileStream)
- ->
+ Result = ok(FileStream),
library__version(Version),
io__set_output_stream(FileStream, OutputStream, !IO),
output_c_file_intro_and_grade(SourceFileName, Version, !IO),
@@ -325,17 +342,21 @@
io__write_string("\n", !IO),
decl_set_init(DeclSet0),
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels, DeclSet0, _DeclSet, !IO),
+ ComplexityProcs, StackLayoutLabels,
+ DeclSet0, _DeclSet, !IO),
c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
io__set_output_stream(OutputStream, _, !IO),
io__close_output(FileStream, !IO)
;
+ Result = error(Error),
io__progname_base("llds.m", ProgName, !IO),
io__write_string("\n", !IO),
io__write_string(ProgName, !IO),
io__write_string(": can't open `", !IO),
io__write_string(FileName, !IO),
- io__write_string("' for output\n", !IO),
+ io__write_string("' for output:\n", !IO),
+ io__write_string(io__error_message(Error), !IO),
+ io__write_string("\n", !IO),
io__set_exit_status(1, !IO)
).
@@ -365,9 +386,11 @@
).
:- pred output_single_c_file(c_file::in, maybe(int)::in,
- map(label, data_addr)::in, maybe(rl_file)::in, io::di, io::uo) is det.
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
+ maybe(rl_file)::in, io::di, io::uo) is det.
-output_single_c_file(CFile, SplitFiles, StackLayoutLabels, MaybeRLFile, !IO) :-
+output_single_c_file(CFile, SplitFiles, ComplexityProcs, StackLayoutLabels,
+ MaybeRLFile, !IO) :-
CFile = c_file(ModuleName, _, _, _, _, _, _),
( SplitFiles = yes(Num) ->
module_name_to_split_c_file_name(ModuleName, Num, ".c",
@@ -376,26 +399,32 @@
module_name_to_file_name(ModuleName, ".c", yes, FileName, !IO)
),
io__open_output(FileName, Result, !IO),
- ( Result = ok(FileStream) ->
+ (
+ Result = ok(FileStream),
decl_set_init(DeclSet0),
- do_output_single_c_file(CFile, SplitFiles, StackLayoutLabels,
- MaybeRLFile, FileStream, DeclSet0, _, !IO),
+ do_output_single_c_file(CFile, SplitFiles, ComplexityProcs,
+ StackLayoutLabels, MaybeRLFile, FileStream,
+ DeclSet0, _, !IO),
io__close_output(FileStream, !IO)
;
+ Result = error(Error),
io__progname_base("llds.m", ProgName, !IO),
io__write_string("\n", !IO),
io__write_string(ProgName, !IO),
io__write_string(": can't open `", !IO),
io__write_string(FileName, !IO),
- io__write_string("' for output\n", !IO),
+ io__write_string("' for output:\n", !IO),
+ io__write_string(io__error_message(Error), !IO),
+ io__write_string("\n", !IO),
io__set_exit_status(1, !IO)
).
:- pred do_output_single_c_file(c_file::in, maybe(int)::in,
- map(label, data_addr)::in, maybe(rl_file)::in, io__output_stream::in,
+ list(complexity_proc_info)::in, map(label, data_addr)::in,
+ maybe(rl_file)::in, io__output_stream::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-do_output_single_c_file(CFile, SplitFiles, StackLayoutLabels,
+do_output_single_c_file(CFile, SplitFiles, ComplexityProcs, StackLayoutLabels,
MaybeRLFile, FileStream, !DeclSet, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines,
UserForeignCode, Exports, Vars, Datas, Modules),
@@ -404,9 +433,10 @@
module_name_to_file_name(ModuleName, ".m", no, SourceFileName,
!IO),
output_c_file_intro_and_grade(SourceFileName, Version, !IO),
- ( SplitFiles = yes(_) ->
- true
+ (
+ SplitFiles = yes(_)
;
+ SplitFiles = no,
output_init_comment(ModuleName, !IO)
),
output_c_file_mercury_headers(!IO),
@@ -434,12 +464,13 @@
list__foldl(output_user_foreign_code, UserForeignCode, !IO),
list__foldl(io__write_string, Exports, !IO),
- ( SplitFiles = yes(_) ->
- true
+ (
+ SplitFiles = yes(_)
;
+ SplitFiles = no,
io__write_string("\n", !IO),
output_c_module_init_list(ModuleName, Modules, Datas,
- StackLayoutLabels, !DeclSet, !IO)
+ ComplexityProcs, StackLayoutLabels, !DeclSet, !IO)
),
c_util__output_rl_file(ModuleName, MaybeRLFile, !IO),
io__set_output_stream(OutputStream, _, !IO).
@@ -474,11 +505,12 @@
!OtherLayouts).
:- 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,
- decl_set::in, decl_set::out, io::di, io::uo) is det.
+ list(comp_gen_c_data)::in, list(complexity_proc_info)::in,
+ map(label, data_addr)::in, decl_set::in, decl_set::out,
+ io::di, io::uo) is det.
-output_c_module_init_list(ModuleName, Modules, Datas, StackLayoutLabels,
- !DeclSet, !IO) :-
+output_c_module_init_list(ModuleName, Modules, Datas, ComplexityProcs,
+ StackLayoutLabels, !DeclSet, !IO) :-
MustInit = (pred(Module::in) is semidet :-
module_defines_label_with_layout(Module, StackLayoutLabels)
),
@@ -491,9 +523,10 @@
output_init_bunch_defs(AlwaysInitModuleBunches, ModuleName,
"always", 0, SplitFiles, !IO),
- ( MaybeInitModuleBunches = [] ->
- true
+ (
+ MaybeInitModuleBunches = []
;
+ MaybeInitModuleBunches = [_ | _],
output_init_bunch_defs(MaybeInitModuleBunches, ModuleName,
"maybe", 0, SplitFiles, !IO)
),
@@ -502,17 +535,26 @@
io__write_string("void ", !IO),
output_init_name(ModuleName, !IO),
io__write_string("init(void);\n", !IO),
+
io__write_string("void ", !IO),
output_init_name(ModuleName, !IO),
io__write_string("init_type_tables(void);\n", !IO),
io__write_string("void ", !IO),
output_init_name(ModuleName, !IO),
io__write_string("init_debugger(void);\n", !IO),
+
io__write_string("#ifdef MR_DEEP_PROFILING\n", !IO),
io__write_string("void ", !IO),
output_init_name(ModuleName, !IO),
io__write_string("write_out_proc_statics(FILE *fp);\n", !IO),
io__write_string("#endif\n", !IO),
+
+ io__write_string("#ifdef MR_RECORD_TERM_SIZES\n", !IO),
+ io__write_string("void ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_complexity_procs(void);\n", !IO),
+ io__write_string("#endif\n", !IO),
+
io__write_string("\n", !IO),
io__write_string("void ", !IO),
@@ -528,9 +570,10 @@
output_init_bunch_calls(AlwaysInitModuleBunches, ModuleName,
"always", 0, !IO),
- ( MaybeInitModuleBunches = [] ->
- true
+ (
+ MaybeInitModuleBunches = []
;
+ MaybeInitModuleBunches = [_ | _],
output_init_bunch_calls(MaybeInitModuleBunches, ModuleName,
"maybe", 0, !IO)
),
@@ -582,6 +625,16 @@
io__write_string("}\n", !IO),
io__write_string("\n#endif\n\n", !IO),
+ io__write_string("#ifdef MR_RECORD_TERM_SIZES\n", !IO),
+ output_complexity_arg_info_arrays(ComplexityProcs, !IO),
+ io__write_string("\nvoid ", !IO),
+ output_init_name(ModuleName, !IO),
+ io__write_string("init_complexity_procs(void)\n", !IO),
+ io__write_string("{\n", !IO),
+ output_init_complexity_proc_list(ComplexityProcs, !IO),
+ io__write_string("}\n", !IO),
+ io__write_string("\n#endif\n\n", !IO),
+
io__write_string(
"/* ensure everything is compiled with the same grade */\n",
!IO),
@@ -623,7 +676,8 @@
output_init_bunch_def([], _, _, !IO).
output_init_bunch_def([Module | Modules], ModuleName, SplitFiles, !IO) :-
Module = comp_gen_c_module(C_ModuleName, _),
- ( SplitFiles = yes ->
+ (
+ SplitFiles = yes,
io__write_string("\t{ extern MR_ModuleFunc ", !IO),
io__write_string(C_ModuleName, !IO),
io__write_string(";\n", !IO),
@@ -631,6 +685,7 @@
io__write_string(C_ModuleName, !IO),
io__write_string("(); }\n", !IO)
;
+ SplitFiles = no,
io__write_string("\t", !IO),
io__write_string(C_ModuleName, !IO),
io__write_string("();\n", !IO)
@@ -671,9 +726,7 @@
output_type_tables_init_list([], _, !IO).
output_type_tables_init_list([Data | Datas], SplitFiles, !IO) :-
- (
- Data = rtti_data(RttiData)
- ->
+ ( Data = rtti_data(RttiData) ->
rtti_out__register_rtti_data_if_nec(RttiData, SplitFiles, !IO)
;
true
@@ -770,6 +823,80 @@
),
output_write_proc_static_list(Datas, !IO).
+:- func complexity_arg_info_array_name(int) = string.
+
+complexity_arg_info_array_name(ProcNum) =
+ "MR_complexity_arg_info_" ++ int_to_string(ProcNum).
+
+:- pred output_complexity_arg_info_arrays(list(complexity_proc_info)::in,
+ io::di, io::uo) is det.
+
+output_complexity_arg_info_arrays([], !IO).
+output_complexity_arg_info_arrays([Info | Infos], !IO) :-
+ Info = complexity_proc_info(ProcNum, _, Args),
+ io__write_string("\nMR_ComplexityArgInfo ", !IO),
+ io__write_string(complexity_arg_info_array_name(ProcNum), !IO),
+ io__write_string("[", !IO),
+ io__write_int(list__length(Args), !IO),
+ io__write_string("] = {\n", !IO),
+ output_complexity_arg_info_array(Args, !IO),
+ io__write_string("};\n", !IO),
+ output_complexity_arg_info_arrays(Infos, !IO).
+
+:- pred output_complexity_arg_info_array(list(complexity_arg_info)::in,
+ io::di, io::uo) is det.
+
+output_complexity_arg_info_array([], !IO).
+output_complexity_arg_info_array([Arg | Args], !IO) :-
+ Arg = complexity_arg_info(MaybeName, Kind),
+ io__write_string("{ ", !IO),
+ (
+ MaybeName = yes(Name),
+ io__write_string("""", !IO),
+ io__write_string(Name, !IO),
+ io__write_string(""", ", !IO)
+ ;
+ MaybeName = no,
+ io__write_string("NULL, ", !IO)
+ ),
+ (
+ Kind = complexity_input_variable_size,
+ io__write_string("MR_COMPLEXITY_INPUT_VAR_SIZE", !IO)
+ ;
+ Kind = complexity_input_fixed_size,
+ io__write_string("MR_COMPLEXITY_INPUT_FIX_SIZE", !IO)
+ ;
+ Kind = complexity_output,
+ io__write_string("MR_COMPLEXITY_OUTPUT", !IO)
+ ),
+ io__write_string(" },\n", !IO),
+ output_complexity_arg_info_array(Args, !IO).
+
+:- pred output_init_complexity_proc_list(list(complexity_proc_info)::in,
+ io::di, io::uo) is det.
+
+output_init_complexity_proc_list([], !IO).
+output_init_complexity_proc_list([Info | Infos], !IO) :-
+ Info = complexity_proc_info(ProcNum, FullProcName, ArgInfos),
+ io__write_string("\tMR_init_complexity_proc(", !IO),
+ io__write_int(ProcNum, !IO),
+ io__write_string(", """, !IO),
+ c_util__output_quoted_string(FullProcName, !IO),
+ io__write_string(""", ", !IO),
+ list__filter(complexity_arg_is_profiled, ArgInfos, ProfiledArgInfos),
+ io__write_int(list__length(ProfiledArgInfos), !IO),
+ io__write_string(", ", !IO),
+ io__write_int(list__length(ArgInfos), !IO),
+ io__write_string(", ", !IO),
+ io__write_string(complexity_arg_info_array_name(ProcNum), !IO),
+ io__write_string(");\n", !IO),
+ output_init_complexity_proc_list(Infos, !IO).
+
+:- pred complexity_arg_is_profiled(complexity_arg_info::in) is semidet.
+
+complexity_arg_is_profiled(complexity_arg_info(_, Kind)) :-
+ Kind = complexity_input_variable_size.
+
% Output a comment to tell mkinit what functions to
% call from <module>_init.c.
:- pred output_init_comment(module_name::in, io::di, io::uo) is det.
@@ -780,13 +907,14 @@
output_init_name(ModuleName, !IO),
io__write_string("init\n", !IO),
globals__io_lookup_bool_option(aditi, Aditi, !IO),
- ( Aditi = yes ->
+ (
+ Aditi = yes,
RLName = make_rl_data_name(ModuleName),
io__write_string("ADITI_DATA ", !IO),
io__write_string(RLName, !IO),
io__write_string("\n", !IO)
;
- true
+ Aditi = no
),
io__write_string("ENDINIT\n", !IO),
io__write_string("*/\n\n", !IO).
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.325
diff -u -r1.325 mercury_compile.m
--- compiler/mercury_compile.m 2 Feb 2005 02:58:42 -0000 1.325
+++ compiler/mercury_compile.m 2 Feb 2005 05:01:06 -0000
@@ -63,6 +63,7 @@
:- import_module transform_hlds__trans_opt.
:- import_module transform_hlds__equiv_type_hlds.
:- import_module transform_hlds__table_gen.
+:- import_module transform_hlds__complexity.
:- import_module transform_hlds__lambda.
:- import_module backend_libs__type_ctor_info.
:- import_module transform_hlds__termination.
@@ -2277,6 +2278,8 @@
globals__io_lookup_bool_option(verbose, Verbose, !IO),
globals__io_lookup_bool_option(statistics, Stats, !IO),
+ mercury_compile__maybe_read_experimental_complexity_file(!HLDS, !IO),
+
mercury_compile__tabling(Verbose, Stats, !HLDS, !IO),
mercury_compile__maybe_dump_hlds(!.HLDS, 105, "tabling", !IO),
@@ -2394,6 +2397,13 @@
mercury_compile__maybe_deep_profiling(Verbose, Stats, !HLDS, !IO),
mercury_compile__maybe_dump_hlds(!.HLDS, 205, "deep_profiling", !IO),
+ % Experimental complexity transformation should be done late in the
+ % piece for the same reason as deep profiling. At the moment, they are
+ % exclusive.
+ mercury_compile__maybe_experimental_complexity(Verbose, Stats, !HLDS,
+ !IO),
+ mercury_compile__maybe_dump_hlds(!.HLDS, 210, "complexity", !IO),
+
mercury_compile__maybe_dump_hlds(!.HLDS, 299, "middle_pass", !IO).
%-----------------------------------------------------------------------------%
@@ -3311,11 +3321,13 @@
module_info::in, module_info::out, io::di, io::uo) is det.
mercury_compile__maybe_do_inlining(Verbose, Stats, !HLDS, !IO) :-
+ globals__io_lookup_bool_option(allow_inlining, Allow, !IO),
globals__io_lookup_bool_option(inline_simple, Simple, !IO),
globals__io_lookup_bool_option(inline_single_use, SingleUse, !IO),
globals__io_lookup_int_option(inline_compound_threshold, Threshold,
!IO),
(
+ Allow = yes,
( Simple = yes
; SingleUse = yes
; Threshold > 0
@@ -3565,6 +3577,77 @@
MaybeTransform = no
).
+:- pred mercury_compile__maybe_read_experimental_complexity_file(
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+mercury_compile__maybe_read_experimental_complexity_file(!HLDS, !IO) :-
+ globals__io_lookup_string_option(experimental_complexity, FileName,
+ !IO),
+ globals__io_lookup_bool_option(record_term_sizes_as_words,
+ RecordTermSizesAsWords, !IO),
+ globals__io_lookup_bool_option(record_term_sizes_as_cells,
+ RecordTermSizesAsCells, !IO),
+ bool__or(RecordTermSizesAsWords, RecordTermSizesAsCells,
+ RecordTermSizes),
+ ( FileName = "" ->
+% While we could include the following sanity check, it is overly
+% strong. For example, a bootcheck in a term size profiling grade
+% would have to supply an --experimental-complexity option for
+% both the stage3 compiler and the test cases. Since the runtime
+% checks that all procedures mentioned in the files actually
+% exist and are transformed by the compiler, this would require
+% a different complexity experiment file for each test case,
+% which is impractical.
+% (
+% RecordTermSizes = yes,
+% report_error("term size profiling grades require " ++
+% "the --experimental-complexity option", !IO)
+% ;
+% RecordTermSizes = no
+% )
+ true
+ ;
+ (
+ RecordTermSizes = yes
+ ;
+ RecordTermSizes = no,
+ report_error("the --experimental-complexity option " ++
+ "requires a term size profiling grade", !IO)
+ ),
+ complexity__read_spec_file(FileName, MaybeNumProcMap, !IO),
+ (
+ MaybeNumProcMap = ok(NumProcs - ProcMap),
+ module_info_set_maybe_complexity_proc_map(
+ yes(NumProcs - ProcMap), !HLDS)
+ ;
+ MaybeNumProcMap = error(Msg),
+ report_error(Msg, !IO)
+ )
+ ).
+
+:- pred mercury_compile__maybe_experimental_complexity(bool::in, bool::in,
+ module_info::in, module_info::out, io::di, io::uo) is det.
+
+mercury_compile__maybe_experimental_complexity(Verbose, Stats, !HLDS, !IO) :-
+ module_info_get_maybe_complexity_proc_map(!.HLDS, MaybeNumProcMap),
+ (
+ MaybeNumProcMap = no
+ ;
+ MaybeNumProcMap = yes(NumProcs - ProcMap),
+ maybe_write_string(Verbose,
+ "% Applying complexity experiment " ++
+ "transformation...\n",
+ !IO),
+ maybe_flush_output(Verbose, !IO),
+ process_all_nonimported_nonaditi_procs(
+ update_module_io(
+ complexity__process_proc_msg(NumProcs,
+ ProcMap)),
+ !HLDS, !IO),
+ maybe_write_string(Verbose, "% done.\n", !IO),
+ maybe_report_stats(Stats, !IO)
+ ).
+
:- pred mercury_compile__maybe_deep_profiling(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
@@ -3888,8 +3971,9 @@
AllData),
mercury_compile__construct_c_file(HLDS, C_InterfaceInfo,
Procs, GlobalVars, AllData, CFile, NumChunks, !IO),
- mercury_compile__output_llds(ModuleName, CFile, LayoutLabels,
- MaybeRLFile, Verbose, Stats, !IO),
+ module_info_get_complexity_proc_infos(HLDS, ComplexityProcs),
+ mercury_compile__output_llds(ModuleName, CFile, ComplexityProcs,
+ LayoutLabels, MaybeRLFile, Verbose, Stats, !IO),
C_InterfaceInfo = foreign_interface_info(_, _, _, _,
C_ExportDecls, _),
@@ -4042,18 +4126,19 @@
mercury_compile__combine_chunks_2(Chunks, ModuleName, Num1, Modules).
:- pred mercury_compile__output_llds(module_name::in, c_file::in,
- map(llds__label, llds__data_addr)::in, maybe(rl_file)::in,
- bool::in, bool::in, io::di, io::uo) is det.
+ list(complexity_proc_info)::in, map(llds__label, llds__data_addr)::in,
+ maybe(rl_file)::in, bool::in, bool::in, io::di, io::uo) is det.
-mercury_compile__output_llds(ModuleName, LLDS0, StackLayoutLabels, MaybeRLFile,
- Verbose, Stats, !IO) :-
+mercury_compile__output_llds(ModuleName, LLDS0, ComplexityProcs,
+ StackLayoutLabels, MaybeRLFile, Verbose, Stats, !IO) :-
maybe_write_string(Verbose, "% Writing output to `", !IO),
module_name_to_file_name(ModuleName, ".c", yes, FileName, !IO),
maybe_write_string(Verbose, FileName, !IO),
maybe_write_string(Verbose, "'...", !IO),
maybe_flush_output(Verbose, !IO),
transform_llds(LLDS0, LLDS, !IO),
- output_llds(LLDS, StackLayoutLabels, MaybeRLFile, !IO),
+ output_llds(LLDS, ComplexityProcs, StackLayoutLabels, MaybeRLFile,
+ !IO),
maybe_write_string(Verbose, " done.\n", !IO),
maybe_flush_output(Verbose, !IO),
maybe_report_stats(Stats, !IO).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.443
diff -u -r1.443 options.m
--- compiler/options.m 14 Feb 2005 05:42:28 -0000 1.443
+++ compiler/options.m 14 Feb 2005 05:45:56 -0000
@@ -235,6 +235,7 @@
; deep_profile_tail_recursion
; record_term_sizes_as_words
; record_term_sizes_as_cells
+ ; experimental_complexity
% (c) Aditi
; aditi
@@ -433,6 +434,7 @@
; transitive_optimization
; split_c_files
% - HLDS
+ ; allow_inlining
; inlining
; inline_simple
; inline_builtins
@@ -906,6 +908,7 @@
- bool(no),
record_term_sizes_as_words - bool(no),
record_term_sizes_as_cells - bool(no),
+ experimental_complexity - string(""),
% (c) Miscellaneous optional features
gc - string("boehm"),
parallel - bool(no),
@@ -1047,6 +1050,7 @@
% optimization level in the opt_level table.
%
% HLDS
+ allow_inlining - bool(yes),
inlining - bool_special,
inline_simple - bool(no),
inline_builtins - bool(yes),
@@ -1563,6 +1567,7 @@
deep_profile_tail_recursion).
long_option("record-term-sizes-as-words", record_term_sizes_as_words).
long_option("record-term-sizes-as-cells", record_term_sizes_as_cells).
+long_option("experimental-complexity", experimental_complexity).
% (c) miscellaneous optional features
long_option("gc", gc).
long_option("garbage-collection", gc).
@@ -3114,33 +3119,38 @@
"--deep-profiling\t\t(grade modifier: `.profdeep')",
"\tEnable deep profiling.",
"\tThis option is not supported for the high-level C, IL",
- "\tor Java back-ends."
-/*****************
-XXX The following options are not documented,
-because they are currently not useful.
-The idea was for you to be able to use --profile-calls
-and --profile-time separately, but that doesn't work
-because compiling with --profile-time instead of
---profile-calls results in different code addresses,
-so you can't combine the data from versions of
-your program compiled with different options.
-
- "--profile-calls\t\t(grade modifier: `.profcalls')",
- "\tSimilar to `--profiling', except that only gathers",
- "\tcall counts, not timing information.",
- "\tUseful on systems where time profiling is not supported,",
- "\tbut not as useful as `--memory-profiling'.",
- "--profile-time\t\t(grade modifier: `.proftime')",
- "\tSimilar to `--profiling', except that it only gathers",
- "\ttiming information, not call counts.",
- "--profile-memory\t\t(grade modifier: `.profmem')",
- "\tSimilar to `--memory-profiling', except that it only gathers",
- "\tmemory usage information, not call counts.",
-% "--record-term-sizes-as-words\t\t(grade modifier: `.tsw')",
-% "\tAugment each heap cells with its size in words.",
-% "--record-term-sizes-as-cells\t\t(grade modifier: `.tsc')",
-% "\tAugment each heap cells with its size in cells.",
-********************/
+ "\tor Java back-ends.",
+% XXX The following options are not documented,
+% because they are currently not useful.
+% The idea was for you to be able to use --profile-calls
+% and --profile-time separately, but that doesn't work
+% because compiling with --profile-time instead of
+% --profile-calls results in different code addresses,
+% so you can't combine the data from versions of
+% your program compiled with different options.
+%
+% "--profile-calls\t\t(grade modifier: `.profcalls')",
+% "\tSimilar to `--profiling', except that only gathers",
+% "\tcall counts, not timing information.",
+% "\tUseful on systems where time profiling is not supported,",
+% "\tbut not as useful as `--memory-profiling'.",
+% "--profile-time\t\t(grade modifier: `.proftime')",
+% "\tSimilar to `--profiling', except that it only gathers",
+% "\ttiming information, not call counts.",
+% "--profile-memory\t\t(grade modifier: `.profmem')",
+% "\tSimilar to `--memory-profiling', except that it only",
+% "\tgathers memory usage information, not call counts.",
+
+ "--record-term-sizes-as-words\t\t(grade modifier: `.tsw')",
+ "\tAugment each heap cells with its size in words.",
+ "--record-term-sizes-as-cells\t\t(grade modifier: `.tsc')",
+ "\tAugment each heap cells with its size in cells.",
+
+ "--experimental-complexity=<filename>\t\t",
+ "\tEnable experimental complexity analysis for the predicates",
+ "\tlisted in the given file.",
+ "\tThis option is supported for the C back-end, with",
+ "\t--no-highlevel-code."
]),
io__write_string(" Aditi\n"),
write_tabbed_lines([
Index: compiler/size_prof.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/size_prof.m,v
retrieving revision 1.14
diff -u -r1.14 size_prof.m
--- compiler/size_prof.m 24 Jan 2005 02:13:40 -0000 1.14
+++ compiler/size_prof.m 24 Jan 2005 03:28:36 -0000
@@ -790,6 +790,14 @@
ArgGoals = []
; zero_size_type(Type, !.Info ^ module_info) ->
ArgGoals = []
+ ; type_is_higher_order(Type, _, _, _, _) ->
+ % Even if higher order types are not zero size for thes
+ % termination analyzer, they are zero size for us.
+ % If the type is a function type, then make_type_info below
+ % would in any case throw an exception, because it can't
+ % construct a function type with an empty list of arguments
+ % (since it has no return value type).
+ ArgGoals = []
;
make_type_info(Context, Type, TypeInfoVar, TypeInfoGoals,
!Info),
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.77
diff -u -r1.77 table_gen.m
--- compiler/table_gen.m 1 Feb 2005 07:11:38 -0000 1.77
+++ compiler/table_gen.m 2 Feb 2005 01:48:06 -0000
@@ -686,7 +686,8 @@
InactiveGoalExpr = conj([OrigGoal, MarkInactiveGoal])
;
CodeModel = model_semi,
- create_renaming(OutputVars, !VarTypes, !VarSet,
+ goal_info_get_instmap_delta(OrigGoalInfo, InstMapDelta),
+ create_renaming(OutputVars, InstMapDelta, !VarTypes, !VarSet,
Unifies, NewVars, Renaming),
rename_vars_in_goal(OrigGoal, Renaming, RenamedOrigGoal),
@@ -930,8 +931,8 @@
]
;
CodeModel = model_semi,
- create_renaming(OutputVars, !VarTypes, !VarSet,
- Unifies, NewVars, Renaming),
+ create_renaming(OutputVars, OrigInstMapDelta,
+ !VarTypes, !VarSet, Unifies, NewVars, Renaming),
rename_vars_in_goal(OrigGoal, Renaming, RenamedOrigGoal),
ThenGoalExpr = conj(list__append(Unifies, SaveAnswerGoals)),
@@ -1791,45 +1792,6 @@
keep_marker(does_not_terminate) = yes.
keep_marker(check_termination) = no.
keep_marker(calls_are_fully_qualified) = yes.
-
-%-----------------------------------------------------------------------------%
-
-:- pred create_renaming(list(prog_var)::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out, list(hlds_goal)::out,
- list(prog_var)::out, map(prog_var, prog_var)::out) is det.
-
-create_renaming(OrigVars, !VarTypes, !VarSet, Unifies, NewVars, Renaming) :-
- create_renaming_2(OrigVars, !VarTypes, !VarSet, [], RevUnifies,
- [], RevNewVars, map__init, Renaming),
- list__reverse(RevNewVars, NewVars),
- list__reverse(RevUnifies, Unifies).
-
-:- pred create_renaming_2(list(prog_var)::in, vartypes::in, vartypes::out,
- prog_varset::in, prog_varset::out,
- list(hlds_goal)::in, list(hlds_goal)::out,
- list(prog_var)::in, list(prog_var)::out,
- map(prog_var, prog_var)::in, map(prog_var, prog_var)::out) is det.
-
-create_renaming_2([], !VarTypes, !VarSet, !RevUnifies, !RevNewVars, !Renaming).
-create_renaming_2([OrigVar | OrigVars], !VarTypes, !VarSet, !RevUnifies,
- !RevNewVars, !Renaming) :-
- varset__new_var(!.VarSet, NewVar, !:VarSet),
- map__lookup(!.VarTypes, OrigVar, Type),
- map__det_insert(!.VarTypes, NewVar, Type, !:VarTypes),
- Ground = ground(shared, none),
- Mode = ((Ground -> Ground) - (free -> Ground)),
- UnifyInfo = assign(OrigVar, NewVar),
- UnifyContext = unify_context(explicit, []),
- GoalExpr = unify(OrigVar, var(NewVar), Mode, UnifyInfo, UnifyContext),
- set__list_to_set([OrigVar, NewVar], NonLocals),
- goal_info_init_hide(NonLocals, bind_vars([OrigVar]), det, pure,
- term__context_init, GoalInfo),
- Goal = GoalExpr - GoalInfo,
- !:RevUnifies = [Goal | !.RevUnifies],
- map__det_insert(!.Renaming, OrigVar, NewVar, !:Renaming),
- !:RevNewVars = [NewVar | !.RevNewVars],
- create_renaming_2(OrigVars, !VarTypes, !VarSet, !RevUnifies,
- !RevNewVars, !Renaming).
%-----------------------------------------------------------------------------%
Index: compiler/transform_hlds.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/transform_hlds.m,v
retrieving revision 1.14
diff -u -r1.14 transform_hlds.m
--- compiler/transform_hlds.m 2 Feb 2005 02:58:42 -0000 1.14
+++ compiler/transform_hlds.m 2 Feb 2005 05:01:07 -0000
@@ -27,6 +27,8 @@
:- include_module table_gen.
+:- include_module complexity.
+
:- include_module (lambda).
:- include_module termination.
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.96
diff -u -r1.96 compiler_design.html
--- compiler/notes/compiler_design.html 22 Jan 2005 06:10:54 -0000 1.96
+++ compiler/notes/compiler_design.html 24 Jan 2005 03:28:37 -0000
@@ -891,8 +891,8 @@
<p>
-The last two HLDS-to-HLDS transformations implement
-term size profiling (size_prof.m) and
+The last three HLDS-to-HLDS transformations implement
+term size profiling (size_prof.m and complexity.m) and
deep profiling (deep_profiling.m, in the ll_backend.m package).
Both passes insert into procedure bodies, among other things,
calls to procedures (some of which are impure)
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.419
diff -u -r1.419 user_guide.texi
--- doc/user_guide.texi 14 Feb 2005 08:03:59 -0000 1.419
+++ doc/user_guide.texi 14 Feb 2005 08:35:50 -0000
@@ -5903,10 +5903,8 @@
@findex --profiling
@findex --memory-profiling
@findex --deep-profiling
- at c The following are undocumented because they are not yet useful,
- at c and thus are not yet for public consumption.
- at c @findex --record-term-sizes-as-words
- at c @findex --record-term-sizes-as-cells
+ at findex --record-term-sizes-as-words
+ at findex --record-term-sizes-as-cells
@item @samp{none}
@code{--target c --no-gcc-global-registers --no-gcc-nonlocal-gotos --no-asm-labels}.
@@ -5974,13 +5972,11 @@
@item @samp{.tr}
@code{--use-trail}.
- at c The following are undocumented because they are not yet useful,
- at c and thus are not yet for public consumption.
- at c @item @samp{.tsw}
- at c @code{--record-term-sizes-as-words}.
- at c
- at c @item @samp{.tsc}
- at c @code{--record-term-sizes-as-cells}.
+ at item @samp{.tsw}
+ at code{--record-term-sizes-as-words}.
+
+ at item @samp{.tsc}
+ at code{--record-term-sizes-as-cells}.
@item @samp{.rt}
@code{--reserve-tag}.
@@ -6200,9 +6196,6 @@
@end ignore
- at ignore
- The following are not yet useful, and hence undocumented.
-
@sp 1
@item @code{--record-term-sizes-as-words} (grades: any grade containing @samp{.tsw})
@findex --record-term-sizes-as-words
@@ -6213,7 +6206,13 @@
@findex --record-term-sizes-as-cells
Record the sizes of terms, using one cell as the unit of memory.
- at end ignore
+ at sp 1
+ at item @code{--experimental-complexity @var{filename}}
+ at findex --experimental-complexity
+Enable experimental complexity analysis
+for the predicates listed in the given file.
+This option is supported for the C back-end, with --no-highlevel-code.
+For now, this option itself is for developers only.
@sp 1
@item @code{--gc @{none, boehm, mps, accurate, automatic@}}
@@ -6642,6 +6641,9 @@
data structure).
@table @code
+ at c @item --no-allow-inlining
+ at c This option is meant to used only inside the compiler;
+ at c its effect is the same as plain --no-inlining
@item --no-inlining
@findex --no-inlining
@findex --inlining
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/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/easyx
cvs diff: Diffing extras/graphics/easyx/samples
cvs diff: Diffing extras/graphics/mercury_glut
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/gears
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
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/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/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 extras/xml_stylesheets
cvs diff: Diffing java
cvs diff: Diffing java/runtime
cvs diff: Diffing library
Index: library/term_size_prof_builtin.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/term_size_prof_builtin.m,v
retrieving revision 1.2
diff -u -r1.2 term_size_prof_builtin.m
--- library/term_size_prof_builtin.m 23 Dec 2003 03:10:18 -0000 1.2
+++ library/term_size_prof_builtin.m 24 Jul 2004 09:49:39 -0000
@@ -44,6 +44,25 @@
% procedure elimination.
:- func term_size_plus(int, int) = int.
+ % We want to take measurements only of the top-level invocations of
+ % the procedures in the complexity experiment, not the recursive
+ % invocations. This type says whether we are already executing the
+ % relevant procedure. Its definition should be kept in sync with
+ % MR_ComplexityIsActive in runtime/mercury_term_size.h.
+:- type complexity_is_active ---> is_inactive ; is_active.
+
+ % For each procedure in the complexity experiment, we can take
+ % measurements for many different top-level invocations. Values
+ % of the complexity_slot type identify one of these invocations.
+:- type complexity_slot == int.
+
+:- impure pred complexity_is_active(complexity_is_active::out) is det.
+
+:- impure pred complexity_call_proc(complexity_slot::out) is det.
+:- impure pred complexity_exit_proc(complexity_slot::in) is det.
+:- impure pred complexity_fail_proc(complexity_slot::in) is failure.
+:- impure pred complexity_redo_proc(complexity_slot::in) is failure.
+
%---------------------------------------------------------------------------%
:- implementation.
@@ -81,6 +100,13 @@
#endif
}").
+measure_size(_Value, Size) :-
+ ( semidet_succeed ->
+ error("measure_size: not implemented")
+ ;
+ Size = 0
+ ).
+
:- pragma foreign_proc("C",
measure_size_acc(Term::in, Size0::in, Size::out),
[thread_safe, promise_pure, will_not_call_mercury],
@@ -101,6 +127,13 @@
#endif
}").
+measure_size_acc(_Value, Size0, Size) :-
+ ( semidet_succeed ->
+ error("measure_size_acc: not implemented")
+ ;
+ Size = Size0
+ ).
+
:- pragma foreign_proc("C",
increment_size(Term::in, Incr::in),
[thread_safe, will_not_call_mercury],
@@ -117,3 +150,78 @@
MR_fatal_error(""increment_size: term size profiling not enabled"");
#endif
}").
+
+increment_size(_Value, _Incr) :-
+ private_builtin__imp.
+
+%---------------------------------------------------------------------------%
+
+% None of the following predicates are designed to be called directly;
+% they are designed only to hang foreign_procs onto.
+
+:- pragma foreign_proc("C",
+ complexity_is_active(IsActive::out),
+ [thread_safe, will_not_call_mercury],
+"
+ /* mention IsActive to avoid warning */
+ MR_fatal_error(""complexity_mark_active"");
+").
+
+:- pragma foreign_proc("C",
+ complexity_call_proc(Slot::out),
+ [thread_safe, will_not_call_mercury],
+"
+ /* mention Slot to avoid warning */
+ MR_fatal_error(""complexity_call_proc"");
+").
+
+:- pragma foreign_proc("C",
+ complexity_exit_proc(Slot::in),
+ [thread_safe, will_not_call_mercury],
+"
+ /* mention Slot to avoid warning */
+ MR_fatal_error(""complexity_exit_proc"");
+").
+
+:- pragma foreign_proc("C",
+ complexity_fail_proc(Slot::in),
+ [thread_safe, will_not_call_mercury],
+"
+ /* mention Slot to avoid warning */
+ MR_fatal_error(""complexity_fail_proc"");
+").
+
+:- pragma foreign_proc("C",
+ complexity_redo_proc(Slot::in),
+ [thread_safe, will_not_call_mercury],
+"
+ /* mention Slot to avoid warning */
+ MR_fatal_error(""complexity_redo_proc"");
+").
+
+complexity_is_active(IsActive) :-
+ private_builtin__imp,
+ ( semidet_succeed ->
+ error("complexity_mark_active: not implemented")
+ ;
+ % Required only to avoid warnings; never executed.
+ IsActive = is_active
+ ).
+
+complexity_call_proc(Slot) :-
+ private_builtin__imp,
+ % Required only to avoid warnings; never executed.
+ private_builtin__unsafe_type_cast(0, Slot).
+
+complexity_exit_proc(_Slot) :-
+ private_builtin__imp.
+
+complexity_fail_proc(_Slot) :-
+ private_builtin__imp,
+ fail.
+
+complexity_redo_proc(_Slot) :-
+ private_builtin__imp,
+ fail.
+
+%---------------------------------------------------------------------------%
cvs diff: Diffing mdbcomp
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.118
diff -u -r1.118 Mmakefile
--- runtime/Mmakefile 1 Feb 2005 03:24:26 -0000 1.118
+++ runtime/Mmakefile 1 Feb 2005 03:28:50 -0000
@@ -30,6 +30,7 @@
mercury_builtin_types.h \
mercury_builtin_types_proc_layouts.h \
mercury_calls.h \
+ mercury_complexity.h \
mercury_conf_bootstrap.h \
mercury_conf.h \
mercury_conf_param.h \
Index: runtime/mercury_complexity.h
===================================================================
RCS file: runtime/mercury_complexity.h
diff -N runtime/mercury_complexity.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_complexity.h 25 Jul 2004 15:31:04 -0000
@@ -0,0 +1,114 @@
+/*
+** vim:ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2003 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_complexity.h
+**
+** This module defines the structures returning the sizes of terms.
+*/
+
+#ifndef MR_MERCURY_COMPLEXITY_H
+#define MR_MERCURY_COMPLEXITY_H
+
+#define MR_COMPLEXITY_SLOTS_PER_CHUNK 1024
+
+/*
+** This type should correspond to the representation of the
+** complexity_is_active type in library/term_size_prof_builtin.m.
+*/
+
+typedef struct MR_ComplexityProc_Struct MR_ComplexityProc;
+
+typedef enum {
+ MR_COMPLEXITY_INPUT_VAR_SIZE,
+ MR_COMPLEXITY_INPUT_FIX_SIZE,
+ MR_COMPLEXITY_OUTPUT
+} MR_ComplexityArgKind;
+
+typedef struct {
+ const char *MR_clpai_maybe_name;
+ MR_ComplexityArgKind MR_clpai_kind;
+} MR_ComplexityArgInfo;
+
+typedef enum {
+ MR_COMPLEXITY_IS_INACTIVE,
+ MR_COMPLEXITY_IS_ACTIVE
+} MR_ComplexityIsActive;
+
+typedef int MR_ComplexityCounter;
+
+typedef struct {
+ MR_ComplexityCounter MR_clpm_num_words;
+ MR_ComplexityCounter MR_clpm_num_cells;
+ MR_ComplexityCounter MR_clpm_num_ticks;
+} MR_ComplexityMetrics;
+
+typedef struct MR_ComplexityPastSlots_Struct MR_ComplexityPastSlots;
+
+struct MR_ComplexityPastSlots_Struct {
+ MR_ComplexityMetrics *MR_clpps_metrics;
+ int *MR_clpps_sizes;
+ MR_ComplexityPastSlots *MR_clpps_previous;
+};
+
+/*
+** The MR_ComplexityProc structure contains all the information we have
+** about a procedure whose complexity we are trying to determine
+** experimentally.
+**
+** The MR_clp_full_proc_name field contains the name of the procedure. The
+** format of the name is name/arity-modenum, where name is the a fully module
+** qualified predicate or function name, arity is the user arity (not including
+** the return value for functions), and modenum is the mode number. This field
+** is initialized in the program's mkinit-generated _init.c file and never
+** modified later, but is sanity-checked on every invocation of
+** MR_complexity_is_active.
+**
+** The MR_clp_num_profiled_args field contains the number of profiled input
+** arguments of the procedure.
+** XXX
+** It is initialized and re-initialized on every invocation of
+** MR_complexity_is_active.
+**
+** The MR_clp_is_active field specifies whether the procedure is currently
+** being executed. It is initialized in the program's _init.c file, and updated
+** as necessary by the macros we invoke at the call, exit, fail and redo ports.
+**
+** The MR_clp_metrics field points to an array of MR_COMPLEXITY_SLOTS_PER_CHUNK
+** elements, while the MR_clp_sizes field point to an array of
+** MR_COMPLEXITY_SLOTS_PER_CHUNK times MR_clp_num_profiled_args elements.
+**
+** Each top-level invocation of the procedure allocates a "slot" for its
+** measurement. The slot consists of one element of the MR_clp_metrics array
+** and MR_clp_num_profiled_args consecutive elements of the MR_clp_sizes array.
+** The MR_clp_next_slot_num identifies the next available slot.
+**
+** When we have used up all the slots in the MR_clp_metrics and MR_clp_sizes
+** arrays, we allocate a MR_ComplexityPastSlots structure, move those arrays to
+** the new structure, and allocate a fresh pair of arrays.
+**
+** The full set of measurements for a procedure is thus the initial
+** MR_clp_next_slot_num elements of the MR_clp_metrics and MR_clp_sizes arrays,
+** and the MR_COMPLEXITY_SLOTS_PER_CHUNK elements of each structure linked
+** via MR_clp_past_slots.
+*/
+
+struct MR_ComplexityProc_Struct {
+ const char *MR_clp_full_proc_name;
+ int MR_clp_num_profiled_args;
+ int MR_clp_num_args;
+ MR_ComplexityArgInfo *MR_clp_arg_infos;
+ MR_ComplexityIsActive MR_clp_is_active;
+ MR_ComplexityPastSlots *MR_clp_past_slots;
+ int MR_clp_next_slot_num;
+ MR_ComplexityMetrics *MR_clp_metrics;
+ int *MR_clp_sizes;
+};
+
+#endif /* MR_MERCURY_COMPLEXITY_H */
Index: runtime/mercury_heap.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_heap.h,v
retrieving revision 1.33
diff -u -r1.33 mercury_heap.h
--- runtime/mercury_heap.h 15 Dec 2004 06:57:50 -0000 1.33
+++ runtime/mercury_heap.h 15 Dec 2004 07:11:32 -0000
@@ -194,8 +194,19 @@
#endif /* not MR_CONSERVATIVE_GC */
+#ifdef MR_RECORD_TERM_SIZES
+ #define MR_maybe_increment_allocation_counters(count) \
+ ( \
+ MR_complexity_word_counter += (count), \
+ MR_complexity_cell_counter += 1 \
+ )
+#else
+ #define MR_maybe_increment_allocation_counters(count) \
+ ((void) 0)
+#endif
+
#if defined (MR_DEEP_PROFILING) && defined(MR_DEEP_PROFILING_MEMORY)
- #define MR_maybe_record_allocation(count, proclabel, type) \
+ #define MR_prof_record_allocation(count, proclabel, type) \
( \
MR_current_call_site_dynamic->MR_csd_own.MR_own_allocs \
+= 1, \
@@ -203,13 +214,19 @@
+= (count) \
)
#elif defined(MR_MPROF_PROFILE_MEMORY)
- #define MR_maybe_record_allocation(count, proclabel, type) \
+ #define MR_prof_record_allocation(count, proclabel, type) \
MR_record_allocation((count), MR_ENTRY(proclabel), \
MR_STRINGIFY(proclabel), (type))
#else
- #define MR_maybe_record_allocation(count, proclabel, type) \
+ #define MR_prof_record_allocation(count, proclabel, type) \
((void) 0)
#endif
+
+#define MR_maybe_record_allocation(count, proclabel, type) \
+ ( \
+ MR_prof_record_allocation((count), proclabel, (type)), \
+ MR_maybe_increment_allocation_counters(count) \
+ )
#define MR_tag_offset_incr_hp_msg(dest, tag, offset, count, proclabel, type) \
( \
Index: runtime/mercury_imp.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_imp.h,v
retrieving revision 1.24
diff -u -r1.24 mercury_imp.h
--- runtime/mercury_imp.h 20 Oct 2004 09:45:10 -0000 1.24
+++ runtime/mercury_imp.h 10 Nov 2004 03:04:06 -0000
@@ -91,6 +91,7 @@
#endif
#include "mercury_univ.h"
+#include "mercury_complexity.h"
#include "mercury_term_size.h"
#include "mercury_grade.h"
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.44
diff -u -r1.44 mercury_init.h
--- runtime/mercury_init.h 15 Dec 2004 06:57:50 -0000 1.44
+++ runtime/mercury_init.h 15 Dec 2004 07:11:32 -0000
@@ -87,6 +87,7 @@
#include "mercury_trace_base.h" /* for MR_trace_port */
#include "mercury_type_info.h" /* for MR_TypeCtorInfo_Struct */
#include "mercury_library_types.h" /* for MercuryFilePtr */
+#include "mercury_complexity.h" /* for MR_ComplexityProc */
#ifdef MR_CONSERVATIVE_GC
#ifdef MR_MPS_GC
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.35
diff -u -r1.35 mercury_tabling.h
--- runtime/mercury_tabling.h 30 Jul 2004 04:58:38 -0000 1.35
+++ runtime/mercury_tabling.h 2 Aug 2004 02:52:38 -0000
@@ -309,14 +309,6 @@
#define MR_TABLE_RESIZE_ARRAY(ptr, type, count) \
MR_GC_RESIZE_ARRAY((ptr), type, (count))
-#if 0
- #define MR_table_allocate_bytes(size) \
- MR_GC_malloc((size))
-
- #define MR_table_reallocate_bytes(pointer, size) \
- MR_GC_realloc((pointer), (size))
-#endif
-
#define MR_table_allocate_words(size) \
((MR_Word *) MR_GC_malloc(sizeof(MR_Word) * (size)))
Index: runtime/mercury_term_size.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_term_size.c,v
retrieving revision 1.3
diff -u -r1.3 mercury_term_size.c
--- runtime/mercury_term_size.c 24 Jan 2005 02:13:42 -0000 1.3
+++ runtime/mercury_term_size.c 24 Jan 2005 03:28:44 -0000
@@ -14,9 +14,23 @@
*/
#include "mercury_imp.h"
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <string.h>
#ifdef MR_RECORD_TERM_SIZES
+MR_ComplexityCounter MR_complexity_word_counter = 0;
+MR_ComplexityCounter MR_complexity_cell_counter = 0;
+MR_ComplexityCounter MR_complexity_tick_counter = 0;
+
+static void MR_write_complexity_proc(MR_ComplexityProc *proc);
+static void MR_complexity_output_args_desc(FILE *fp,
+ MR_ComplexityProc *proc);
+
MR_Unsigned
MR_term_size(MR_TypeInfo type_info, MR_Word term)
{
@@ -310,6 +324,380 @@
}
MR_fatal_error("MR_term_size: unexpected fallthrough");
+}
+
+void
+MR_write_complexity_procs(void)
+{
+ int proc_num;
+ MR_ComplexityProc *proc;
+
+ for (proc_num = 0; proc_num < MR_num_complexity_procs; proc_num++) {
+ proc = &MR_complexity_procs[proc_num];
+ if (proc->MR_clp_num_profiled_args >= 0) {
+ MR_write_complexity_proc(proc);
+ }
+ }
+}
+
+#define MR_COMPLEXITY_ARGS_DIR "ComplexityArgs"
+#define MR_COMPLEXITY_DATA_DIR "ComplexityData"
+
+static MR_bool MR_have_created_complexity_dirs = MR_FALSE;
+static MR_bool MR_have_printed_complexity_dirs_error = MR_FALSE;
+
+static void
+MR_write_complexity_proc(MR_ComplexityProc *proc)
+{
+ char *full_proc_name;
+ int full_proc_name_len;
+ FILE *fp;
+ char *args_filename;
+ char *data_filename;
+ const char *data_filemode;
+ struct stat statbuf;
+ char *slash;
+ MR_ComplexityMetrics *metrics;
+ int num_profiled_args;
+ int *sizes;
+ int num_slots;
+ MR_ComplexityPastSlots *past_slots;
+ char *cmd_buf;
+
+ full_proc_name_len = strlen(proc->MR_clp_full_proc_name);
+ full_proc_name = MR_malloc(100 + full_proc_name_len);
+ strcpy(full_proc_name, proc->MR_clp_full_proc_name);
+
+ /*
+ ** We can't have slash characters in the filenames we construct from
+ ** full_proc_name.
+ */
+ while ((slash = strchr(full_proc_name, '/')) != NULL) {
+ *slash = ':';
+ }
+
+ cmd_buf = MR_malloc(100 + 2 * full_proc_name_len);
+ /* will be big enough */
+
+ if (! MR_have_created_complexity_dirs) {
+ sprintf(cmd_buf, "mkdir -p %s %s",
+ MR_COMPLEXITY_ARGS_DIR, MR_COMPLEXITY_DATA_DIR);
+ if (system(cmd_buf) != 0) {
+ if (! MR_have_printed_complexity_dirs_error) {
+ fprintf(stderr, "%s: cannot create %s and %s: %s\n",
+ MR_progname, MR_COMPLEXITY_ARGS_DIR,
+ MR_COMPLEXITY_DATA_DIR, strerror(errno));
+ /* there is no point in aborting */
+ MR_have_printed_complexity_dirs_error = MR_TRUE;
+ return;
+ }
+ }
+ MR_have_created_complexity_dirs = MR_TRUE;
+ }
+
+ args_filename = MR_malloc(100 + full_proc_name_len);
+ /* will be big enough */
+ sprintf(args_filename, "%s/%s", MR_COMPLEXITY_ARGS_DIR, full_proc_name);
+
+ if (stat(args_filename, &statbuf) != 0) {
+ /* args_filename does not exist */
+ fp = fopen(args_filename, "w");
+ if (fp == NULL) {
+ fprintf(stderr, "%s: cannot open %s: %s\n",
+ MR_progname, args_filename, strerror(errno));
+ /* there is no point in aborting */
+ return;
+ }
+
+ MR_complexity_output_args_desc(fp, proc);
+ fclose(fp);
+ data_filemode = "w";
+ } else {
+ /* args_filename does exist */
+ char *tmp_filename;
+
+ tmp_filename = MR_malloc(100 + full_proc_name_len);
+ sprintf(tmp_filename, "%s/%s.tmp",
+ MR_COMPLEXITY_ARGS_DIR, full_proc_name);
+ fp = fopen(tmp_filename, "w");
+ if (fp == NULL) {
+ fprintf(stderr, "%s: cannot open %s: %s\n",
+ MR_progname, tmp_filename, strerror(errno));
+ /* there is no point in aborting */
+ return;
+ }
+
+ MR_complexity_output_args_desc(fp, proc);
+ fclose(fp);
+
+ sprintf(cmd_buf, "cmp -s %s %s", args_filename, tmp_filename);
+ if (system(cmd_buf) == 0) {
+ /* the files are identical */
+ (void) unlink(tmp_filename);
+ data_filemode = "a";
+ } else {
+ /* the files are different */
+ rename(tmp_filename, args_filename);
+ data_filemode = "w";
+ }
+ }
+
+ data_filename = MR_malloc(100 + full_proc_name_len);
+ sprintf(data_filename, "%s/%s", MR_COMPLEXITY_DATA_DIR, full_proc_name);
+
+ fp = fopen(data_filename, data_filemode);
+ if (fp == NULL) {
+ fprintf(stderr, "%s: cannot open %s: %s\n",
+ MR_progname, data_filename, strerror(errno));
+ /* there is no point in aborting */
+ return;
+ }
+
+ num_profiled_args = proc->MR_clp_num_profiled_args;
+
+ metrics = proc->MR_clp_metrics;
+ sizes = proc->MR_clp_sizes;
+ num_slots = proc->MR_clp_next_slot_num;
+ past_slots = proc->MR_clp_past_slots;
+
+ do {
+ int slot, arg;
+
+ for (slot = num_slots - 1; slot >= 0; slot--) {
+ fprintf(fp, "%d %d %d",
+ metrics[slot].MR_clpm_num_words,
+ metrics[slot].MR_clpm_num_cells,
+ metrics[slot].MR_clpm_num_ticks);
+
+ for (arg = 0; arg < num_profiled_args; arg++) {
+ fprintf(fp, " %d", sizes[slot * num_profiled_args + arg]);
+ }
+
+ fprintf(fp, "\n");
+ }
+
+ if (past_slots == NULL) {
+ break;
+ }
+
+ metrics = past_slots->MR_clpps_metrics;
+ sizes = past_slots->MR_clpps_sizes;
+ num_slots = MR_COMPLEXITY_SLOTS_PER_CHUNK;
+ past_slots = past_slots->MR_clpps_previous;
+ } while (MR_TRUE);
+
+ (void) fclose(fp);
+}
+
+static void
+MR_complexity_output_args_desc(FILE *fp, MR_ComplexityProc *proc)
+{
+ int arg;
+ int num_args;
+ MR_ComplexityArgInfo *arg_infos;
+
+ arg_infos = proc->MR_clp_arg_infos;
+ num_args = proc->MR_clp_num_args;
+
+ for (arg = 0; arg < num_args; arg++) {
+ if (arg_infos[arg].MR_clpai_maybe_name != NULL) {
+ fprintf(fp, "%s ", arg_infos[arg].MR_clpai_maybe_name);
+ } else {
+ fprintf(fp, "_ ");
+ }
+
+ switch (arg_infos[arg].MR_clpai_kind) {
+ case MR_COMPLEXITY_INPUT_VAR_SIZE:
+ fprintf(fp, "profiled_input\n");
+ break;
+ case MR_COMPLEXITY_INPUT_FIX_SIZE:
+ fprintf(fp, "unprofiled_input\n");
+ break;
+ case MR_COMPLEXITY_OUTPUT:
+ fprintf(fp, "output\n");
+ break;
+ default:
+ fprintf(fp, "unknown\n");
+ break;
+ }
+ }
+}
+
+void
+MR_init_complexity_proc(int proc_num, const char *fullname,
+ int num_profiled_args, int num_args, MR_ComplexityArgInfo *arg_infos)
+{
+ MR_ComplexityProc *proc;
+
+ if (MR_complexity_procs == NULL) {
+ fprintf(stderr, "%s: executable wasn't fully prepared "
+ "for complexity experiment\n", MR_progname);
+ exit(1);
+ }
+
+ proc = &MR_complexity_procs[proc_num];
+ if (! MR_streq(fullname, proc->MR_clp_full_proc_name)) {
+ fprintf(stderr, "%s: proc_num %d is %s: expected %s\n",
+ MR_progname, proc_num, proc->MR_clp_full_proc_name, fullname);
+ exit(1);
+ }
+
+ if (proc->MR_clp_num_profiled_args >= 0) {
+ fprintf(stderr, "%s: proc_num %d: duplicate initialization\n",
+ MR_progname, proc_num);
+ exit(1);
+ }
+
+ if (num_profiled_args < 0) {
+ fprintf(stderr, "%s: proc_num %d: bad num_profiled_args\n",
+ MR_progname, proc_num);
+ exit(1);
+ }
+
+ proc->MR_clp_num_profiled_args = num_profiled_args;
+ proc->MR_clp_num_args = num_args;
+ proc->MR_clp_arg_infos = arg_infos;
+
+ proc->MR_clp_metrics = MR_NEW_ARRAY(MR_ComplexityMetrics,
+ MR_COMPLEXITY_SLOTS_PER_CHUNK);
+ proc->MR_clp_sizes = MR_NEW_ARRAY(int,
+ MR_COMPLEXITY_SLOTS_PER_CHUNK * num_profiled_args);
+}
+
+void
+MR_check_complexity_init(void)
+{
+ int proc_num;
+ MR_bool printed_heading;
+ MR_ComplexityProc *proc;
+
+ printed_heading = MR_FALSE;
+ for (proc_num = 0; proc_num < MR_num_complexity_procs; proc_num++) {
+ proc = &MR_complexity_procs[proc_num];
+
+ if (proc->MR_clp_num_profiled_args < 0) {
+ if (! printed_heading) {
+ fprintf(stderr, "%s: the following procedures are "
+ "not available for complexity experiment:\n",
+ MR_progname);
+ printed_heading = MR_TRUE;
+ }
+
+ fprintf(stderr, "%s\n", proc->MR_clp_full_proc_name);
+ }
+ }
+
+ if (printed_heading) {
+ exit(1);
+ }
+}
+
+MR_ComplexityIsActive
+MR_complexity_is_active_func(int num_procs, int proc_num, const char *name,
+ int num_profiled_inputs)
+{
+ MR_ComplexityProc *proc;
+
+ if (num_procs != MR_num_complexity_procs || MR_complexity_procs == NULL) {
+ fprintf(stderr, "%s: executable wasn't fully prepared "
+ "for complexity experiment\n", MR_progname);
+ exit(1);
+ }
+
+ if (proc_num >= num_procs) {
+ fprintf(stderr, "%s: proc_num %d >= num_procs %d\n",
+ MR_progname, proc_num, num_procs);
+ exit(1);
+ }
+
+ proc = &MR_complexity_procs[proc_num];
+ if (! MR_streq(name, proc->MR_clp_full_proc_name)) {
+ fprintf(stderr, "%s: proc_num %d is %s: expected %s\n",
+ MR_progname, proc_num, proc->MR_clp_full_proc_name, name);
+ exit(1);
+ }
+
+ if (proc->MR_clp_num_profiled_args != num_profiled_inputs) {
+ fprintf(stderr, "%s: proc_num %d: bad num_profiled_inputs\n",
+ MR_progname, proc_num);
+ exit(1);
+ }
+
+ return proc->MR_clp_is_active;
+}
+
+int
+MR_complexity_call_func(int procnum)
+{
+ MR_ComplexityProc *proc;
+ MR_ComplexityMetrics *metrics;
+ int slot;
+
+ proc = &MR_complexity_procs[procnum];
+ slot = proc->MR_clp_next_slot_num;
+ if (slot < MR_COMPLEXITY_SLOTS_PER_CHUNK) {
+ proc->MR_clp_next_slot_num++;
+ } else {
+ MR_ComplexityPastSlots *past_slots;
+
+ past_slots = MR_NEW(MR_ComplexityPastSlots);
+ past_slots->MR_clpps_metrics = proc->MR_clp_metrics;
+ past_slots->MR_clpps_sizes = proc->MR_clp_sizes;
+ past_slots->MR_clpps_previous = proc->MR_clp_past_slots;
+ proc->MR_clp_past_slots = past_slots;
+
+ proc->MR_clp_metrics = MR_NEW_ARRAY(MR_ComplexityMetrics,
+ MR_COMPLEXITY_SLOTS_PER_CHUNK);
+ proc->MR_clp_sizes = MR_NEW_ARRAY(int,
+ MR_COMPLEXITY_SLOTS_PER_CHUNK * proc->MR_clp_num_profiled_args);
+ proc->MR_clp_next_slot_num = 1;
+ slot = 0;
+ }
+ metrics = &proc->MR_clp_metrics[slot];
+ metrics->MR_clpm_num_words -= MR_complexity_word_counter;
+ metrics->MR_clpm_num_cells -= MR_complexity_cell_counter;
+ metrics->MR_clpm_num_ticks -= MR_complexity_tick_counter;
+ proc->MR_clp_is_active = MR_COMPLEXITY_IS_ACTIVE;
+
+ return slot;
+}
+
+void
+MR_complexity_fill_size_slot(MR_ComplexityProc *proc, int slot,
+ int num_profiled_args, int argnum, int size)
+{
+ MR_ComplexityCounter *sizes;
+
+ sizes = proc->MR_clp_sizes;
+ sizes[(slot * proc->MR_clp_num_profiled_args) + argnum] = size;
+}
+
+void
+MR_complexity_leave_func(int procnum, int slot)
+{
+ MR_ComplexityProc *proc;
+ MR_ComplexityMetrics *metrics;
+
+ proc = &MR_complexity_procs[procnum];
+ metrics = &proc->MR_clp_metrics[slot];
+ metrics->MR_clpm_num_words += MR_complexity_word_counter;
+ metrics->MR_clpm_num_cells += MR_complexity_cell_counter;
+ metrics->MR_clpm_num_ticks += MR_complexity_tick_counter;
+ proc->MR_clp_is_active = MR_COMPLEXITY_IS_INACTIVE;
+}
+
+void
+MR_complexity_redo_func(int procnum, int slot)
+{
+ MR_ComplexityProc *proc;
+ MR_ComplexityMetrics *metrics;
+
+ proc = &MR_complexity_procs[procnum];
+ metrics = &proc->MR_clp_metrics[slot];
+ metrics->MR_clpm_num_words -= MR_complexity_word_counter;
+ metrics->MR_clpm_num_cells -= MR_complexity_cell_counter;
+ metrics->MR_clpm_num_ticks -= MR_complexity_tick_counter;
+ proc->MR_clp_is_active = MR_COMPLEXITY_IS_ACTIVE;
}
#endif /* MR_RECORD_TERM_SIZES */
Index: runtime/mercury_term_size.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_term_size.h,v
retrieving revision 1.1
diff -u -r1.1 mercury_term_size.h
--- runtime/mercury_term_size.h 20 Oct 2003 07:29:32 -0000 1.1
+++ runtime/mercury_term_size.h 26 Jul 2004 00:28:47 -0000
@@ -16,12 +16,61 @@
#ifndef MR_MERCURY_TERM_SIZE_H
#define MR_MERCURY_TERM_SIZE_H
-#include "mercury_types.h"
+#include "mercury_std.h" /* for MR_bool */
+#include "mercury_types.h" /* for the typedefs of the structs we define */
+
+#include "mercury_complexity.h" /* for MR_ComplexityProc, etc */
#ifdef MR_RECORD_TERM_SIZES
+extern MR_ComplexityCounter MR_complexity_word_counter;
+extern MR_ComplexityCounter MR_complexity_cell_counter;
+extern MR_ComplexityCounter MR_complexity_tick_counter;
+
+#define MR_complexity_is_active(numprocs, procnum, name, inputs, is_active) \
+ do { \
+ is_active = MR_complexity_is_active_func((numprocs), (procnum), \
+ (name), (inputs)); \
+ } while (0)
+
+#define MR_complexity_call_proc(procnum, slot) \
+ do { \
+ slot = MR_complexity_call_func(procnum); \
+ } while (0)
+
+#define MR_complexity_exit_proc(procnum, slot) \
+ do { \
+ MR_complexity_leave_func(procnum, slot); \
+ } while (0)
+
+#define MR_complexity_fail_proc(procnum, slot) \
+ do { \
+ MR_complexity_leave_func(procnum, slot); \
+ } while (0)
+
+#define MR_complexity_redo_proc(procnum, slot) \
+ do { \
+ MR_complexity_redo_func(procnum, slot); \
+ } while (0)
+
extern MR_Unsigned MR_term_size(MR_TypeInfo type_info, MR_Word term);
+extern void MR_init_complexity_proc(int proc_num, const char *fullname,
+ int num_profiled_args, int num_args,
+ MR_ComplexityArgInfo *arg_infos);
+extern void MR_check_complexity_init(void);
+
+extern void MR_write_complexity_procs(void);
+
+extern MR_ComplexityIsActive
+ MR_complexity_is_active_func(int num_procs, int proc_num,
+ const char *name, int num_inputs);
+extern int MR_complexity_call_func(int procnum);
+extern void MR_complexity_leave_func(int procnum, int slot);
+extern void MR_complexity_redo_func(int procnum, int slot);
+extern void MR_complexity_fill_size_slot(MR_ComplexityProc *proc, int slot,
+ int num_input_args, int argnum, int size);
+
#else /* MR_RECORD_TERM_SIZES */
/*
@@ -36,3 +85,5 @@
#endif /* MR_RECORD_TERM_SIZES */
#endif /* MR_MERCURY_TERM_SIZE_H */
+
+#define MR_COMPLEXITY_SLOTS_PER_CHUNK 1024
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.143
diff -u -r1.143 mercury_wrapper.c
--- runtime/mercury_wrapper.c 28 Jan 2005 07:11:55 -0000 1.143
+++ runtime/mercury_wrapper.c 28 Jan 2005 07:15:37 -0000
@@ -262,14 +262,15 @@
enum MR_TimeProfileMethod
MR_time_profile_method = MR_profile_user_plus_system_time;
-const char * MR_progname;
+const char *MR_progname;
int mercury_argc; /* not counting progname */
-char ** mercury_argv;
+char **mercury_argv;
int mercury_exit_status = 0;
MR_bool MR_profiling = MR_TRUE;
MR_bool MR_print_deep_profiling_statistics = MR_FALSE;
MR_bool MR_deep_profiling_save_results = MR_TRUE;
+MR_bool MR_complexity_save_results = MR_TRUE;
#ifdef MR_TYPE_CTOR_STATS
@@ -331,6 +332,9 @@
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_RECORD_TERM_SIZES
+void (*MR_address_of_init_modules_complexity)(void);
+#endif
#ifdef MR_DEEP_PROFILING
void (*MR_address_of_write_out_proc_statics)(FILE *fp);
#endif
@@ -399,6 +403,11 @@
void (*MR_register_module_layout)(const MR_Module_Layout *);
+#ifdef MR_RECORD_TERM_SIZES
+MR_ComplexityProc *MR_complexity_procs;
+int MR_num_complexity_procs;
+#endif
+
#ifdef MR_USE_GCC_NONLOCAL_GOTOS
#define SAFETY_BUFFER_SIZE 1024 /* size of stack safety buffer */
@@ -577,6 +586,13 @@
}
#endif
+#ifdef MR_RECORD_TERM_SIZES
+ if (MR_complexity_save_results) {
+ MR_do_init_modules_complexity();
+ MR_check_complexity_init();
+ }
+#endif
+
/*
** We need to call MR_save_registers(), since we're about to
** call a C->Mercury interface function, and the C->Mercury
@@ -755,6 +771,19 @@
}
}
+#ifdef MR_RECORD_TERM_SIZES
+void
+MR_do_init_modules_complexity(void)
+{
+ static MR_bool done = MR_FALSE;
+
+ if (! done) {
+ (*MR_address_of_init_modules_complexity)();
+ done = MR_TRUE;
+ }
+}
+#endif
+
/*
** Given a string, parse it into arguments and create an argv vector for it.
** The return value is NULL if the string parses OK, or an error message
@@ -1381,6 +1410,7 @@
case 's':
MR_deep_profiling_save_results = MR_FALSE;
+ MR_complexity_save_results = MR_FALSE;
break;
case 'S':
@@ -1989,6 +2019,12 @@
MR_deep_prof_turn_off_time_profiling();
if (MR_deep_profiling_save_results) {
MR_write_out_profiling_tree();
+ }
+#endif
+
+#ifdef MR_RECORD_TERM_SIZES
+ if (MR_complexity_save_results) {
+ MR_write_complexity_procs();
}
#endif
Index: runtime/mercury_wrapper.h
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/runtime/mercury_wrapper.h,v
retrieving revision 1.66
diff -u -r1.66 mercury_wrapper.h
--- runtime/mercury_wrapper.h 10 Jan 2005 05:23:50 -0000 1.66
+++ runtime/mercury_wrapper.h 10 Jan 2005 05:37:58 -0000
@@ -20,6 +20,7 @@
#include "mercury_stacks.h" /* for `MR_{Cut,Generator}StackFrame' */
#include "mercury_type_info.h" /* for `MR_TypeCtorInfo' */
#include "mercury_library_types.h" /* for `MercuryFilePtr' */
+#include "mercury_complexity.h" /* for `MR_ComplexityProc' */
#include <stdio.h> /* for `FILE' */
/*
@@ -79,7 +80,7 @@
/* normally mercury__main_2_0; */
#endif
-extern const char * MR_runtime_flags;
+extern const char *MR_runtime_flags;
extern void (*MR_library_initializer)(void);
extern void (*MR_library_finalizer)(void);
@@ -95,6 +96,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_RECORD_TERM_SIZES
+extern void (*MR_address_of_init_modules_complexity)(void);
+#endif
#ifdef MR_DEEP_PROFILING
extern void (*MR_address_of_write_out_proc_statics)(FILE *fp);
#endif
@@ -173,9 +177,21 @@
*/
extern void (*MR_register_module_layout)(const MR_Module_Layout *);
+/*
+** These global variables have their values defined in the program's _init.c
+** file. MR_complexity_preds_size gives the number of elements in the
+** MR_complexity_preds array.
+*/
+
extern void MR_do_init_modules(void);
extern void MR_do_init_modules_type_tables(void);
extern void MR_do_init_modules_debugger(void);
+#ifdef MR_RECORD_TERM_SIZES
+extern void MR_do_init_modules_complexity(void);
+
+extern MR_ComplexityProc *MR_complexity_procs;
+extern int MR_num_complexity_procs;
+#endif
extern const char *MR_progname;
extern int mercury_argc;
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/c2init.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/c2init.in,v
retrieving revision 1.44
diff -u -r1.44 c2init.in
--- scripts/c2init.in 20 May 2004 22:53:32 -0000 1.44
+++ scripts/c2init.in 25 Jul 2004 05:42:45 -0000
@@ -69,7 +69,14 @@
init_opt="-i" ;;
esac
-if [ "$mercury_stdlib_dir" != "" ]
+if test "$experimental_complexity" != ""
+then
+ experimental_complexity_opt="-X $experimental_complexity"
+else
+ experimental_complexity_opt=""
+fi
+
+if test "$mercury_stdlib_dir" != ""
then
MERCURY_MOD_LIB_MODS="$mercury_stdlib_dir/modules/$RT_LIB_NAME.init \
$mercury_stdlib_dir/modules/$STD_LIB_NAME.init"
@@ -93,13 +100,14 @@
case $# in
0) exec $MKINIT $aditi_opt -c"$maxcalls" $init_opt $trace_opt \
$library_opt $defentry_opt $extra_inits_opt \
- -g "$GRADE" -o "$init_c_file" \
+ -g "$GRADE" -o "$init_c_file" $experimental_complexity_opt \
$extra_init_dirs $EXTRA_INIT_FILES $TRACE_INIT_FILES \
$MERCURY_ALL_LIB_MODS
;;
*) exec $MKINIT $aditi_opt -c"$maxcalls" $init_opt $trace_opt \
$library_opt $defentry_opt $extra_inits_opt \
- -g "$GRADE" -o "$init_c_file" -r "$runtime_flags" \
+ -g "$GRADE" -o "$init_c_file" $experimental_complexity_opt \
+ -r "$runtime_flags" \
$extra_init_dirs "$@" $EXTRA_INIT_FILES $TRACE_INIT_FILES \
$MERCURY_ALL_LIB_MODS
;;
Index: scripts/parse_ml_options.sh-subr.in
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/scripts/parse_ml_options.sh-subr.in,v
retrieving revision 1.8
diff -u -r1.8 parse_ml_options.sh-subr.in
--- scripts/parse_ml_options.sh-subr.in 10 Apr 2004 05:12:23 -0000 1.8
+++ scripts/parse_ml_options.sh-subr.in 25 Jul 2004 05:44:39 -0000
@@ -64,6 +64,7 @@
trace_init_files=""
init_c_file="-"
runtime_flags=""
+experimental_complexity=""
# include the file `init_grade_options.sh-subr'
@INIT_GRADE_OPTIONS@
@@ -183,6 +184,9 @@
For the list of available flags, see the documentation
for MERCURY_OPTIONS in the "Environment" chapter
of the Mercury User's Guide.
+ --experimental-complexity <filename>
+ Set up for the experimental determination of the complexity
+ of the procedures listed in the given file.
--init-c-file <filename>
Output the generated C initialization program to the
specified file, rather than sending it to the standard
@@ -438,6 +442,18 @@
--runtime-flags)
runtime_flags="$runtime_flags $2"; shift;;
+
+ --experimental-complexity)
+ if test "$experimental_complexity" = ""
+ then
+ experimental_complexity="$2"; shift
+ else
+ cat 1>&2 << EOF
+$progname: Error: duplicate --experimental-complexity parameter
+EOF
+ exit 1
+ fi
+ ;;
-w|--entry-point)
defentry_opt="-w$2"; shift;;
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
Index: tools/bootcheck
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/bootcheck,v
retrieving revision 1.165
diff -u -r1.165 bootcheck
--- tools/bootcheck 10 Feb 2005 04:10:32 -0000 1.165
+++ tools/bootcheck 11 Feb 2005 03:21:50 -0000
@@ -1189,6 +1189,27 @@
echo "** error - stage 2 and stage 3 differ!"
else
echo "stage 2 and stage 3 compare ok"
+ if test -d $stage3dir/library/ComplexityArgs
+ then
+ mv $stage3dir/library/ComplexityArgs \
+ $root/stage3_library_ComplexityArgs
+ fi
+ if test -d $stage3dir/library/ComplexityData
+ then
+ mv $stage3dir/library/ComplexityData \
+ $root/stage3_library_ComplexityData
+ fi
+ if test -d $stage3dir/compiler/ComplexityArgs
+ then
+ mv $stage3dir/compiler/ComplexityArgs \
+ $root/stage3_compiler_ComplexityArgs
+ fi
+ if test -d $stage3dir/compiler/ComplexityData
+ then
+ mv $stage3dir/compiler/ComplexityData \
+ $root/stage3_compiler_ComplexityData
+ fi
+
echo "removing stage 3..."
# We try to do the removal of the stage 3 directory in parallel
# since recursive rm's across NFS can be quite slow ...
Index: tools/makebatch
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/tools/makebatch,v
retrieving revision 1.26
diff -u -r1.26 makebatch
--- tools/makebatch 7 Jul 2004 07:11:21 -0000 1.26
+++ tools/makebatch 1 Aug 2004 16:06:59 -0000
@@ -4,9 +4,10 @@
#
# The control and output files are all in the subdirectory batch.
# The control files are $batch.MCFLAGS and possibly $batch.CFLAGS,
-# $batch.MGNUCFLAGS, $batch.GRADE, and/or $batch.MMAKE, where $batch is
-# the last argument of makebatch. $batch.CFLAGS, $batch.MGNUCFLAGS,
-# $batch.GRADE and $batch.MMAKE are consulted if they exist.
+# $batch.MGNUCFLAGS, $batch.MLFLAGS, $batch.GRADE, and/or $batch.MMAKE,
+# where $batch is the last argument of makebatch. $batch.CFLAGS,
+# $batch.MGNUCFLAGS, $batch.MLFLAGS, $batch.GRADE and $batch.MMAKE
+# are consulted if they exist.
#
# All the control files except $batch.MMAKE must have the same number
# of lines. Each line corresponds to a version of the compiler that is
@@ -113,6 +114,13 @@
needcflags=false
fi
+if test -r batch/$batch.MLFLAGS
+then
+ needmlflags=true
+else
+ needmlflags=false
+fi
+
if test -r batch/$batch.GRADE
then
needgrade=true
@@ -165,6 +173,12 @@
then
mgnucflags=`awk "NR == $n" batch/$batch.MGNUCFLAGS`
echo "EXTRA_MGNUCFLAGS = $mgnucflags" >> Mmake.stage.params
+ fi
+
+ if $needmlflags
+ then
+ mlflags=`awk "NR == $n" batch/$batch.MLFLAGS`
+ echo "EXTRA_MLFLAGS = $mlflags" >> Mmake.stage.params
fi
if $needgrade
cvs diff: Diffing trace
cvs diff: Diffing util
Index: util/mkinit.c
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/util/mkinit.c,v
retrieving revision 1.95
diff -u -r1.95 mkinit.c
--- util/mkinit.c 10 Jan 2005 05:23:56 -0000 1.95
+++ util/mkinit.c 10 Jan 2005 05:38:08 -0000
@@ -51,6 +51,9 @@
static const char if_need_to_init[] =
"#if defined(MR_MAY_NEED_INITIALIZATION)\n";
+static const char if_need_term_size[] =
+ "#if defined(MR_RECORD_TERM_SIZES)\n";
+
static const char if_need_deep_prof[] =
"#if defined(MR_DEEP_PROFILING)\n";
@@ -59,7 +62,8 @@
PURPOSE_INIT = 0,
PURPOSE_TYPE_TABLE = 1,
PURPOSE_DEBUGGER = 2,
- PURPOSE_PROC_STATIC = 3
+ PURPOSE_COMPLEXITY = 3,
+ PURPOSE_PROC_STATIC = 4
} Purpose;
const char *main_func_name[] =
@@ -67,6 +71,7 @@
"init_modules",
"init_modules_type_tables",
"init_modules_debugger",
+ "init_modules_complexity_procs",
"write_out_proc_statics"
};
@@ -75,6 +80,7 @@
"init",
"init_type_tables",
"init_debugger",
+ "init_complexity_procs",
"write_out_proc_statics"
};
@@ -83,6 +89,7 @@
"",
"_type_tables",
"_debugger",
+ "_complexity",
"write_out_proc_statics"
};
@@ -91,6 +98,7 @@
if_need_to_init,
NULL,
if_need_to_init,
+ if_need_term_size,
if_need_deep_prof
};
@@ -99,6 +107,7 @@
NULL,
NULL,
NULL,
+ if_need_term_size,
if_need_deep_prof
};
@@ -107,6 +116,7 @@
if_need_to_init,
NULL,
if_need_to_init,
+ NULL,
NULL
};
@@ -115,6 +125,7 @@
"void",
"void",
"void",
+ "void",
"FILE *fp"
};
@@ -123,6 +134,7 @@
"void",
"void",
"void",
+ "void",
"FILE *"
};
@@ -131,6 +143,7 @@
"",
"",
"",
+ "",
"fp"
};
@@ -166,32 +179,35 @@
static MR_bool aditi = MR_FALSE;
static MR_bool need_initialization_code = MR_FALSE;
static MR_bool need_tracing = MR_FALSE;
+static const char *experimental_complexity = NULL;
+
+static int num_experimental_complexity_procs = 0;
-static int num_errors = 0;
+static int num_errors = 0;
/* List of options to pass to the runtime */
-static String_List *runtime_flags = NULL;
+static String_List *runtime_flags = NULL;
/* Pointer to tail of the runtime_flags list */
-static String_List **runtime_flags_tail = &runtime_flags;
+static String_List **runtime_flags_tail = &runtime_flags;
/* List of directories to search for init files */
-static String_List *init_file_dirs = NULL;
+static String_List *init_file_dirs = NULL;
/* Pointer to tail of the init_file_dirs list */
-static String_List **init_file_dirs_tail = &init_file_dirs;
+static String_List **init_file_dirs_tail = &init_file_dirs;
/* --- code fragments to put in the output file --- */
-static const char header1[] =
+static const char header1[] =
"/*\n"
- "** This code automatically generated by mkinit - do not edit.\n"
+ "** This code was automatically generated by mkinit - do not edit.\n"
"**\n"
"** Grade: %s\n"
"** Input files:\n"
"**\n"
;
-static const char header2[] =
+static const char header2[] =
"*/\n"
"\n"
"#include <stddef.h>\n"
@@ -258,7 +274,7 @@
" ** Explicitly register the bottom of the stack, so that the\n"
" ** GC knows where it starts. This is necessary for AIX 4.1\n"
" ** on RS/6000, and for gnu-win32 on Windows 95 or NT.\n"
- " ** it may also be helpful on other systems.\n"
+ " ** It may also be helpful on other systems.\n"
" */\n"
" GC_stackbottom = stackbottom;\n"
"#endif\n"
@@ -283,10 +299,17 @@
" 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_RECORD_TERM_SIZES\n"
+ " MR_address_of_init_modules_complexity = init_modules_complexity_procs;\n"
+ "#endif\n"
"#ifdef MR_DEEP_PROFILING\n"
" MR_address_of_write_out_proc_statics =\n"
" write_out_proc_statics;\n"
"#endif\n"
+ "#ifdef MR_RECORD_TERM_SIZES\n"
+ " MR_complexity_procs = MR_complexity_proc_table;\n"
+ " MR_num_complexity_procs = %d;\n"
+ "#endif\n"
" MR_type_ctor_info_for_univ = ML_type_ctor_info_for_univ;\n"
" MR_type_info_for_type_info = (MR_TypeInfo)\n"
" &ML_type_info_for_type_info;\n"
@@ -405,6 +428,9 @@
static void do_path_search(void);
static char *find_init_file(const char *base_name);
static MR_bool file_exists(const char *filename);
+static char *read_line(const char *filename, FILE *fp, int max);
+static void output_complexity_proc(const char *procname);
+static void output_complexity_experiment_table(const char *filename);
static void output_headers(void);
static int output_sub_init_functions(Purpose purpose);
static void output_main_init_function(Purpose purpose, int num_bunches);
@@ -443,7 +469,8 @@
if (errnum >= 0 && errnum < sys_nerr && sys_errlist[errnum] != NULL) {
return sys_errlist[errnum];
} else {
- static char buf[30];
+ static char buf[30];
+
sprintf(buf, "Error %d", errnum);
return buf;
}
@@ -453,7 +480,7 @@
/*---------------------------------------------------------------------------*/
-int
+int
main(int argc, char **argv)
{
int num_bunches;
@@ -469,7 +496,7 @@
if (need_initialization_code) {
printf("#define MR_MAY_NEED_INITIALIZATION\n\n");
- }
+ }
num_bunches = output_sub_init_functions(PURPOSE_INIT);
output_main_init_function(PURPOSE_INIT, num_bunches);
@@ -480,9 +507,12 @@
num_bunches = output_sub_init_functions(PURPOSE_DEBUGGER);
output_main_init_function(PURPOSE_DEBUGGER, num_bunches);
+ num_bunches = output_sub_init_functions(PURPOSE_COMPLEXITY);
+ output_main_init_function(PURPOSE_COMPLEXITY, 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();
}
@@ -505,14 +535,14 @@
/*---------------------------------------------------------------------------*/
-static void
+static void
parse_options(int argc, char *argv[])
{
int c;
int i;
String_List *tmp_slist;
- while ((c = getopt(argc, argv, "ac:g:iI:lo:r:tw:x")) != EOF) {
+ while ((c = getopt(argc, argv, "ac:g:iI:lo:r:tw:xX:")) != EOF) {
switch (c) {
case 'a':
aditi = MR_TRUE;
@@ -537,10 +567,10 @@
** search path for `.init' files.
*/
tmp_slist = (String_List *)
- checked_malloc(sizeof(String_List));
+ checked_malloc(sizeof(String_List));
tmp_slist->next = NULL;
tmp_slist->data = (char *)
- checked_malloc(strlen(optarg) + 1);
+ checked_malloc(strlen(optarg) + 1);
strcpy(tmp_slist->data, optarg);
*init_file_dirs_tail = tmp_slist;
init_file_dirs_tail = &tmp_slist->next;
@@ -588,6 +618,10 @@
c_files_contain_extra_inits = MR_TRUE;
break;
+ case 'X':
+ experimental_complexity = optarg;
+ break;
+
default:
usage();
}
@@ -601,7 +635,7 @@
files = argv + optind;
}
-static void
+static void
usage(void)
{
fprintf(stderr,
@@ -617,6 +651,7 @@
** and the file name specified is not `-' (which we take to mean stdout),
** then reassign stdout to the specified file.
*/
+
static void
set_output_file(void)
{
@@ -634,16 +669,17 @@
/*---------------------------------------------------------------------------*/
- /*
- ** Scan the list of files for ones not found in the current
- ** directory, and replace them with their full path equivalent
- ** if they are found in the list of search directories.
- */
+/*
+** Scan the list of files for ones not found in the current
+** directory, and replace them with their full path equivalent
+** if they are found in the list of search directories.
+*/
+
static void
do_path_search(void)
{
- int filenum;
- char *init_file;
+ int filenum;
+ char *init_file;
for (filenum = 0; filenum < num_files; filenum++) {
init_file = find_init_file(files[filenum]);
@@ -652,23 +688,24 @@
}
}
- /*
- ** Search the init file directory list to locate the file.
- ** If the file is in the current directory or is not in any of the
- ** search directories, then return NULL. Otherwise return the full
- ** path name to the file.
- ** It is the caller's responsibility to free the returned buffer
- ** holding the full path name when it is no longer needed.
- */
+/*
+** Search the init file directory list to locate the file.
+** If the file is in the current directory or is not in any of the
+** search directories, then return NULL. Otherwise return the full
+** path name to the file.
+** It is the caller's responsibility to free the returned buffer
+** holding the full path name when it is no longer needed.
+*/
+
static char *
find_init_file(const char *base_name)
{
- char *filename;
- char *dirname;
- String_List *dir_ptr;
- int dirlen;
- int baselen;
- int len;
+ char *filename;
+ char *dirname;
+ String_List *dir_ptr;
+ int dirlen;
+ int baselen;
+ int len;
if (file_exists(base_name)) {
/* File is in current directory, so no search required */
@@ -678,7 +715,7 @@
baselen = strlen(base_name);
for (dir_ptr = init_file_dirs; dir_ptr != NULL;
- dir_ptr = dir_ptr->next)
+ dir_ptr = dir_ptr->next)
{
dirname = dir_ptr->data;
dirlen = strlen(dirname);
@@ -689,8 +726,9 @@
filename[dirlen] = '/';
strcpy(filename + dirlen + 1, base_name);
- if (file_exists(filename))
+ if (file_exists(filename)) {
return filename;
+ }
free(filename);
}
@@ -699,18 +737,21 @@
return NULL;
}
- /*
- ** Check whether a file exists.
- */
+/*
+** Check whether a file exists.
+*/
+
static MR_bool
file_exists(const char *filename)
{
#ifdef MR_HAVE_SYS_STAT_H
- struct stat buf;
+ struct stat buf;
return (stat(filename, &buf) == 0);
#else
- FILE *f = fopen(filename, "rb");
+ FILE *f;
+
+ f = fopen(filename, "rb");
if (f != NULL) {
fclose(f);
return MR_TRUE;
@@ -722,10 +763,88 @@
/*---------------------------------------------------------------------------*/
-static void
+/*
+** Read a line from a file, and return a pointer to a malloc'd buffer
+** holding the line (without the final newline). If EOF occurs on a
+** nonempty line, treat the EOF as a newline; if EOF occurs on an empty
+** line, return NULL.
+*/
+
+char *
+read_line(const char *filename, FILE *fp, int max)
+{
+ char *buf;
+ int c;
+ int i;
+
+ buf = checked_malloc(max + 1);
+ i = 0;
+ while ((c = getc(fp)) != EOF && c != '\n') {
+ if (i >= max) {
+ fprintf(stderr, "%s: line too long in file `%s'\n",
+ MR_progname, filename);
+ num_errors++;
+ return NULL;
+ }
+
+ buf[i++] = c;
+ }
+
+ if (c == '\n' || i > 0) {
+ if (i >= max) {
+ fprintf(stderr, "%s: line too long in file `%s'\n",
+ MR_progname, filename);
+ num_errors++;
+ return NULL;
+ }
+
+ buf[i] = '\0';
+ return buf;
+ } else {
+ free(buf);
+ return NULL;
+ }
+}
+
+#define MAX_PROCNAME_LEN 1024
+
+static void
+output_complexity_proc(const char *procname)
+{
+ printf("{ \"%s\", -1, -1, NULL,\n", procname);
+ printf("MR_COMPLEXITY_IS_INACTIVE, NULL, 0, NULL, NULL },\n");
+}
+
+static void
+output_complexity_experiment_table(const char *filename)
+{
+ const char *procname;
+ FILE *fp;
+
+ fp = fopen(filename, "r");
+ if (fp == NULL) {
+ fprintf(stderr, "%s: error opening file `%s': %s\n",
+ MR_progname, filename, strerror(errno));
+ num_errors++;
+ return;
+ }
+
+ printf("\nMR_ComplexityProc MR_complexity_proc_table[] = {\n");
+
+ num_experimental_complexity_procs = 0;
+ while ((procname = read_line(filename, fp, MAX_PROCNAME_LEN)) != NULL)
+ {
+ num_experimental_complexity_procs++;
+ output_complexity_proc(procname);
+ }
+
+ printf("};\n");
+}
+
+static void
output_headers(void)
{
- int filenum;
+ int filenum;
printf(header1, grade);
@@ -774,10 +893,10 @@
return num_bunches;
}
-static void
+static void
output_main_init_function(Purpose purpose, int num_bunches)
{
- int i;
+ int i;
fputs("\n", stdout);
if (main_func_guard[purpose] != NULL) {
@@ -809,27 +928,38 @@
}
}
-static void
+static void
output_main(void)
{
- const char *aditi_load_func;
- String_List *list_tmp;
- char *options_str;
+ const char *aditi_load_func;
+ String_List *list_tmp;
+ char *options_str;
if (aditi) {
aditi_load_func = "MR_do_load_aditi_rl_code";
} else {
aditi_load_func = "NULL";
}
-
+
+ if (experimental_complexity != NULL) {
+ output_complexity_experiment_table(experimental_complexity);
+ } else {
+ printf("\nMR_ComplexityProc MR_complexity_proc_table[] = {\n");
+ output_complexity_proc("dummy_proc/0-0");
+ printf("};\n");
+ }
+
printf(mercury_funcs1, hl_entry_point, entry_point);
- printf(mercury_funcs2, aditi_load_func, hl_entry_point, entry_point);
+ printf(mercury_funcs2, num_experimental_complexity_procs,
+ aditi_load_func, hl_entry_point, entry_point);
printf(" MR_runtime_flags = \"");
for (list_tmp = runtime_flags;
- list_tmp != NULL; list_tmp = list_tmp->next) {
+ list_tmp != NULL; list_tmp = list_tmp->next)
+ {
for (options_str = list_tmp->data;
- *options_str != '\0'; options_str++) {
+ *options_str != '\0'; options_str++)
+ {
if (*options_str == '\n') {
putchar('\\');
putchar('n');
@@ -857,11 +987,13 @@
/*---------------------------------------------------------------------------*/
-static void
+static void
process_file(const char *filename, int *num_bunches_ptr,
int *num_calls_in_cur_bunch_ptr, Purpose purpose)
{
- int len = strlen(filename);
+ int len;
+
+ 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,
@@ -907,7 +1039,7 @@
** all `.'s replaced with `__', and with each
** component of the module name mangled according
** to the algorithm in llds_out__name_mangle/2
- ** in compiler/llds_out.m.
+ ** in compiler/llds_out.m.
**
** XXX We don't handle the full name mangling algorithm here;
** instead we use a simplified version:
@@ -948,9 +1080,9 @@
num_calls_in_cur_bunch_ptr, purpose, MR_FALSE);
if (aditi) {
- char *rl_data_name;
- int module_name_size;
- int mercury_len;
+ char *rl_data_name;
+ int module_name_size;
+ int mercury_len;
mercury_len = strlen("mercury__");
module_name_size =
@@ -964,7 +1096,7 @@
}
}
-static void
+static void
process_init_file(const char *filename, int *num_bunches_ptr,
int *num_calls_in_cur_bunch_ptr, Purpose purpose)
{
@@ -987,18 +1119,18 @@
}
while (get_line(cfile, line, MAXLINE) > 0) {
- if (strncmp(line, init_str, init_strlen) == 0) {
+ if (strncmp(line, init_str, init_strlen) == 0) {
char *func_name;
int func_name_len;
- int j;
+ int j;
MR_bool special;
- for (j = init_strlen;
- MR_isalnum(line[j]) || line[j] == '_'; j++)
- {
- /* VOID */
- }
- line[j] = '\0';
+ for (j = init_strlen;
+ MR_isalnum(line[j]) || line[j] == '_'; j++)
+ {
+ /* VOID */
+ }
+ line[j] = '\0';
func_name = line + init_strlen;
func_name_len = strlen(func_name);
@@ -1015,23 +1147,24 @@
} else if (aditi &&
strncmp(line, aditi_init_str, aditi_init_strlen) == 0)
{
- int j;
-
- for (j = aditi_init_strlen;
+ int j;
+
+ for (j = aditi_init_strlen;
MR_isalnum(line[j]) || line[j] == '_';
j++)
- {
- /* VOID */
- }
- line[j] = '\0';
+ {
+ /* VOID */
+ }
+ line[j] = '\0';
- rl_data_name = checked_malloc(
+ rl_data_name = checked_malloc(
strlen(line + aditi_init_strlen) + 1);
- strcpy(rl_data_name, line + aditi_init_strlen);
- add_rl_data(rl_data_name);
- } else if (strncmp(line, endinit_str, endinit_strlen) == 0) {
- break;
- }
+ strcpy(rl_data_name, line + aditi_init_strlen);
+ add_rl_data(rl_data_name);
+
+ } else if (strncmp(line, endinit_str, endinit_strlen) == 0) {
+ break;
+ }
}
fclose(cfile);
@@ -1048,7 +1181,7 @@
** of the current bunch.
*/
-static void
+static void
output_init_function(const char *func_name, int *num_bunches_ptr,
int *num_calls_in_cur_bunch_ptr, Purpose purpose,
MR_bool special_module)
@@ -1064,6 +1197,17 @@
}
}
+ if (purpose == PURPOSE_COMPLEXITY) {
+ if (special_module) {
+ /*
+ ** This is a handwritten "module" whose code
+ ** cannot participate in complexity experiments.
+ */
+
+ return;
+ }
+ }
+
if (*num_calls_in_cur_bunch_ptr >= maxcalls) {
printf("}\n\n");
@@ -1087,20 +1231,21 @@
/*---------------------------------------------------------------------------*/
- /*
- ** Load the Aditi-RL for each module into the database.
- ** MR_do_load_aditi_rl_code() is called by MR_load_aditi_rl_code()
- ** in runtime/mercury_wrapper.c, which is called by
- ** `aditi__connect/6' in extras/aditi/aditi.m.
- */
+/*
+** Load the Aditi-RL for each module into the database.
+** MR_do_load_aditi_rl_code() is called by MR_load_aditi_rl_code()
+** in runtime/mercury_wrapper.c, which is called by
+** `aditi__connect/6' in extras/aditi/aditi.m.
+*/
+
static void
output_aditi_load_function(void)
{
- int len;
- int filenum;
- char filename[1000];
- int num_rl_modules;
- String_List *node;
+ int len;
+ int filenum;
+ char filename[1000];
+ int num_rl_modules;
+ String_List *node;
printf("\n/*\n** Load the Aditi-RL code for the program into the\n");
printf("** currently connected database.\n*/\n");
@@ -1138,7 +1283,7 @@
printf("&%s__length,\n\t\t", node->data);
}
printf("0};\n");
-
+
printf("\tconst int num_rl_modules = %d;\n", num_rl_modules);
printf(
@@ -1195,7 +1340,7 @@
/*---------------------------------------------------------------------------*/
-static int
+static int
get_line(FILE *file, char *line, int line_max)
{
int c, num_chars, limit;
@@ -1207,7 +1352,7 @@
line[num_chars++] = c;
}
}
-
+
if (c == '\n' || num_chars > 0) {
line[num_chars++] = '\n';
}
@@ -1221,7 +1366,8 @@
static void *
checked_malloc(size_t size)
{
- void *mem;
+ void *mem;
+
if ((mem = malloc(size)) == NULL) {
fprintf(stderr, "Out of memory\n");
exit(EXIT_FAILURE);
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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