for review: software errors from C code

[Andrew Bromage]

G'day all.

Tyson, could you review this please?

Cheers,
Andrew Bromage


Estimated hours taken: 1

Fix to allow software errors which happen in C library code to produce
a stack dump.

Note: Not every kind of fatal error in the C library is a "software
error".  Only the ones which users have a hope of fixing really count
(e.g. array bounds check errors).

Also hidden away in here are two small changes:

	- a fix for a problem with the user-declared array_module
	  which conflicts with the compiler-declared array_module.
	  The fix is to call the user-declared one array_moduleX.

	- checked_realloc(), which is like checked_malloc() only
	  it calls realloc() instead of malloc().

runtime/mercury_misc.h:
runtime/mercury_misc.c:
	Minor reorganisation of the way fatal errors are handled.
	fatal_error() and the new function software_error() both
	call clean_up_after_fatal_error() which currently does
	nothing, but if any cleaning up had to be done, this is
	where it should go.

	Implementation of checked_realloc().

library/require.m:
	Make error/1 call software_error() to ensure that any
	cleanups happen.

library/array.m:
library/io.m:
library/std_util.m:
library/store.m:
	Call software_error() instead of fatal_error() for the
	kinds of error where a stack dump may help.


Index: library/array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/array.m,v
retrieving revision 1.43
diff -u -r1.43 array.m
--- array.m	1998/01/30 05:59:40	1.43
+++ array.m	1998/03/26 05:13:13
@@ -287,7 +287,7 @@
 Declare_entry(mercury__array__array_equal_2_0);
 Declare_entry(mercury__array__array_compare_3_0);
 
-BEGIN_MODULE(array_module)
+BEGIN_MODULE(array_moduleX)
 	init_entry(mercury____Unify___array__array_1_0);
 	init_entry(mercury____Index___array__array_1_0);
 	init_entry(mercury____Compare___array__array_1_0);
@@ -311,12 +311,12 @@
 
 /* Ensure that the initialization code for the above module gets run. */
 /*
-INIT sys_init_array_module
+INIT sys_init_array_moduleX
 */
-void sys_init_array_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_array_module(void) {
+void sys_init_array_moduleX(void); /* suppress gcc -Wmissing-decl warning */
+void sys_init_array_moduleX(void) {
 	extern ModuleFunc array_module;
-	array_module();
+	array_moduleX();
 }
 
 ").
@@ -469,7 +469,7 @@
 	MR_ArrayType *array = (MR_ArrayType *)Array;
 #ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""array__lookup: array index out of bounds"");
+		software_error(""array__lookup: array index out of bounds"");
 	}
 #endif
 	Item = array->elements[Index];
@@ -478,7 +478,7 @@
 	MR_ArrayType *array = (MR_ArrayType *)Array;
 #ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""array__lookup: array index out of bounds"");
+		software_error(""array__lookup: array index out of bounds"");
 	}
 #endif
 	Item = array->elements[Index];
@@ -491,7 +491,7 @@
 	MR_ArrayType *array = (MR_ArrayType *)Array0;
 #ifndef ML_OMIT_ARRAY_BOUNDS_CHECKS
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""array__set: array index out of bounds"");
+		software_error(""array__set: array index out of bounds"");
 	}
 #endif
 	array->elements[Index] = Item;	/* destructive update! */
@@ -565,7 +565,7 @@
 	old_array_size = old_array->size;
 	if (old_array_size == array_size) return old_array;
 	if (old_array_size < array_size) {
-		fatal_error(""array__shrink: can't shrink to a larger size"");
+		software_error(""array__shrink: can't shrink to a larger size"");
 	}
 
 	array = (MR_ArrayType *) make_many(Word, array_size + 1);
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.153
diff -u -r1.153 io.m
--- io.m	1998/03/12 19:45:38	1.153
+++ io.m	1998/03/26 05:19:49
@@ -2187,7 +2187,7 @@
 	}
 	/* XXX should work even if ungetc() fails */
 	if (ungetc(Character, mf->file) == EOF) {
-		fatal_error(""io__putback_char: ungetc failed"");
+		software_error(""io__putback_char: ungetc failed"");
 	}
 	update_io(IO0, IO);
 }").
