diff: library/io.m fix (was: [m-dev.] mainline regression: io.buffer vs ISO C)

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

library/io.m:
	Back out petdr's recent change (revision 1.285), since it was broken;
	among other problems, it was allocating buffers with GC_malloc()
	rather than GC_malloc_atomic(), which can cause memory leaks due
	to pointer misidentification.

	Instead, provide an alternative fix to the ISO C compliance
	problems introduced in petdr's earlier change (revision 1.282)
	which the change in revision 1.285 was attempting to fix.
	This fix involved going through all of the places where the
	`buffer' type was passed to C code and updating them to reflect
	the fact that this now corresponds to `MR_Char *' rather than
	`MR_Word' in C.

	Also, call MR_GC_realloc() rather than calling GC_REALLOC() directly,
	to ensure that we report an error message if GC_REALLOC() fails.

Workspace: /home/ceres/fjh/mercury
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.286
diff -u -d -r1.286 io.m
--- library/io.m	17 Jan 2003 05:56:50 -0000	1.286
+++ library/io.m	20 Jan 2003 09:43:43 -0000
@@ -2125,11 +2125,12 @@
 	io__alloc_buffer(Size::in, Buffer::buffer_uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "{
-	MR_maybe_record_allocation(
+	MR_Word buf;
+	MR_incr_hp_atomic_msg(buf,
 		(Size * sizeof(MR_Char) + sizeof(MR_Word) - 1)
 			/ sizeof(MR_Word),
 		MR_PROC_LABEL, ""io:buffer/0"");
-	Buffer = MR_GC_NEW_ARRAY(MR_Char, Size);
+	Buffer = (MR_Char *) buf;
 }").
 
 io__alloc_buffer(Size, buffer(Array)) :-
@@ -2144,37 +2145,36 @@
 		NewSize::in, Buffer::buffer_uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "{
-	MR_Char *buffer0 = (MR_Char *) Buffer0;
-	MR_Char *buffer;
+	MR_CHECK_EXPR_TYPE(Buffer0, MR_Char *);
+	MR_CHECK_EXPR_TYPE(Buffer, MR_Char *);
 
 #ifdef MR_CONSERVATIVE_GC
-	buffer = GC_REALLOC(buffer0, NewSize * sizeof(MR_Char));
+	Buffer = MR_GC_realloc(Buffer0, NewSize * sizeof(MR_Char));
 #else
-	if (buffer0 + OldSize == (MR_Char *) MR_hp) {
+	if (Buffer0 + OldSize == (MR_Char *) MR_hp) {
 		MR_Word next;
 		MR_incr_hp_atomic_msg(next, 
 		   (NewSize * sizeof(MR_Char) + sizeof(MR_Word) - 1)
 		   	/ sizeof(MR_Word),
 		   MR_PROC_LABEL,
 		   ""io:buffer/0"");
-		assert(buffer0 + OldSize == (MR_Char *) next);
-	    	buffer = buffer0;
+		assert(Buffer0 + OldSize == (MR_Char *) next);
+	    	Buffer = Buffer0;
 	} else {
 		/* just have to alloc and copy */
-		MR_incr_hp_atomic_msg(Buffer,
+		MR_Word buf;
+		MR_incr_hp_atomic_msg(buf,
 		   (NewSize * sizeof(MR_Char) + sizeof(MR_Word) - 1)
 		   	/ sizeof(MR_Word),
 		   MR_PROC_LABEL, ""io:buffer/0"");
-		buffer = (MR_Char *) Buffer;
+		Buffer = (MR_Char *) buf;
 		if (OldSize > NewSize) {
-			memcpy(buffer, buffer0, NewSize);
+			memcpy(Buffer, Buffer0, NewSize);
 		} else {
-			memcpy(buffer, buffer0, OldSize);
+			memcpy(Buffer, Buffer0, OldSize);
 		}
 	}
 #endif
-
-	Buffer = buffer;
 }").
 
 io__resize_buffer(buffer(Array0), _OldSize, NewSize, buffer(Array)) :-
@@ -2187,7 +2187,7 @@
 	io__buffer_to_string(Buffer::buffer_di, Len::in, Str::uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "{
-	Str = (MR_String) Buffer;
+	Str = Buffer;
 	Str[Len] = '\\0';
 }").
 
@@ -2199,7 +2199,7 @@
 	io__buffer_to_string(Buffer::buffer_di, Str::uo),
 	[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "{
-	Str = (MR_String) Buffer;
+	Str = Buffer;
 }").
 
 io__buffer_to_string(buffer(Array), from_char_list(List)) :-
@@ -2216,12 +2216,14 @@
 			thread_safe],
 "{
 	MercuryFile *f = (MercuryFile *) Stream;
-	char *buffer = (MR_Char *) Buffer0;
 	int items_read;
 
-	items_read = MR_READ(*f, buffer + Pos0, Size - Pos0);
+	MR_CHECK_EXPR_TYPE(Buffer0, MR_Char *);
+	MR_CHECK_EXPR_TYPE(Buffer, MR_Char *);
 
-	Buffer = buffer;
+	items_read = MR_READ(*f, Buffer0 + Pos0, Size - Pos0);
+
+	Buffer = Buffer0;
 	Pos = Pos0 + items_read;
 	MR_update_io(IO0, IO);
 }").


-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- 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
--------------------------------------------------------------------------