[m-dev.] diff: fix memory profiling bug
Fergus Henderson
fjh at cs.mu.OZ.AU
Fri Oct 1 07:58:15 AEST 1999
Estimated hours taken: 8
Fix a bug introduced by my improvements to memory profiling.
The bug was that it wasn't properly handling the case when the
pragma c_code fragments get inlined.
compiler/pragma_c_gen.m:
When generating model_det/model_semi pragma c_code,
#define MR_PROC_LABEL to be the entry label of the procedure
containing the `pragma c_code' goal.
library/io.m:
library/string.m:
library/std_util.m:
library/store.m:
Use MR_PROC_LABEL rather than hard-coding the procedure entry label.
Workspace: /home/mercury0/fjh/mercury
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.28
diff -u -r1.28 pragma_c_gen.m
--- pragma_c_gen.m 1999/03/28 01:27:21 1.28
+++ pragma_c_gen.m 1999/09/30 21:38:57
@@ -39,6 +39,7 @@
:- implementation.
:- import_module hlds_module, hlds_pred, call_gen, llds_out, trace, tree.
+:- import_module code_util.
:- import_module options, globals.
:- import_module bool, string, int, assoc_list, set, map, require.
@@ -49,6 +50,7 @@
% <save live variables onto the stack> /* see note (1) below */
% {
% <declaration of one local variable for each arg>
+% #define MR_PROC_LABEL <procedure label> /* see note (5) below */
%
% <assignment of input values from registers to local variables>
% save_registers(); /* see notes (1) and (2) below */
@@ -58,6 +60,8 @@
% restore_registers(); /* see notes (1) and (3) below */
% #endif
% <assignment of the output values from local variables to registers>
+%
+% #undef MR_PROC_LABEL /* see note (5) below */
% }
%
% In the case of a semidet pragma c_code, the above is followed by
@@ -276,6 +280,14 @@
% away ourselves, since these macros can be invoked from other macros,
% and thus we do not have a sure test of whether the code fragments
% invoke the macros.
+%
+% (5) We insert a #define for MR_PROC_LABEL, so that the C code in the
+% Mercury standard library that allocates memory manually can use
+% MR_PROC_LABEL as the procname argument to incr_hp_msg(), for memory
+% profiling. Hard-coding the procname argument in the C code would
+% be wrong, since it wouldn't handle the case where the original
+% pragma c_code procedure gets inlined and optimized away.
+% Of course we also need to #undef it afterwards.
pragma_c_gen__generate_pragma_c_code(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, _GoalInfo,
@@ -364,6 +376,15 @@
{ make_pragma_decls(Args, Decls) },
%
+ % Generate <declaration for procedure>
+ %
+ code_info__get_module_info(ModuleInfo),
+ code_info__get_pred_id(CallerPredId),
+ code_info__get_proc_id(CallerProcId),
+ { make_proc_label_hash_define(ModuleInfo, CallerPredId, CallerProcId,
+ ProcLabelHashDefine, ProcLabelHashUndef) },
+
+ %
% <assignment of input values from registers to local vars>
%
{ InputComp = pragma_c_inputs(InputDescs) },
@@ -382,7 +403,6 @@
%
% Code fragments to obtain and release the global lock
%
- code_info__get_module_info(ModuleInfo),
{ ThreadSafe = thread_safe ->
ObtainLock = pragma_c_raw_code(""),
ReleaseLock = pragma_c_raw_code("")
@@ -452,9 +472,10 @@
%
% join all the components of the pragma_c together
%
- { Components = [InputComp, SaveRegsComp, ObtainLock, C_Code_Comp,
- ReleaseLock, CheckR1_Comp, RestoreRegsComp,
- OutputComp] },
+ { Components = [ProcLabelHashDefine, InputComp, SaveRegsComp,
+ ObtainLock, C_Code_Comp, ReleaseLock,
+ CheckR1_Comp, RestoreRegsComp,
+ OutputComp, ProcLabelHashUndef] },
{ PragmaCCode = node([
pragma_c(Decls, Components, MayCallMercury, MaybeFailLabel, no)
- "Pragma C inclusion"
@@ -497,7 +518,26 @@
FailureCode))))
}.
-%---------------------------------------------------------------------------%
+:- pred make_proc_label_hash_define(module_info, pred_id, proc_id,
+ pragma_c_component, pragma_c_component).
+:- mode make_proc_label_hash_define(in, in, in, out, out) is det.
+
+make_proc_label_hash_define(ModuleInfo, PredId, ProcId,
+ ProcLabelHashDef, ProcLabelHashUndef) :-
+ code_util__make_entry_label(ModuleInfo, PredId, ProcId, no,
+ CodeAddr),
+ ( CodeAddr = imported(ProcLabel) ->
+ llds_out__get_proc_label(ProcLabel, yes, ProcLabelString)
+ ; CodeAddr = label(ProcLabel) ->
+ llds_out__get_label(ProcLabel, yes, ProcLabelString)
+ ;
+ error("unexpected code_addr in make_proc_label_hash_define")
+ ),
+ ProcLabelHashDef = pragma_c_raw_code(string__append_list([
+ "#define MR_PROC_LABEL ", ProcLabelString, "\n"])),
+ ProcLabelHashUndef = pragma_c_raw_code("#undef MR_PROC_LABEL\n").
+
+%-----------------------------------------------------------------------------%
:- pred pragma_c_gen__nondet_pragma_c_code(code_model::in,
pragma_c_code_attributes::in, pred_id::in, proc_id::in,
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.183
diff -u -r1.183 io.m
--- io.m 1999/09/24 06:25:09 1.183
+++ io.m 1999/09/30 20:36:55
@@ -1353,8 +1353,7 @@
if (Res == 0) {
incr_hp_atomic_msg(LVALUE_CAST(Word, RetString),
ML_IO_BYTES_TO_WORDS((i + 1) * sizeof(Char)),
- mercury__io__read_line_as_string_2_5_0,
- ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
memcpy(RetString, read_buffer, i * sizeof(Char));
RetString[i] = '\\0';
} else {
@@ -1484,7 +1483,7 @@
MercuryFile *f = (MercuryFile *) Stream;
RetVal = ferror(f->file);
ML_maybe_make_err_msg(RetVal != 0, ""read failed: "",
- mercury__io__ferror_5_0, RetStr);
+ MR_PROC_LABEL, RetStr);
}").
% io__make_err_msg(MessagePrefix, Message):
@@ -1497,8 +1496,7 @@
:- pragma c_code(make_err_msg(Msg0::in, Msg::out, _IO0::di, _IO::uo),
will_not_call_mercury,
"{
- ML_maybe_make_err_msg(TRUE, Msg0, mercury__io__make_err_msg_4_0,
- Msg);
+ ML_maybe_make_err_msg(TRUE, Msg0, MR_PROC_LABEL, Msg);
}").
%-----------------------------------------------------------------------------%
@@ -1548,8 +1546,7 @@
"{
incr_hp_atomic_msg(Buffer,
(Size * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
- mercury__io__alloc_buffer_2_0,
- ""io:buffer/0"");
+ MR_PROC_LABEL, ""io:buffer/0"");
}").
:- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
@@ -1567,7 +1564,7 @@
Word next;
incr_hp_atomic_msg(next,
(NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
- mercury__io__resize_buffer_4_0,
+ MR_PROC_LABEL,
""io:buffer/0"");
assert(buffer0 + OldSize == (Char *) next);
buffer = buffer0;
@@ -1575,8 +1572,7 @@
/* just have to alloc and copy */
incr_hp_atomic_msg(Buffer,
(NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
- mercury__io__resize_buffer_4_0,
- ""io:buffer/0"");
+ MR_PROC_LABEL, ""io:buffer/0"");
buffer = (Char *) Buffer;
if (OldSize > NewSize) {
memcpy(buffer, buffer0, NewSize);
@@ -3226,10 +3222,10 @@
[will_not_call_mercury, thread_safe], "
/* convert mercury_argv from a vector to a list */
{ int i = mercury_argc;
- Args = MR_list_empty_msg(mercury__io__command_line_arguments_3_0);
+ Args = MR_list_empty_msg(MR_PROC_LABEL);
while (--i >= 0) {
Args = MR_list_cons_msg((Word) mercury_argv[i], Args,
- mercury__io__command_line_arguments_3_0);
+ MR_PROC_LABEL);
}
}
update_io(IO0, IO);
@@ -3364,7 +3360,7 @@
/* Dir + / + Prefix + counter_high + . + counter_low + \\0 */
incr_hp_atomic_msg(LVALUE_CAST(Word, FileName),
(len + sizeof(Word)) / sizeof(Word),
- mercury__io__make_temp_5_0, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
if (ML_io_tempnam_counter == 0) {
ML_io_tempnam_counter = getpid();
}
@@ -3453,7 +3449,7 @@
"{
RetVal = remove(FileName);
ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "",
- mercury__io__remove_file_2_5_0, RetStr);
+ MR_PROC_LABEL, RetStr);
update_io(IO0, IO);
}").
@@ -3474,7 +3470,7 @@
"{
RetVal = rename(OldFileName, NewFileName);
ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "",
- mercury__io__rename_file_2_6_0, RetStr);
+ MR_PROC_LABEL, RetStr);
update_io(IO0, IO);
}").
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.158
diff -u -r1.158 std_util.m
--- std_util.m 1999/09/27 05:20:36 1.158
+++ std_util.m 1999/09/30 21:13:19
@@ -1032,7 +1032,7 @@
% of the type_info for this type, and then store the input argument
% in the second field.
:- pragma c_code(type_to_univ(Type::di, Univ::uo), will_not_call_mercury, "
- incr_hp_msg(Univ, 2, mercury__std_util__type_to_univ_2_0,
+ incr_hp_msg(Univ, 2, MR_PROC_LABEL,
""std_util:univ/0"");
MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO)
= (Word) TypeInfo_for_T;
@@ -1040,7 +1040,7 @@
= (Word) Type;
").
:- pragma c_code(type_to_univ(Type::in, Univ::out), will_not_call_mercury, "
- incr_hp_msg(Univ, 2, mercury__std_util__type_to_univ_2_1,
+ incr_hp_msg(Univ, 2, MR_PROC_LABEL,
""std_util:univ/0"");
MR_field(MR_mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO)
= (Word) TypeInfo_for_T;
@@ -1721,8 +1721,7 @@
** be the rest of the words.
*/
incr_hp_msg(new_data, info.arity + 1,
- mercury__fn__std_util__construct_3_0,
- ""<unknown type from ""
+ MR_PROC_LABEL, ""<unknown type from ""
""std_util:construct/3>"");
MR_field(0, new_data, 0) = info.secondary_tag;
term_vector = (Word) (new_data + sizeof(Word));
@@ -1746,8 +1745,7 @@
*/
incr_hp_msg(new_data, info.arity,
- mercury__fn__std_util__construct_3_0,
- ""<unknown type from ""
+ MR_PROC_LABEL, ""<unknown type from ""
""std_util:construct/3>"");
term_vector = (Word) new_data;
}
@@ -1771,8 +1769,7 @@
*/
incr_hp_msg(Term, 2,
- mercury__fn__std_util__construct_3_0,
- ""std_util:univ/0"");
+ MR_PROC_LABEL, ""std_util:univ/0"");
MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_TYPEINFO) =
(Word) TypeInfo;
MR_field(MR_mktag(0), Term, UNIV_OFFSET_FOR_DATA) =
@@ -1988,9 +1985,8 @@
Word *type_info;
restore_transient_registers();
- incr_hp_msg(LVALUE_CAST(Word, type_info), arity + extra_args,
- mercury__fn__std_util__make_type_2_0,
- ""std_util:type_info/0"");
+ /* XXX should use incr_hp_msg() here */
+ incr_hp(LVALUE_CAST(Word, type_info), arity + extra_args);
save_transient_registers();
MR_field(MR_mktag(0), type_info, 0) = type_ctor_info;
@@ -2664,8 +2660,7 @@
if (success) {
/* Allocate enough room for a univ */
- incr_hp_msg(ArgumentUniv, 2,
- mercury__fn__std_util__argument_2_0,
+ incr_hp_msg(ArgumentUniv, 2, MR_PROC_LABEL,
""std_util:univ/0"");
MR_field(0, ArgumentUniv, UNIV_OFFSET_FOR_TYPEINFO) =
arg_type_info;
@@ -2736,19 +2731,17 @@
Arity = info.arity;
/* Build argument list */
- Arguments = MR_list_empty_msg(mercury__std_util__deconstruct_4_0);
+ Arguments = MR_list_empty_msg(MR_PROC_LABEL);
i = info.arity;
while (--i >= 0) {
/* Create an argument on the heap */
- incr_hp_msg(Argument, 2,
- mercury__std_util__deconstruct_4_0,
- ""std_util:univ/0"");
+ incr_hp_msg(Argument, 2, MR_PROC_LABEL, ""std_util:univ/0"");
/* Join the argument to the front of the list */
Arguments = MR_list_cons_msg(Argument, Arguments,
- mercury__std_util__deconstruct_4_0);
+ MR_PROC_LABEL);
/* Fill in the arguments */
arg_pseudo_type_info = info.type_info_vector[i];
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.15
diff -u -r1.15 store.m
--- store.m 1999/09/27 05:20:39 1.15
+++ store.m 1999/09/30 21:10:28
@@ -237,8 +237,7 @@
:- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
will_not_call_mercury,
"
- incr_hp_msg(Mutvar, 1, mercury__store__new_mutvar_4_0,
- ""store:mutvar/2"");
+ incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, ""store:mutvar/2"");
*(Word *)Mutvar = Val;
S = S0;
").
@@ -264,9 +263,7 @@
:- pragma c_code(unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
will_not_call_mercury,
"
- incr_hp_msg(Mutvar, 1,
- mercury__store__unsafe_new_uninitialized_mutvar_3_0,
- ""store:mutvar/2"");
+ incr_hp_msg(Mutvar, 1, MR_PROC_LABEL, ""store:mutvar/2"");
S = S0;
").
@@ -280,7 +277,7 @@
:- pragma c_code(new_ref(Val::di, Ref::out, S0::di, S::uo),
will_not_call_mercury,
"
- incr_hp_msg(Ref, 1, mercury__store__new_ref_4_0, ""store:ref/2"");
+ incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""store:ref/2"");
*(Word *)Ref = Val;
S = S0;
").
@@ -370,8 +367,7 @@
** to copy it to the heap before returning.
*/
if (arg_ref == &Val) {
- incr_hp_msg(ArgRef, 1, mercury__store__new_arg_ref_5_0,
- ""store:ref/2"");
+ incr_hp_msg(ArgRef, 1, MR_PROC_LABEL, ""store:ref/2"");
*(Word *)ArgRef = Val;
} else {
ArgRef = (Word) arg_ref;
Index: library/string.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/string.m,v
retrieving revision 1.115
diff -u -r1.115 string.m
--- string.m 1999/09/24 06:25:10 1.115
+++ string.m 1999/09/30 21:11:56
@@ -608,7 +608,7 @@
** i.e. (length + 1 + sizeof(Word) - 1) / sizeof(Word) words
*/
incr_hp_atomic_msg(str_ptr, size / sizeof(Word),
- mercury__string__from_rev_char_list_2_0,
+ MR_PROC_LABEL,
""string:string/0"");
Str = (char *) str_ptr;
/*
@@ -1564,8 +1564,7 @@
Word tmp;
sprintf(buf, ""%#.15g"", FloatVal);
incr_hp_atomic_msg(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word),
- mercury__string__float_to_string_2_0,
- ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
FloatString = (char *)tmp;
strcpy(FloatString, buf);
}").
@@ -1581,8 +1580,7 @@
Word tmp;
sprintf(buf, ""%.15f"", FloatVal);
incr_hp_atomic_msg(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word),
- mercury__string__float_to_f_string_2_0,
- ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
FloatString = (char *)tmp;
strcpy(FloatString, buf);
}").
@@ -1608,11 +1606,11 @@
:- pragma c_code(string__to_int_list(Str::in, IntList::out),
[will_not_call_mercury, thread_safe], "{
const char *p = Str + strlen(Str);
- IntList = MR_list_empty_msg(mercury__string__to_int_list_2_0);
+ IntList = MR_list_empty_msg(MR_PROC_LABEL);
while (p > Str) {
p--;
IntList = MR_list_cons_msg((UnsignedChar) *p, IntList,
- mercury__string__to_int_list_2_0);
+ MR_PROC_LABEL);
}
}").
@@ -1637,8 +1635,7 @@
** i.e. (length + 1 + sizeof(Word) - 1) / sizeof(Word) words
*/
incr_hp_atomic_msg(str_ptr, size / sizeof(Word),
- mercury__string__to_int_list_2_1,
- ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Str = (char *) str_ptr;
/*
** loop to copy the characters from the int_list to the string
@@ -1741,7 +1738,7 @@
** word-aligned.
*/
incr_hp_atomic_msg(tmp, (len_2 + sizeof(Word)) / sizeof(Word),
- mercury__string__append_3_1, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
S2 = (char *) tmp;
strcpy(S2, S3 + len_1);
SUCCESS_INDICATOR = TRUE;
@@ -1758,7 +1755,7 @@
len_1 = strlen(S1);
len_2 = strlen(S2);
incr_hp_atomic_msg(tmp, (len_1 + len_2 + sizeof(Word)) / sizeof(Word),
- mercury__string__append_3_2, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
S3 = (char *) tmp;
strcpy(S3, S1);
strcpy(S3 + len_1, S2);
@@ -1784,14 +1781,14 @@
incr_hp_atomic_msg(temp,
(LOCALS->count + sizeof(Word)) / sizeof(Word),
- mercury__string__append_3_3, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
S1 = (String) temp;
memcpy(S1, LOCALS->s, LOCALS->count);
S1[LOCALS->count] = '\\0';
incr_hp_atomic_msg(temp,
(LOCALS->len - LOCALS->count + sizeof(Word))
/ sizeof(Word),
- mercury__string__append_3_3, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
S2 = (String) temp;
strcpy(S2, LOCALS->s + LOCALS->count);
@@ -1825,7 +1822,7 @@
if (Start > len) Start = len;
if (Count > len - Start) Count = len - Start;
incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
- mercury__string__substring_4_0, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
SubString = (char *) tmp;
memcpy(SubString, Str + Start, Count);
SubString[Count] = '\\0';
@@ -1846,7 +1843,7 @@
Integer len;
Word tmp;
incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
- mercury__string__unsafe_substring_4_0, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
SubString = (char *) tmp;
memcpy(SubString, Str + Start, Count);
SubString[Count] = '\\0';
@@ -1874,7 +1871,7 @@
len = strlen(Str);
if (Count > len) Count = len;
incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
- mercury__string__split_4_0, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Left = (char *) tmp;
memcpy(Left, Str, Count);
Left[Count] = '\\0';
@@ -1884,7 +1881,7 @@
*/
incr_hp_atomic_msg(tmp,
(len - Count + sizeof(Word)) / sizeof(Word),
- mercury__string__split_4_0, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Right = (char *) tmp;
strcpy(Right, Str + Count);
}
@@ -1941,7 +1938,7 @@
*/
incr_hp_atomic_msg(tmp,
(strlen(Str) + sizeof(Word)) / sizeof(Word),
- mercury__string__first_char_3_2, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Rest = (char *) tmp;
strcpy(Rest, Str);
SUCCESS_INDICATOR = TRUE;
@@ -1965,7 +1962,7 @@
*/
incr_hp_atomic_msg(tmp,
(strlen(Str) + sizeof(Word)) / sizeof(Word),
- mercury__string__first_char_3_3, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Rest = (char *) tmp;
strcpy(Rest, Str);
SUCCESS_INDICATOR = TRUE;
@@ -1980,7 +1977,7 @@
size_t len = strlen(Rest) + 1;
Word tmp;
incr_hp_atomic_msg(tmp, (len + sizeof(Word)) / sizeof(Word),
- mercury__string__first_char_3_4, ""string:string/0"");
+ MR_PROC_LABEL, ""string:string/0"");
Str = (char *) tmp;
Str[0] = First;
strcpy(Str + 1, Rest);
--
Fergus Henderson <fjh at cs.mu.oz.au> | "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh> | of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3 | -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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