@@ -2197,7 +2197,7 @@
 	MercuryFile* mf = (MercuryFile *)File;
 	/* XXX should work even if ungetc() fails */
 	if (ungetc(Character, mf->file) == EOF) {
-		fatal_error(""io__putback_byte: ungetc failed"");
+		software_error(""io__putback_byte: ungetc failed"");
 	}
 	update_io(IO0, IO);
 }").
@@ -2650,7 +2650,7 @@
 
 	incr_hp_atomic(tmp, (L_tmpnam + sizeof(Word)) / sizeof(Word));
 	if (tmpnam((char *)tmp) == NULL) {
-		fatal_error(""unable to create temporary filename"");
+		software_error(""unable to create temporary filename"");
 	}
 	FileName = (char *)tmp;
 	update_io(IO0, IO);
@@ -2688,7 +2688,7 @@
 
 	tmp = tempnam(Dir, Prefix);
 	if (tmp  == NULL) {
-		fatal_error(""unable to create temporary filename"");
+		software_error(""unable to create temporary filename"");
 	}
 	incr_hp_atomic(LVALUE_CAST(Word *,FileName),
 		(strlen(tmp) + sizeof(Word)) / sizeof(Word));
@@ -2727,7 +2727,7 @@
 	} while ((err != -1 || errno != ENOENT)
 		&& num_tries < MAX_TEMPNAME_TRIES);
 	if (err != -1 || errno != ENOENT) {
-		fatal_error(""unable to create temporary filename"");
+		software_error(""unable to create temporary filename"");
 	}
 	update_io(IO0, IO);
 #endif
