revised diff for lcc changes

[Peter Ross]

Fergus,

Here is the revised diff.

Pete.

===================================================================


Estimated hours taken: 60

Changes required to get the samples directory to compile using lcc in
the grade `none.gc'.

compiler/llds_out.m:
    Add a pass to make sure that the constants are all declared (with
    a complete type) before they are initialised.  We can't just
    forward declare each constant immediately before it is used in an
    initializer, as was done previously, because at that point we don't
    know the type of the constant, and ANSI C doesn't allow forward
    declarations of static variables with incomplete types.

    Also change data_ptr to type (Word *).  This is because (Word *) is
    a superset of (const Word *) and it is a non-trivial task to get the
    consts output in the correct places.  Hopefully consts will be
    output when I get the compiler to bootstrap using lcc.

scripts/mgnuc.in:
    Don't warn about casts which remove the const. ie (const char *) to
    (char *)

runtime/mercury_string.h:
    Get rid of a cast.

runtime/mercury_tags.h:
    Get rid of some of the const casts.

util/mkinit.c:
    Make mkinit compile using lcc.

Index: compiler/llds_out.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/llds_out.m,v
retrieving revision 1.88
diff -u -r1.88 llds_out.m
--- llds_out.m	1998/09/03 11:13:29	1.88
+++ llds_out.m	1998/10/19 00:31:02
@@ -269,7 +269,8 @@
 		io__write_string("\n"),
 		{ gather_c_file_labels(Modules, Labels) },
 		{ bintree_set__init(DeclSet0) },
-		output_c_label_decl_list(Labels, DeclSet0, DeclSet),
+		output_c_label_decl_list(Labels, DeclSet0, DeclSet1),
+		output_c_data_def_list(Modules, DeclSet1, DeclSet),
 		output_c_module_list(Modules, StackLayoutLabels, DeclSet),
 		( { SplitFiles = yes(_) } ->
 			[]
@@ -439,6 +440,7 @@
 	string__append_list(["mercury__", MangledModuleName, "__init"],
 		InitName).
 
+
 :- pred output_bunch_name(module_name, int, io__state, io__state).
 :- mode output_bunch_name(in, in, di, uo) is det.
 
@@ -449,6 +451,60 @@
 	io__write_string("_bunch_"),
 	io__write_int(Number).
 
+	%
+	% output_c_data_def_list outputs all the type definitions of
+	% the module.  This is needed because some compilers need the
+	% data definition to appear before any use of the type in
+	% forward declarations of static constants.
+	%
+:- pred output_c_data_def_list(list(c_module), decl_set, decl_set, 
+		io__state, io__state).
+:- mode output_c_data_def_list(in, in, out, di, uo) is det.
+
+output_c_data_def_list([], DeclSet, DeclSet) --> [].
+output_c_data_def_list([M | Ms], DeclSet0, DeclSet) -->
+	output_c_data_def(M, DeclSet0, DeclSet1),
+	output_c_data_def_list(Ms, DeclSet1, DeclSet).
+
+:- pred output_c_data_def(c_module, decl_set, decl_set, io__state, io__state).
+:- mode output_c_data_def(in, in, out, di, uo) is det.
+
+output_c_data_def(c_module(_, _), DeclSet, DeclSet) --> [].
+output_c_data_def(c_code(_, _), DeclSet, DeclSet) --> [].
+output_c_data_def(c_export(_), DeclSet, DeclSet) --> [].
+output_c_data_def(c_data(ModuleName, VarName, ExportedFromModule, ArgVals,
+		_Refs), DeclSet0, DeclSet) -->
+	io__write_string("\n"),
+	{ DataAddr = data_addr(data_addr(ModuleName, VarName)) },
+
+	{ linkage(VarName, Linkage) },
+	{
+		( Linkage = extern, ExportedFromModule = yes
+		; Linkage = static, ExportedFromModule = no
+		)
+	->
+		true
+	;
+		error("linkage mismatch")
+	},
+
+		% The code for data local to a Mercury module
+		% should normally be visible only within the C file
+		% generated for that module. However, if we generate
+		% multiple C files, the code in each C file must be
+		% visible to the other C files for that Mercury module.
+	( { ExportedFromModule = yes } ->
+		{ ExportedFromFile = yes }
+	;
+		globals__io_lookup_bool_option(split_c_files, SplitFiles),
+		{ ExportedFromFile = SplitFiles }
+	),
+
+	output_const_term_decl(ArgVals, DataAddr, ExportedFromFile, 
+			yes, yes, no, "", "", 0, _),
+	{ bintree_set__insert(DeclSet0, DataAddr, DeclSet) }.
+
+
 :- pred output_c_module_list(list(c_module), set_bbbtree(label), decl_set,
 	io__state, io__state).
 :- mode output_c_module_list(in, in, in, di, uo) is det.
@@ -513,8 +569,8 @@
 		globals__io_lookup_bool_option(split_c_files, SplitFiles),
 		{ ExportedFromFile = SplitFiles }
 	),
-	output_const_term_decl(ArgVals, DataAddr, ExportedFromFile, "", "",
-		0, _),
+	output_const_term_decl(ArgVals, DataAddr, ExportedFromFile, no, yes,
+		yes, "", "", 0, _),
 	{ bintree_set__insert(DeclSet1, DataAddr, DeclSet) }.
 
 output_c_module(c_code(C_Code, Context), _, DeclSet, DeclSet) -->
@@ -1715,8 +1771,8 @@
 		{ bintree_set__insert(DeclSet0, CreateLabel, DeclSet1) },
 		output_cons_arg_decls(ArgVals, FirstIndent, LaterIndent, N0, N1,
 			DeclSet1, DeclSet),
-		output_const_term_decl(ArgVals, CreateLabel, no, FirstIndent,
-			LaterIndent, N1, N)
+		output_const_term_decl(ArgVals, CreateLabel, no, yes, yes, yes,
+			FirstIndent, LaterIndent, N1, N)
 	).
 output_rval_decls(mem_addr(MemRef), FirstIndent, LaterIndent,
 		N0, N, DeclSet0, DeclSet) -->
@@ -1805,11 +1861,13 @@
 	% We output constant terms as follows:
 	%
 	%	static const struct <foo>_struct {
-	%		Word field1;
-	%		Float field2;
+	%		Word field1;			// Def
+	%		Float field2;			
 	%		Word * field3;
 	%		...
-	%	} <foo> = {
+	%	} 
+	%	<foo> 					// Decl
+	%	= {					// Init
 	%		...
 	%	};
 	%
@@ -1817,40 +1875,84 @@
 	% static code addresses available, in which case we'll have
 	% to initialize them dynamically, so we must omit `const'
 	% from the above structure.
