[m-rev.] hlc.agc: fix GC of closure wrappers

[Fergus Henderson]

Estimated hours taken: 16
Branches: main

Implement the last remaining bits needed to do accurate GC for
closure wrappers.

compiler/ml_call_gen.m:
	Add an extra boolean argument to ml_gen_call and
	ml_gen_box_or_unbox_lval specifying whether or not
	the calling procedure is a closure wrapper.
	If it is, declare any local variables allocated
	to hold temporaries needed for boxing/unboxing
	using ml_gen_local_for_output_arg from ml_closure_gen.m,
	so that the GC tracing code gets handled right.

compiler/ml_closure_gen.m:
	Pass `yes' for the new boolean argument to ml_gen_call.
	Export ml_gen_local_for_output_arg, for use by ml_call_gen.m.
	Fix a bug where the `allocated_memory_cells' list was not being
	initialized.

compiler/ml_code_gen.m:
	Pass `no' for the new boolean argument to ml_gen_call
	and ml_gen_box_or_unbox_lval.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.34
diff -u -d -r1.34 ml_call_gen.m
--- compiler/ml_call_gen.m	2 Apr 2002 16:36:09 -0000	1.34
+++ compiler/ml_call_gen.m	2 Jun 2002 11:01:17 -0000
@@ -21,7 +21,7 @@
 :- import_module backend_libs__code_model.
 :- import_module ml_backend__mlds, ml_backend__ml_code_util.
 
-:- import_module list.
+:- import_module list, bool.
 
 	% Generate MLDS code for an HLDS generic_call goal.
 	% This includes boxing/unboxing the arguments if necessary.
@@ -31,13 +31,23 @@
 :- mode ml_gen_generic_call(in, in, in, in, in, out, out, in, out) is det.
 
 	%
+	% ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ArgTypes,
+	%	CodeModel, Context, ForClosureWrapper,
+	%	MLDS_Defns, MLDS_Statements):
+	%
 	% Generate MLDS code for an HLDS procedure call, making sure to
 	% box/unbox the arguments if necessary.
 	%
+	% If ForClosureWrapper = yes, then the type_info for type variables
+	% in CallerType may not be available in the current procedure, so
+	% the GC tracing code for temps introduced for boxing/unboxing (if any)
+	% should obtain the type_info from the corresponding entry in the
+	% `type_params' local.
+	%
 :- pred ml_gen_call(pred_id, proc_id, list(var_name), list(mlds__lval),
-		list(prog_data__type), code_model, prog_context,
+		list(prog_data__type), code_model, prog_context, bool,
 		mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
-:- mode ml_gen_call(in, in, in, in, in, in, in, out, out, in, out) is det.
+:- mode ml_gen_call(in, in, in, in, in, in, in, in, out, out, in, out) is det.
 
 	%
 	% Generate MLDS code for a call to a builtin procedure.
@@ -63,7 +73,7 @@
 :- mode ml_gen_box_or_unbox_rval(in, in, in, out, in, out) is det.
 
 	% ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName,
-	%	Context,
+	%	Context, ForClosureWrapper,
 	%	ArgLval, ConvDecls, ConvInputStatements, ConvOutputStatements):
 	%
 	% This is like `ml_gen_box_or_unbox_rval', except that it
@@ -77,16 +87,20 @@
 	% to the destination lval, and code to assign from the
 	% destination lval (suitable converted) to the source lval.
 	%
+	% If ForClosureWrapper = yes, then the type_info for type variables
+	% in CallerType may not be available in the current procedure, so
+	% the GC tracing code for the ConvDecls (if any) should obtain the
+	% type_info from the corresponding entry in the `type_params' local.
+	%
 :- pred ml_gen_box_or_unbox_lval(prog_type, prog_type, mlds__lval, var_name,
-		prog_context, mlds__lval, mlds__defns, mlds__statements,
+		prog_context, bool, mlds__lval, mlds__defns, mlds__statements,
 		mlds__statements, ml_gen_info, ml_gen_info).