Index: library/require.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/require.m,v
retrieving revision 1.18
diff -u -r1.18 require.m
--- require.m	1998/03/11 05:57:41	1.18
+++ require.m	1998/03/26 05:14:24
@@ -56,10 +56,7 @@
 :- pragma no_inline(error/1). 
 
 :- pragma c_code(error(Message::in), "
-	fflush(stdout);
-	fprintf(stderr, ""Software error: %s\\n"", Message);
-	MR_dump_stack(MR_succip, MR_sp);
-	exit(1);
+	software_error(Message);
 #ifndef USE_GCC_NONLOCAL_GOTOS
 	return 0;	/* suppress some dumb warnings */
 #endif
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.115
diff -u -r1.115 std_util.m
--- std_util.m	1998/01/30 02:15:04	1.115
+++ std_util.m	1998/03/26 05:13:42
@@ -552,7 +552,7 @@
 #ifndef CONSERVATIVE_GC
 
 #ifndef USE_TYPE_LAYOUT
-	fatal_error(""builtin_aggregate/4 not supported with this grade ""
+	software_error(""builtin_aggregate/4 not supported with this grade ""
 		    ""on this system.\n""
 		""Try using a `.gc' (conservative gc) grade.\n"");
 #endif
@@ -2772,7 +2772,7 @@
 		** that allows this.)
 		*/
 	if (info.non_canonical_type) {
-		fatal_error(""called argument/2 for a type with a ""
+		software_error(""called argument/2 for a type with a ""
 			""user-defined equality predicate"");
 	}
 
@@ -2829,7 +2829,7 @@
 		** that allows this.)
 		*/
 	if (info.non_canonical_type) {
-		fatal_error(""called functor/2 for a type with a ""
+		software_error(""called functor/2 for a type with a ""
 			""user-defined equality predicate"");
 	}
 
@@ -2947,7 +2947,7 @@
 		** that allows this.)
 		*/
 	if (info.non_canonical_type) {
-		fatal_error(""called deconstruct/4 for a type with a ""
+		software_error(""called deconstruct/4 for a type with a ""
 			""user-defined equality predicate"");
 	}
 
Index: library/store.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/store.m,v
retrieving revision 1.12
diff -u -r1.12 store.m
--- store.m	1998/01/23 12:33:37	1.12
+++ store.m	1998/03/26 05:13:43
@@ -323,13 +323,13 @@
 	if (!ML_arg(TypeInfo_for_T, (Word *) Ref, ArgNum,
 			&arg_type_info, &arg_ref))
 	{
-		fatal_error(""store__arg_ref: argument number out of range"");
+		software_error(""store__arg_ref: argument number out of range"");
 	}
 
 	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
 		COMPARE_EQUAL)
 	{
-		fatal_error(""store__arg_ref: argument has wrong type"");
+		software_error(""store__arg_ref: argument has wrong type"");
 	}
 
 	restore_transient_registers();
@@ -349,13 +349,13 @@
 	if (!ML_arg(TypeInfo_for_T, (Word *) &Val, ArgNum,
 			&arg_type_info, &arg_ref))
 	{
-	      fatal_error(""store__new_arg_ref: argument number out of range"");
+	      software_error(""store__new_arg_ref: argument number out of range"");
 	}
 
 	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
 		COMPARE_EQUAL)
 	{
-	      fatal_error(""store__new_arg_ref: argument has wrong type"");
+	      software_error(""store__new_arg_ref: argument has wrong type"");
 	}
 
 	restore_transient_registers();
Index: runtime/mercury_misc.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_misc.c,v
retrieving revision 1.4
diff -u -r1.4 mercury_misc.c
--- mercury_misc.c	1998/03/16 12:23:33	1.4
+++ mercury_misc.c	1998/03/26 05:10:11
@@ -462,25 +462,55 @@
 	return p;
 }
 
-/* XXX will need to modify this to kill other processes if PARALLEL
- * (and cleanup resources, etc....)
- */
+static void
+clean_up_after_fatal_error(void)
+{
+	/* XXX will need to modify this to kill other processes if PARALLEL
+	 * (and cleanup resources, etc....)
+	 */
+}
+
 void 
 fatal_error(const char *message) {
+	fflush(stdout);
 	fprintf(stderr, "Mercury runtime: %s\n", message);
+	clean_up_after_fatal_error();
+	exit(1);
+}
+
+void 
+software_error(const char *message) {
+	fflush(stdout);
+	fprintf(stderr, "Software error: %s\n", message);
+	MR_dump_stack(MR_succip, MR_sp);
+	clean_up_after_fatal_error();
 	exit(1);
 }
 
-		/* Note: checked_malloc()ed structures */
-		/* never contain pointers into GCed    */
-		/* memory, so we don't need to         */
-		/* GC_malloc() them. (cf. newmem())    */
+		/* Note: checked_malloc()ed and     */
+		/* checked_realloc()ed structures   */
+		/* never contain pointers into GCed */
+		/* memory, so we don't need to      */
+		/* GC_malloc() them. (cf. newmem()) */
 void *
 checked_malloc(size_t n)
 {
 	reg	void	*p;
 
 	p = malloc(n);
+	if (p == NULL && n != 0) {
+		fatal_error("ran out of memory");
+	}
+
+	return p;
+}
+
+void *
+checked_realloc(void *old, size_t n)
+{
+	reg	void	*p;
+
+	p = realloc(old, n);
 	if (p == NULL && n != 0) {
 		fatal_error("ran out of memory");
 	}
Index: runtime/mercury_misc.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_misc.h,v
retrieving revision 1.4
diff -u -r1.4 mercury_misc.h
--- mercury_misc.h	1998/03/16 12:23:34	1.4
+++ mercury_misc.h	1998/03/26 05:10:34
@@ -62,11 +62,14 @@
 	#define NO_RETURN
 #endif
 extern	void	fatal_error(const char *msg) NO_RETURN;
+extern	void	software_error(const char *msg) NO_RETURN;
 
 /* 
-** XXX checked_malloc() should be moved to mercury_memory.h or mercury_heap.h
+** XXX checked_malloc() and checked_realloc() should be moved to
+**     mercury_memory.h or mercury_heap.h
 */
 #include <stddef.h>	/* for size_t */
 void *checked_malloc(size_t n);
+void *checked_realloc(void *old, size_t n);
 
 #endif /* not MERCURY_MISC_H */