[m-dev.] for review: GCC back-end: variable scoping

[Fergus Henderson]

This is relative to my previously posted diff.

Estimated hours taken: 12

Implement proper variable scoping.
This has two consequences:
- the generated code uses less stack space, since various
  whose scope does not overlap get assigned the same stack slot
- local variables now show up in gdb.

mercury/compiler/gcc.m:
	New routines start_block and end_block.

mercury/compiler/mlds_to_gcc.m:
	Call the new routines.

gcc/mercury/mercury-gcc.c:
	- Call pushdecl() for builtin types and for local variables,
	  to ensure that they get recorded in gcc's symbol tables,
	  so that it will generate debugging information for them.
	- Fix a bug (copied from the toy.c example front-end)
	  where it was clobbering the function DECL_ARGUMENTS field.
	- Simplify the spec1() macro by eliminating its first arg.

===================================================================
RCS file: gcc.m,v
retrieving revision 1.11
diff -u -r1.11 gcc.m
--- gcc.m	2001/01/06 15:15:41	1.11
+++ gcc.m	2001/01/07 08:31:15
@@ -163,6 +163,22 @@
 :- pred set_var_decl_readonly(gcc__var_decl::in, io__state::di, io__state::uo) is det.
 
 %
+% Routines to start/end a block.
+%
+% Every start_block must be matched by a corresponding end_block.
+% The lifetime of any local variable declarations
+% within the block will end at the corresponding end_block.
+%
+
+	% Like `{' in C.
+:- pred start_block(io__state, io__state).
+:- mode start_block(di, uo) is det.
+
+	% Like `}' in C.
+:- pred end_block(io__state, io__state).
+:- mode end_block(di, uo) is det.
+
+%
 % Stuff for function declarations
 %
 
@@ -1181,6 +1197,24 @@
 %
 % Statements.
 %
