[m-dev.] diff: MLDS back-end: eliminate some GNU C dependencies

[Fergus Henderson]

Estimated hours taken: 2

Add options to eliminate some of the dependencies on GNU C
in the MLDS back-end.

compiler/options.m:
	Add new options `--gcc-nested-functions' and `--gcc-local-labels';
	the documentation for these options is commented out for now.
	Also add commented out documentation for `--high-level-c'.
	
compiler/mlds_to_c.m:
	Implement the --no-gcc-local-labels option.

compiler/mercury_compile.m:
	Add a stub implementation for the --no-gcc-nested-functions option:
	if --high-level-c is set and --no-gcc-nested-functions is not set,
	then call `error("Sorry, not implemented: --no-gcc-nested-functions")'.

Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.140
diff -u -d -r1.140 mercury_compile.m
--- compiler/mercury_compile.m	1999/10/19 03:16:18	1.140
+++ compiler/mercury_compile.m	1999/11/06 03:55:25
@@ -2227,9 +2227,18 @@
 	globals__io_lookup_bool_option(statistics, Stats),
 
 	maybe_write_string(Verbose, "% Converting HLDS to MLDS...\n"),
-	ml_code_gen(HLDS, MLDS),
+	ml_code_gen(HLDS, MLDS0),
 	maybe_write_string(Verbose, "% done.\n"),
 	maybe_report_stats(Stats),
+
+	globals__io_lookup_bool_option(gcc_nested_functions, NestedFuncs),
+	( { NestedFuncs = no } ->
+		% XXX the pass to convert nested functions into unnested
+		% functions is not yet implemented.
+		{ error("Sorry, not implemented: --no-gcc-nested-functions.") }
+	;
+		{ MLDS = MLDS0 }
+	),
 
 	maybe_write_string(Verbose, "% Converting MLDS to C...\n"),
 	mlds_to_c__output_mlds(MLDS),
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.8
diff -u -d -r1.8 mlds_to_c.m
--- compiler/mlds_to_c.m	1999/11/05 21:18:54	1.8
+++ compiler/mlds_to_c.m	1999/11/06 04:43:45
@@ -234,13 +234,19 @@
 :- mode mlds_output_defns(in, in, in, di, uo) is det.
 
 mlds_output_defns(Indent, ModuleName, Defns) -->
-	%
-	% GNU C __label__ declarations must precede
-	% ordinary variable declarations.
-	%
-	{ list__filter(defn_is_commit_type_var, Defns, LabelDecls, OtherDefns) },
-	list__foldl(mlds_output_defn(Indent, ModuleName), LabelDecls),
-	list__foldl(mlds_output_defn(Indent, ModuleName), OtherDefns).
+	{ OutputDefn = mlds_output_defn(Indent, ModuleName) },
+	globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels),
+	( { GCC_LocalLabels = yes } ->
+		%
+		% GNU C __label__ declarations must precede
+		% ordinary variable declarations.
+		%
+		{ list__filter(defn_is_commit_type_var, Defns, LabelDecls, OtherDefns) },
+		list__foldl(OutputDefn, LabelDecls),
+		list__foldl(OutputDefn, OtherDefns)
+	;
+		list__foldl(OutputDefn, Defns)
+	).
 
 
 :- pred mlds_output_decl(int, mlds_module_name, mlds__defn,
@@ -591,8 +597,12 @@
 	mlds_output_type(Type),
 	io__write_string(" *").
 mlds_output_type(mlds__commit_type) -->
-	% XXX this assumes GNU C
-	io__write_string("__label__").
+	globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels),
+	( { GCC_LocalLabels = yes } ->
+		io__write_string("__label__")
+	;
+		io__write_string("jmp_buf")
+	).
 
 %-----------------------------------------------------------------------------%
 %
@@ -822,47 +832,100 @@
 	
 	%
 	% commits
-	% XXX Currently we handle these using GNU C constructs.
 	%
 mlds_output_stmt(Indent, _FuncName, do_commit(Ref)) -->
 	mlds_indent(Indent),
-	io__write_string("goto "),
-	mlds_output_fully_qualified_name(Ref, io__write_string),
+	globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels),
+	( { GCC_LocalLabels = yes } ->
+		% output "goto <Ref>"
+		io__write_string("goto "),
+		mlds_output_var(Ref)
+	;
+		% output "longjmp(<Ref>, 1)"
+		io__write_string("longjmp("),
+		mlds_output_var(Ref),
+		io__write_string(", 1)")
+	),
 	io__write_string(";\n").
