[m-rev.] diff: fix C compiler warnings for reserved addrs

Fergus Henderson fjh at cs.mu.OZ.AU
Thu Nov 1 04:58:32 AEDT 2001


Branches: main
Estimated hours taken: 1.5

Fix C compiler warnings in the C code generated
when using reserved addresses.

compiler/ml_unify_gen.m:
	When generating reserved address constants,
	add an explicit downcast, for targets that need it.
	This avoids compiler warnings in the C code generated
	by the MLDS->C back-end.

compiler/rtti_to_mlds.m:
	Pass the module_info to ml_gen_reserved_address.

runtime/mercury.h:
	Fix a bug where there was one too many levels of indirection
	in the definition of MR_ReservedAddrs.

runtime/mercury_type_info.h:
runtime/mercury_deep_copy_body.h:
	Add `const' to the definition of MR_DuTypeLayout.

Workspace: /home/earth/fjh/ws-earth3/mercury
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.45
diff -u -d -r1.45 ml_unify_gen.m
--- compiler/ml_unify_gen.m	31 Oct 2001 16:58:09 -0000	1.45
+++ compiler/ml_unify_gen.m	31 Oct 2001 17:47:16 -0000
@@ -77,7 +77,8 @@
 
 	% Generate an MLDS rval for a given reserved address,
 	% cast to the appropriate type.
-:- func ml_gen_reserved_address(reserved_address, mlds__type) = mlds__rval.
+:- func ml_gen_reserved_address(module_info, reserved_address, mlds__type) =
+	mlds__rval.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -447,8 +448,11 @@
 	ml_gen_proc_addr_rval(PredId, ProcId, ProcAddrRval).
 
 ml_gen_constant(reserved_address(ReservedAddr), VarType, Rval) -->
+	=(Info),
+	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
 	ml_gen_type(VarType, MLDS_VarType),
-	{ Rval = ml_gen_reserved_address(ReservedAddr, MLDS_VarType) }.
+	{ Rval = ml_gen_reserved_address(ModuleInfo, ReservedAddr,
+		MLDS_VarType) }.
 
 ml_gen_constant(shared_with_reserved_addresses(_, ThisTag), VarType, Rval) -->
 	% For shared_with_reserved_address, the sharing is only
@@ -474,11 +478,11 @@
 
 % Generate an MLDS rval for a given reserved address,
 % cast to the appropriate type.
-ml_gen_reserved_address(null_pointer, MLDS_Type) = const(null(MLDS_Type)).
-ml_gen_reserved_address(small_pointer(Int), MLDS_Type) =
+ml_gen_reserved_address(_, null_pointer, MLDS_Type) = const(null(MLDS_Type)).
+ml_gen_reserved_address(_, small_pointer(Int), MLDS_Type) =
 		unop(cast(MLDS_Type), const(int_const(Int))).
-ml_gen_reserved_address(reserved_object(TypeId, QualCtorName, CtorArity),
-		_Type) = Rval :-
+ml_gen_reserved_address(ModuleInfo, reserved_object(TypeId, QualCtorName,
+		CtorArity), _Type) = Rval :-
 	( QualCtorName = qualified(ModuleName, CtorName) ->
 		MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
 		TypeId = TypeName - TypeArity,
@@ -486,13 +490,42 @@
 		MLDS_TypeName = mlds__append_class_qualifier(MLDS_ModuleName,
 			UnqualTypeName, TypeArity),
 		Name = ml_format_reserved_object_name(CtorName, CtorArity),
-		Rval = const(data_addr_const(
-			data_addr(MLDS_TypeName, var(Name))))
+		Rval0 = const(data_addr_const(
+			data_addr(MLDS_TypeName, var(Name)))),
+		%
+		% The MLDS type of the reserved object may be a class
+		% derived from the base class for this Mercury type.
+		% So for some back-ends, we need to insert a (down-)cast
+		% here to convert from the derived class to the base class.
+		% In particular, this is needed to avoid compiler warnings
+		% in the C code generated by the MLDS->C back-end.
+		% But inserting the cast could slow down the
+		% generated code for the .NET back-end (where
+		% the JIT probably doesn't optimize downcasts).
+		% So we only do it if the back-end requires it.
+	  	%
+		module_info_globals(ModuleInfo, Globals),
+		globals__get_target(Globals, Target),
+		( target_supports_inheritence(Target) = yes ->
+			Rval = Rval0
+		;
+			MLDS_Type = mlds__ptr_type(mlds__class_type(
+				qual(MLDS_ModuleName, UnqualTypeName),
+				TypeArity, mlds__class)),
+			Rval = unop(cast(MLDS_Type), Rval0)
+		)
 	;
 		unexpected(this_file,
 			"unqualified ctor name in reserved_object")
 	).
 
+	% This should return `yes' iff downcasts are not needed.
+:- func target_supports_inheritence(compilation_target) = bool.
+target_supports_inheritence(c) = no.
+target_supports_inheritence(il) = yes.
+target_supports_inheritence(java) = yes.
+target_supports_inheritence(asm) = no.
+
 %-----------------------------------------------------------------------------%
 
 :- pred ml_gen_closure(pred_id, proc_id, lambda_eval_method, prog_var,
@@ -1930,7 +1963,8 @@
 ml_gen_tag_test_rval(reserved_address(ReservedAddr), VarType, ModuleInfo,
 		Rval) = TestRval :-
 	MLDS_VarType = mercury_type_to_mlds_type(ModuleInfo, VarType),
-	ReservedAddrRval = ml_gen_reserved_address(ReservedAddr, MLDS_VarType),
+	ReservedAddrRval = ml_gen_reserved_address(ModuleInfo, ReservedAddr,
+			MLDS_VarType),
 	TestRval = binop(eq, Rval, ReservedAddrRval).
 
 ml_gen_tag_test_rval(shared_with_reserved_addresses(ReservedAddrs, ThisTag),
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.20
diff -u -d -r1.20 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m	24 Oct 2001 13:34:37 -0000	1.20
+++ compiler/rtti_to_mlds.m	31 Oct 2001 17:09:42 -0000
@@ -145,8 +145,9 @@
 		gen_init_cast_rtti_data(mlds__pseudo_type_info_type,
 		ModuleName), Types).
 gen_init_rtti_data_defn(reserved_addrs(_RttiTypeId, ReservedAddrs),
-		_ModuleName, _, Init, []) :-
-	Init = gen_init_array(gen_init_reserved_address, ReservedAddrs).
+		_ModuleName, ModuleInfo, Init, []) :-
+	Init = gen_init_array(gen_init_reserved_address(ModuleInfo),
+		ReservedAddrs).
 gen_init_rtti_data_defn(reserved_addr_functors(RttiTypeId,
 			ReservedAddrFunctorDescs),
 		ModuleName, _, Init, []) :-
