[m-rev.] diff: fix hlc.agc bug

[Fergus Henderson]

Estimated hours taken: 3
Branches: main

Fix a bug in my earlier change to add the first part of
support for accurate GC for the MLDS->C back-end.
The bug was that it was trying to access `stack_chain->prev'
when `stack_chain' had type `void *'.

compiler/ml_elim_nested.m:
	Use a field offset, rather than a named field,
	to access the `prev' field of the the `stack_chain' global.

runtime/mercury.h:
	Mention that ml_elim_nested.m assumes that the `prev' field
	is at offset zero.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.44
diff -u -d -r1.44 ml_elim_nested.m
--- compiler/ml_elim_nested.m	7 Dec 2001 07:53:40 -0000	1.44
+++ compiler/ml_elim_nested.m	12 Dec 2001 09:35:27 -0000
@@ -2086,18 +2086,26 @@
 :- func ml_gen_unchain_frame(mlds__context, elim_info) = mlds__statement.
 ml_gen_unchain_frame(Context, ElimInfo) = UnchainFrame :-
 	EnvPtrTypeName = ElimInfo ^ env_ptr_type_name,
-	ModuleName = ElimInfo ^ module_name,
 	%
 	% Generate code to remove this frame from the stack chain:
+	%
 	%	stack_chain = stack_chain->prev;
 	%
+	% Actually, it's not quite as simple as that.  The global
+	% `stack_chain' has type `void *', rather than `MR_StackChain *', and
+	% the MLDS has no way of representing the `struct MR_StackChain' type
+	% (which we'd need to cast it to) or of accessing an unqualified
+	% field name like `prev' (rather than `modulename__prev').
+	%
+	% So we do this in a slightly lower-level fashion, using
+	% a field offset rather than a field name:
+	%
+	%	stack_chain = MR_hl_field(stack_chain, 0);
+	%
 	StackChain = ml_stack_chain_var,
 	Tag = yes(0),
-	PrevFieldName = var_name("prev", no),
-	PrevFieldNameString = ml_var_name_to_string(PrevFieldName),
-	PrevFieldId = named_field(qual(ModuleName, PrevFieldNameString),
-		EnvPtrTypeName),
-	PrevFieldType = mlds__generic_env_ptr_type,
+	PrevFieldId = offset(const(int_const(0))),
+	PrevFieldType = mlds__generic_type,
 	PrevFieldRval = lval(field(Tag, lval(StackChain), PrevFieldId,
 		PrevFieldType, EnvPtrTypeName)),
 	Assignment = assign(StackChain, PrevFieldRval),
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.42
diff -u -d -r1.42 mercury.h
--- runtime/mercury.h	7 Dec 2001 07:53:44 -0000	1.42
+++ runtime/mercury.h	12 Dec 2001 09:33:41 -0000
@@ -273,7 +273,14 @@
 typedef struct MR_FO_PseudoTypeInfo_Struct19 MR_FO_PseudoTypeInfo_Struct19;
 typedef struct MR_FO_PseudoTypeInfo_Struct20 MR_FO_PseudoTypeInfo_Struct20;
 
-/* The chain of stack frames, used for accurate GC. */
+/*
+** The chain of stack frames, used for accurate GC.
+**
+** Any changes to this struct may require changes to
+** compiler/ml_elim_nested.m, which generates structs
+** that whose initial members have to match the layout here,
+** and which assumes that the `prev' is at offset zero.
+*/
 struct MR_StackChain {
 	struct MR_StackChain *prev;
 	void (*trace)(void *this_frame);

----------

Incidentally, I originally tried the following change.
But eventually I decided to go with the above approach instead,
since it seemed a little simpler.

----------

Fix a bug in my earlier change to add the first part of
support for accurate GC for the MLDS->C back-end.
The bug was that it was trying to access `stack_chain->prev'
when `stack_chain' had type `void *'.

runtime/mercury.h:
runtime/mercury.c:
	Change the type of the `stack_chain' global
	from `void *' to `struct MR_StackChain *'.

compiler/mlds.m:
	Add a new alternative `mlds__stack_chain_type', which represents
	a `struct MR_StackChain', to the `mlds__type' type.

compiler/ml_elim_nested.m:
	When assigning to the `stack_chain' global,
	cast to `mlds__ptr_type(mlds__stack_chain_type)'.
	
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
	Minor additions to handle `mlds__stack_chain_type'.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.44
diff -u -d -r1.44 ml_elim_nested.m
--- compiler/ml_elim_nested.m	7 Dec 2001 07:53:40 -0000	1.44
+++ compiler/ml_elim_nested.m	12 Dec 2001 08:16:14 -0000
@@ -705,13 +705,15 @@
 		%
 		% Generate code to set the global stack chain
 		% to point to the current environment.
-		%	 stack_chain = env_ptr;
+		%	 stack_chain = (MR_StackChain *) env_ptr;
 		%
 		EnvPtrTypeName = ml_make_env_ptr_type(Globals, EnvTypeName),
 		EnvPtr = lval(var(qual(ModuleName,
 				mlds__var_name("env_ptr", no)),
 			EnvPtrTypeName)),
-		AssignToStackChain = assign(StackChain, EnvPtr),
+		CastEnvPtr = unop(cast(mlds__ptr_type(mlds__stack_chain_type)),
+			EnvPtr),
+		AssignToStackChain = assign(StackChain, CastEnvPtr),
 		LinkStackChain = [mlds__statement(atomic(AssignToStackChain),
 			Context)]
 	;
@@ -1347,6 +1349,7 @@
 ml_type_might_contain_pointers(mlds__cont_type(_)) = no. 
 ml_type_might_contain_pointers(mlds__commit_type) = no.
 ml_type_might_contain_pointers(mlds__rtti_type(_)) = yes.
+ml_type_might_contain_pointers(mlds__stack_chain_type) = yes.
 ml_type_might_contain_pointers(mlds__unknown_type) = yes.
 
 :- func ml_type_category_might_contain_pointers(builtin_type) = bool.
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.77
diff -u -d -r1.77 mlds.m
--- compiler/mlds.m	8 Nov 2001 11:47:59 -0000	1.77
+++ compiler/mlds.m	12 Dec 2001 07:59:51 -0000
@@ -654,6 +654,10 @@
 	
 	;	mlds__rtti_type(rtti_name)
 
+		% `struct MR_StackChain' (see runtime/mercury.h).
+		% This is used for accurate GC support in the MLDS->C back-end.
+	;	mlds__stack_chain_type
+
 		% A type used by the ML code generator for references 
 		% to variables that have yet to be declared.  This occurs 
 		% once in ml_code_util.m where references to env_ptr's are 
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.110
diff -u -d -r1.110 mlds_to_c.m
--- compiler/mlds_to_c.m	10 Dec 2001 04:16:30 -0000	1.110
+++ compiler/mlds_to_c.m	12 Dec 2001 08:04:36 -0000
@@ -670,6 +670,8 @@
 	io__write_string("MR_Word").
 mlds_output_pragma_export_type(prefix, mlds__rtti_type(_)) -->
 	io__write_string("MR_Word").
+mlds_output_pragma_export_type(prefix, mlds__stack_chain_type) -->
+	io__write_string("struct MR_StackChain").
 mlds_output_pragma_export_type(prefix, mlds__unknown_type) -->
 	{ unexpected(this_file, 
 		"mlds_output_pragma_export_type: unknown_type") }. 
@@ -1640,6 +1642,8 @@
 mlds_output_type_prefix(mlds__rtti_type(RttiName)) -->
 	io__write_string("MR_"),
 	io__write_string(mlds_rtti_type_name(RttiName)).
+mlds_output_type_prefix(mlds__stack_chain_type) -->
+	io__write_string("struct MR_StackChain").
 mlds_output_type_prefix(mlds__unknown_type) -->
 	{ error("mlds_to_c.m: prefix has unknown type") }.
 
@@ -1777,6 +1781,7 @@
 	;
 		[]
 	).
+mlds_output_type_suffix(mlds__stack_chain_type, _) --> [].
 mlds_output_type_suffix(mlds__unknown_type, _) -->
 	{ unexpected(this_file,
 		"mlds_output_type_suffix: unknown_type") }.
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.55
diff -u -d -r1.55 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m	6 Nov 2001 15:21:03 -0000	1.55
+++ compiler/mlds_to_gcc.m	12 Dec 2001 08:07:59 -0000
@@ -1792,6 +1792,9 @@
 build_type(mlds__rtti_type(RttiName), InitializerSize, _GlobalInfo,
 		GCC_Type) -->
 	build_rtti_type(RttiName, InitializerSize, GCC_Type).
+build_type(mlds__stack_chain_type, _, _, _) -->
+	% XXX `--gc accurate' not yet supported here
+	{ sorry(this_file, "`--gc accurate' with `--target asm'") }.
 build_type(mlds__unknown_type, _, _, _) -->
 	{ unexpected(this_file, "build_type: unknown type") }.
 
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.92
diff -u -d -r1.92 mlds_to_il.m
--- compiler/mlds_to_il.m	21 Nov 2001 03:49:29 -0000	1.92
+++ compiler/mlds_to_il.m	12 Dec 2001 08:17:50 -0000
@@ -2942,6 +2942,11 @@
 	;
 		il_object_array_type
 	).