+
+%
+% blocks
+%
+
+:- pragma c_code(start_block(_IO0::di, _IO::uo),
+	[will_not_call_mercury],
+"
+	pushlevel(0);
+	expand_start_bindings(0);
+").
+
+:- pragma c_code(end_block(_IO0::di, _IO::uo),
+	[will_not_call_mercury],
+"
+	tree block = poplevel(/*keep=*/1, /*reverse=*/1, /*functionbody=*/0);
+	expand_end_bindings(block, /*mark_ends=*/1, /*dont_jump_in=*/0);
+").
 
 %
 % if-then-else
===================================================================
RCS file: mlds_to_gcc.m,v
retrieving revision 1.13
diff -u -r1.13 mlds_to_gcc.m
--- mlds_to_gcc.m	2001/01/06 15:15:41	1.13
+++ mlds_to_gcc.m	2001/01/07 08:35:59
@@ -18,6 +18,10 @@
 % it will end up compiling everything via C.
 
 % TODO:
+%	Fix bugs:
+%	- calling convention for semidet code not binary compatible
+%	  with C; need to promote boolean return type to int
+%
 %	Fix configuration issues:
 %	- mmake support
 %	- document installation procedure
@@ -35,18 +39,23 @@
 %
 %	Implement implementation-specific features that are supported
 %	by other gcc front-ends:
+%	- generate gcc trees rather than expanding as we go
 %	- support gdb
 %		- improve accuracy of line numbers (e.g. for decls).
-%		- fix variable scoping so that local vars show up
-%	- generate gcc trees rather than expanding as we go
+%		- make variable names match what's in the original source
+%		- use nested functions or something like that to hide
+%		  from the user the environment struct stuff that we
+%		  generate for nondet code
+%		- extend gdb to print Mercury data structures better
+%		- extend gdb to print Mercury stacks better
 %
 %	Improve efficiency of generated code:
+%	- implement annotation in gcc tree to force tailcalls
 %	- improve code for switches with default_is_unreachable.
+%	  (We already do a reasonably good job, so this is a low priority.)
 %	  One way would be to implement computed_goto and cast_to_unsigned,
 %	  and change target_supports_computed_goto_2(asm) in ml_switch_gen.m
 %	  to `yes'.
-%	- fix variable scoping
-%	- implement annotation in gcc tree to force tailcalls
 %
 %	Improve efficiency of compilation:
 %	- improve symbol table handling
@@ -2153,12 +2162,14 @@
 	% sequence
 	%
 gen_stmt(FuncInfo0, block(Defns, Statements), _Context) -->
+	gcc__start_block,
 	{ FuncName = FuncInfo0 ^ func_name },
 	{ FuncName = qual(ModuleName, _) },
 	{ SymbolTable0 = FuncInfo0 ^ local_vars },
 	build_local_defns(Defns, FuncInfo0, ModuleName, SymbolTable0, SymbolTable),
 	{ FuncInfo = FuncInfo0 ^ local_vars := SymbolTable },
-	gen_statements(FuncInfo, Statements).
+	gen_statements(FuncInfo, Statements),
+	gcc__end_block.
 
 	%
 	% iteration
Index: mercury-gcc.c
===================================================================
RCS file: /home/pgrad/fjh/fs/hg/fjh_repository/mercury/mercury-gcc.c,v
retrieving revision 1.19
diff -u -d -u -r1.19 mercury-gcc.c
--- mercury-gcc.c	2001/01/05 06:01:26	1.19
+++ mercury-gcc.c	2001/01/07 08:17:45
@@ -200,6 +200,7 @@
   tree var_decl = build_decl (VAR_DECL, get_identifier (var_name),
 			      var_type);
   expand_decl (var_decl);
+  pushdecl (var_decl);
   return var_decl;
 }
 
@@ -535,9 +536,6 @@
 merc_start_function (fndecl)
      tree fndecl;
 {
-  tree param_decl, next_param;
-  tree first_param;
-
   /* Set line number information.  */
   DECL_SOURCE_FILE (fndecl) = input_filename;
   DECL_SOURCE_LINE (fndecl) = lineno;
@@ -561,13 +559,18 @@
   expand_function_start (fndecl, 0);
 
   pushlevel (0);
-  expand_start_bindings (2);
+  expand_start_bindings (0);
 
+#if 0
+{
+  tree param_decl, next_param;
+  tree first_param;
+
   /* Push all the PARM_DECL nodes onto the current scope (i.e. the scope of the
      subprogram body) so that they can be recognized as local variables in the
      subprogram.   */
 
-  for (first_param = param_decl = nreverse (DECL_ARGUMENTS (fndecl));
+  for (first_param = param_decl = DECL_ARGUMENTS (fndecl);
        param_decl;
        param_decl = next_param)
     {
@@ -577,7 +580,9 @@
     }
 
   /* Store back the PARM_DECL nodes. They appear in the right order. */
-  DECL_ARGUMENTS (fndecl) = first_param; /*getdecls ();*/
+  DECL_ARGUMENTS (fndecl) = getdecls ();
+}
+#endif
 
   pushlevel (0);
   expand_start_bindings (0);
@@ -1148,6 +1153,7 @@
 init_decl_processing ()
 {
   tree array_domain_type;
+  tree jmpbuf_domain_type;
 
   set_identifier_size (sizeof (struct tree_identifier));
 
@@ -1195,63 +1201,70 @@
   /* Define `int' and `char' first so that dbx will output them first.  */
 
   /* spec1() ensures that the type's type is itself. Needed for DBX.
+     Should only be used for atomic types.
      For the C front-end this is done in pushdecl with a kludge.  */
 
-#define spec1(type, id, node) \
+#define spec1(id, type_node) \
  { \
    tree spec1_decl; \
-   TREE_TYPE (node) = node; \
-   spec1_decl = build_decl (type, id, node); \
-   TYPE_NAME (node) = spec1_decl; \
+   TREE_TYPE (type_node) = type_node; \
+   spec1_decl = build_decl (TYPE_DECL, id, type_node); \
+   TYPE_NAME (type_node) = spec1_decl; \
+   TYPE_STUB_DECL (type_node) = spec1_decl; \
    pushdecl (spec1_decl); \
  }
 
- spec1(TYPE_DECL, ridpointers[(int) RID_INT], integer_type_node);
- spec1(TYPE_DECL, get_identifier ("char"), char_type_node);
- spec1(TYPE_DECL, get_identifier ("long int"), long_integer_type_node);
- spec1(TYPE_DECL, get_identifier ("unsigned int"), unsigned_type_node);
- spec1(TYPE_DECL, get_identifier ("long unsigned int"), long_unsigned_type_node);
- spec1(TYPE_DECL, get_identifier ("long long int"), long_long_integer_type_node);
- spec1(TYPE_DECL, get_identifier ("long long unsigned int"), long_long_unsigned_type_node);
- spec1(TYPE_DECL, get_identifier ("short int"), short_integer_type_node);
- spec1(TYPE_DECL, get_identifier ("short unsigned int"), short_unsigned_type_node);
- spec1(TYPE_DECL, get_identifier ("signed char"), signed_char_type_node);
- spec1(TYPE_DECL, get_identifier ("unsigned char"), unsigned_char_type_node);
- spec1(TYPE_DECL, NULL_TREE, intQI_type_node);
- spec1(TYPE_DECL, NULL_TREE, intHI_type_node);
- spec1(TYPE_DECL, NULL_TREE, intSI_type_node);
- spec1(TYPE_DECL, NULL_TREE, intDI_type_node);
+ spec1(ridpointers[(int) RID_INT], integer_type_node);
+ spec1(get_identifier ("char"), char_type_node);
+ spec1(get_identifier ("long int"), long_integer_type_node);
+ spec1(get_identifier ("unsigned int"), unsigned_type_node);
+ spec1(get_identifier ("long unsigned int"), long_unsigned_type_node);
+ spec1(get_identifier ("long long int"), long_long_integer_type_node);
+ spec1(get_identifier ("long long unsigned int"), long_long_unsigned_type_node);
+ spec1(get_identifier ("short int"), short_integer_type_node);
+ spec1(get_identifier ("short unsigned int"), short_unsigned_type_node);
+ spec1(get_identifier ("signed char"), signed_char_type_node);
+ spec1(get_identifier ("unsigned char"), unsigned_char_type_node);
+ spec1(NULL_TREE, intQI_type_node);
+ spec1(NULL_TREE, intHI_type_node);
+ spec1(NULL_TREE, intSI_type_node);
+ spec1(NULL_TREE, intDI_type_node);
 #if HOST_BITS_PER_WIDE_INT >= 64
- spec1(TYPE_DECL, NULL_TREE, intTI_type_node);
+ spec1(NULL_TREE, intTI_type_node);
 #endif
- spec1(TYPE_DECL, NULL_TREE, unsigned_intQI_type_node);
- spec1(TYPE_DECL, NULL_TREE, unsigned_intHI_type_node);
- spec1(TYPE_DECL, NULL_TREE, unsigned_intSI_type_node);
- spec1(TYPE_DECL, NULL_TREE, unsigned_intDI_type_node);
+ spec1(NULL_TREE, unsigned_intQI_type_node);
+ spec1(NULL_TREE, unsigned_intHI_type_node);
+ spec1(NULL_TREE, unsigned_intSI_type_node);
+ spec1(NULL_TREE, unsigned_intDI_type_node);
 #if HOST_BITS_PER_WIDE_INT >= 64
- spec1(TYPE_DECL, NULL_TREE, unsigned_intTI_type_node);
+ spec1(NULL_TREE, unsigned_intTI_type_node);
 #endif
   
  /* Create the widest literal types. */
   widest_integer_literal_type_node = make_signed_type (HOST_BITS_PER_WIDE_INT * 2);
   widest_unsigned_literal_type_node = make_unsigned_type (HOST_BITS_PER_WIDE_INT * 2);
-  spec1(TYPE_DECL, NULL_TREE, widest_integer_literal_type_node);
-  spec1(TYPE_DECL, NULL_TREE, widest_unsigned_literal_type_node);
+  spec1(NULL_TREE, widest_integer_literal_type_node);
+  spec1(NULL_TREE, widest_unsigned_literal_type_node);
 
   merc_int8_type_node = make_signed_type (8);
   merc_int16_type_node = make_signed_type (16);
   merc_int32_type_node = make_signed_type (32);
   merc_int64_type_node = make_signed_type (64);
   merc_intptr_type_node = make_signed_type (POINTER_SIZE);
+  spec1(get_identifier ("MR_int8_t"), merc_int8_type_node);
+  spec1(get_identifier ("MR_int16_t"), merc_int16_type_node);
+  spec1(get_identifier ("MR_int32_t"), merc_int32_type_node);
+  spec1(get_identifier ("MR_int64_t"), merc_int64_type_node);
+  spec1(get_identifier ("MR_intptr_t"), merc_intptr_type_node);
 
   set_sizetype (merc_intptr_type_node);
 
   build_common_tree_nodes_2 (merc_flag_short_double);
 
-  spec1(TYPE_DECL, ridpointers[(int) RID_FLOAT], float_type_node);
-  spec1(TYPE_DECL, ridpointers[(int) RID_DOUBLE], double_type_node);
-  spec1(TYPE_DECL, get_identifier ("long double"), long_double_type_node);
-  spec1(TYPE_DECL, ridpointers[(int) RID_VOID], void_type_node);
+  spec1(ridpointers[(int) RID_FLOAT], float_type_node);
+  spec1(ridpointers[(int) RID_DOUBLE], double_type_node);
+  spec1(get_identifier ("long double"), long_double_type_node);
+  spec1(ridpointers[(int) RID_VOID], void_type_node);
 
 #ifdef MD_INIT_BUILTINS
   MD_INIT_BUILTINS;
@@ -1271,8 +1284,7 @@
   boolean_type_node = make_node (BOOLEAN_TYPE);
   TYPE_PRECISION (boolean_type_node) = 1;
   fixup_unsigned_type (boolean_type_node);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("boolean"),
-			boolean_type_node));
+  spec1(get_identifier ("boolean"), boolean_type_node);
   boolean_false_node = TYPE_MIN_VALUE (boolean_type_node);
   boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
 #endif
