[m-rev.] diff: more hlc.agc fixes

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

Some more bug fixes for accurate GC with the MLDS->C back-end.

With these changes, and a few hacks (see http://www.cs.mu.oz.au/research/
mercury/mailing-lists/mercury-reviews/mercury-reviews.0201/0188.html),
I was able to build all of the programs in tests/benchmarks in grade hlc.agc,
with `EXTRA_MCFLAGS = -O5 --no-deforestation --no-reclaim-heap-on-failure'.

compiler/ml_elim_nested.m:
	- Use an assignment rather than an initializer when
	  saving the stack chain; this is needed because
	  the hoist_nested_funcs pass (which gets run next)
	  assumes that the MLDS doesn't have any initializers
	  for local variables.
	- Include a counter in the ml_elim_info, and use it to ensure that
	  all the saved stack chain variables get named differently;
	  this is needed because the hoist_nested_funcs pass doesn't
	  handle variables with overlapping scopes.
	- Move the code for generating the code to save/restore
	  the stack chain into a separate function.

compiler/notes/compiler_design.html:
	Mention the accurate GC pass in ml_elim_nested.m.

Workspace: /home/earth/fjh/ws-earth4/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.48
diff -u -d -r1.48 ml_elim_nested.m
--- compiler/ml_elim_nested.m	1 Feb 2002 22:06:10 -0000	1.48
+++ compiler/ml_elim_nested.m	4 Feb 2002 06:34:11 -0000
@@ -166,6 +166,8 @@
 % There are also some things that could be done to improve efficiency,
 % e.g.
 %	- optimize away temporary variables
+%	- put stack_chain and/or heap pointer in global register variables
+%	- avoid linking stack chain unnecessarily?
 %
 %-----------------------------------------------------------------------------%
 %
@@ -357,7 +359,7 @@
 %-----------------------------------------------------------------------------%
 
 :- implementation.
-:- import_module bool, int, list, std_util, string, require.
+:- import_module bool, counter, int, list, std_util, string, require.
 
 :- import_module ml_code_util, ml_util.
 :- import_module prog_util, type_util.
@@ -1389,30 +1391,13 @@
 		fixup_lval(Ref0, Ref),
 		flatten_statement(Statement0, Statement1),
 		flatten_statement(Handler0, Handler1),
-		%
-		% add code to save/restore the stack chain pointer
-		%
+		{ Stmt1 = try_commit(Ref, Statement1, Handler1) },
 		Action =^ action,
-		ModuleName =^ module_name,
-		{ Action = chain_gc_stack_frames ->
-			Statement1 = mlds__statement(_, StatementContext),
-			Handler1 = mlds__statement(_, HandlerContext),
-			Handler = mlds__statement(
-				block(
-				    [],
-				    [gen_restore_stack_chain_var(ModuleName,
-						HandlerContext),
-				     Handler1]
-				),
-				HandlerContext),
-			TryCommit = try_commit(Ref, Statement1, Handler),
-			Stmt = block(
-				[gen_saved_stack_chain_var(StatementContext)],
-				[mlds__statement(TryCommit, StatementContext)]
-			)
+		( { Action = chain_gc_stack_frames } ->
+			save_and_restore_stack_chain(Stmt1, Stmt)
 		;
-			Stmt = try_commit(Ref, Statement1, Handler1)
-		}
+			{ Stmt = Stmt1 }
+		)
 	;
 		{ Stmt0 = atomic(AtomicStmt0) },
 		fixup_atomic_stmt(AtomicStmt0, AtomicStmt),
@@ -1438,6 +1423,58 @@
 	
 %-----------------------------------------------------------------------------%
 
+	%
+	% add code to save/restore the stack chain pointer:
+	% convert
+	%	try {
+	%	    Statement
+	%	} commit {
+	%	    Handler
+	%	}
+	% into
+	%	{
+	%	    void *saved_stack_chain;
+	%	    try {
+	%		saved_stack_chain = stack_chain;
+	%		Statement
+	%	    } commit {
+	%		stack_chain = saved_stack_chain;
+	%		Handler
+	%	    }
+	%	}
+	%
+:- inst try_commit ---> try_commit(ground, ground, ground).
+
+:- pred save_and_restore_stack_chain(mlds__stmt, mlds__stmt,
+		elim_info, elim_info).
+:- mode save_and_restore_stack_chain(in(try_commit), out, in, out) is det.
+
+save_and_restore_stack_chain(Stmt0, Stmt, ElimInfo0, ElimInfo) :-
+	ModuleName = ElimInfo0 ^ module_name,
+	counter__allocate(Id, ElimInfo0 ^ saved_stack_chain_counter, NextId),
+	ElimInfo = (ElimInfo0 ^ saved_stack_chain_counter := NextId),
+	Stmt0 = try_commit(Ref, Statement0, Handler0),
+	Statement0 = mlds__statement(_, StatementContext),
+	Handler0 = mlds__statement(_, HandlerContext),
+	SavedVarDecl = gen_saved_stack_chain_var(Id, StatementContext),
+	SaveStatement = gen_save_stack_chain_var(ModuleName, Id,
+		StatementContext),
+	RestoreStatement = gen_restore_stack_chain_var(ModuleName, Id,
+		HandlerContext),
+	Statement = mlds__statement(
+		block([], [SaveStatement, Statement0]),
+		HandlerContext),
+	Handler = mlds__statement(
+		block([], [RestoreStatement, Handler0]),
+		HandlerContext),
+	TryCommit = try_commit(Ref, Statement, Handler),
+	Stmt = block(
+		[SavedVarDecl],
+		[mlds__statement(TryCommit, StatementContext)]
+	).
+
+%-----------------------------------------------------------------------------%
+
 %
 % flatten_nested_defns:
 % flatten_nested_defn:
@@ -2442,32 +2479,42 @@
 	UnchainFrame = mlds__statement(atomic(Assignment), Context).
 
 	% Generate a local variable declaration
-	% to save the stack chain pointer:
-	%	void *saved_stack_chain = stack_chain;
-:- func gen_saved_stack_chain_var(mlds__context) = mlds__defn.
-gen_saved_stack_chain_var(Context) = Defn :-
-	Name = data(var(ml_saved_stack_chain_name)),
+	% to hold the saved stack chain pointer:
+	%	void *saved_stack_chain;
+:- func gen_saved_stack_chain_var(int, mlds__context) = mlds__defn.
+gen_saved_stack_chain_var(Id, Context) = Defn :-
+	Name = data(var(ml_saved_stack_chain_name(Id))),
 	Flags = ml_gen_local_var_decl_flags,
 	Type = ml_stack_chain_type,
-	Initializer = init_obj(lval(ml_stack_chain_var)),
+	Initializer = no_initializer,
 	% The saved stack chain never needs to be traced by the GC,
 	% since it will always point to the stack, not into the heap.
 	GCTraceCode = no,
 	DefnBody = mlds__data(Type, Initializer, GCTraceCode),
 	Defn = mlds__defn(Name, Context, Flags, DefnBody).
 
+	% Generate a statement to save the stack chain pointer:
+	%	saved_stack_chain = stack_chain;
+:- func gen_save_stack_chain_var(mlds_module_name, int, mlds__context) =
+	mlds__statement.
+gen_save_stack_chain_var(MLDS_Module, Id, Context) = SaveStatement :-
+	SavedStackChain = var(qual(MLDS_Module,
+		ml_saved_stack_chain_name(Id)), ml_stack_chain_type),
+	Assignment = assign(SavedStackChain, lval(ml_stack_chain_var)),
+	SaveStatement = mlds__statement(atomic(Assignment), Context).
+
 	% Generate a statement to restore the stack chain pointer:
 	%	stack_chain = saved_stack_chain;
-:- func gen_restore_stack_chain_var(mlds_module_name, mlds__context) =
+:- func gen_restore_stack_chain_var(mlds_module_name, int, mlds__context) =
 	mlds__statement.
-gen_restore_stack_chain_var(MLDS_Module, Context) = RestoreStatement :-
+gen_restore_stack_chain_var(MLDS_Module, Id, Context) = RestoreStatement :-
 	SavedStackChain = var(qual(MLDS_Module,
-		ml_saved_stack_chain_name), ml_stack_chain_type),
+		ml_saved_stack_chain_name(Id)), ml_stack_chain_type),
 	Assignment = assign(ml_stack_chain_var, lval(SavedStackChain)),
 	RestoreStatement = mlds__statement(atomic(Assignment), Context).
 
-:- func ml_saved_stack_chain_name = mlds__var_name.
-ml_saved_stack_chain_name = var_name("saved_stack_chain", no).
+:- func ml_saved_stack_chain_name(int) = mlds__var_name.
+ml_saved_stack_chain_name(Id) = var_name("saved_stack_chain", yes(Id)).
 
 %-----------------------------------------------------------------------------%
 
@@ -2515,7 +2562,11 @@
 				% a pointer to the env_type_name (in the
 				% IL backend we don't necessarily use a
 				% pointer).
-			env_ptr_type_name :: mlds__type
+			env_ptr_type_name :: mlds__type,
+
+				% A counter used to number the local variables
+				% used to save the stack chain
+			saved_stack_chain_counter :: counter
 	).
 
 	% The lists of local variables for
@@ -2527,7 +2578,7 @@
 		mlds__type, mlds__type) = elim_info.
 elim_info_init(Action, ModuleName, OuterVars, EnvTypeName, EnvPtrTypeName) =
 	elim_info(Action, ModuleName, OuterVars, [], [],
-		EnvTypeName, EnvPtrTypeName).
+		EnvTypeName, EnvPtrTypeName, counter__init(0)).
 
 :- func elim_info_get_module_name(elim_info) = mlds_module_name.
 elim_info_get_module_name(ElimInfo) = ElimInfo ^ module_name.
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.68
diff -u -d -r1.68 compiler_design.html
--- compiler/notes/compiler_design.html	31 Dec 2001 06:07:25 -0000	1.68
+++ compiler/notes/compiler_design.html	3 Feb 2002 06:28:53 -0000
@@ -937,7 +937,9 @@
 <ul>
 <li> ml_tailcall.m annotates the MLDS with information about tailcalls.
 <li> ml_optimize.m does MLDS->MLDS optimizations
-<li> ml_elim_nested.m transforms the MLDS to eliminate nested functions.
+<li> ml_elim_nested.m does two MLDS transformations that happen
+     to have a lot in common: (1) eliminating nested functions
+     and (2) adding code to handle accurate garbage collection.
 </ul>
 
 <h4> 6b. MLDS output </h4>

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