+mlds_type_to_ilds_type(_, mlds__stack_chain_type) = _ :-
+	% This should only be used for accurate GC with the MLDS->C back-end.
+	% It shouldn't be used for the IL back-end.
+	unexpected(this_file,
+		"mlds_type_to_ilds_type: mlds__stack_pointer_type").
 mlds_type_to_ilds_type(_, mlds__unknown_type) = _ :-
 	unexpected(this_file, "mlds_type_to_ilds_type: unknown_type").
 
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.16
diff -u -d -r1.16 mlds_to_java.m
--- compiler/mlds_to_java.m	25 Oct 2001 08:35:39 -0000	1.16
+++ compiler/mlds_to_java.m	12 Dec 2001 08:18:25 -0000
@@ -879,6 +879,11 @@
 get_java_type_initializer(mlds__generic_env_ptr_type) = "null".
 get_java_type_initializer(mlds__pseudo_type_info_type) = "null".
 get_java_type_initializer(mlds__rtti_type(_)) = "null".
+get_java_type_initializer(mlds__stack_chain_type) = _ :-
+	% This should only be used for accurate GC with the MLDS->C back-end.
+	% It shouldn't be used for the IL back-end.
+	unexpected(this_file, 
+		"get_type_initializer: mlds__stack_pointer_type"). 
 get_java_type_initializer(mlds__unknown_type) = _ :-
 	unexpected(this_file, 
 		"get_type_initializer: variable has unknown_type"). 