+	%
+	% Also we now conditionally output some parts.  The parts that
+	% are conditionally output are Def, Decl and Init.  It is an
+	% error for Init to be yes and Decl to be no.
 
-:- pred output_const_term_decl(list(maybe(rval)), decl_id, bool, string, string,
-	int, int, io__state, io__state).
-:- mode output_const_term_decl(in, in, in, in, in, in, out, di, uo) is det.
+:- pred output_const_term_decl(list(maybe(rval)), decl_id, bool, bool, bool, 
+		bool, string, string, int, int, io__state, io__state).
+:- mode output_const_term_decl(in, in, in, in, in,
+		in, in, in, in, out, di, uo) is det.
 
-output_const_term_decl(ArgVals, DeclId, Exported, FirstIndent, LaterIndent,
-		N1, N) -->
-	output_indent(FirstIndent, LaterIndent, N1),
-	{ N is N1 + 1 },
-	( { Exported = yes } ->
-		[]
+output_const_term_decl(ArgVals, DeclId, Exported, Def, Decl, Init, FirstIndent, 
+		LaterIndent, N1, N) -->
+	(
+		{ Init = yes }, { Decl = no }
+	->
+		{ error("output_const_term_decl: Inconsistent Decl and Init") }
 	;
-		io__write_string("static ")
+		[]
 	),
-	globals__io_get_globals(Globals),
-	{ globals__have_static_code_addresses(Globals, StaticCode) },
+	output_indent(FirstIndent, LaterIndent, N1),
+	{ N is N1 + 1 },
 	(
-		{ StaticCode = no },
-		{ DeclId = data_addr(data_addr(_, base_type(info, _, _))) }
+		{ Decl = yes }
 	->
-		[]
+		(
+			{ Exported = yes }
+		->
+			[]
+		;
+			io__write_string("static ")
+		),
+		globals__io_get_globals(Globals),
+		{ globals__have_static_code_addresses(Globals, StaticCode) },
+		(
+				% Don't make decls of base_type_infos `const' 
+				% if we don't have static code addresses.
+			{ StaticCode = no },
+			{ DeclId = data_addr(
+					data_addr(_, base_type(info, _, _))) }
+		->
+			[]
+		;
+			io__write_string("const ")
+		)
 	;
-		io__write_string("const ")
+		[]
 	),
 	io__write_string("struct "),
 	output_decl_id(DeclId),
-	io__write_string("_struct {\n"),
-	output_cons_arg_types(ArgVals, "\t", 1),
-	io__write_string("} "),
-	output_decl_id(DeclId),
-	io__write_string(" = {\n"),
-	output_cons_args(ArgVals, "\t"),
-	io__write_string(LaterIndent),
-	io__write_string("};\n").
+	io__write_string("_struct"),
+	(
+		{ Def = yes }
+	->
+		io__write_string(" {\n"),
+		output_cons_arg_types(ArgVals, "\t", 1),
+		io__write_string("} ")
+	;
+		[]
+	),
+	(
+		{ Decl = yes }
+	->
+		io__write_string(" "),
+		output_decl_id(DeclId),
+		(
+			{ Init = yes }
+		->
+			io__write_string(" = {\n"),
+			output_cons_args(ArgVals, "\t"),
+			io__write_string(LaterIndent),
+			io__write_string("};\n")
+		;
+			io__write_string(";\n")
+		)
+	;
+		io__write_string(";\n")
+	).
+
 
 :- pred output_decl_id(decl_id, io__state, io__state).
 :- mode output_decl_id(in, di, uo) is det.
@@ -1912,7 +2014,7 @@
 output_llds_type(unsigned) --> io__write_string("Unsigned").
 output_llds_type(float)    --> io__write_string("Float").
 output_llds_type(word)     --> io__write_string("Word").
-output_llds_type(data_ptr) --> io__write_string("const Word *").
+output_llds_type(data_ptr) --> io__write_string("Word *").
 output_llds_type(code_ptr) --> io__write_string("Code *").
 
 :- pred output_cons_arg_decls(list(maybe(rval)), string, string, int, int,
@@ -2908,7 +3010,7 @@
 	io__write_string("mkword("),
 	output_tag(Tag),
 	io__write_string(", "),
-	output_rval_as_type(Exprn, word),
+	output_rval_as_type(Exprn, data_ptr),
 	io__write_string(")").
 output_rval(lval(Lval)) -->
 	% if a field is used as an rval, then we need to use
@@ -3031,9 +3133,7 @@
 	io__write_string("(Float) "),
 	io__write_float(FloatVal).
 output_rval_const(string_const(String)) -->
-		% XXX we should change the definition of `string_const'
-		% so that this cast is not necessary
-	io__write_string("(const Word *) string_const("""),
+	io__write_string("string_const("""),
 	output_c_quoted_string(String),
 	{ string__length(String, StringLength) },
 	io__write_string(""", "),
@@ -3048,7 +3148,8 @@
 output_rval_const(data_addr_const(data_addr(ModuleName, VarName))) -->
 	% data addresses are all assumed to be of type `Word *';
 	% we need to cast them here to avoid type errors
-	io__write_string("(const Word *) &"),
+	% XXX No we don't to make lcc accept it.
+	io__write_string("(Word *) &"),
 	output_data_addr(ModuleName, VarName).
 output_rval_const(label_entry(Label)) -->
 	io__write_string("ENTRY("),
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_string.h,v
retrieving revision 1.9
diff -u -r1.9 mercury_string.h
--- mercury_string.h	1998/05/15 07:09:19	1.9
+++ mercury_string.h	1998/10/19 00:30:55
@@ -36,7 +36,7 @@
 ** string_const("...", len):
 **	Given a C string literal and its length, returns a Mercury string.
 */
-#define string_const(string, len) ((Word)string)
+#define string_const(string, len) ((Word *) string)
 
 /*
 ** bool string_equal(ConstString s1, ConstString s2):
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_tags.h,v
retrieving revision 1.3
diff -u -r1.3 mercury_tags.h
--- mercury_tags.h	1997/12/22 06:59:25	1.3
+++ mercury_tags.h	1998/10/12 01:46:04
@@ -56,12 +56,14 @@
 #endif /* ! HIGHTAGS */
 
 /*
-** the result of mkword() is cast to (const Word *), not to (Word)
+** the result of mkword() is cast to (Word *), not to (Word)
 ** because mkword() may be used in initializers for static constants
 ** and casts from pointers to integral types are not valid
-** constant-expressions in ANSI C.
+** constant-expressions in ANSI C.  It cannot be (const Word *) because
+** some ANSI C compilers won't allow assignments where the RHS is of type
+** const and the LHS is not declared const.
 */
-#define	mkword(t, p)	((const Word *)((const char *)(p) + (t)))
+#define	mkword(t, p)	((Word *)((char *)(p) + (t)))
 
 #define	field(t, p, i)		((Word *) body((p), (t)))[i]
 #define	const_field(t, p, i)	((const Word *) body((p), (t)))[i]
Index: scripts/mgnuc.in
===================================================================
RCS file: /home/staff/zs/imp/mercury/scripts/mgnuc.in,v
retrieving revision 1.53
diff -u -r1.53 mgnuc.in
--- mgnuc.in	1998/08/07 00:50:40	1.53
+++ mgnuc.in	1998/10/16 02:36:56
@@ -69,7 +69,7 @@
     *gcc*)
 	ANSI_OPTS="" # --no-ansi to avoid syntax errors in Solaris pthread.h
 	CHECK_OPTS="
-	      -Wall -Wwrite-strings -Wpointer-arith -Wcast-qual -Wtraditional
+	      -Wall -Wwrite-strings -Wpointer-arith -Wtraditional
 	      -Wshadow -Wstrict-prototypes -Wmissing-prototypes -Wno-unused"
 
 # Note: we do not enable the following gcc warnings:
@@ -77,6 +77,7 @@
 # -Wconversion		really only intended to help people using \`unprotoize'
 # -Waggregate-return	not useful, IMHO
 
+# -Wcast-qual		causes LOTS of redundant warnings
 # -Wcast-align 		causes redundant warnings in memory.c
 # -pedantic		causes unsuppressable warnings about LVALUE_CAST()
 # -Wnested-externs	causes unsuppressable warnings about callentry()
Index: util/mkinit.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/util/mkinit.c,v
retrieving revision 1.41
diff -u -r1.41 mkinit.c
--- mkinit.c	1998/09/29 05:12:06	1.41
+++ mkinit.c	1998/10/05 06:12:41
@@ -140,8 +140,8 @@
 	"	MR_type_name = ML_type_name;\n"
 	"	MR_DI_output_current_vars = ML_DI_output_current_vars;\n"
   	"	MR_DI_output_current_nth_var = ML_DI_output_current_nth_var;\n"
-	"	MR_DI_output_current_live_var_names =
-			ML_DI_output_current_live_var_names;\n"
+	"	MR_DI_output_current_live_var_names = "
+			"ML_DI_output_current_live_var_names;\n"
 	"	MR_DI_output_current_slots = ML_DI_output_current_slots;\n"
   	"	MR_DI_get_var_number = ML_DI_get_var_number;\n"
 	"	MR_DI_found_match = ML_DI_found_match;\n"
@@ -153,7 +153,8 @@
 	"#endif\n"
 	"	program_entry_point = ENTRY(%s);\n"
 	"\n"
-	"	return mercury_runtime_init(argc, argv);\n"
+	"	mercury_runtime_init(argc, argv);\n"
+	"	return;\n"
 	"}\n"
 	"\n"
 	"void\n"

----
 +----------------------------------------------------------------------+
 | Peter Ross      M Sci/Eng Melbourne Uni                              |
 | petdr at cs.mu.oz.au  WWW: www.cs.mu.oz.au/~petdr/ ph: +61 3 9344 9158  |
 +----------------------------------------------------------------------+