-mlds_output_stmt(Indent, FuncName, try_commit(Ref, Stmt, Handler)) -->
+mlds_output_stmt(Indent, FuncName, try_commit(Ref, Stmt0, Handler)) -->
+	globals__io_lookup_bool_option(gcc_local_labels, GCC_LocalLabels),
+	(
+		{ GCC_LocalLabels = yes },
 	
-	% Output the following:
-	%
-	%               <Stmt>
-	%               goto <Ref>_done;
-	%       <Ref>:
-	%               <Handler>
-	%       <Ref>_done:
-	%               ;
+		% Output the following:
+		%
+		%               <Stmt>
+		%               goto <Ref>_done;
+		%       <Ref>:
+		%               <Handler>
+		%       <Ref>_done:
+		%               ;
 
-	mlds_output_statement(Indent, FuncName, Stmt),
+		mlds_output_statement(Indent, FuncName, Stmt0),
 
-	mlds_indent(Indent),
-	io__write_string("goto "),
-	mlds_output_fully_qualified_name(Ref, io__write_string),
-	io__write_string("_done;\n"),
+		mlds_indent(Indent),
+		io__write_string("goto "),
+		mlds_output_var(Ref),
+		io__write_string("_done;\n"),
 
-	mlds_indent(Indent - 1),
-	mlds_output_fully_qualified_name(Ref, io__write_string),
-	io__write_string(":\n"),
+		mlds_indent(Indent - 1),
+		mlds_output_var(Ref),
+		io__write_string(":\n"),
 
-	mlds_output_statement(Indent, FuncName, Handler),
+		mlds_output_statement(Indent, FuncName, Handler),
 
-	mlds_indent(Indent - 1),
-	mlds_output_fully_qualified_name(Ref, io__write_string),
-	io__write_string("_done:\t;\n").
+		mlds_indent(Indent - 1),
+		mlds_output_var(Ref),
+		io__write_string("_done:\t;\n")
+
+	;
+		{ GCC_LocalLabels = no },
+
+		% Output the following:
+		%
+		%	if (setjmp(<Ref>) == 0)
+		%               <Stmt>
+		%       else
+		%               <Handler>
+
+		%
+		% XXX do we need to declare the local variables as volatile,
+		% because of the setjmp()?
+		%
 
+		%
+		% we need to take care to avoid problems caused by the
+		% dangling else ambiguity
+		%
+		{
+			Stmt0 = statement(if_then_else(_, _, no), Context)
+		->
+			Stmt = statement(block([], [Stmt0]), Context)
+		;
+			Stmt = Stmt0
+		},
+
+		mlds_indent(Indent),
+		io__write_string("if (setjmp("),
+		mlds_output_var(Ref),
+		io__write_string(") == 0)\n"),
+
+		mlds_output_statement(Indent + 1, FuncName, Stmt),
+
+		mlds_indent(Indent),
+		io__write_string("else\n"),
+
+		mlds_output_statement(Indent + 1, FuncName, Handler)
+	).
+
+
 	%
 	% exception handling
 	%
 
 	/* XXX not yet implemented */
 
+
 	%
 	% atomic statements
 	%
@@ -1035,6 +1098,12 @@
 	io__write_string("*"),
 	mlds_output_bracketed_rval(Rval).
 mlds_output_lval(var(VarName)) -->
