for review: changes required for lcc

[Peter Ross]

Hi,

Fergus could you review this.

Pete.


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


Estimated hours taken: 60

Changes required to get the samples directory to compiler using lcc in
the grade none.gc

compiler/llds_out.m:
    Add a pass to make sure that the variables are all declared before
    they are initialised.

    Also change data_ptr to type (Word *).  This is because lcc doesn't
    like casts between const and non-const, when doing certain
    initialisations.

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/15 06:53:34
@@ -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,59 @@
 	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
+	% definition to appear before its declaration.
+	%
+:- 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 +568,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 +1770,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) -->
@@ -1817,40 +1872,81 @@
 	% 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 according to
+	% whether we are outputting the definition, declaration or both.
 
-:- 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) },
+		(
+			{ 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 +2008,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 +3004,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
@@ -3033,7 +3129,7 @@
 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("(Word *) string_const("""),
 	output_c_quoted_string(String),
 	{ string__length(String, StringLength) },
 	io__write_string(""", "),
@@ -3048,7 +3144,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/09/18 06:41:34
@@ -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) (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  |
 +----------------------------------------------------------------------+