-:- mode ml_gen_box_or_unbox_lval(in, in, in, in, in, out, out, out, out,
+:- mode ml_gen_box_or_unbox_lval(in, in, in, in, in, in, out, out, out, out,
 		in, out) is det.
 
         % Generate the appropriate MLDS type for a continuation function
         % for a nondet procedure whose output arguments have the
         % specified types.
-        % 
         %
 :- pred ml_gen_cont_params(list(mlds__type), mlds__func_params,
 		ml_gen_info, ml_gen_info).
@@ -97,6 +111,7 @@
 
 :- implementation.
 
+:- import_module ml_backend__ml_closure_gen.
 :- import_module hlds__hlds_module, hlds__hlds_data.
 :- import_module backend_libs__builtin_ops.
 :- import_module check_hlds__type_util, check_hlds__mode_util.
@@ -231,7 +246,7 @@
 	ml_gen_var_list(ArgVars, ArgLvals),
 	ml_variable_types(ArgVars, ActualArgTypes),
 	ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, BoxedArgTypes,
-		ArgModes, PredOrFunc, CodeModel, Context,
+		ArgModes, PredOrFunc, CodeModel, Context, no,
 		InputRvals, OutputLvals, OutputTypes,
 		ConvArgDecls, ConvOutputStatements),
 	{ ClosureRval = unop(unbox(ClosureArgType), lval(ClosureLval)) },
@@ -315,7 +330,7 @@
 	% we just pass the original argument unchanged.
 	%
 ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ActualArgTypes, CodeModel,
-		Context, MLDS_Decls, MLDS_Statements) -->
+		Context, ForClosureWrapper, MLDS_Decls, MLDS_Statements) -->
 	%
 	% Compute the function signature
 	%
@@ -344,7 +359,7 @@
 	% to pass as the function call's arguments and return values
 	%
 	ml_gen_arg_list(ArgNames, ArgLvals, ActualArgTypes, PredArgTypes,
-		ArgModes, PredOrFunc, CodeModel, Context,
+		ArgModes, PredOrFunc, CodeModel, Context, ForClosureWrapper,
 		InputRvals, OutputLvals, OutputTypes,
 		ConvArgDecls, ConvOutputStatements),
 
@@ -599,14 +614,14 @@
 %
 :- pred ml_gen_arg_list(list(var_name), list(mlds__lval), list(prog_type),
 		list(prog_type), list(mode), pred_or_func, code_model,
-		prog_context, list(mlds__rval), list(mlds__lval),
+		prog_context, bool, list(mlds__rval), list(mlds__lval),
 		list(mlds__type), mlds__defns, mlds__statements,
 		ml_gen_info, ml_gen_info).
-:- mode ml_gen_arg_list(in, in, in, in, in, in, in, in, out, out, out, out, out,
-		in, out) is det.
+:- mode ml_gen_arg_list(in, in, in, in, in, in, in, in, in,
+		out, out, out, out, out, in, out) is det.
 
 ml_gen_arg_list(VarNames, VarLvals, CallerTypes, CalleeTypes, Modes,
-		PredOrFunc, CodeModel, Context,
+		PredOrFunc, CodeModel, Context, ForClosureWrapper,
 		InputRvals, OutputLvals, OutputTypes,
 		ConvDecls, ConvOutputStatements) -->
 	(
@@ -630,7 +645,7 @@
 	->
 		ml_gen_arg_list(VarNames1, VarLvals1,
 			CallerTypes1, CalleeTypes1, Modes1,
-			PredOrFunc, CodeModel, Context,
+			PredOrFunc, CodeModel, Context, ForClosureWrapper,
 			InputRvals1, OutputLvals1, OutputTypes1,
 			ConvDecls1, ConvOutputStatements1),
 		=(MLDSGenInfo),
@@ -674,8 +689,8 @@
 			% it's an output argument, or an unused argument
 			%
 			ml_gen_box_or_unbox_lval(CallerType, CalleeType,
-				VarLval, VarName, Context, ArgLval,
-				ThisArgConvDecls, _ThisArgConvInput,
+				VarLval, VarName, Context, ForClosureWrapper,
+				ArgLval, ThisArgConvDecls, _ThisArgConvInput,
 				ThisArgConvOutput),
 			{ ConvDecls = ThisArgConvDecls ++ ConvDecls1 },
 			{ ConvOutputStatements =
@@ -826,8 +841,8 @@
 	).
 	
 ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName, Context,
-		ArgLval, ConvDecls, ConvInputStatements, ConvOutputStatements)
-		-->
+		ForClosureWrapper, ArgLval, ConvDecls,
+		ConvInputStatements, ConvOutputStatements) -->
 	%
 	% First see if we can just convert the lval as an rval;
 	% if no boxing/unboxing is required, then ml_box_or_unbox_rval
@@ -868,11 +883,28 @@
 			"conv%d_%s", [i(ConvVarNum), s(VarNameStr)]),
 			MaybeNum) },
 		ml_gen_type(CalleeType, MLDS_CalleeType),