@@ -189,11 +190,11 @@
 			MaybeExist)
 	]).
 gen_init_rtti_data_defn(reserved_addr_functor_desc(_RttiTypeId, FunctorName, Ordinal,
-		ReservedAddress), _, _, Init, []) :-
+		ReservedAddress), _, ModuleInfo, Init, []) :-
 	Init = init_struct([
 		gen_init_string(FunctorName),
 		gen_init_int(Ordinal),
-		gen_init_reserved_address(ReservedAddress)
+		gen_init_reserved_address(ModuleInfo, ReservedAddress)
 	]).
 gen_init_rtti_data_defn(enum_name_ordered_table(RttiTypeId, Functors),
 		ModuleName, _, Init, []) :-
@@ -635,10 +636,12 @@
 gen_init_boxed_int(Int) =
 	init_obj(unop(box(mlds__native_int_type), const(int_const(Int)))).
 
-:- func gen_init_reserved_address(reserved_address) = mlds__initializer.
+:- func gen_init_reserved_address(module_info, reserved_address) =
+	mlds__initializer.
 	/* XXX using `mlds__generic_type' here is probably wrong */
-gen_init_reserved_address(ReservedAddress) =
-	init_obj(ml_gen_reserved_address(ReservedAddress, mlds__generic_type)).
+gen_init_reserved_address(ModuleInfo, ReservedAddress) =
+	init_obj(ml_gen_reserved_address(ModuleInfo, ReservedAddress,
+		mlds__generic_type)).
 
 %-----------------------------------------------------------------------------%
 
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.38
diff -u -d -r1.38 mercury.h
--- runtime/mercury.h	24 Oct 2001 07:43:23 -0000	1.38
+++ runtime/mercury.h	31 Oct 2001 17:39:36 -0000
@@ -168,7 +168,7 @@
 typedef const MR_DuFunctorDesc *	MR_DuFunctorDescPtr;
 typedef union MR_TableNode_Union * *	MR_TableNodePtrPtr;
 typedef MR_Box				MR_BaseTypeclassInfo;
-typedef const void * const *		MR_ReservedAddrs;
+typedef const void * 			MR_ReservedAddrs;
 typedef const MR_ReservedAddrFunctorDesc *MR_ReservedAddrFunctors;
 
 
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.39
diff -u -d -r1.39 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h	24 Oct 2001 07:43:23 -0000	1.39
+++ runtime/mercury_deep_copy_body.h	31 Oct 2001 17:49:27 -0000
@@ -101,9 +101,9 @@
     */
     du_type:
         {
-            MR_Word             *data_value;
-	    MR_DuPtagLayout     *ptag_layout;
-	    int                 ptag;
+            MR_Word               *data_value;
+	    const MR_DuPtagLayout *ptag_layout;
+	    int                   ptag;
 
             ptag = MR_tag(data);
             ptag_layout = &du_type_layout[ptag];
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.75
diff -u -d -r1.75 mercury_type_info.h
--- runtime/mercury_type_info.h	24 Oct 2001 07:43:24 -0000	1.75
+++ runtime/mercury_type_info.h	31 Oct 2001 17:47:48 -0000
@@ -817,7 +817,7 @@
     const MR_DuFunctorDesc * const * MR_sectag_alternatives;
 } MR_DuPtagLayout;
 
-typedef MR_DuPtagLayout     *MR_DuTypeLayout;
+typedef const MR_DuPtagLayout *MR_DuTypeLayout;
 
 /*---------------------------------------------------------------------------*/
 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  | "... it seems to me that 15 years of
The University of Melbourne         | email is plenty for one lifetime."
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- Prof. Donald E. Knuth
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list