+	mlds_output_var(VarName).
+
+:- pred mlds_output_var(mlds__var, io__state, io__state).
+:- mode mlds_output_var(in, di, uo) is det.
+
+mlds_output_var(VarName) -->
 	mlds_output_fully_qualified_name(VarName, io__write_string).
 
 :- pred mlds_output_bracketed_rval(mlds__rval, io__state, io__state).
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.270
diff -u -d -r1.270 options.m
--- compiler/options.m	1999/10/19 03:16:20	1.270
+++ compiler/options.m	1999/11/06 04:17:36
@@ -161,6 +161,7 @@
 				% `--num-tag-bits'.
 		;	args
 		;	highlevel_c
+		;	gcc_nested_functions
 		;	unboxed_float
 		;	sync_term_size % in words
 		;	type_layout
@@ -257,6 +258,8 @@
 				% be allowed to get, given as an integer
 				% percentage.
 
+		;	gcc_local_labels
+
 	% Optimization Options
 		;	opt_level
 		;	opt_space	% default is to optimize time
@@ -539,6 +542,7 @@
 	type_ctor_layout	-	bool(yes),
 	type_ctor_functors	-	bool(yes),
 	highlevel_c		-	bool(no),
+	gcc_nested_functions	-	bool(no),
 	unboxed_float		-	bool(no)
 ]).
 option_defaults_2(code_gen_option, [
@@ -580,7 +584,8 @@
 	max_jump_table_size	-	int(0),
 					% 0 indicates any size.
 	fact_table_max_array_size -	int(1024),
-	fact_table_hash_percent_full - 	int(90)
+	fact_table_hash_percent_full - 	int(90),
+	gcc_local_labels	-	bool(no)
 ]).
 option_defaults_2(special_optimization_option, [
 		% Special optimization options.
@@ -893,6 +898,7 @@
 long_option("highlevel-c",		highlevel_c).
 long_option("high-level-C",		highlevel_c).
 long_option("high-level-c",		highlevel_c).
+long_option("gcc-nested-functions",	gcc_nested_functions).
 long_option("unboxed-float",		unboxed_float).
 
 % code generation options
@@ -923,6 +929,7 @@
 long_option("fact-table-max-array-size",fact_table_max_array_size).
 long_option("fact-table-hash-percent-full",
 					fact_table_hash_percent_full).
+long_option("gcc-local-labels",		gcc_local_labels).
 
 % optimization options
 
@@ -1707,6 +1714,9 @@
 		"-s <grade>, --grade <grade>",
 		"\tSelect the compilation model. The <grade> should be one of",
 		"\t`none', `reg', `jump', `asm_jump', `fast', `asm_fast',",
+% These grades are not yet implemented.
+% The --high-level-c option is not yet documented.
+%		"\t`ansi', `nest'",
 		"\tor one of those with `.gc', `.prof', `.proftime',",
 		"\t`.profcalls', `.tr', `.sa', `.debug', and/or `.pic_reg'",
 		"\tappended (in that order).",
@@ -1718,14 +1728,31 @@
 		"--no-gcc-global-registers\t(grades: none, jump, asm_jump)",
 		"\tSpecify whether or not to use GNU C's",
 		"\tglobal register variables extension.",
+% The --high-level-c option is not yet documented.
+%		"\tThis option is ignored if the `--high-level-c' option is enabled.",
 		"--gcc-non-local-gotos\t\t(grades: jump, fast, asm_jump, asm_fast)",
 		"--no-gcc-non-local-gotos\t(grades: none, reg)",
 		"\tSpecify whether or not to use GNU C's",
 		"\t""labels as values"" extension.",
+% The --high-level-c option is not yet documented.
+%		"\tThis option is ignored if the `--high-level-c' option is enabled.",
 		"--asm-labels\t\t\t(grades: asm_jump, asm_fast)",
 		"--no-asm-labels\t\t\t(grades: none, reg, jump, fast)",
 		"\tSpecify whether or not to use GNU C's",
 		"\tasm extensions for inline assembler labels.",
+% The --high-level-c option is not yet documented.
+%		"\tThis option is ignored if the `--high-level-c' option is enabled.",
+% The --high-level-c option is not yet documented,
+% because the MLDS back-end is not yet complete enough to be useful.
+%		"--high-level-c\t\t\t(grades: ansi, nest)",
+%		"\tUse an alternative back-end that generates high-level C code",
+%		"\trather than the very low-level C code that is generated by our",
+%		"\toriginal back-end.",
+% The --gcc-nested-functions option is not yet documented,
+% because it is not yet implemented.
+%		"--gcc-nested-functions\t\t(grades: nest)",
+%		"\tSpecify whether or not to use GNU C's nested functions extension.",
+%		"\tThis option is ignored if the `--high-level-c' option is not enabled.",
 		"--gc {none, conservative, accurate}",
 		"--garbage-collection {none, conservative, accurate}",
 		"\t\t\t\t(`.gc' grades use `--gc conservative',",
@@ -1906,6 +1933,18 @@
 		"\tSpecify how full the `:- pragma fact_table' hash tables",
 		"\tshould be allowed to get.  Given as an integer percentage",
 		"\t(valid range: 1 to 100, default: 90)."
+
+% This option is not yet documented because the `--high-level-c' MLDS backend
+% is still not yet complete.
+%		"--gcc-local-labels",
+%		"\tThis option has no effect unless both the `--high-level-c' option",
+%		"\tand the `--gcc-nested-functions' options are enabled.",
+%		"\tIf this option is enabled, the Mercury compiler will generate",
+%		"\tC code that uses GNU C's local labels extension to allow",
+%		"\tGNU C nested functions to exit into their containing function",
+%		"\tvia a `goto'.",
+%		"\tIf this option is not enabled, the default behaviour is to",
+%		"\tuse the standard ANSI/ISO C setjmp() and longjmp() functions."
 	]),
 
 	io__write_string("\n    Code generation target options:\n"),

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- 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
--------------------------------------------------------------------------