[m-rev.] for review: add agc tracing code to exception.m

[Fergus Henderson]

Estimated hours taken: 4
Branches: main

library/exception.m:
	For accurate garbage collection, add code to trace the local
	variables in the hand-coded C builtin_catch_*() functions.

Workspace: /home/ceres/fjh/mercury
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.60
diff -u -d -r1.60 exception.m
--- library/exception.m	28 Mar 2002 03:44:40 -0000	1.60
+++ library/exception.m	3 Jun 2002 05:14:01 -0000
@@ -777,6 +777,10 @@
 	MR_Univ		exception;
 } ML_ExceptionHandler;
 
+/*
+** XXX This is currently not thread-safe!
+** The ML_exception_handler variable should be thread-local.
+*/
 ML_ExceptionHandler *ML_exception_handler;
 
 void MR_CALL
@@ -795,15 +799,93 @@
 	}
 }
 
+#ifdef MR_NATIVE_GC
+
+/*
+** The following code is needed to trace the local variables
+** in the builtin_catch_* functions for accurate GC.
+*/
+
+struct mercury__exception__builtin_catch_locals {
+	/* fixed fields, from struct MR_StackChain */
+	struct MR_StackChain *prev;
+	void (*trace)(void *this_frame);
+	/* locals for this function */
+	MR_Mercury_Type_Info type_info;
+	MR_Pred handler_pred;
+};
+
+static void
+mercury__exception__builtin_catch_gc_trace(void *frame)
+{
+	struct mercury__exception__builtin_catch_locals *agc_locals = frame;
+	/*
+	** Construct a type_info for the type `pred(univ, T)',
+	** which is the type of the handler_pred.
+	*/
+	MR_VAR_ARITY_TYPEINFO_STRUCT(s, 2) type_info_for_handler_pred;
+	type_info_for_handler_pred.MR_ti_type_ctor_info = 
+		&mercury__builtin__builtin__type_ctor_info_pred_0;
+	type_info_for_handler_pred.MR_ti_var_arity_arity = 2;
+	type_info_for_handler_pred.MR_ti_var_arity_arg_typeinfos[0] =
+		(MR_TypeInfo)
+		&mercury__std_util__std_util__type_ctor_info_univ_0;
+	type_info_for_handler_pred.MR_ti_var_arity_arg_typeinfos[1] =
+		(MR_TypeInfo) agc_locals->type_info;
+	/*
+	** Call gc_trace/1 to trace the two local variables in this frame.
+	*/
+	mercury__private_builtin__gc_trace_1_p_0(
+		(MR_Word)
+		&mercury__type_desc__type_desc__type_ctor_info_type_desc_0,
+		(MR_Word) &agc_locals->type_info);
+	mercury__private_builtin__gc_trace_1_p_0(
+		(MR_Word) &type_info_for_handler_pred,
+		(MR_Word) &agc_locals->handler_pred);
+}
+
+ #define MR_DECLARE_AGC_HANDLER \
+	struct mercury__exception__builtin_catch_locals agc_locals;
+
+ #define MR_INSTALL_AGC_HANDLER(TYPE_INFO, HANDLER_PRED) \
+ 	do { \
+	    agc_locals.prev = mercury__private_builtin__stack_chain; \
+	    agc_locals.trace = mercury__exception__builtin_catch_gc_trace; \
+	    agc_locals.type_info = (TYPE_INFO); \
+	    agc_locals.handler_pred = (HANDLER_PRED); \
+	    mercury__private_builtin__stack_chain = &agc_locals; \
+	} while(0);
+
+ #define MR_UNINSTALL_AGC_HANDLER() \
+ 	do { \
+	    mercury__private_builtin__stack_chain = ((struct MR_StackChain *) \
+		mercury__private_builtin__stack_chain)->prev; \
+	} while (0)
+
+  #define MR_AGC_LOCAL(NAME) (agc_locals.NAME)
+
+#else /* !MR_NATIVE_GC */
+
+  /* If accurate GC is not enabled, we define all of these as NOPs. */
+  #define MR_DECLARE_AGC_HANDLER
+  #define MR_INSTALL_AGC_HANDLER(type_info, handler_pred)
+  #define MR_UNINSTALL_AGC_HANDLER()
+  #define MR_AGC_LOCAL(name) (name)
+
+#endif /* !MR_NATIVE_GC */
+
 void MR_CALL
 mercury__exception__builtin_catch_model_det(MR_Mercury_Type_Info type_info,
 	MR_Pred pred, MR_Pred handler_pred, MR_Box *output)
 {
 	ML_ExceptionHandler this_handler;
-
+	MR_DECLARE_AGC_HANDLER
+	
 	this_handler.prev = ML_exception_handler;
 	ML_exception_handler = &this_handler;
 
+	MR_INSTALL_AGC_HANDLER(type_info, handler_pred);
+
 #ifdef	MR_DEBUG_JMPBUFS
 	fprintf(stderr, ""detcatch setjmp %p\\n"", this_handler.handler);
 #endif
@@ -811,6 +893,7 @@
 	if (setjmp(this_handler.handler) == 0) {
 		ML_call_goal_det_handcoded(type_info, pred, output);
 		ML_exception_handler = this_handler.prev;
+		MR_UNINSTALL_AGC_HANDLER();
 	} else {
 #ifdef	MR_DEBUG_JMPBUFS
 		fprintf(stderr, ""detcatch caught jmp %p\\n"",
@@ -818,7 +901,9 @@
 #endif
 
 		ML_exception_handler = this_handler.prev;
-		ML_call_handler_det_handcoded(type_info, handler_pred,
+		MR_UNINSTALL_AGC_HANDLER();
+		ML_call_handler_det_handcoded(
+			MR_AGC_LOCAL(type_info), MR_AGC_LOCAL(handler_pred),
 			this_handler.exception, output);
 	}
 }
@@ -828,10 +913,13 @@
 	MR_Pred pred, MR_Pred handler_pred, MR_Box *output)
 {
 	ML_ExceptionHandler this_handler;
+	MR_DECLARE_AGC_HANDLER
 
 	this_handler.prev = ML_exception_handler;
 	ML_exception_handler = &this_handler;
 
+	MR_INSTALL_AGC_HANDLER(type_info, handler_pred);
+
 #ifdef	MR_DEBUG_JMPBUFS
 	fprintf(stderr, ""semicatch setjmp %p\\n"", this_handler.handler);
 #endif
@@ -840,6 +928,7 @@
 		MR_bool result = ML_call_goal_semi_handcoded(type_info, pred,
 			output);
 		ML_exception_handler = this_handler.prev;
+		MR_UNINSTALL_AGC_HANDLER();
 		return result;
 	} else {
 #ifdef	MR_DEBUG_JMPBUFS
@@ -848,7 +937,9 @@
 #endif
 
 		ML_exception_handler = this_handler.prev;
-		ML_call_handler_det_handcoded(type_info, handler_pred,
+		MR_UNINSTALL_AGC_HANDLER();
+		ML_call_handler_det_handcoded(
+			MR_AGC_LOCAL(type_info), MR_AGC_LOCAL(handler_pred),
 			this_handler.exception, output);
 		return MR_TRUE;
 	}
@@ -862,6 +953,7 @@
 	MR_NestedCont cont)
 {
 	ML_ExceptionHandler this_handler;
+	MR_DECLARE_AGC_HANDLER
 
 	auto void MR_CALL success_cont(void);
 	void MR_CALL success_cont(void) {
@@ -886,6 +978,8 @@
 	this_handler.prev = ML_exception_handler;
 	ML_exception_handler = &this_handler;
 
+	MR_INSTALL_AGC_HANDLER(type_info, handler_pred);
+
 #ifdef	MR_DEBUG_JMPBUFS
 	fprintf(stderr, ""noncatch setjmp %p\\n"", this_handler.handler);
 #endif
@@ -894,6 +988,7 @@
 		ML_call_goal_non_handcoded(type_info, pred, output,
 			success_cont);
 		ML_exception_handler = this_handler.prev;
+		MR_UNINSTALL_AGC_HANDLER();
 	} else {
 #ifdef	MR_DEBUG_JMPBUFS
 		fprintf(stderr, ""noncatch caught jmp %p\\n"",
@@ -901,7 +996,9 @@
 #endif
 
 		ML_exception_handler = this_handler.prev;
-		ML_call_handler_det_handcoded(type_info, handler_pred,
+		MR_UNINSTALL_AGC_HANDLER();
+		ML_call_handler_det_handcoded(
+			MR_AGC_LOCAL(type_info), MR_AGC_LOCAL(handler_pred),
 			this_handler.exception, output);
 		(*cont)();
 	}
@@ -942,6 +1039,7 @@
 	MR_Pred pred, MR_Pred handler_pred, MR_Box *output,
 	MR_Cont cont, void *cont_env)
 {
+	MR_DECLARE_AGC_HANDLER
 	struct ML_catch_env locals;
 	locals.cont = cont;
 	locals.cont_env = cont_env;
@@ -949,6 +1047,8 @@
 	locals.this_handler.prev = ML_exception_handler;
 	ML_exception_handler = &locals.this_handler;
 
+	MR_INSTALL_AGC_HANDLER(type_info, handler_pred);
+
 #ifdef	MR_DEBUG_JMPBUFS
 	fprintf(stderr, ""noncatch setjmp %p\\n"", locals.this_handler.handler);
 #endif
@@ -963,6 +1063,7 @@
 		** handler 
 		*/
 		ML_exception_handler = locals.this_handler.prev;
+		MR_UNINSTALL_AGC_HANDLER();
 		return;
 	} else {
 		/*
@@ -979,7 +1080,9 @@
 
 
 		ML_exception_handler = locals.this_handler.prev;
-		ML_call_handler_det_handcoded(type_info, handler_pred,
+		MR_UNINSTALL_AGC_HANDLER();
+		ML_call_handler_det_handcoded(
+			MR_AGC_LOCAL(type_info), MR_AGC_LOCAL(handler_pred),
 			locals.this_handler.exception, output);
 		cont(cont_env);
 	}

-- 
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-reviews mailing list
post:  mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe:   Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------