[m-dev.] for review: fix unsafe_type_cast for MLDS back-end

[Fergus Henderson]

Peter Ross, could you please review this one?

I think this change will cause bootstrapping problems if you try to
bootstrap in grade hlc.gc, since it deletes the definition of
unsafe_type_cast from runtime/mercury.h which older compilers rely on.
But it should be fine if you bootstrap in grade asm_fast.gc or
none.gc.

----------

Estimated hours taken: 2

Fix a problem with unsafe_type_cast that stopped the
compiler from bootstrapping in MLDS grades.

compiler/builtin_ops.m:
	Add a comment about unsafe_type_cast.

compiler/ml_code_gen.m:
	Generate code for unsafe_type_cast as an inline builtin.

compiler/mlds_to_c.m:
	Delete a hack that was previously needed for unsafe_type_cast.

library/private_builtin.m:
	Delete the `:- external' declaration for unsafe_type_cast;
	this is not needed, and could cause problems because it
	suppresses the definition for unsafe_type_cast,
	which could cause problems if you take its address.

runtime/mercury.h:
	Delete the definition of unsafe_type_cast, since it is
	no longer needed.

Workspace: /home/pgrad/fjh/ws/hg3
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.3
diff -u -d -r1.3 builtin_ops.m
--- compiler/builtin_ops.m	2000/10/06 10:18:10	1.3
+++ compiler/builtin_ops.m	2000/12/13 10:39:11
@@ -140,6 +140,10 @@
 :- pred builtin_translation(string, string, int, list(T), simple_code(T)).
 :- mode builtin_translation(in, in, in, in, out) is semidet.
 
+	% Note that the code we generate for unsafe_type_cast is not
+	% type-correct.  Back-ends that require type-correct intermediate
+	% code (e.g. the MLDS back-end) must handle unsafe_type_cast
+	% separately, rather than by calling builtin_translation.
 builtin_translation("private_builtin", "unsafe_type_cast", 0,
 		[X, Y], assign(Y, leaf(X))).
 builtin_translation("builtin", "unsafe_promise_unique", 0,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.70
diff -u -d -r1.70 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/12/11 04:52:43	1.70
+++ compiler/ml_code_gen.m	2000/12/13 11:03:44
@@ -1907,19 +1907,7 @@
 ml_gen_goal_expr(call(PredId, ProcId, ArgVars, BuiltinState, _, PredName),
 		CodeModel, Context, MLDS_Decls, MLDS_Statements) -->
 	(
-		{
-			BuiltinState = not_builtin
-		;
-			% For the MLDS back-end, we can't treat
-			% private_builtin:unsafe_type_cast as an
-			% inline builtin, since the code that
-			% builtin_ops__translate_builtin generates
-			% for it is not type-correct.  Instead,
-			% we treat it as an ordinary polymorphic
-			% procedure; ml_gen_call will then generate
-			% the proper type conversions automatically.
-			PredName = qualified(_, "unsafe_type_cast")
-		}
+		{ BuiltinState = not_builtin }
 	->
 		ml_gen_var_list(ArgVars, ArgLvals),
 		=(MLDSGenInfo),
@@ -1928,6 +1916,30 @@
 		ml_variable_types(ArgVars, ActualArgTypes),
 		ml_gen_call(PredId, ProcId, ArgNames, ArgLvals, ActualArgTypes,
 			CodeModel, Context, MLDS_Decls, MLDS_Statements)
+	;
+		% For the MLDS back-end, we can't treat
+		% private_builtin:unsafe_type_cast as an
+		% ordinary builtin, since the code that
+		% builtin_ops__translate_builtin generates
+		% for it is not type-correct.  Instead,
+		% we handle it separately here.
+		{ PredName = qualified(_, "unsafe_type_cast") }
+	->
+		ml_gen_var_list(ArgVars, ArgLvals),
+		ml_variable_types(ArgVars, ArgTypes),
+		(
+			{ ArgLvals = [DestLval, SrcLval] },
+			{ ArgTypes = [DestType, SrcType] }
+		->
+			ml_gen_box_or_unbox_rval(SrcType, DestType,
+				lval(SrcLval), CastRval),
+			{ Assign = ml_gen_assign(DestLval, CastRval,
+				Context) },
+			{ MLDS_Statements = [Assign] },
+			{ MLDS_Decls = [] }
+		;
+			{ error("wrong number of args for unsafe_type_cast") }
+		)
 	;
 		ml_gen_builtin(PredId, ProcId, ArgVars, CodeModel, Context,
 			MLDS_Decls, MLDS_Statements)
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.73
diff -u -d -r1.73 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/12/11 04:52:46	1.73
+++ compiler/mlds_to_c.m	2000/12/13 11:04:48
@@ -2301,15 +2301,7 @@
 mlds_maybe_output_call_profile_instr(Context, Indent,
 		CalleeFuncRval, CallerName) -->
 	globals__io_lookup_bool_option(profile_calls, ProfileCalls),
-	(
-		{
-			ProfileCalls = yes,
-
-				% Some functions don't have a
-				% code_addr so we can't record the arc.
-			\+ no_code_address(CalleeFuncRval)
-		}
-	->
+	( { ProfileCalls = yes } ->
 		mlds_indent(Context, Indent),
 		io__write_string("MR_prof_call_profile("),
 		mlds_output_bracketed_rval(CalleeFuncRval),
@@ -2341,17 +2333,6 @@
 	;
 		[]
 	).
-
-	%
-	% Does the rval represent a special procedure for which a
-	% code address doesn't exist.
-	%
-:- pred no_code_address(mlds__rval::in) is semidet.
-
-no_code_address(const(code_addr_const(proc(qual(Module, PredLabel - _), _)))) :-
-	SymName = mlds_module_name_to_sym_name(Module),
-	SymName = qualified(unqualified("mercury"), "private_builtin"),
-	PredLabel = pred(predicate, _, "unsafe_type_cast", 2).
 
 %-----------------------------------------------------------------------------%
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.27
diff -u -d -u -r1.27 mercury.h
--- runtime/mercury.h	2000/12/04 18:35:05	1.27
+++ runtime/mercury.h	2000/12/13 12:25:59
@@ -351,20 +351,6 @@
   #define MR_unbox_float(ptr) (*(MR_Float *)ptr)
 #endif
 
-#ifdef MR_AVOID_MACROS
-  MR_EXTERN_INLINE void mercury__private_builtin__unsafe_type_cast_2_p_0(
-  	MR_Box src, MR_Box *dest);
-
-  MR_EXTERN_INLINE void mercury__private_builtin__unsafe_type_cast_2_p_0(
-  	MR_Box src, MR_Box *dest)
-  {
-  	*dest = src;
-  }
-#else
-  #define mercury__private_builtin__unsafe_type_cast_2_p_0(src, dest) \
-	(*(dest) = (src))
-#endif
-
 /*---------------------------------------------------------------------------*/
 /*
 ** Function declarations
 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------