@@ -1266,6 +1271,10 @@
 output_type(mlds__rtti_type(RttiName)) -->
 	io__write_string("static mercury.runtime."),
 	io__write_string(mlds_rtti_type_name(RttiName)).
+output_type(mlds__stack_chain_type) -->
+	% This should only be used for accurate GC with the MLDS->C back-end.
+	% It shouldn't be used for the IL back-end.
+	{ unexpected(this_file, "output_type: mlds__stack_pointer_type") }.
 output_type(mlds__unknown_type) -->
 	{ unexpected(this_file, "output_type: unknown type") }.
 
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.27
diff -u -d -r1.27 mercury.c
--- runtime/mercury.c	7 Dec 2001 07:53:44 -0000	1.27
+++ runtime/mercury.c	12 Dec 2001 08:16:33 -0000
@@ -27,7 +27,7 @@
 */
 
 #ifdef NATIVE_GC
-  void *mercury__private_builtin____stack_chain;
+  struct MR_StackChain *mercury__private_builtin____stack_chain;
 #endif
 
 MR_Word mercury__private_builtin__dummy_var;
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.42
diff -u -d -r1.42 mercury.h
--- runtime/mercury.h	7 Dec 2001 07:53:44 -0000	1.42
+++ runtime/mercury.h	12 Dec 2001 08:17:24 -0000
@@ -293,7 +293,7 @@
   #ifdef MR_THREAD_SAFE
     #error "Sorry, not supported: --high-level-code --gc accurate --thread-safe"
   #endif
-  extern void *mercury__private_builtin__stack_chain;
+  extern struct MR_StackChain *mercury__private_builtin__stack_chain;
 #endif
 
 /* declare MR_TypeCtorInfo_Structs for the builtin types */

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