@@ -1280,6 +1292,8 @@
   string_type_node = build_pointer_type (char_type_node);
   const_string_type_node
     = build_pointer_type (build_type_variant (char_type_node, 1, 0));
+  spec1(get_identifier ("MR_String"), string_type_node);
+  spec1(get_identifier ("MR_ConstString"), const_string_type_node);
 
   /* Make a type to be the domain of a few array types
      whose domains don't really matter.
@@ -1296,8 +1310,11 @@
 
   /* The documentation in builtins.c says that __builtin_setjmp expects its
      argument to be a pointer to an array of five words.  */
-  merc_jmpbuf_type_node
-    = build_array_type (ptr_type_node, build_index_type (build_int_2 (4, 0)));
+  jmpbuf_domain_type = build_index_type (build_int_2 (4, 0));
+  spec1(get_identifier ("__builtin_jmpbuf_index"), jmpbuf_domain_type);
+  merc_jmpbuf_type_node = build_array_type (ptr_type_node, jmpbuf_domain_type);
+  spec1(get_identifier ("__builtin_jmpbuf"), merc_jmpbuf_type_node);
+  TREE_TYPE (merc_jmpbuf_type_node) = ptr_type_node;
 
   merc_init_builtin_functions ();
 
-- 
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
--------------------------------------------------------------------------