[m-dev.] for review: deep profiling changes [part 2/3]
Thomas Conway
conway at cs.mu.OZ.AU
Sat Feb 26 15:24:48 AEDT 2000
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.148
diff -u -r1.148 mercury_compile.m
--- compiler/mercury_compile.m 2000/02/10 04:37:38 1.148
+++ compiler/mercury_compile.m 2000/02/25 23:39:10
@@ -34,7 +34,7 @@
:- import_module equiv_type, make_hlds, typecheck, purity, polymorphism, modes.
:- import_module switch_detection, cse_detection, det_analysis, unique_modes.
:- import_module stratify, check_typeclass, simplify, intermod, trans_opt.
-:- import_module table_gen.
+:- import_module table_gen, profiling.
:- import_module bytecode_gen, bytecode.
:- import_module (lambda), termination, higher_order, accumulator, inlining.
:- import_module deforest, dnf, magic, dead_proc_elim.
@@ -1016,7 +1016,10 @@
mercury_compile__maybe_do_inlining(HLDS33, Verbose, Stats, HLDS34), !,
mercury_compile__maybe_dump_hlds(HLDS34, "34", "inlining"), !,
- mercury_compile__maybe_deforestation(HLDS34,
+ mercury_compile__maybe_compute_sccs(HLDS34, Verbose, Stats, HLDS35), !,
+ mercury_compile__maybe_dump_hlds(HLDS35, "35", "compute_sccs"), !,
+
+ mercury_compile__maybe_deforestation(HLDS35,
Verbose, Stats, HLDS36), !,
mercury_compile__maybe_dump_hlds(HLDS36, "36", "deforestation"), !,
@@ -1263,9 +1266,11 @@
"% Generating low-level (LLDS) code for ",
PredId, ProcId, ModuleInfo3),
{ module_info_get_cell_count(ModuleInfo3, CellCount0) },
+ { module_info_get_scc_info(ModuleInfo3, SCCInfo0) },
{ generate_proc_code(PredInfo, ProcInfo, ProcId, PredId, ModuleInfo3,
Globals, GlobalData0, GlobalData1, CellCount0, CellCount,
- Proc0) },
+ SCCInfo0, SCCInfo, Proc0) },
+ { module_info_set_scc_info(ModuleInfo3, SCCInfo, ModuleInfo4) },
{ globals__lookup_bool_option(Globals, optimize, Optimize) },
( { Optimize = yes } ->
optimize__proc(Proc0, GlobalData1, Proc)
@@ -1278,7 +1283,7 @@
PredId, ProcId, ModuleInfo3),
{ continuation_info__maybe_process_proc_llds(Instructions, PredProcId,
ModuleInfo3, GlobalData1, GlobalData) },
- { module_info_set_cell_count(ModuleInfo3, CellCount, ModuleInfo) }.
+ { module_info_set_cell_count(ModuleInfo4, CellCount, ModuleInfo) }.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1725,6 +1730,26 @@
{ HLDS = HLDS0 }
).
+:- pred mercury_compile__maybe_compute_sccs(module_info, bool, bool,
+ module_info, io__state, io__state).
+:- mode mercury_compile__maybe_compute_sccs(in, in, in, out, di, uo) is det.
+
+mercury_compile__maybe_compute_sccs(HLDS0, Verbose, Stats, HLDS) -->
+ globals__io_lookup_bool_option(errorcheck_only, ErrorCheckOnly),
+ globals__io_lookup_bool_option(profile_deep, DeepProfiling),
+ (
+ { ErrorCheckOnly = no },
+ { DeepProfiling = yes }
+ ->
+ maybe_write_string(Verbose, "% Computing SCC information...\n"),
+ maybe_flush_output(Verbose),
+ { profiling__compute_scc_info(HLDS0, HLDS) },
+ maybe_write_string(Verbose, "% done.\n"),
+ maybe_report_stats(Stats)
+ ;
+ { HLDS = HLDS0 }
+ ).
+
:- pred mercury_compile__maybe_deforestation(module_info, bool, bool,
module_info, io__state, io__state).
:- mode mercury_compile__maybe_deforestation(in, in, in, out, di, uo) is det.
@@ -2063,21 +2088,24 @@
globals__io_lookup_bool_option(common_data, CommonData),
{ base_type_info__generate_llds(HLDS0, TypeCtorInfos) },
{ base_type_layout__generate_llds(HLDS0, HLDS1, TypeCtorLayouts) },
- { stack_layout__generate_llds(HLDS1, HLDS, GlobalData,
+ { stack_layout__generate_llds(HLDS1, HLDS2, GlobalData,
PossiblyDynamicLayouts, StaticLayouts, LayoutLabels) },
+ { profiling__generate_scc_ids(HLDS2, HLDS, SCCData, SCCVars) },
{ get_c_interface_info(HLDS, C_InterfaceInfo) },
- { global_data_get_all_proc_vars(GlobalData, GlobalVars) },
+ { global_data_get_all_proc_vars(GlobalData, GlobalVars0) },
+ { append(SCCVars, GlobalVars0, GlobalVars) },
{ global_data_get_all_non_common_static_data(GlobalData,
NonCommonStaticData) },
{ list__append(StaticLayouts, TypeCtorLayouts, StaticData0) },
+ { list__append(SCCData, StaticData0, StaticData1) },
( { CommonData = yes } ->
- { llds_common(Procs0, StaticData0, ModuleName, Procs1,
- StaticData1) }
+ { llds_common(Procs0, StaticData1, ModuleName, Procs1,
+ StaticData2) }
;
- { StaticData1 = StaticData0 },
+ { StaticData2 = StaticData1 },
{ Procs1 = Procs0 }
),
- { list__append(StaticData1, NonCommonStaticData, StaticData) },
+ { list__append(StaticData2, NonCommonStaticData, StaticData) },
{ list__condense([TypeCtorInfos, PossiblyDynamicLayouts, StaticData],
AllData) },
mercury_compile__construct_c_file(C_InterfaceInfo, Procs1, GlobalVars,
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.81
diff -u -r1.81 middle_rec.m
--- compiler/middle_rec.m 2000/01/14 01:10:31 1.81
+++ compiler/middle_rec.m 2000/02/25 23:39:10
@@ -513,6 +513,13 @@
;
Rval = mem_addr(MemRef),
middle_rec__find_used_registers_mem_ref(MemRef, Used0, Used)
+ ;
+ Rval = c_func(_, _, Args, _),
+ list__foldl(lambda([Arg::in, Used1::di, Used2::uo] is det, (
+ Arg = _Type - ArgRval,
+ middle_rec__find_used_registers_rval(ArgRval,
+ Used1, Used2)
+ )), Args, Used0, Used)
).
:- pred middle_rec__find_used_registers_mem_ref(mem_ref, set(int), set(int)).
Index: compiler/opt_debug.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_debug.m,v
retrieving revision 1.98
diff -u -r1.98 opt_debug.m
--- compiler/opt_debug.m 2000/01/14 01:10:35 1.98
+++ compiler/opt_debug.m 2000/02/25 23:39:10
@@ -532,6 +532,8 @@
opt_debug__dump_vnlval(vn_mem_ref(N), Str) :-
string__int_to_string(N, N_str),
string__append_list(["vn_mem_ref(", N_str, ")"], Str).
+opt_debug__dump_vnlval(vn_global(_Type, Name), Str) :-
+ string__append_list(["vn_global(", Name, ")"], Str).
opt_debug__dump_vnrval(vn_origlval(Vnlval), Str) :-
opt_debug__dump_vnlval(Vnlval, Lval_str),
@@ -571,6 +573,14 @@
string__int_to_string(N, N_str),
string__append_list(["vn_heap_addr(", B_str, ", ", T_str, ", ",
N_str, ")"], Str).
+opt_debug__dump_vnrval(vn_c_func(_RetType, Name, Args, _Static), Str) :-
+ list__map(lambda([Arg::in, ArgStr::out] is det, (
+ Arg = _Type - ArgRval,
+ opt_debug__dump_rval(ArgRval, ArgRvalStr0),
+ string__append(ArgRvalStr0, ", ", ArgStr)
+ )), Args, ArgStrs),
+ list__append(ArgStrs, [")"], RestArgs),
+ string__append_list([Name, "("|RestArgs], Str).
opt_debug__dump_lval(reg(Type, Num), Str) :-
opt_debug__dump_reg(Type, Num, R_str),
@@ -621,6 +631,8 @@
opt_debug__dump_lval(temp(Type, Num), Str) :-
opt_debug__dump_reg(Type, Num, R_str),
string__append_list(["temp(", R_str, ")"], Str).
+opt_debug__dump_lval(global(_Type, Name), Str) :-
+ string__append_list(["global(", Name, ")"], Str).
opt_debug__dump_lval(mem_ref(R), Str) :-
opt_debug__dump_rval(R, R_str),
string__append_list(["mem_ref(", R_str, ")"], Str).
@@ -666,6 +678,14 @@
opt_debug__dump_rval(mem_addr(M), Str) :-
opt_debug__dump_mem_ref(M, M_str),
string__append_list(["mem_addr(", M_str, ")"], Str).
+opt_debug__dump_rval(c_func(_RetType, Name, Args, _Static), Str) :-
+ list__map(lambda([Arg::in, ArgStr::out] is det, (
+ Arg = _Type - Rval,
+ opt_debug__dump_rval(Rval, ArgStr0),
+ string__append(ArgStr0, ", ", ArgStr)
+ )), Args, ArgStrs),
+ list__append(ArgStrs, [")"], EndStrs),
+ string__append_list([Name, "("|EndStrs], Str).
opt_debug__dump_rvals([], "").
opt_debug__dump_rvals([Rval | Rvals], Str) :-
@@ -708,9 +728,13 @@
opt_debug__dump_const(label_entry(Label), Str) :-
opt_debug__dump_label(Label, LabelStr),
string__append_list(["label_entry(", LabelStr, ")"], Str).
+
opt_debug__dump_data_name(common(N), Str) :-
string__int_to_string(N, N_str),
string__append("common", N_str, Str).
+opt_debug__dump_data_name(scc_id(N), Str) :-
+ string__int_to_string(N, N_str),
+ string__append("scc_id", N_str, Str).
opt_debug__dump_data_name(type_ctor(BaseData, TypeName, TypeArity), Str) :-
llds_out__make_type_ctor_name(BaseData, TypeName, TypeArity, Str).
opt_debug__dump_data_name(base_typeclass_info(ClassId, InstanceNum), Str) :-
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.105
diff -u -r1.105 opt_util.m
--- compiler/opt_util.m 2000/01/14 01:10:36 1.105
+++ compiler/opt_util.m 2000/02/25 23:39:14
@@ -678,6 +678,7 @@
opt_util__lval_refers_stackvars(lvar(_), _) :-
error("found lvar in lval_refers_stackvars").
opt_util__lval_refers_stackvars(temp(_, _), no).
+opt_util__lval_refers_stackvars(global(_, _), no).
opt_util__lval_refers_stackvars(mem_ref(Rval), Refers) :-
opt_util__rval_refers_stackvars(Rval, Refers).
@@ -706,6 +707,12 @@
bool__or(Refers1, Refers2, Refers).
opt_util__rval_refers_stackvars(mem_addr(MemRef), Refers) :-
opt_util__mem_ref_refers_stackvars(MemRef, Refers).
+opt_util__rval_refers_stackvars(c_func(_, _, Args, _), Refers) :-
+ list__foldl(lambda([Arg::in, Ref0::in, Ref1::out] is det, (
+ Arg = _Type - Rval,
+ opt_util__rval_refers_stackvars(Rval, ArgRef),
+ bool__or(Ref0, ArgRef, Ref1)
+ )), Args, no, Refers).
opt_util__rvals_refer_stackvars([], no).
opt_util__rvals_refer_stackvars([MaybeRval | Tail], Refers) :-
@@ -1495,8 +1502,7 @@
:- pred opt_util__format_proclabel(proc_label, string).
:- mode opt_util__format_proclabel(in, out) is det.
-opt_util__format_proclabel(proc(_Module, _PredOrFunc, _, Name, Arity, ProcId),
- Str) :-
+opt_util__format_proclabel(proc(_Module, _POrF, _, Name, Arity, ProcId), Str) :-
string__int_to_string(Arity, ArityStr),
proc_id_to_int(ProcId, Mode),
string__int_to_string(Mode, ModeStr),
@@ -1587,6 +1593,7 @@
bool__or(Touch1, Touch2, Touch).
opt_util__touches_nondet_ctrl_lval(lvar(_), no).
opt_util__touches_nondet_ctrl_lval(temp(_, _), no).
+opt_util__touches_nondet_ctrl_lval(global(_, _), no).
opt_util__touches_nondet_ctrl_lval(mem_ref(Rval), Touch) :-
opt_util__touches_nondet_ctrl_rval(Rval, Touch).
@@ -1608,6 +1615,12 @@
bool__or(Touch1, Touch2, Touch).
opt_util__touches_nondet_ctrl_rval(mem_addr(MemRef), Touch) :-
opt_util__touches_nondet_ctrl_mem_ref(MemRef, Touch).
+opt_util__touches_nondet_ctrl_rval(c_func(_, _, Args, _), Touch) :-
+ list__foldl(lambda([Arg::in, Ref0::in, Ref1::out] is det, (
+ Arg = _Type - Rval,
+ opt_util__touches_nondet_ctrl_rval(Rval, ArgRef),
+ bool__or(Ref0, ArgRef, Ref1)
+ )), Args, no, Touch).
:- pred opt_util__touches_nondet_ctrl_mem_ref(mem_ref, bool).
:- mode opt_util__touches_nondet_ctrl_mem_ref(in, out) is det.
@@ -1661,6 +1674,7 @@
opt_util__lval_access_rvals(sp, []).
opt_util__lval_access_rvals(field(_, Rval1, Rval2), [Rval1, Rval2]).
opt_util__lval_access_rvals(temp(_, _), []).
+opt_util__lval_access_rvals(global(_, _), []).
opt_util__lval_access_rvals(lvar(_), _) :-
error("lvar detected in opt_util__lval_access_rvals").
opt_util__lval_access_rvals(mem_ref(Rval), [Rval]).
@@ -1977,6 +1991,7 @@
opt_util__replace_labels_rval(Offset0, ReplMap, Offset).
opt_util__replace_labels_lval(lvar(Var), _, lvar(Var)).
opt_util__replace_labels_lval(temp(Type, Num), _, temp(Type, Num)).
+opt_util__replace_labels_lval(global(Type, Glob), _, global(Type, Glob)).
opt_util__replace_labels_lval(mem_ref(Rval0), ReplMap, mem_ref(Rval)) :-
opt_util__replace_labels_rval(Rval0, ReplMap, Rval).
@@ -1999,6 +2014,13 @@
binop(Op, LRval, RRval)) :-
opt_util__replace_labels_rval(LRval0, ReplMap, LRval),
opt_util__replace_labels_rval(RRval0, ReplMap, RRval).
+opt_util__replace_labels_rval(c_func(RT, Name, Args0, Static), ReplMap,
+ c_func(RT, Name, Args, Static)) :-
+ map((pred(Pair0::in, Pair::out) is det :-
+ Pair0 = Type - RVal0,
+ Pair = Type - RVal,
+ opt_util__replace_labels_rval(RVal0, ReplMap, RVal)
+ ), Args0, Args).
opt_util__replace_labels_rval(mem_addr(MemRef0), ReplMap, mem_addr(MemRef)) :-
opt_util__replace_labels_mem_ref(MemRef0, ReplMap, MemRef).
Index: compiler/optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/optimize.m,v
retrieving revision 1.22
diff -u -r1.22 optimize.m
--- compiler/optimize.m 2000/02/10 04:37:36 1.22
+++ compiler/optimize.m 2000/02/25 23:39:14
@@ -52,8 +52,8 @@
global_data_maybe_get_proc_layout(GlobalData, PredProcId,
ProcLayout)
->
- ProcLayout = proc_layout_info(_, _, _, _, _, _, _, _,
- LabelMap),
+ ProcLayout = proc_layout_info(_, _, _, _, _, _, _, _, _, _,
+ LabelMap),
map__sorted_keys(LabelMap, LayoutLabels),
set__sorted_list_to_set(LayoutLabels, LayoutLabelSet)
;
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.181
diff -u -r1.181 polymorphism.m
--- compiler/polymorphism.m 2000/01/17 03:38:55 1.181
+++ compiler/polymorphism.m 2000/02/25 23:39:23
@@ -47,10 +47,16 @@
% word 4 <MR_TypeCtorRepresentation for type constructor>
% word 5 <type_ctor_functors for type>
% word 6 <type_ctor_layout for type>
+% word 8 <string name of module>
% word 7 <string name of type constructor>
% e.g. "int" for `int', "list" for `list(T)',
% "map" for `map(K,V)'
-% word 8 <string name of module>
+% word 9 version number
+% If deep profiling is enabled (see profiling.m) then the following extra
+% fields are present:
+% word 10 <proc entry layout for =/2>
+% word 11 <proc entry layout for index/2>
+% word 12 <proc entry layout for compare/3>
%
% The other cell is the type_info structure, laid out like this:
%
Index: compiler/rl_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rl_code.m,v
retrieving revision 1.9
diff -u -r1.9 rl_code.m
--- compiler/rl_code.m 1999/09/07 05:48:54 1.9
+++ compiler/rl_code.m 2000/02/25 23:39:25
@@ -63,6 +63,7 @@
:- type bytecode --->
rl_EXP_bool_immed(int32)
+/*
; rl_EXP_int_immed(int32)
; rl_EXP_bool_push(int32)
; rl_EXP_int_push(int32)
@@ -419,6 +420,7 @@
; rl_HEAD_var_stream(int32)
; rl_HEAD_define_rule(int32,int32,int32)
; rl_HEAD_last_bytecode
+*/
.
@@ -445,6 +447,7 @@
int16_to_bytecode(0, I0Codes),
int32_to_bytecode(X0int32, X0int32Codes),
list__condense([I0Codes,X0int32Codes], Splits).
+/*
bytecode_to_intlist(rl_EXP_int_immed(X0int32), Splits) :-
int16_to_bytecode(1, I1Codes),
int32_to_bytecode(X0int32, X0int32Codes),
@@ -1714,6 +1717,7 @@
bytecode_to_intlist(rl_HEAD_last_bytecode, Splits) :-
int16_to_bytecode(356, I356Codes),
list__condense([I356Codes], Splits).
+*/
int32_to_bytecode(X, List) :-
int32_to_byte_list(X, List).
Index: compiler/stack_layout.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/stack_layout.m,v
retrieving revision 1.43
diff -u -r1.43 stack_layout.m
--- compiler/stack_layout.m 2000/01/14 01:10:43 1.43
+++ compiler/stack_layout.m 2000/02/25 23:39:36
@@ -46,6 +46,7 @@
% predicate name (String)
% predicate arity (int_least16_t)
% procedure number (int_least16_t)
+% owner scc id (Word) actually MR_SCCId *
%
% Automatically generated unification, index and comparison predicates
% use the second form:
@@ -56,6 +57,7 @@
% predicate name (String)
% predicate arity (int_least16_t)
% procedure number (int_least16_t)
+% owner scc id (Word) actually MR_SCCId *
%
% The runtime system can figure out which form is present by testing
% the value of the first slot. A value of 0 or 1 indicates the first form;
@@ -239,15 +241,15 @@
:- interface.
:- import_module continuation_info, hlds_module, llds.
-:- import_module std_util, list, set_bbbtree.
+:- import_module bool, std_util, list, set_bbbtree.
:- pred stack_layout__generate_llds(module_info::in, module_info::out,
global_data::in,
list(comp_gen_c_data)::out, list(comp_gen_c_data)::out,
set_bbbtree(label)::out) is det.
-:- pred stack_layout__construct_closure_layout(proc_label::in,
- closure_layout_info::in, list(maybe(rval))::out,
+:- pred stack_layout__construct_closure_layout(bool::in, proc_label::in,
+ maybe(rval)::in, closure_layout_info::in, list(maybe(rval))::out,
create_arg_types::out, int::in, int::out) is det.
:- implementation.
@@ -255,7 +257,7 @@
:- import_module globals, options, llds_out, trace.
:- import_module hlds_data, hlds_pred, base_type_layout, prog_data, prog_out.
:- import_module (inst), code_util.
-:- import_module assoc_list, bool, string, int, require.
+:- import_module assoc_list, string, int, require.
:- import_module map, term, set.
%---------------------------------------------------------------------------%
@@ -270,6 +272,7 @@
module_info_name(ModuleInfo0, ModuleName),
module_info_get_cell_count(ModuleInfo0, CellCount),
module_info_globals(ModuleInfo0, Globals),
+ % module_info_get_scc_info(ModuleInfo0, scc_info(ProcSCCs, _)),
globals__lookup_bool_option(Globals, agc_stack_layout, AgcLayout),
globals__lookup_bool_option(Globals, trace_stack_layout, TraceLayout),
globals__lookup_bool_option(Globals, procid_stack_layout,
@@ -299,7 +302,7 @@
ConcatStrings),
( TraceLayout = yes ->
- Exported = no, % ignored; see linkage/2 in llds_out.m
+ Exported = yes, % ignored; see linkage/2 in llds_out.m
list__length(ProcLayoutList, NumProcLayouts),
llds_out__sym_name_mangle(ModuleName, ModuleNameStr),
stack_layout__get_next_cell_number(ProcVectorCellNum,
@@ -516,14 +519,15 @@
% with the labels defined in this procedure.
:- pred stack_layout__construct_layouts(proc_layout_info::in,
- stack_layout_info::in, stack_layout_info::out) is det.
+ stack_layout_info::in, stack_layout_info::out) is det.
stack_layout__construct_layouts(ProcLayoutInfo) -->
- { ProcLayoutInfo = proc_layout_info(EntryLabel, Detism,
- StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
+ { ProcLayoutInfo = proc_layout_info(ImportStatus, EntryLabel, Detism,
+ SCCId, StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
TraceSlotInfo, ForceProcIdLayout, InternalMap) },
- stack_layout__construct_proc_layout(EntryLabel, Detism,
- StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
+ { status_is_exported(ImportStatus, Exported) },
+ stack_layout__construct_proc_layout(Exported, EntryLabel, Detism,
+ SCCId, StackSlots, SuccipLoc, MaybeCallLabel, MaxTraceReg,
TraceSlotInfo, ForceProcIdLayout),
{ map__to_assoc_list(InternalMap, Internals) },
list__foldl(stack_layout__construct_internal_layout(EntryLabel),
@@ -620,14 +624,14 @@
% Construct a procedure-specific layout.
-:- pred stack_layout__construct_proc_layout(label::in, determinism::in,
- int::in, maybe(int)::in, maybe(label)::in, int::in,
- trace_slot_info::in, bool::in,
+:- pred stack_layout__construct_proc_layout(bool::in, label::in,
+ determinism::in, maybe(rval)::in, int::in, maybe(int)::in,
+ maybe(label)::in, int::in, trace_slot_info::in, bool::in,
stack_layout_info::in, stack_layout_info::out) is det.
-stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots,
- MaybeSuccipLoc, MaybeCallLabel, MaxTraceReg, TraceSlotInfo,
- ForceProcIdLayout) -->
+stack_layout__construct_proc_layout(Exported, EntryLabel, Detism, SCCId,
+ StackSlots, MaybeSuccipLoc, MaybeCallLabel, MaxTraceReg,
+ TraceSlotInfo, ForceProcIdLayout) -->
{
MaybeSuccipLoc = yes(Location0)
->
@@ -689,8 +693,8 @@
->
{ code_util__extract_proc_label_from_label(EntryLabel,
ProcLabel) },
- { stack_layout__construct_procid_rvals(ProcLabel, IdRvals,
- IdArgTypes) },
+ { stack_layout__construct_procid_rvals(ProcLabel, SCCId,
+ IdRvals, IdArgTypes) },
stack_layout__construct_trace_layout(MaybeCallLabel,
MaxTraceReg, TraceSlotInfo, TraceRvals, TraceArgTypes),
{ list__append(IdRvals, TraceRvals, IdTraceRvals) },
@@ -701,11 +705,6 @@
{ IdTraceArgTypes = initial([1 - yes(integer)], none) }
),
- { Exported = no }, % XXX With the new profiler, we will need to
- % set this to `yes' if the profiling option
- % is given and if the procedure is exported.
- % Beware however that linkage/2 in llds_out.m
- % assumes that this is `no'.
{ list__append(TraversalRvals, IdTraceRvals, Rvals) },
{ ArgTypes = initial(TraversalArgTypes, IdTraceArgTypes) },
stack_layout__get_module_name(ModuleName),
@@ -767,10 +766,19 @@
%---------------------------------------------------------------------------%
-:- pred stack_layout__construct_procid_rvals(proc_label::in,
+:- pred stack_layout__construct_procid_rvals(proc_label::in, maybe(rval)::in,
list(maybe(rval))::out, initial_arg_types::out) is det.
-stack_layout__construct_procid_rvals(ProcLabel, Rvals, ArgTypes) :-
+stack_layout__construct_procid_rvals(ProcLabel, SCCId0, Rvals, ArgTypes) :-
+ (
+ SCCId0 = yes(_),
+ SCCIdElem = [SCCId0],
+ SCCIdElemType = [1 - no]
+ ;
+ SCCId0 = no,
+ SCCIdElem = [],
+ SCCIdElemType = []
+ ),
(
ProcLabel = proc(DefModule, PredFunc, DeclModule,
PredName, Arity, ProcId),
@@ -784,9 +792,10 @@
yes(const(string_const(DefModuleString))),
yes(const(string_const(PredName))),
yes(const(int_const(Arity))),
- yes(const(int_const(Mode)))
+ yes(const(int_const(Mode)))|
+ SCCIdElem
],
- ArgTypes = [4 - no, 2 - yes(int_least16)]
+ ArgTypes = [4 - no, 2 - yes(int_least16)|SCCIdElemType]
;
ProcLabel = special_proc(DefModule, PredName, TypeModule,
TypeName, Arity, ProcId),
@@ -799,9 +808,10 @@
yes(const(string_const(DefModuleString))),
yes(const(string_const(PredName))),
yes(const(int_const(Arity))),
- yes(const(int_const(Mode)))
+ yes(const(int_const(Mode)))|
+ SCCIdElem
],
- ArgTypes = [4 - no, 2 - yes(int_least16)]
+ ArgTypes = [4 - no, 2 - yes(int_least16)|SCCIdElemType]
).
:- pred stack_layout__represent_pred_or_func(pred_or_func::in, int::out) is det.
@@ -1247,21 +1257,39 @@
% with runtime/mercury_ho_call.h, which contains macros to access
% the data structures we build here.
-stack_layout__construct_closure_layout(ProcLabel, ClosureLayoutInfo,
- Rvals, ArgTypes, CNum0, CNum) :-
- stack_layout__construct_procid_rvals(ProcLabel, ProcIdRvals,
- ProcIdTypes),
+stack_layout__construct_closure_layout(UsingStackLayouts, ProcLabel, SCCId,
+ ClosureLayoutInfo, Rvals, ArgTypes, CNum0, CNum) :-
+ (
+ ProcLabel = proc(_, _, ModuleName, _, _, _)
+ ;
+ ProcLabel = special_proc(_, _, ModuleName, _, _, _)
+ ),
+ ( UsingStackLayouts = yes ->
+ ProcIdRval = c_func(data_ptr, "MR_ENTRY_LAYOUT_ADDRESS",
+ [data_ptr - const(data_addr_const(
+ data_addr(ModuleName,
+ proc_layout(exported(ProcLabel)))
+ ))], static),
+ CNum1 = CNum0
+ ;
+ stack_layout__construct_procid_rvals(ProcLabel, SCCId,
+ ProcIdRvals, ProcIdTypes),
+ ProcIdRval = create(0, ProcIdRvals,
+ initial(ProcIdTypes, none), must_be_static,
+ CNum0, "proc_layout_vector", no),
+ CNum1 = CNum0 + 1
+ ),
ClosureLayoutInfo = closure_layout_info(ClosureArgs,
TVarLocnMap),
stack_layout__construct_closure_arg_rvals(ClosureArgs,
- ClosureArgRvals, ClosureArgTypes, CNum0, CNum1),
+ ClosureArgRvals, ClosureArgTypes, CNum1, CNum2),
stack_layout__construct_tvar_vector(TVarLocnMap, TVarVectorRval,
- CNum1, CNum),
+ CNum2, CNum),
TVarVectorRvals = [yes(TVarVectorRval)],
TVarVectorTypes = [1 - yes(data_ptr)],
list__append(TVarVectorRvals, ClosureArgRvals, LayoutRvals),
- list__append(ProcIdRvals, LayoutRvals, Rvals),
- ArgTypes = initial(ProcIdTypes, initial(TVarVectorTypes,
+ Rvals = [yes(ProcIdRval)|LayoutRvals],
+ ArgTypes = initial([1 - yes(data_ptr)], initial(TVarVectorTypes,
initial(ClosureArgTypes, none))).
:- pred stack_layout__construct_closure_arg_rvals(list(closure_arg_info)::in,
@@ -1430,6 +1458,9 @@
stack_layout__represent_lval(temp(_, _), _) :-
error("stack_layout: continuation live value stored in temp register").
+
+stack_layout__represent_lval(global(_, _), _) :-
+ error("stack_layout: continuation live value stored in global").
stack_layout__represent_lval(succip(_), _) :-
error("stack_layout: continuation live value stored in fixed slot").
Index: compiler/unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_gen.m,v
retrieving revision 1.104
diff -u -r1.104 unify_gen.m
--- compiler/unify_gen.m 2000/01/14 01:10:46 1.104
+++ compiler/unify_gen.m 2000/02/25 23:39:38
@@ -41,6 +41,7 @@
:- import_module hlds_module, hlds_pred, prog_data, prog_out, code_util.
:- import_module mode_util, type_util, code_aux, hlds_out, tree, arg_info.
:- import_module globals, options, continuation_info, stack_layout.
+:- import_module profiling.
:- import_module term, bool, string, int, list, map, require, std_util.
@@ -530,8 +531,13 @@
{ code_util__extract_proc_label_from_code_addr(CodeAddr,
ProcLabel) },
code_info__get_cell_count(CNum0),
- { stack_layout__construct_closure_layout(ProcLabel,
- ClosureInfo, ClosureLayoutMaybeRvals,
+ profiling__scc_id(proc(PredId, ProcId), SCCId),
+ code_info__get_globals(Globals),
+ { globals__lookup_bool_option(Globals, procid_stack_layout,
+ StackLayouts) },
+ { stack_layout__construct_closure_layout(StackLayouts,
+ ProcLabel, SCCId, ClosureInfo,
+ ClosureLayoutMaybeRvals,
ClosureLayoutArgTypes, CNum0, CNum) },
code_info__set_cell_count(CNum),
code_info__get_next_cell_number(ClosureLayoutCellNo),
Index: compiler/vn_cost.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_cost.m,v
retrieving revision 1.40
diff -u -r1.40 vn_cost.m
--- compiler/vn_cost.m 2000/01/14 01:10:57 1.40
+++ compiler/vn_cost.m 2000/02/25 23:39:39
@@ -238,6 +238,9 @@
)
)
;
+ Lval = global(_, _),
+ Cost = 0
+ ;
Lval = stackvar(_),
vn_type__costof_stackref(Params, StackrefCost),
Cost = StackrefCost
@@ -338,6 +341,13 @@
;
Rval = mem_addr(MemRef),
vn_cost__mem_ref_cost(MemRef, Params, Cost)
+ ;
+ Rval = c_func(_, _, Args, _),
+ list__foldl(lambda([Arg::in, Cost0::in, Cost1::out] is det, (
+ Arg = _Type - ArgRval,
+ vn_cost__rval_cost(ArgRval, Params, Cost2),
+ Cost1 is Cost0 + Cost2
+ )), Args, 0, Cost)
).
:- pred vn_cost__mem_ref_cost(mem_ref, vn_params, int).
Index: compiler/vn_filter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_filter.m,v
retrieving revision 1.24
diff -u -r1.24 vn_filter.m
--- compiler/vn_filter.m 2000/01/14 01:11:01 1.24
+++ compiler/vn_filter.m 2000/02/25 23:39:40
@@ -376,6 +376,7 @@
vn_filter__replace_in_lval(lvar(_), _, _, _) :-
error("found lvar in vn_filter__replace_in_lval").
vn_filter__replace_in_lval(temp(T, N), _, _, temp(T, N)).
+vn_filter__replace_in_lval(global(Typ, Glob), _, _, global(Typ, Glob)).
vn_filter__replace_in_lval(mem_ref(Rval0), Temp, Defn, mem_ref(Rval)) :-
vn_filter__replace_in_rval(Rval0, Temp, Defn, Rval).
@@ -408,6 +409,13 @@
vn_filter__replace_in_rval(Rval2, Temp, Defn, Rval4).
vn_filter__replace_in_rval(mem_addr(MemRef0), Temp, Defn, mem_addr(MemRef)) :-
vn_filter__replace_in_mem_ref(MemRef0, Temp, Defn, MemRef).
+vn_filter__replace_in_rval(c_func(RT, Nm, Args0, St), Temp, Defn,
+ c_func(RT, Nm, Args, St)) :-
+ list__map(lambda([Arg0::in, Arg::out] is det, (
+ Arg0 = Type - ArgRval0,
+ Arg = Type - ArgRval,
+ vn_filter__replace_in_rval(ArgRval0, Temp, Defn, ArgRval)
+ )), Args0, Args).
% vn_filter__replace_in_mem_ref(Ref0, Old, New, Ref):
% Replace all occurrences of lval(Old) with New in Ref0,
Index: compiler/vn_flush.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_flush.m,v
retrieving revision 1.51
diff -u -r1.51 vn_flush.m
--- compiler/vn_flush.m 2000/01/14 01:11:02 1.51
+++ compiler/vn_flush.m 2000/02/25 23:39:42
@@ -739,6 +739,12 @@
VnTables0, VnTables, Templocs0, Templocs, Params,
Instrs),
Rval = mem_addr(heap_ref(Rval1, Tag, Field))
+ ;
+ Vnrval = vn_c_func(RT, Name, Args, St),
+ Rval = c_func(RT, Name, Args, St),
+ VnTables = VnTables0,
+ Templocs = Templocs0,
+ Instrs = []
).
%-----------------------------------------------------------------------------%
@@ -952,6 +958,9 @@
;
Vnrval = vn_heap_addr(_, _, _),
error("heap_addr in calculation of new hp")
+ ;
+ Vnrval = vn_c_func(_, _, _, _),
+ error("vn_c_func in calculation of new hp")
),
( Srcs = [SrcPrime | _] ->
Src = SrcPrime
@@ -1099,6 +1108,12 @@
VnTables0, VnTables,
Templocs0, Templocs, Params, AccessInstrs),
Lval = mem_ref(Rval)
+ ;
+ Vnlval = vn_global(Type, Glob),
+ Lval = global(Type, Glob),
+ VnTables = VnTables0,
+ Templocs = Templocs0,
+ AccessInstrs = []
).
%-----------------------------------------------------------------------------%
Index: compiler/vn_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_order.m,v
retrieving revision 1.50
diff -u -r1.50 vn_order.m
--- compiler/vn_order.m 2000/01/14 01:11:03 1.50
+++ compiler/vn_order.m 2000/02/25 23:39:44
@@ -668,6 +668,11 @@
Vnrval = vn_heap_addr(SubVn, _, _),
vn_order__find_links(SubVn, Sink, VnTables0, VnTables,
Succmap0, Succmap, Predmap0, Predmap)
+ ;
+ Vnrval = vn_c_func(_, _, _, _),
+ Succmap = Succmap0,
+ Predmap = Predmap0,
+ VnTables = VnTables0
)
).
Index: compiler/vn_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_type.m,v
retrieving revision 1.43
diff -u -r1.43 vn_type.m
--- compiler/vn_type.m 2000/01/14 01:11:05 1.43
+++ compiler/vn_type.m 2000/02/25 23:39:44
@@ -20,6 +20,7 @@
:- type vnlval ---> vn_reg(reg_type, int)
; vn_temp(reg_type, int)
+ ; vn_global(llds_type, string)
; vn_stackvar(int)
; vn_framevar(int)
; vn_succip
@@ -48,7 +49,9 @@
; vn_binop(binary_op, vn, vn)
; vn_stackvar_addr(int)
; vn_framevar_addr(int)
- ; vn_heap_addr(vn, int, int).
+ ; vn_heap_addr(vn, int, int)
+ ; vn_c_func(llds_type, string, list(pair(llds_type, rval)), staticly_evaluable)
+ .
% these rvals do not have vnrval parallels
% var(var)
@@ -190,6 +193,7 @@
vn_type__vnrval_type(vn_stackvar_addr(_), data_ptr).
vn_type__vnrval_type(vn_framevar_addr(_), data_ptr).
vn_type__vnrval_type(vn_heap_addr(_, _, _), data_ptr).
+vn_type__vnrval_type(vn_c_func(_, _, _, _), word).
vn_type__vnlval_type(vn_reg(RegType, _), Type) :-
llds__register_type(RegType, Type).
@@ -209,3 +213,4 @@
vn_type__vnlval_type(vn_prevfr(_), data_ptr).
vn_type__vnlval_type(vn_field(_, _, _), word).
vn_type__vnlval_type(vn_mem_ref(_), word).
+vn_type__vnlval_type(vn_global(Type, _), Type).
Index: compiler/vn_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/vn_util.m,v
retrieving revision 1.68
diff -u -r1.68 vn_util.m
--- compiler/vn_util.m 2000/01/14 01:11:06 1.68
+++ compiler/vn_util.m 2000/02/25 23:39:47
@@ -51,6 +51,7 @@
vn_util__find_specials(vn_succfr(Vn), [vn_succfr(Vn)]).
vn_util__find_specials(vn_hp, [vn_hp]).
vn_util__find_specials(vn_sp, [vn_sp]).
+vn_util__find_specials(vn_global(_, _), []).
vn_util__find_specials(vn_field(_, _, _), []).
vn_util__find_specials(vn_mem_ref(_), []).
@@ -174,6 +175,10 @@
;
Rval = mem_addr(MemRef),
vn_util__mem_ref_to_vn(MemRef, Vn, VnTables0, VnTables)
+ ;
+ Rval = c_func(RT, Name, Args, St),
+ vn_util__vnrval_to_vn(vn_c_func(RT, Name, Args, St),
+ Vn, VnTables0, VnTables)
).
:- pred vn_util__mem_ref_to_vn(mem_ref, vn, vn_tables, vn_tables).
@@ -983,6 +988,7 @@
vn_util__no_access_lval_to_vnlval(hp, yes(vn_hp)).
vn_util__no_access_lval_to_vnlval(sp, yes(vn_sp)).
vn_util__no_access_lval_to_vnlval(mem_ref(_), no).
+vn_util__no_access_lval_to_vnlval(global(T, Nam), yes(vn_global(T, Nam))).
vn_util__no_access_lval_to_vnlval(field(_, _, _), no).
vn_util__no_access_lval_to_vnlval(lvar(_Var), _) :-
error("lvar detected in value_number").
@@ -1003,6 +1009,7 @@
vn_util__no_access_vnlval_to_lval(vn_sp, yes(sp)).
vn_util__no_access_vnlval_to_lval(vn_field(_, _, _), no).
vn_util__no_access_vnlval_to_lval(vn_mem_ref(_), no).
+vn_util__no_access_vnlval_to_lval(vn_global(T, Glob), yes(global(T, Glob))).
/* one of these preds should be eliminated XXX */
vn_util__vnlval_access_vns(vn_reg(_, _), []).
@@ -1019,6 +1026,7 @@
vn_util__vnlval_access_vns(vn_succfr(Vn), [Vn]).
vn_util__vnlval_access_vns(vn_hp, []).
vn_util__vnlval_access_vns(vn_sp, []).
+vn_util__vnlval_access_vns(vn_global(_, _), []).
vn_util__vnlval_access_vns(vn_field(_, Vn1, Vn2), [Vn1, Vn2]).
vn_util__vnlval_access_vns(vn_mem_ref(Vn), [Vn]).
@@ -1032,6 +1040,7 @@
vn_util__find_sub_vns(vn_stackvar_addr(_), []).
vn_util__find_sub_vns(vn_framevar_addr(_), []).
vn_util__find_sub_vns(vn_heap_addr(SubVn, _, _), [SubVn]).
+vn_util__find_sub_vns(vn_c_func(_, _, _, _), []).
vn_util__is_const_expr(Vn, IsConst, VnTables) :-
vn_table__lookup_defn(Vn, Vnrval, "vn_util__is_const_expr", VnTables),
@@ -1064,6 +1073,9 @@
;
Vnrval = vn_heap_addr(_, _, _),
IsConst = no
+ ;
+ Vnrval = vn_c_func(_, _, _, _),
+ IsConst = no
).
vn_util__find_lvals_in_rval(Rval, Lvals) :-
@@ -1095,6 +1107,13 @@
;
Rval = mem_addr(MemRef),
vn_util__find_lvals_in_mem_ref(MemRef, Lvals)
+ ;
+ Rval = c_func(_, _, Args, _),
+ list__map(lambda([Arg::in, ArgLvals::out] is det, (
+ Arg = _Type - ArgRval,
+ vn_util__find_lvals_in_rval(ArgRval, ArgLvals)
+ )), Args, LvalsList),
+ list__condense(LvalsList, Lvals)
).
vn_util__find_lvals_in_rvals([], []).
@@ -1197,6 +1216,7 @@
vn_util__classify_loc_cost(vn_succfr(_), 1).
vn_util__classify_loc_cost(vn_hp, 0).
vn_util__classify_loc_cost(vn_sp, 0).
+vn_util__classify_loc_cost(vn_global(_, _), 0).
vn_util__classify_loc_cost(vn_field(_, _, _), 2).
vn_util__classify_loc_cost(vn_mem_ref(_), 2).
@@ -1369,6 +1389,9 @@
Vnrval = vn_heap_addr(SubVn, _, _),
vn_util__record_use(SubVn, src_vn(Vn),
VnTables1, VnTables)
+ ;
+ Vnrval = vn_c_func(_, _, _, _),
+ VnTables = VnTables1
)
;
VnTables = VnTables1
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.67
diff -u -r1.67 array.m
--- library/array.m 2000/01/19 09:45:16 1.67
+++ library/array.m 2000/02/25 23:39:49
@@ -276,6 +276,26 @@
Declare_entry(mercury__array__array_equal_2_0);
Declare_entry(mercury__array__array_compare_3_0);
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(unify_array_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Unify___array__array_1_0,
+ MR_DETISM_SEMI, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""array"", ""builtin_compare"", 2, 0,
+ unify_array_scc_id);
+
+ MR_MAKE_SCC_ID(index_array_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Index___array__array_1_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""array"", ""builtin_index"", 2, 0,
+ index_array_scc_id);
+
+ MR_MAKE_SCC_ID(compare_array_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Compare___array__array_1_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""array"", ""builtin_index"", 3, 0,
+ compare_array_scc_id);
+#endif
+
BEGIN_MODULE(array_module_builtins)
init_entry(mercury____Unify___array__array_1_0);
init_entry(mercury____Index___array__array_1_0);
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.27
diff -u -r1.27 builtin.m
--- library/builtin.m 2000/01/19 09:45:17 1.27
+++ library/builtin.m 2000/02/25 23:39:50
@@ -283,6 +283,26 @@
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(void, 0, MR_TYPECTOR_REP_VOID);
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(closure_unify_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__builtin_unify_pred_2_0,
+ MR_DETISM_SEMI, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""closure"", ""builtin_unify"", 2, 0,
+ closure_unify_scc_id);
+
+ MR_MAKE_SCC_ID(closure_index_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__builtin_index_pred_2_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""closure"", ""builtin_index"", 2, 0,
+ closure_index_scc_id);
+
+ MR_MAKE_SCC_ID(closure_compare_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__builtin_compare_pred_3_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""closure"", ""builtin_compare"", 3, 0,
+ closure_compare_scc_id);
+#endif
+
#ifdef NATIVE_GC
/*
@@ -403,6 +423,19 @@
Define_extern_entry(mercury__copy_2_0);
Define_extern_entry(mercury__copy_2_1);
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(copy_scc_id_0, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__copy_2_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""builtin"", ""builtin_copy"", 2, 0,
+ copy_scc_id_0);
+ MR_MAKE_SCC_ID(copy_scc_id_1, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__copy_2_1,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""builtin"", ""builtin_copy"", 2, 1,
+ copy_scc_id_1);
+#endif
+
BEGIN_MODULE(copy_module)
init_entry(mercury__copy_2_0);
init_entry(mercury__copy_2_1);
@@ -457,6 +490,26 @@
mercury____Unify___builtin__c_pointer_0_0,
mercury____Index___builtin__c_pointer_0_0,
mercury____Compare___builtin__c_pointer_0_0);
+
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(c_pointer_unify_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Unify___builtin__c_pointer_0_0,
+ MR_DETISM_SEMI, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""builtin_c_pointer"", ""builtin_unify"", 2, 0,
+ c_pointer_unify_scc_id);
+
+ MR_MAKE_SCC_ID(c_pointer_index_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Index___builtin__c_pointer_0_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""builtin_c_pointer"", ""builtin_index"", 2, 0,
+ c_pointer_index_scc_id);
+
+ MR_MAKE_SCC_ID(c_pointer_compare_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Compare___builtin__c_pointer_0_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""builtin_c_pointer"", ""builtin_compare"", 3, 0,
+ c_pointer_compare_scc_id);
+#endif
BEGIN_MODULE(unify_c_pointer_module)
init_entry(mercury____Unify___builtin__c_pointer_0_0);
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.12
diff -u -r1.12 exception.m
--- library/exception.m 1999/12/30 15:06:26 1.12
+++ library/exception.m 2000/02/25 23:39:53
@@ -965,29 +965,52 @@
** module, name, arity, mode)
*/
+MR_MAKE_SCC_ID(throw_scc_id_1, { }, { }, { });
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_throw_1_0,
MR_DETISM_DET, BUILTIN_THROW_STACK_SIZE, MR_LONG_LVAL_STACKVAR(1),
- MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0);
+ MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0,
+ throw_scc_id_1);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_throw_1_0, 1);
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(catch_scc_id_1, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 0,
+ catch_scc_id_1);
+
+ MR_MAKE_SCC_ID(catch_scc_id_4, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_4,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 4,
+ catch_scc_id_4);
+#endif
/*
** The following procedures all allocate their stack frames on
** the nondet stack, so for the purposes of doing stack traces
** we say they have MR_DETISM_NON, even though they are not
** actually nondet.
*/
+MR_MAKE_SCC_ID(catch_scc_id_2, { }, { }, { });
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_2,
MR_DETISM_NON, /* really cc_multi; also used for det */
MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
- MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 2);
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 2,
+ catch_scc_id_2);
+
+MR_MAKE_SCC_ID(catch_scc_id_3, { }, { }, { });
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_3,
MR_DETISM_NON, /* really cc_nondet; also used for semidet */
MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
- MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 3);
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 3,
+ catch_scc_id_3);
+
+MR_MAKE_SCC_ID(catch_scc_id_5, { }, { }, { });
MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_5,
MR_DETISM_NON, /* ; also used for multi */
MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
- MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 5);
+ MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 5,
+ catch_scc_id_5);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 1);
MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 2);
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.40
diff -u -r1.40 private_builtin.m
--- library/private_builtin.m 2000/02/16 09:17:30 1.40
+++ library/private_builtin.m 2000/02/25 23:39:56
@@ -286,6 +286,27 @@
** type_ctor_infos.
*/
+Declare_entry(mercury____Unify___private_builtin__type_info_1_0);
+MR_MAKE_SCC_ID(unify_type_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Unify___private_builtin__type_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""unify_type_info"", 2, 0,
+ unify_type_info_scc_id);
+
+Declare_entry(mercury____Index___private_builtin__type_info_1_0);
+MR_MAKE_SCC_ID(index_type_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Index___private_builtin__type_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""index_type_info"", 2, 0,
+ index_type_info_scc_id);
+
+Declare_entry(mercury____Compare___private_builtin__type_info_1_0);
+MR_MAKE_SCC_ID(comapre_type_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Compare___private_builtin__type_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""comapre_type_info"", 2, 0,
+ comapre_type_info_scc_id);
+
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, type_ctor_info, 1,
MR_TYPECTOR_REP_TYPEINFO,
mercury____Unify___private_builtin__type_info_1_0,
@@ -293,6 +314,27 @@
mercury____Compare___private_builtin__type_info_1_0);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
MR_TYPECTOR_REP_TYPEINFO);
+
+Declare_entry(mercury____Unify___private_builtin__typeclass_info_1_0);
+MR_MAKE_SCC_ID(unify_typeclass_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Unify___private_builtin__typeclass_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""unify_typeclass_info"", 2, 0,
+ unify_typeclass_info_scc_id);
+
+Declare_entry(mercury____Index___private_builtin__typeclass_info_1_0);
+MR_MAKE_SCC_ID(index_typeclass_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Index___private_builtin__typeclass_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""index_typeclass_info"", 2, 0,
+ index_typeclass_info_scc_id);
+
+Declare_entry(mercury____Compare___private_builtin__typeclass_info_1_0);
+MR_MAKE_SCC_ID(comapre_typeclass_info_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(mercury____Compare___private_builtin__typeclass_info_1_0,
+ MR_DETISM_SEMI, 0, 0, MR_PREDICATE,
+ ""private_builtin"", ""comapre_typeclass_info"", 2, 0,
+ comapre_typeclass_info_scc_id);
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, base_typeclass_info, 1,
MR_TYPECTOR_REP_TYPECLASSINFO,
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.180
diff -u -r1.180 std_util.m
--- library/std_util.m 2000/02/25 01:15:40 1.180
+++ library/std_util.m 2000/02/25 23:40:02
@@ -997,9 +997,11 @@
Declare_label(mercury____Compare___std_util__univ_0_0_i1);
+MR_MAKE_SCC_ID(univ_compare_scc_id, { }, { }, { });
MR_MAKE_PROC_LAYOUT(mercury____Compare___std_util__univ_0_0,
MR_DETISM_DET, 1, MR_LONG_LVAL_STACKVAR(1),
- MR_PREDICATE, ""std_util"", ""compare_univ"", 3, 0);
+ MR_PREDICATE, ""std_util"", ""compare_univ"", 3, 0,
+ univ_compare_scc_id);
MR_MAKE_INTERNAL_LAYOUT(mercury____Compare___std_util__univ_0_0, 1);
#endif
@@ -1007,6 +1009,38 @@
Define_extern_entry(mercury____Unify___std_util__type_info_0_0);
Define_extern_entry(mercury____Index___std_util__type_info_0_0);
Define_extern_entry(mercury____Compare___std_util__type_info_0_0);
+
+#ifdef MR_PROFILE_DEEP
+ MR_MAKE_SCC_ID(univ_unify_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Unify___std_util__univ_0_0,
+ MR_DETISM_SEMI, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""univ"", ""builtin_unify"", 2, 0,
+ univ_unify_scc_id);
+
+ MR_MAKE_SCC_ID(univ_index_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Index___std_util__univ_0_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""univ"", ""builtin_index"", 2, 0,
+ univ_index_scc_id);
+
+ MR_MAKE_SCC_ID(type_info_unify_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Unify___std_util__type_info_0_0,
+ MR_DETISM_SEMI, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""type_info"", ""builtin_unify"", 2, 0,
+ type_info_unify_scc_id);
+
+ MR_MAKE_SCC_ID(type_info_index_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Index___std_util__type_info_0_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""type_info"", ""builtin_index"", 2, 0,
+ type_info_index_scc_id);
+
+ MR_MAKE_SCC_ID(type_info_compare_scc_id, { }, { }, { });
+ MR_MAKE_PROC_LAYOUT(mercury____Compare___std_util__type_info_0_0,
+ MR_DETISM_DET, MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN,
+ MR_PREDICATE, ""type_info"", ""builtin_compare"", 3, 0,
+ type_info_compare_scc_id);
+#endif
BEGIN_MODULE(unify_univ_module)
init_entry(mercury____Unify___std_util__univ_0_0);
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.51
diff -u -r1.51 Mmakefile
--- runtime/Mmakefile 2000/02/03 10:31:52 1.51
+++ runtime/Mmakefile 2000/02/25 23:40:03
@@ -60,6 +60,7 @@
mercury_misc.h \
mercury_overflow.h \
mercury_prof.h \
+ mercury_prof_deep.h \
mercury_prof_mem.h \
mercury_reg_workarounds.h \
mercury_regorder.h \
@@ -119,6 +120,7 @@
mercury_memory_handlers.c \
mercury_misc.c \
mercury_prof.c \
+ mercury_prof_deep.c \
mercury_prof_mem.c \
mercury_reg_workarounds.c \
mercury_regs.c \
Index: runtime/mercury_conf_param.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_conf_param.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_conf_param.h
--- runtime/mercury_conf_param.h 2000/02/17 06:47:28 1.34
+++ runtime/mercury_conf_param.h 2000/02/25 23:40:04
@@ -185,6 +185,9 @@
**
** PROFILE_MEMORY
** Enables profiling of memory usage.
+**
+** MR_PROFILE_DEEP
+** Enables deep call-graph profiling.
*/
/*
Index: runtime/mercury_engine.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_engine.c,v
retrieving revision 1.21
diff -u -r1.21 mercury_engine.c
--- runtime/mercury_engine.c 1999/11/22 18:37:36 1.21
+++ runtime/mercury_engine.c 2000/02/25 23:40:06
@@ -672,6 +672,9 @@
** check for a redoip of `exception_handler_do_fail' and
** handle it specially.
*/
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->failures++;
+#endif
MR_fail();
END_MODULE
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.29
diff -u -r1.29 mercury_ho_call.c
--- runtime/mercury_ho_call.c 2000/02/02 07:50:39 1.29
+++ runtime/mercury_ho_call.c 2000/02/25 23:40:07
@@ -67,14 +67,60 @@
*/
Define_extern_entry(mercury__unify_2_0);
+Declare_label(mercury__unify_2_0_i0);
Define_extern_entry(mercury__index_2_0);
-Declare_label(mercury__index_2_0_i1);
+Declare_label(mercury__index_2_0_i0);
Define_extern_entry(mercury__compare_3_0);
Define_extern_entry(mercury__compare_3_1);
Define_extern_entry(mercury__compare_3_2);
Define_extern_entry(mercury__compare_3_3);
-Declare_label(mercury__compare_3_0_i1);
+Declare_label(mercury__compare_3_3_i0);
+/*
+** These are the proc layout structures for unify, index and compare.
+**
+** MR_MAKE_PROC_LAYOUT(entry, detism, slots, succip_locn,
+** pf, module, name, arity, mode)
+*/
+
+#ifdef MR_PROF_DEEP
+MR_MAKE_HO_CALL_SITE(genu_to_specu, mercury__unify_2_0, "runtime", 334);
+MR_MAKE_SCC_ID(unify_scc_id, { }, { &genu_to_specu }, { });
+MR_MAKE_PROC_LAYOUT(mercury__unify_2_0, MR_DETISM_SEMI, 0, 0,
+ MR_PREDICATE, "builtin", "unify", 2, 0,
+ unify_scc_id);
+
+MR_MAKE_HO_CALL_SITE(geni_to_speci, mercury__index_2_0, "builtin", 574);
+MR_MAKE_SCC_ID(index_scc_id, { }, { &geni_to_speci }, { });
+MR_MAKE_PROC_LAYOUT(mercury__index_2_0, MR_DETISM_DET, 0, 0,
+ MR_PREDICATE, "builtin", "index", 2, 0,
+ index_scc_id);
+
+MR_MAKE_HO_CALL_SITE(genc_to_specc0, mercury__compare_3_0, "builtin", 738);
+MR_MAKE_SCC_ID(compare_scc_id_0, { }, { &genc_to_specc0 }, { });
+MR_MAKE_PROC_LAYOUT(mercury__compare_3_0, MR_DETISM_DET, 0, 0,
+ MR_PREDICATE, "builtin", "compare", 3, 0,
+ compare_scc_id_0);
+
+MR_MAKE_HO_CALL_SITE(genc_to_specc1, mercury__compare_3_0, "builtin", 738);
+MR_MAKE_SCC_ID(compare_scc_id_1, { }, { &genc_to_specc1 }, { });
+MR_MAKE_PROC_LAYOUT(mercury__compare_3_1, MR_DETISM_DET, 0, 0,
+ MR_PREDICATE, "builtin", "compare", 3, 1,
+ compare_scc_id_1);
+
+MR_MAKE_HO_CALL_SITE(genc_to_specc2, mercury__compare_3_0, "builtin", 738);
+MR_MAKE_SCC_ID(compare_scc_id_2, { }, { &genc_to_specc2 }, { });
+MR_MAKE_PROC_LAYOUT(mercury__compare_3_2, MR_DETISM_DET, 0, 0,
+ MR_PREDICATE, "builtin", "compare", 3, 2,
+ compare_scc_id_2);
+
+MR_MAKE_HO_CALL_SITE(genc_to_specc3, mercury__compare_3_0, "builtin", 738);
+MR_MAKE_SCC_ID(compare_scc_id_3, { }, { &genc_to_specc3 }, { });
+MR_MAKE_PROC_LAYOUT(mercury__compare_3_3, MR_DETISM_DET, 0, 0,
+ MR_PREDICATE, "builtin", "compare", 3, 3,
+ compare_scc_id_3);
+#endif
+
BEGIN_MODULE(call_module)
init_entry_ai(mercury__do_call_closure);
init_entry_ai(mercury__do_call_class_method);
@@ -184,6 +230,10 @@
x = r2;
y = r3;
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->calls++;
+#endif
+
unify_start:
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
@@ -268,13 +318,59 @@
restore_registers();
}
+#ifndef MR_PROFILE_DEEP
tailcall(type_ctor_info->unify_pred,
LABEL(mercury__unify_2_0));
+#else
+{
+ /*
+ ** When doing deep profiling, we need to
+ ** make a stack frame and treat the call
+ ** the way user HO calls get treated,
+ ** except that instead of using an MR_Closure
+ ** we use the
+ */
+ MR_incr_sp_push_msg(3, "runtime:unify/2");
+ MR_stackvar(1) = (Word) LVALUE_CAST(Word *, MR_prof_current_scc);
+ MR_stackvar(2) = (Word) LVALUE_CAST(Word *, MR_prof_current_proc);
+ MR_stackvar(3) = (Word) MR_succip;
+ MR_prof_current_proc = MR_special_ho_call(MR_stackvar(1), 0,
+ type_ctor_info->unify_pred,
+ type_ctor_info->unify_info);
+ MR_prof_current_scc = MR_scc_from_current_proc();
+
+ noprof_call_localret(type_ctor_info->unify_pred,
+ mercury__unify_2_0_i0);
+
+Define_label(mercury__unify_2_0_i0);
+ LVALUE_CAST(Word *, MR_prof_current_proc) = (Word *) MR_stackvar(2);
+ LVALUE_CAST(Word *, MR_prof_current_scc) = (Word *) MR_stackvar(1);
+ MR_succip = (Code *) MR_stackvar(3);
+ MR_decr_sp_pop_msg(3);
+
+ if (r1) {
+ MR_prof_current_proc->successes++;
+ } else {
+ MR_prof_current_proc->failures++;
+ }
+
+ proceed();
+}
+#endif
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_CHAR:
r1 = ((Integer) x == (Integer) y);
+
+#ifdef MR_PROFILE_DEEP
+ if (r1) {
+ MR_prof_current_proc->successes++;
+ } else {
+ MR_prof_current_proc->failures++;
+ }
+#endif
+
proceed();
case MR_TYPECTOR_REP_FLOAT:
@@ -377,6 +473,10 @@
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->calls++;
+#endif
+
#ifdef MR_CTOR_REP_STATS
MR_ctor_rep_index[type_ctor_info->type_ctor_rep]++;
#endif
@@ -453,13 +553,47 @@
restore_registers();
}
+#ifndef MR_PROFILE_DEEP
tailcall(type_ctor_info->index_pred,
LABEL(mercury__index_2_0));
+#else
+{
+ /*
+ ** When doing deep profiling, we need to
+ ** make a stack frame and treat the call
+ ** the way user HO calls get treated,
+ ** except that instead of using an MR_Closure
+ ** we use the
+ */
+ MR_incr_sp_push_msg(3, "runtime:index/2");
+ MR_stackvar(1) = (Word) LVALUE_CAST(Word *, MR_prof_current_scc);
+ MR_stackvar(2) = (Word) LVALUE_CAST(Word *, MR_prof_current_proc);
+ MR_stackvar(3) = (Word) MR_succip;
+ MR_prof_current_proc = MR_special_ho_call(MR_stackvar(1), 0,
+ type_ctor_info->index_pred,
+ type_ctor_info->index_info);
+ MR_prof_current_scc = MR_scc_from_current_proc();
+
+ noprof_call_localret(type_ctor_info->index_pred,
+ mercury__index_2_0_i0);
+
+Define_label(mercury__index_2_0_i0);
+ LVALUE_CAST(Word *, MR_prof_current_proc) = (Word *) MR_stackvar(2);
+ LVALUE_CAST(Word *, MR_prof_current_scc) = (Word *) MR_stackvar(1);
+ MR_succip = (Code *) MR_stackvar(3);
+ MR_decr_sp_pop_msg(3);
+ MR_prof_current_proc->successes++;
+ proceed();
+}
+#endif
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_CHAR:
r1 = x;
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
case MR_TYPECTOR_REP_FLOAT:
@@ -467,13 +601,15 @@
case MR_TYPECTOR_REP_STRING:
fatal_error("attempt to index a string");
- proceed();
case MR_TYPECTOR_REP_UNIV:
fatal_error("attempt to index a term of type `univ'");
case MR_TYPECTOR_REP_C_POINTER:
r1 = x;
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
case MR_TYPECTOR_REP_TYPEINFO:
@@ -532,6 +668,10 @@
x = r2;
y = r3;
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->calls++;
+#endif
+
compare_start:
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO((Word *) type_info);
@@ -616,8 +756,39 @@
restore_registers();
}
+#ifndef MR_PROFILE_DEEP
tailcall(type_ctor_info->compare_pred,
LABEL(mercury__compare_3_3));
+#else
+{
+ /*
+ ** When doing deep profiling, we need to
+ ** make a stack frame and treat the call
+ ** the way user HO calls get treated,
+ ** except that instead of using an MR_Closure
+ ** we use the
+ */
+ MR_incr_sp_push_msg(3, "builtin:compare/3");
+ MR_stackvar(1) = (Word) LVALUE_CAST(Word *, MR_prof_current_scc);
+ MR_stackvar(2) = (Word) LVALUE_CAST(Word *, MR_prof_current_proc);
+ MR_stackvar(3) = (Word) MR_succip;
+ MR_prof_current_proc = MR_special_ho_call(MR_stackvar(1), 0,
+ type_ctor_info->compare_pred,
+ type_ctor_info->compare_info);
+ MR_prof_current_scc = MR_scc_from_current_proc();
+
+ noprof_call_localret(type_ctor_info->compare_pred,
+ mercury__compare_3_3_i0);
+
+Define_label(mercury__compare_3_3_i0);
+ LVALUE_CAST(Word *, MR_prof_current_proc) = (Word *) MR_stackvar(2);
+ LVALUE_CAST(Word *, MR_prof_current_scc) = (Word *) MR_stackvar(1);
+ MR_succip = (Code *) MR_stackvar(3);
+ MR_decr_sp_pop_msg(3);
+ MR_prof_current_proc->successes++;
+ proceed();
+}
+#endif
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_INT:
@@ -630,6 +801,9 @@
r1 = MR_COMPARE_GREATER;
}
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
case MR_TYPECTOR_REP_FLOAT:
@@ -646,6 +820,9 @@
r1 = MR_COMPARE_GREATER;
}
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
}
@@ -662,6 +839,9 @@
r1 = MR_COMPARE_GREATER;
}
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
}
@@ -706,6 +886,9 @@
r1 = MR_COMPARE_GREATER;
}
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
case MR_TYPECTOR_REP_TYPEINFO:
@@ -716,6 +899,9 @@
result = MR_compare_type_info(x, y);
restore_transient_registers();
r1 = result;
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc->successes++;
+#endif
proceed();
}
Index: runtime/mercury_ho_call.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_ho_call.h
--- runtime/mercury_ho_call.h 1999/10/07 11:24:04 1.2
+++ runtime/mercury_ho_call.h 2000/02/25 23:40:08
@@ -66,7 +66,7 @@
*/
typedef struct MR_Closure_Layout_Struct {
- MR_Stack_Layout_Proc_Id proc_id;
+ MR_Stack_Layout_Proc_Id *proc_id;
MR_Type_Param_Locns *type_params;
Integer num_all_args;
MR_PseudoTypeInfo arg_pseudo_type_info[MR_VARIABLE_SIZED];
Index: runtime/mercury_init.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_init.h,v
retrieving revision 1.20
diff -u -r1.20 mercury_init.h
--- runtime/mercury_init.h 2000/02/08 02:08:05 1.20
+++ runtime/mercury_init.h 2000/02/25 23:40:08
@@ -85,6 +85,7 @@
mercury_runtime_terminate(),
etc. */
#include "mercury_trace_base.h" /* for MR_trace_port */
+#include "mercury_prof_deep.h" /* for MR_prof_init_globals */
#ifdef CONSERVATIVE_GC
#include "gc.h"
Index: runtime/mercury_prof.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_prof.c,v
retrieving revision 1.7
diff -u -r1.7 mercury_prof.c
--- runtime/mercury_prof.c 1998/05/15 05:15:15 1.7
+++ runtime/mercury_prof.c 2000/02/25 23:40:09
@@ -19,6 +19,7 @@
#include "mercury_prof.h"
#include "mercury_heap_profile.h" /* for MR_prof_output_mem_tables() */
+#include "mercury_prof_deep.h"
#include "mercury_prof_mem.h" /* for prof_malloc() */
#include "mercury_signal.h"
@@ -88,7 +89,9 @@
** Global Variables
*/
-Code * volatile MR_prof_current_proc;
+#ifndef MR_PROFILE_DEEP
+ Code * volatile MR_prof_current_proc;
+#endif
/*
** Private global variables
@@ -111,6 +114,9 @@
** Local function declarations
*/
+void
+checked_atexit(void (*func)(void));
+
#ifdef PROFILE_TIME
static void prof_init_time_profile_method(void);
static void prof_time_profile(int);
@@ -164,7 +170,7 @@
#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
-static FILE *
+FILE *
checked_fopen(const char *filename, const char *message, const char *mode)
{
FILE *file;
@@ -179,7 +185,7 @@
return file;
}
-static void
+void
checked_fclose(FILE *file, const char *filename)
{
errno = 0;
@@ -191,7 +197,7 @@
}
}
-static void
+void
checked_atexit(void (*func)(void))
{
errno = 0;
@@ -351,6 +357,7 @@
static void
prof_time_profile(int signum)
{
+#ifndef MR_PROFILE_DEEP
prof_time_node *node, **node_addr, *new_node;
int hash_value;
Code *current_proc;
@@ -387,6 +394,10 @@
in_profiling_code = FALSE;
return;
+#else
+ MR_prof_num_sigs++;
+ MR_prof_current_proc->quanta++;
+#endif
} /* end prof_time_profile() */
/* ======================================================================== */
@@ -597,7 +608,8 @@
prof_init_time_profile_method();
#endif
-#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY)
+#if defined(PROFILE_TIME) || defined(PROFILE_CALLS) || defined(PROFILE_MEMORY) \
+ || defined(MR_PROFILE_DEEP)
checked_atexit(MR_prof_finish);
#endif
}
@@ -612,7 +624,14 @@
#ifdef PROFILE_TIME
MR_prof_turn_off_time_profiling();
+#endif
+
+#if defined(PROFILE_TIME) && !defined(MR_PROFILE_DEEP)
prof_output_addr_table();
+#endif
+
+#if defined(PROFILE_TIME) && defined(MR_PROFILE_DEEP)
+ MR_prof_output_deep_tables();
#endif
#ifdef PROFILE_CALLS
Index: runtime/mercury_prof.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_prof.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_prof.h
--- runtime/mercury_prof.h 1997/12/05 15:56:44 1.3
+++ runtime/mercury_prof.h 2000/02/25 23:40:09
@@ -13,6 +13,7 @@
#define MERCURY_PROF_H
#include "mercury_types.h" /* for `Code *' */
+#include "mercury_prof_deep.h"
/*
** This variable holds the address of the "current" procedure so that
@@ -20,7 +21,9 @@
** so that it can credit the time to the appropriate procedure.
*/
-extern Code * volatile MR_prof_current_proc;
+#ifndef MR_PROFILE_DEEP
+ extern Code * volatile MR_prof_current_proc;
+#endif
/*
** The following two macros are used to ensure that the profiler can
@@ -28,7 +31,7 @@
** being executed when a profiling interrupt occurs.
*/
-#ifdef PROFILE_TIME
+#if defined(PROFILE_TIME) && !defined(MR_PROFILE_DEEP)
#define set_prof_current_proc(target) \
(MR_prof_current_proc = (target))
#define update_prof_current_proc(target) \
@@ -60,6 +63,15 @@
extern void MR_prof_output_addr_decl(const char *name, const Code *address);
+/*
+** Export checked_fopen and checked_fclose for use by mercury_profile_deep.c
+*/
+
+FILE *
+checked_fopen(const char *filename, const char *message, const char *mode);
+
+void
+checked_fclose(FILE *file, const char *filename);
/*
** The following functions are used by mercury_wrapper.c to
Index: runtime/mercury_stack_layout.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_stack_layout.h,v
retrieving revision 1.35
diff -u -r1.35 mercury_stack_layout.h
--- runtime/mercury_stack_layout.h 1999/12/16 11:39:22 1.35
+++ runtime/mercury_stack_layout.h 2000/02/25 23:40:11
@@ -350,6 +350,21 @@
ConstString MR_user_name;
MR_int_least16_t MR_user_arity;
MR_int_least16_t MR_user_mode;
+#ifdef MR_PROFILE_DEEP
+ const struct MR_SCC_ID *MR_user_scc_id;
+ /*
+ ** The MR_user_scc_id pointer has one of two meanings:
+ ** if it has a tag of 0, it is a pointer to the MR_SCC_ID
+ ** structure. If it has a tag of 1, then it is a pointer
+ ** to an MR_Stack_Layout_Entry which will have in its
+ ** MR_Stack_Layout_User_Proc_Struct a 0 tagged pointer
+ ** to the MR_SCC_ID.
+ ** This design is necessary because in some cases we create
+ ** MR_Stack_Layout_Proc_Id structs for MR_Closure_Layouts
+ ** in remote modules, where we don't know the SCCId of the
+ ** procedure.
+ */
+#endif
} MR_Stack_Layout_User_Proc;
typedef struct MR_Stack_Layout_Compiler_Proc_Struct {
@@ -359,6 +374,10 @@
ConstString MR_comp_pred_name;
MR_int_least16_t MR_comp_arity;
MR_int_least16_t MR_comp_mode;
+#ifdef MR_PROFILE_DEEP
+ const struct MR_SCC_ID *MR_comp_scc_id;
+ /* The comments about the MR_user_scc_id above apply here. */
+#endif
} MR_Stack_Layout_Compiler_Proc;
typedef union MR_Stack_Layout_Proc_Id_Union {
@@ -391,16 +410,26 @@
#define MR_sle_comp MR_sle_proc_id.MR_proc_comp
#define MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \
- ((Word) entry->MR_sle_user.MR_user_pred_or_func != -1)
+ ((Word) (entry)->MR_sle_user.MR_user_pred_or_func != -1)
#define MR_ENTRY_LAYOUT_HAS_EXEC_TRACE(entry) \
- (MR_ENTRY_LAYOUT_HAS_PROC_ID(entry) \
- && entry->MR_sle_call_label != NULL)
+ (MR_ENTRY_LAYOUT_HAS_PROC_ID((entry)) \
+ && (entry)->MR_sle_call_label != NULL)
#define MR_ENTRY_LAYOUT_COMPILER_GENERATED(entry) \
- ((Unsigned) entry->MR_sle_user.MR_user_pred_or_func \
+ ((Unsigned) (entry)->MR_sle_user.MR_user_pred_or_func \
> MR_FUNCTION)
+#define MR_ENTRY_LAYOUT_ADDRESS(entry) \
+ (Word *) &(((MR_Stack_Layout_Entry *) (entry))->MR_sle_proc_id)
+
+#ifdef MR_PROFILE_DEEP
+#define MR_ENTRY_LAYOUT_SCC_ID(entry) \
+ (MR_ENTRY_LAYOUT_COMPILER_GENERATED((entry)) ? \
+ (entry)->MR_sle_user.MR_user_scc_id \
+ : (entry)->MR_sle_comp.MR_comp_scc_id)
+#endif
+
/*
** Define a layout structure for a procedure, containing information
** for the first two groups of fields.
@@ -440,9 +469,23 @@
} while (0)
#endif
+#ifdef MR_PROFILE_DEEP
+ #define IF_MR_PROFILE_DEEP(x) x
+#else
+ #define IF_MR_PROFILE_DEEP(x)
+#endif
+
#define MR_MAKE_PROC_LAYOUT(entry, detism, slots, succip_locn, \
- pf, module, name, arity, mode) \
- MR_Stack_Layout_Entry mercury_data__layout__##entry = { \
+ pf, module, name, arity, mode, sccd) \
+ const struct mercury_data__layout__##entry##_struct { \
+ /* stack traversal group */ \
+ Code *MR_sle_code_addr; \
+ MR_Long_Lval MR_sle_succip_locn; \
+ MR_int_least16_t MR_sle_stack_slots; \
+ MR_Determinism MR_sle_detism; \
+ /* proc id group */ \
+ MR_Stack_Layout_Proc_Id MR_sle_proc_id; \
+ } mercury_data__layout__##entry = { \
MR_MAKE_PROC_LAYOUT_ADDR(entry), \
succip_locn, \
slots, \
@@ -453,9 +496,11 @@
module, \
name, \
arity, \
- mode \
- }}, \
- NULL \
+ mode, \
+IF_MR_PROFILE_DEEP( \
+ &sccd \
+) \
+ }} \
}
/*
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.39
diff -u -r1.39 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/01/19 09:45:23 1.39
+++ runtime/mercury_type_info.h 2000/02/25 23:40:13
@@ -32,8 +32,8 @@
#ifndef MERCURY_TYPE_INFO_H
#define MERCURY_TYPE_INFO_H
-#include "mercury_std.h" /* for `MR_STRINGIFY' and `MR_PASTEn' */
-#include "mercury_types.h" /* for `Word' */
+#include "mercury_std.h" /* for `MR_STRINGIFY' and `MR_PASTEn' */
+#include "mercury_types.h" /* for `Word' */
/*---------------------------------------------------------------------------*/
@@ -848,6 +848,11 @@
String type_ctor_module_name;
String type_ctor_name;
Integer type_ctor_version;
+#ifdef MR_PROFILE_DEEP
+ const Word *unify_info;
+ const Word *index_info;
+ const Word *compare_info;
+#endif
};
typedef struct MR_TypeCtorInfo_struct *MR_TypeCtorInfo;
@@ -871,6 +876,11 @@
Declare_entry(u); \
Declare_entry(i); \
Declare_entry(c); \
+MR_IF_PROFILE_DEEP( \
+ MR_DECL_SLE(u); \
+ MR_DECL_SLE(i); \
+ MR_DECL_SLE(c); \
+) \
MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_struct \
MR_PASTE6(mercury_data_, cm, __type_ctor_info_, n, _, a) = { \
a, \
@@ -882,7 +892,16 @@
NULL, \
MR_string_const(MR_STRINGIFY(m), sizeof(MR_STRINGIFY(m))-1),\
MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),\
- MR_RTTI_VERSION \
+ MR_RTTI_VERSION, \
+ MR_IF_PROFILE_DEEP( \
+ (const Word *) MR_REF_SLEc(u) \
+ ) \
+ MR_IF_PROFILE_DEEP( \
+ (const Word *) MR_REF_SLEc(i) \
+ ) \
+ MR_IF_PROFILE_DEEP( \
+ (const Word *) MR_REF_SLEc(c) \
+ ) \
}
#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, i, c) \
Index: runtime/mercury_wrapper.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_wrapper.c,v
retrieving revision 1.54
diff -u -r1.54 mercury_wrapper.c
--- runtime/mercury_wrapper.c 2000/02/08 02:08:06 1.54
+++ runtime/mercury_wrapper.c 2000/02/25 23:40:16
@@ -32,6 +32,7 @@
#include <stdio.h>
#include <string.h>
+#include "mercury_wrapper.h"
#include "mercury_getopt.h"
#include "mercury_timing.h"
#include "mercury_init.h"
@@ -164,6 +165,12 @@
Code *program_entry_point;
/* normally mercury__main_2_0 (main/2) */
+
+#ifdef MR_PROFILE_DEEP
+MR_Stack_Layout_Entry *program_entry_layout;
+ /* normally mercury_data__layout__mercury__main_2_0 */
+#endif
+
void (*MR_library_initializer)(void);
/* normally ML_io_init_state (io__init_state/2)*/
void (*MR_library_finalizer)(void);
@@ -1185,6 +1192,11 @@
Declare_label(global_fail);
Declare_label(all_done);
+MR_MAKE_SCC_ID(do_interpreter_scc_id, { }, { }, { });
+MR_MAKE_PROC_LAYOUT(do_interpreter, MR_DETISM_DET, 0, 0, MR_PREDICATE,
+ "mercury_wrapper", "do_interpreter", 0, 0,
+ do_interpreter_scc_id);
+
BEGIN_MODULE(interpreter_module)
init_entry_ai(do_interpreter);
init_label_ai(global_success);
@@ -1193,11 +1205,19 @@
BEGIN_CODE
Define_entry(do_interpreter);
+#ifndef MR_PROFILE_DEEP
MR_incr_sp(4);
+#else
+ MR_incr_sp(6);
+#endif
MR_stackvar(1) = (Word) MR_hp;
MR_stackvar(2) = (Word) MR_succip;
MR_stackvar(3) = (Word) MR_maxfr;
MR_stackvar(4) = (Word) MR_curfr;
+#ifdef MR_PROFILE_DEEP
+ MR_stackvar(5) = (Word) MR_prof_current_scc;
+ MR_stackvar(6) = (Word) MR_prof_current_proc;
+#endif
MR_mkframe("interpreter", 1, LABEL(global_fail));
@@ -1208,10 +1228,17 @@
fatal_error("no program entry point supplied");
}
-#ifdef PROFILE_TIME
+#if defined(PROFILE_TIME) || defined(MR_PROFILE_DEEP)
if (MR_profiling) MR_prof_turn_on_time_profiling();
#endif
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_proc =
+ MR_nonlocal_inter_scc(MR_prof_current_scc, 0,
+ program_entry_layout);
+ MR_prof_current_scc = MR_scc_from_current_proc();
+#endif
+
noprof_call(program_entry_point, LABEL(global_success));
Define_label(global_success);
@@ -1250,7 +1277,13 @@
MR_succip = (Code *) MR_stackvar(2);
MR_maxfr = (Word *) MR_stackvar(3);
MR_curfr = (Word *) MR_stackvar(4);
+#ifdef MR_PROFILE_DEEP
+ MR_prof_current_scc = (MR_SCCInstance *) MR_stackvar(5);
+ MR_prof_current_proc = (MR_ProcCallProfile *) MR_stackvar(6);
+ MR_decr_sp(6);
+#else
MR_decr_sp(4);
+#endif
#ifdef MR_LOWLEVEL_DEBUG
if (MR_finaldebug && MR_detaildebug) {
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list