-		ml_gen_maybe_gc_trace_code(ArgVarName, CalleeType, CallerType,
-			Context, GC_TraceCode),
-		{ ArgVarDecl = ml_gen_mlds_var_decl(var(ArgVarName),
-			MLDS_CalleeType, GC_TraceCode,
-			mlds__make_context(Context)) },
+		( { ForClosureWrapper = yes } ->
+			% For closure wrappers, the argument type_infos are
+			% stored in the `type_params' local, so we need to
+			% handle the GC tracing code specially
+			( { type_util__var(CallerType, TypeVar) } ->
+				% XXX here we rely on the allocation order
+				%     of type variable numbers
+				{ term__var_to_int(TypeVar, ArgNum) },
+				ml_gen_local_for_output_arg(ArgVarName,
+					CalleeType, ArgNum, Context,
+					ArgVarDecl)
+			;
+				{ unexpected(this_file,
+				    "invalid CalleeType for closure wrapper") }
+			)
+		;
+			ml_gen_maybe_gc_trace_code(ArgVarName, CalleeType,
+				CallerType, Context, GC_TraceCode),
+			{ ArgVarDecl = ml_gen_mlds_var_decl(var(ArgVarName),
+				MLDS_CalleeType, GC_TraceCode,
+				mlds__make_context(Context)) }
+		),
 		{ ConvDecls = [ArgVarDecl] },
 
 		% create the lval for the variable and use it for the
Index: compiler/ml_closure_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_closure_gen.m,v
retrieving revision 1.10
diff -u -d -r1.10 ml_closure_gen.m
--- compiler/ml_closure_gen.m	12 Apr 2002 01:24:07 -0000	1.10
+++ compiler/ml_closure_gen.m	2 Jun 2002 11:04:51 -0000
@@ -57,6 +57,17 @@
 :- mode ml_gen_closure_wrapper(in, in, in, in, in, out, out,
 		in, out) is det.
 
+	% ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context,
+	%	LocalVarDefn):
+	% Generate a declaration for a local variable with the specified
+	% VarName and Type.  However, don't use the normal GC tracing code;
+	% instead, generate GC tracing code that gets the typeinfo from
+	% the ArgNum-th entry in `type_params'.
+
+:- pred ml_gen_local_for_output_arg(var_name, prog_type, int, prog_context,
+		mlds__defn, ml_gen_info, ml_gen_info).
+:- mode ml_gen_local_for_output_arg(in, in, in, in, out, in, out) is det.
+
 %-----------------------------------------------------------------------------%
 
 :- implementation.
@@ -579,7 +590,6 @@
 	%		/* declarations needed for converting output args */
 	%		Arg2Type conv_arg2;
 	%		/* GC tracing code same as below */
-	%		/* XXX FIXME generation of this is N.Y.I. */
 	%		...
 	%
 	%		/* declarations needed for by-value outputs */
@@ -588,7 +598,7 @@
 	%   #if 0 /* GC tracing code */
 	%     {
 	%	MR_TypeInfo type_info;
-	%	MR_MemoryList allocated_memory_cells;
+	%	MR_MemoryList allocated_memory_cells = NULL;
     	%	type_info = MR_make_type_info_maybe_existq(type_params,
 	%	    ((MR_Closure*)closure)->MR_closure_layout
 	%	    	->MR_closure_arg_pseudo_type_info[ <arg number> ],
@@ -840,14 +850,11 @@
 		ClosureArgLvals),
 	{ CallLvals = list__append(ClosureArgLvals, WrapperHeadVarLvals) },
 	ml_gen_call(PredId, ProcId, ProcHeadVarNames, CallLvals,
-		ProcBoxedArgTypes, CodeModel, Context, Decls0, Statements0),
-	% XXX FIXME the accurate GC handling for Decls0 is wrong,
-	% because we don't have type_infos for the type variables in
-	% ProcBoxedArgTypes.
-	{ FixedDecls0 = list__map(cannot_gc, Decls0) },
+		ProcBoxedArgTypes, CodeModel, Context, yes,
+		Decls0, Statements0),
 
 	% insert the stuff to declare and initialize the closure
-	{ Decls1 = [ClosureDecl | FixedDecls0] },
+	{ Decls1 = [ClosureDecl | Decls0] },
 	{ Statements1 = [InitClosure | Statements0] },
 
 	%
@@ -909,29 +916,6 @@
 	Argument0 = mlds__argument(Name, Type, _GCTraceCode),
 	Argument = mlds__argument(Name, Type, no).
 
-% XXX FIXME Accurate GC of variables declared in closure wrapper
-% functions is not yet implemented.  We use the following hack
-% to make sure that it crashes nicely at runtime if GC ever occurs
-% while one of these variables is live.
-:- func cannot_gc(mlds__defn) = mlds__defn.
-cannot_gc(Defn0) = Defn :-
-	(
-		Defn0 = mlds__defn(Name, Context, Flags, Body0),
-		Body0 = mlds__data(Type, Init, yes(_GCTraceCode))
-	->
-		Abort = mlds__statement(atomic(
-			inline_target_code(lang_C, [raw_target_code(
-			"MR_fatal_error(""don't know how to GC this\\n"");\n",
-			[])])),
-			Context),
-		MaybeGCTraceCode = yes(Abort),
-		% MaybeGCTraceCode = no,
-		Body = mlds__data(Type, Init, MaybeGCTraceCode),
-		Defn = mlds__defn(Name, Context, Flags, Body)
-	;
-		Defn = Defn0
-	).
-
 :- pred ml_gen_wrapper_func(ml_label_func, mlds__func_params, prog_context,
 		mlds__statement, mlds__defn, ml_gen_info, ml_gen_info).
 :- mode ml_gen_wrapper_func(in, in, in, in, out, in, out) is det.
@@ -1077,10 +1061,6 @@
 		raw_target_code(");\n", [])
 	])), Context) }.
 
