[m-dev.] diff: improve memory profiling

Fergus Henderson fjh at cs.mu.OZ.AU
Fri Sep 24 15:36:49 AEST 1999


Estimated hours taken: 1.5

Improve memory profiling.

library/io.m:
library/string.m:
library/store.m:
library/std_util.m:
	Change calls to incr_hp() to instead call incr_hp_msg() so that
	these allocations will get included in the memory profile.
	Likewise for calls to tag_incr_hp(), incr_hp_atomic(), etc.

runtime/mercury_heap.h:
	When calling MR_record_allocation() in tag_incr_hp_msg(),
	use ENTRY(proclabel) rather than LABEL(proclabel), so that
	it works even if the allocation is actually done outside
	of the procedure, where the ENTRY label is visible but the
	LABEL isn't.  This can happen if pragma c_code that calls
	tag_incr_hp_msg() is inlined into some other procedure.

Workspace: /home/mercury0/fjh/mercury
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.181
diff -u -r1.181 io.m
--- io.m	1999/09/23 02:15:05	1.181
+++ io.m	1999/09/24 04:46:16
@@ -1351,8 +1351,10 @@
 		}
 	}
 	if (Res == 0) {
-		incr_hp_atomic(LVALUE_CAST(Word, RetString),
-			ML_IO_BYTES_TO_WORDS((i + 1) * sizeof(Char)));
+		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"");
 		memcpy(RetString, read_buffer, i * sizeof(Char));
 		RetString[i] = '\\0';
 	} else {
@@ -1481,7 +1483,8 @@
 "{
 	MercuryFile *f = (MercuryFile *) Stream;
 	RetVal = ferror(f->file);
-	ML_maybe_make_err_msg(RetVal != 0, ""read failed: "", RetStr);
+	ML_maybe_make_err_msg(RetVal != 0, ""read failed: "",
+		mercury__io__ferror_5_0, RetStr);
 }").
 
 % io__make_err_msg(MessagePrefix, Message):
@@ -1494,7 +1497,8 @@
 :- 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, Msg);
+	ML_maybe_make_err_msg(TRUE, Msg0, mercury__io__make_err_msg_4_0,
+		Msg);
 }").
 
 %-----------------------------------------------------------------------------%
@@ -1542,8 +1546,10 @@
 :- pragma c_code(io__alloc_buffer(Size::in, Buffer::uo),
 		[will_not_call_mercury, thread_safe],
 "{
-	incr_hp_atomic(Buffer,
-		(Size * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word));
+	incr_hp_atomic_msg(Buffer,
+		(Size * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
+		mercury__io__alloc_buffer_2_0,
+		""io:buffer/0"");
 }").
 
 :- pred io__resize_buffer(buffer::di, int::in, int::in, buffer::uo) is det.
@@ -1559,14 +1565,18 @@
 #else
 	if (buffer0 + OldSize == (Char *) MR_hp) {
 		Word next;
-		incr_hp_atomic(next, 
-		   (NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word));
+		incr_hp_atomic_msg(next, 
+		   (NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
+		   mercury__io__resize_buffer_4_0,
+		   ""io:buffer/0"");
 		assert(buffer0 + OldSize == (Char *) next);
 	    	buffer = buffer0;
 	} else {
 		/* just have to alloc and copy */
-		incr_hp_atomic(Buffer,
-		   (NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word));
+		incr_hp_atomic_msg(Buffer,
+		   (NewSize * sizeof(Char) + sizeof(Word) - 1) / sizeof(Word),
+		   mercury__io__resize_buffer_4_0,
+		   ""io:buffer/0"");
 		buffer = (Char *) Buffer;
 		if (OldSize > NewSize) {
 			memcpy(buffer, buffer0, NewSize);
@@ -3351,8 +3361,9 @@
 
 	len = strlen(Dir) + 1 + 5 + 3 + 1 + 3 + 1;
 		/* Dir + / + Prefix + counter_high + . + counter_low + \\0 */
-	incr_hp_atomic(LVALUE_CAST(Word, FileName),
-		(len + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(LVALUE_CAST(Word, FileName),
+		(len + sizeof(Word)) / sizeof(Word),
+		mercury__io__make_temp_5_0, ""string:string/0"");
 	if (ML_io_tempnam_counter == 0) {
 		ML_io_tempnam_counter = getpid();
 	}
@@ -3399,8 +3410,10 @@
 ** This is defined as a macro rather than a C function
 ** to avoid worrying about the `hp' register being
 ** invalidated by the function call.
+** It also needs to be a macro because incr_hp_atomic_msg()
+** stringizes its third argument.
 */
-#define ML_maybe_make_err_msg(was_error, msg, error_msg)		\\
+#define ML_maybe_make_err_msg(was_error, msg, procname, error_msg)	\\
 	do {								\\
 		char *errno_msg;					\\
 		size_t len;						\\
@@ -3409,8 +3422,10 @@
 		if (was_error) {					\\
 			errno_msg = strerror(errno);			\\
 			len = strlen(msg) + strlen(errno_msg);		\\
-			incr_hp_atomic(tmp,				\\
-				(len + sizeof(Word)) / sizeof(Word));	\\
+			incr_hp_atomic_msg(tmp,				\\
+				(len + sizeof(Word)) / sizeof(Word),	\\
+				procname,				\\
+				""string:string/0"");			\\
 			(error_msg) = (char *)tmp;			\\
 			strcpy((error_msg), msg);			\\
 			strcat((error_msg), errno_msg);			\\
@@ -3436,7 +3451,8 @@
 		IO0::di, IO::uo), [will_not_call_mercury, thread_safe],
 "{
 	RetVal = remove(FileName);
-	ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "", RetStr);
+	ML_maybe_make_err_msg(RetVal != 0, ""remove failed: "",
+		mercury__io__remove_file_2_5_0, RetStr);
 	update_io(IO0, IO);
 }").
 
@@ -3456,7 +3472,8 @@
 		[will_not_call_mercury, thread_safe],
 "{
 	RetVal = rename(OldFileName, NewFileName);
-	ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "", RetStr);
+	ML_maybe_make_err_msg(RetVal != 0, ""rename failed: "",
+		mercury__io__rename_file_2_6_0, RetStr);
 	update_io(IO0, IO);
 }").
 
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.155
diff -u -r1.155 std_util.m
--- std_util.m	1999/09/17 06:40:32	1.155
+++ std_util.m	1999/09/24 04:32:42
@@ -1032,12 +1032,14 @@
 	% 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(Univ, 2);
+	incr_hp_msg(Univ, 2, mercury__std_util__type_to_univ_2_0,
+		""std_util:univ/0"");
 	field(mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO) = (Word) TypeInfo_for_T;
 	field(mktag(0), Univ, UNIV_OFFSET_FOR_DATA) = (Word) Type;
 ").
 :- pragma c_code(type_to_univ(Type::in, Univ::out), will_not_call_mercury, "
-	incr_hp(Univ, 2);
+	incr_hp_msg(Univ, 2, mercury__std_util__type_to_univ_2_1,
+		""std_util:univ/0"");
 	field(mktag(0), Univ, UNIV_OFFSET_FOR_TYPEINFO) = (Word) TypeInfo_for_T;
 	field(mktag(0), Univ, UNIV_OFFSET_FOR_DATA) = (Word) Type;
 ").
@@ -1714,7 +1716,10 @@
 				** secondary tag, and the term_vector will
 				** be the rest of the words.
 				*/
-				incr_hp(new_data, info.arity + 1);
+				incr_hp_msg(new_data, info.arity + 1,
+					mercury__fn__std_util__construct_3_0,
+					""<unknown type from ""
+					""std_util:construct/3>"");
 				field(0, new_data, 0) = info.secondary_tag;
 				term_vector = (Word) (new_data + sizeof(Word));
 
@@ -1736,7 +1741,10 @@
 				** create arguments.
 				*/
 
-				incr_hp(new_data, info.arity);
+				incr_hp_msg(new_data, info.arity,
+					mercury__fn__std_util__construct_3_0,
+					""<unknown type from ""
+					""std_util:construct/3>"");
 				term_vector = (Word) new_data; 
 			}
 
@@ -1758,7 +1766,9 @@
 		** Create a univ.
 		*/
 
-		incr_hp(Term, 2);
+		incr_hp_msg(Term, 2,
+			mercury__fn__std_util__construct_3_0,
+			""std_util:univ/0"");
 		field(mktag(0), Term, UNIV_OFFSET_FOR_TYPEINFO) = 
 			(Word) TypeInfo;
 		field(mktag(0), Term, UNIV_OFFSET_FOR_DATA) = (Word) new_data;
@@ -1973,7 +1983,9 @@
 		Word *type_info;
 
 		restore_transient_registers();
-		incr_hp(LVALUE_CAST(Word, type_info), arity + extra_args);
+		incr_hp_msg(LVALUE_CAST(Word, type_info), arity + extra_args,
+			mercury__fn__std_util__make_type_2_0,
+			""std_util:type_info/0"");
 		save_transient_registers();
 		
 		field(mktag(0), type_info, 0) = type_ctor_info;
@@ -2645,7 +2657,9 @@
 
 	if (success) {
 		/* Allocate enough room for a univ */
-		incr_hp(ArgumentUniv, 2);
+		incr_hp_msg(ArgumentUniv, 2,
+			mercury__fn__std_util__argument_2_0,
+			""std_util:univ/0"");
 		field(0, ArgumentUniv, UNIV_OFFSET_FOR_TYPEINFO) =
 			arg_type_info;
 		field(0, ArgumentUniv, UNIV_OFFSET_FOR_DATA) = *argument_ptr;
@@ -2720,7 +2734,9 @@
 	while (--i >= 0) {
 
 			/* Create an argument on the heap */
-		incr_hp(Argument, 2);
+		incr_hp_msg(Argument, 2,
+			mercury__std_util__deconstruct_4_0,
+			""std_util:univ/0"");
 
 			/* Join the argument to the front of the list */
 		Arguments = MR_list_cons(Argument, Arguments);
Index: library/store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/store.m,v
retrieving revision 1.13
diff -u -r1.13 store.m
--- store.m	1998/05/15 07:08:46	1.13
+++ store.m	1999/09/24 04:33:26
@@ -237,7 +237,8 @@
 :- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
 		will_not_call_mercury,
 "
-	incr_hp(Mutvar, 1);
+	incr_hp_msg(Mutvar, 1, mercury__store__new_mutvar_4_0,
+		""store:mutvar/2"");
 	*(Word *)Mutvar = Val;
 	S = S0;
 ").
@@ -263,7 +264,9 @@
 :- pragma c_code(unsafe_new_uninitialized_mutvar(Mutvar::out, S0::di, S::uo),
 		will_not_call_mercury,
 "
-	incr_hp(Mutvar, 1);
+	incr_hp_msg(Mutvar, 1,
+		mercury__store__unsafe_new_uninitialized_mutvar_3_0,
+		""store:mutvar/2"");
 	S = S0;
 ").
 
@@ -277,7 +280,7 @@
 :- pragma c_code(new_ref(Val::di, Ref::out, S0::di, S::uo),
 		will_not_call_mercury,
 "
-	incr_hp(Ref, 1);
+	incr_hp_msg(Ref, 1, mercury__store__new_ref_4_0, ""store:ref/2"");
 	*(Word *)Ref = Val;
 	S = S0;
 ").
@@ -367,7 +370,8 @@
 	** to copy it to the heap before returning.
 	*/
 	if (arg_ref == &Val) {
-		incr_hp(ArgRef, 1);
+		incr_hp_msg(ArgRef, 1, mercury__store__new_arg_ref_5_0,
+			""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.113
diff -u -r1.113 string.m
--- string.m	1999/07/07 15:19:42	1.113
+++ string.m	1999/09/24 04:52:25
@@ -607,7 +607,9 @@
 ** allocate (length + 1) bytes of heap space for string
 ** i.e. (length + 1 + sizeof(Word) - 1) / sizeof(Word) words
 */
-	incr_hp_atomic(str_ptr, size / sizeof(Word));
+	incr_hp_atomic_msg(str_ptr, size / sizeof(Word),
+		mercury__string__from_rev_char_list_2_0,
+		""string:string/0"");
 	Str = (char *) str_ptr;
 /*
 ** set size to be the offset of the end of the string
@@ -1561,7 +1563,9 @@
 	char buf[500];
 	Word tmp;
 	sprintf(buf, ""%#.15g"", FloatVal);
-	incr_hp_atomic(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word),
+		mercury__string__float_to_string_2_0,
+		""string:string/0"");
 	FloatString = (char *)tmp;
 	strcpy(FloatString, buf);
 }").
@@ -1576,7 +1580,9 @@
 	char buf[500];
 	Word tmp;
 	sprintf(buf, ""%.15f"", FloatVal);
-	incr_hp_atomic(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(tmp, (strlen(buf) + sizeof(Word)) / sizeof(Word),
+		mercury__string__float_to_f_string_2_0,
+		""string:string/0"");
 	FloatString = (char *)tmp;
 	strcpy(FloatString, buf);
 }").
@@ -1629,7 +1635,9 @@
 ** allocate (length + 1) bytes of heap space for string
 ** i.e. (length + 1 + sizeof(Word) - 1) / sizeof(Word) words
 */
-	incr_hp_atomic(str_ptr, size / sizeof(Word));
+	incr_hp_atomic_msg(str_ptr, size / sizeof(Word),
+		mercury__string__to_int_list_2_1,
+		""string:string/0"");
 	Str = (char *) str_ptr;
 /*
 ** loop to copy the characters from the int_list to the string
@@ -1731,7 +1739,8 @@
 		** We need to make a copy to ensure that the pointer is
 		** word-aligned.
 		*/
-		incr_hp_atomic(tmp, (len_2 + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp, (len_2 + sizeof(Word)) / sizeof(Word),
+			mercury__string__append_3_1, ""string:string/0"");
 		S2 = (char *) tmp;
 		strcpy(S2, S3 + len_1);
 		SUCCESS_INDICATOR = TRUE;
@@ -1747,7 +1756,8 @@
 	Word tmp;
 	len_1 = strlen(S1);
 	len_2 = strlen(S2);
-	incr_hp_atomic(tmp, (len_1 + len_2 + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(tmp, (len_1 + len_2 + sizeof(Word)) / sizeof(Word),
+		mercury__string__append_3_2, ""string:string/0"");
 	S3 = (char *) tmp;
 	strcpy(S3, S1);
 	strcpy(S3 + len_1, S2);
@@ -1771,14 +1781,16 @@
 	common_code("
 		Word	temp;
 
-		incr_hp_atomic(temp,
-			(LOCALS->count + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(temp,
+			(LOCALS->count + sizeof(Word)) / sizeof(Word),
+			mercury__string__append_3_3, ""string:string/0"");
 		S1 = (String) temp;
 		memcpy(S1, LOCALS->s, LOCALS->count);
 		S1[LOCALS->count] = '\\0';
-		incr_hp_atomic(temp,
+		incr_hp_atomic_msg(temp,
 			(LOCALS->len - LOCALS->count + sizeof(Word))
-			/ sizeof(Word));
+				/ sizeof(Word),
+			mercury__string__append_3_3, ""string:string/0"");
 		S2 = (String) temp;
 		strcpy(S2, LOCALS->s + LOCALS->count);
 
@@ -1811,7 +1823,8 @@
 		len = strlen(Str);
 		if (Start > len) Start = len;
 		if (Count > len - Start) Count = len - Start;
-		incr_hp_atomic(tmp, (Count + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
+			mercury__string__substring_4_0, ""string:string/0"");
 		SubString = (char *) tmp;
 		memcpy(SubString, Str + Start, Count);
 		SubString[Count] = '\\0';
@@ -1831,7 +1844,8 @@
 "{
 	Integer len;
 	Word tmp;
-	incr_hp_atomic(tmp, (Count + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
+		mercury__string__unsafe_substring_4_0, ""string:string/0"");
 	SubString = (char *) tmp;
 	memcpy(SubString, Str + Start, Count);
 	SubString[Count] = '\\0';
@@ -1858,7 +1872,8 @@
 	} else {
 		len = strlen(Str);
 		if (Count > len) Count = len;
-		incr_hp_atomic(tmp, (Count + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp, (Count + sizeof(Word)) / sizeof(Word),
+			mercury__string__split_4_0, ""string:string/0"");
 		Left = (char *) tmp;
 		memcpy(Left, Str, Count);
 		Left[Count] = '\\0';
@@ -1866,8 +1881,9 @@
 		** We need to make a copy to ensure that the pointer is
 		** word-aligned.
 		*/
-		incr_hp_atomic(tmp,
-			(len - Count + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp,
+			(len - Count + sizeof(Word)) / sizeof(Word),
+			mercury__string__split_4_0, ""string:string/0"");
 		Right = (char *) tmp;
 		strcpy(Right, Str + Count);
 	}
@@ -1922,8 +1938,9 @@
 		** We need to make a copy to ensure that the pointer is
 		** word-aligned.
 		*/
-		incr_hp_atomic(tmp,
-			(strlen(Str) + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp,
+			(strlen(Str) + sizeof(Word)) / sizeof(Word),
+			mercury__string__first_char_3_2, ""string:string/0"");
 		Rest = (char *) tmp;
 		strcpy(Rest, Str);
 		SUCCESS_INDICATOR = TRUE;
@@ -1945,8 +1962,9 @@
 		** We need to make a copy to ensure that the pointer is
 		** word-aligned.
 		*/
-		incr_hp_atomic(tmp,
-			(strlen(Str) + sizeof(Word)) / sizeof(Word));
+		incr_hp_atomic_msg(tmp,
+			(strlen(Str) + sizeof(Word)) / sizeof(Word),
+			mercury__string__first_char_3_3, ""string:string/0"");
 		Rest = (char *) tmp;
 		strcpy(Rest, Str);
 		SUCCESS_INDICATOR = TRUE;
@@ -1960,7 +1978,8 @@
 		[will_not_call_mercury, thread_safe], "{
 	size_t len = strlen(Rest) + 1;
 	Word tmp;
-	incr_hp_atomic(tmp, (len + sizeof(Word)) / sizeof(Word));
+	incr_hp_atomic_msg(tmp, (len + sizeof(Word)) / sizeof(Word),
+		mercury__string__first_char_3_4, ""string:string/0"");
 	Str = (char *) tmp;
 	Str[0] = First;
 	strcpy(Str + 1, Rest);
Index: runtime/mercury_heap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_heap.h,v
retrieving revision 1.10
diff -u -r1.10 mercury_heap.h
--- mercury_heap.h	1999/03/10 22:05:23	1.10
+++ mercury_heap.h	1999/09/24 05:02:02
@@ -135,13 +135,13 @@
 #ifdef	PROFILE_MEMORY
   #define tag_incr_hp_msg(dest, tag, count, proclabel, type)		\
 	(								\
-		MR_record_allocation((count), LABEL(proclabel), 	\
+		MR_record_allocation((count), ENTRY(proclabel), 	\
 			MR_STRINGIFY(proclabel), (type)),		\
 		tag_incr_hp((dest), (tag), (count))			\
 	)
   #define tag_incr_hp_atomic_msg(dest, tag, count, proclabel, type) 	\
 	(								\
-		MR_record_allocation((count), LABEL(proclabel), 	\
+		MR_record_allocation((count), ENTRY(proclabel), 	\
 			MR_STRINGIFY(proclabel), (type)),		\
 		tag_incr_hp_atomic((dest), (tag), (count))		\
 	)

-- 
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