-:- pred ml_gen_local_for_output_arg(var_name, prog_type, int, prog_context,
-		mlds__defn, ml_gen_info, ml_gen_info).
-:- mode ml_gen_local_for_output_arg(in, in, in, in, out, in, out) is det.
-
 ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context, LocalVarDefn) -->
 	%
 	% Generate a declaration for a corresponding local variable.
@@ -1089,6 +1069,7 @@
 	% the following code:
 	%
 	%	MR_TypeInfo type_info;
+	%	MR_MemoryList allocated_memory_cells = NULL;
     	%	type_info = MR_make_type_info_maybe_existq(type_params,
 	%	  closure_layout->MR_closure_arg_pseudo_type_info[<ArgNum>],
 	%         NULL, NULL, &allocated_memory_cells);
@@ -1128,7 +1109,8 @@
 	{ MaybeGCTraceCode0 = yes(CallTraceFuncCode) ->
 		MakeTypeInfoCode = atomic(inline_target_code(lang_C, [
 			raw_target_code("{\n", []),
-			raw_target_code("MR_MemoryList allocated_mem;\n", []),
+			raw_target_code(
+			    "MR_MemoryList allocated_mem = NULL;\n", []),
 			target_code_output(TypeInfoLval),
 			raw_target_code(
 			    " = (MR_C_Pointer) " ++
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.116
diff -u -d -r1.116 ml_code_gen.m
--- compiler/ml_code_gen.m	30 May 2002 11:00:10 -0000	1.116
+++ compiler/ml_code_gen.m	2 Jun 2002 08:12:38 -0000
@@ -1412,7 +1412,7 @@
 		{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
 		{ VarName = ml_gen_var_name(VarSet, Var) },
 		ml_gen_box_or_unbox_lval(HeadType, BodyType, HeadVarLval,
-			VarName, Context, BodyLval, ConvDecls,
+			VarName, Context, no, BodyLval, ConvDecls,
 			ConvInputStatements, ConvOutputStatements),
 
 		%
@@ -2054,7 +2054,7 @@
 		{ ArgNames = ml_gen_var_names(VarSet, ArgVars) },
 		ml_variable_types(ArgVars, ActualArgTypes),
 		ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ActualArgTypes,
-			CodeModel, Context, MLDS_Decls, MLDS_Statements)
+			CodeModel, Context, no, MLDS_Decls, MLDS_Statements)
 	;
 		% For the MLDS back-end, we can't treat
 		% private_builtin:unsafe_type_cast as an
@@ -3016,8 +3016,8 @@
 		ml_variable_type(Var, VarType),
 		ml_gen_var(Var, VarLval),
 		ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval,
-			mlds__var_name(ArgName, no),
-			Context, ArgLval, ConvDecls, _ConvInputStatements,
+			mlds__var_name(ArgName, no), Context, no,
+			ArgLval, ConvDecls, _ConvInputStatements,
 			ConvOutputStatements),
 		% At this point we have an lval with the right type for
 		% *internal* use in the code generated by the Mercury

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