[COMMITTED] a68: avoid indirect calls to publicized C functions

[Jose E. Marchesi]

Publicized identifiers of proc modes with the form:

  pub proc(int)int fclose = nest C "_libga68_posixclose"

currently results in a export like:

  iden extract: POSIX_fclose [*.LMD11] variable=0 inproc=0

Note how the "inproc" export flag is not set.  This causes the
resulting applied identifier in calls to fclose to be lowered to a
VAR_DECL rather than a FUNCTION_DECL, resulting in an indirect call.

This patch makes the parser to mark identity declarations of proc
modes whose actual parameters are formal holes as "inproc".

Signed-off-by: Jose E. Marchesi <jemarch@gnu.org>

gcc/algol68/ChangeLog

	* a68.h: Prototype for a68_make_proc_formal_hole_decl.
	* a68-parser-extract.cc (extract_identities): Mark identity
	declarations of proc modes whose actual parameter is a formal hole
	as "inproc".
	* a68-low.cc (a68_make_proc_formal_hole_decl): New function.
	* a68-low-units.cc (a68_lower_formal_hole): Call
	a68_make_proc_formal_hole_decl whenever necessary.
---
 gcc/algol68/a68-low-units.cc      |  7 ++++++-
 gcc/algol68/a68-low.cc            | 27 +++++++++++++++++++++++++++
 gcc/algol68/a68-parser-extract.cc |  7 +++++++
 gcc/algol68/a68.h                 |  1 +
 4 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc
index 4584ff10933..4002a4b608a 100644
--- a/gcc/algol68/a68-low-units.cc
+++ b/gcc/algol68/a68-low-units.cc
@@ -1256,7 +1256,12 @@ a68_lower_formal_hole (NODE_T *p, LOW_CTX_T ctx ATTRIBUTE_UNUSED)
   gcc_assert (IS (str, ROW_CHAR_DENOTATION));
 
   char *symbol = a68_string_process_breaks (p, NSYMBOL (str));
-  tree decl = a68_make_formal_hole_decl (p, symbol);
+
+  tree decl;
+  if (IS (MOID (p), PROC_SYMBOL))
+    decl = a68_make_proc_formal_hole_decl (p, symbol);
+  else
+    decl = a68_make_formal_hole_decl (p, symbol);
   return decl;
 }
 
diff --git a/gcc/algol68/a68-low.cc b/gcc/algol68/a68-low.cc
index dee1a6d26c5..1f341aaa977 100644
--- a/gcc/algol68/a68-low.cc
+++ b/gcc/algol68/a68-low.cc
@@ -660,6 +660,33 @@ a68_make_formal_hole_decl (NODE_T *p, const char *extern_symbol)
   return decl;
 }
 
+/* Make an extern declaration for a formal hole that is a function.  */
+
+tree
+a68_make_proc_formal_hole_decl (NODE_T *p, const char *extern_symbol)
+{
+  /* The CTYPE of MODE is a pointer to a function.  We need the pointed
+     function type for the FUNCTION_DECL.  */
+  tree type = TREE_TYPE (CTYPE (MOID (p)));
+
+  gcc_assert (strlen (extern_symbol) > 0);
+  const char *sym = (extern_symbol[0] == '&'
+		     ? extern_symbol + 1
+		     : extern_symbol);
+
+  tree decl = build_decl (a68_get_node_location (p),
+			  FUNCTION_DECL,
+			  get_identifier (sym),
+			  type);
+  DECL_EXTERNAL (decl) = 1;
+  TREE_PUBLIC (decl) = 1;
+  DECL_INITIAL (decl) = a68_get_skip_tree (MOID (p));
+
+  if (extern_symbol[0] == '&')
+    decl = fold_build1 (ADDR_EXPR, type, decl);
+  return decl;
+}
+
 /* Do a checked indirection.
 
    P is a tree node used for its location information.
diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc
index 4779d3915f4..32a9933bd72 100644
--- a/gcc/algol68/a68-parser-extract.cc
+++ b/gcc/algol68/a68-parser-extract.cc
@@ -758,6 +758,7 @@ extract_identities (NODE_T *p)
 	      FORWARD (q);
 	    }
 
+	  NODE_T *declarer = q;
 	  do
 	    {
 	      if (a68_whether ((FORWARD (q)), IDENTIFIER, EQUALS_SYMBOL, STOP))
@@ -767,6 +768,12 @@ extract_identities (NODE_T *p)
 		    gcc_unreachable ();
 		  ATTRIBUTE (q) = DEFINING_IDENTIFIER;
 		  PUBLICIZED (q) = is_public;
+		  if (IS (SUB (declarer), PROC_SYMBOL))
+		    {
+		      NODE_T *actual_param = NEXT (NEXT (q));
+		      if (actual_param != NO_NODE && IS (actual_param, FORMAL_NEST_SYMBOL))
+			IN_PROC (tag) = true;
+		    }
 		  FORWARD (q);
 		  ATTRIBUTE (q) = ALT_EQUALS_SYMBOL;
 		  q = skip_unit (q);
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index cb8bcef4950..c0fc8bedb94 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -815,6 +815,7 @@ tree a68_make_proc_identity_declaration_decl (NODE_T *identifier, const char *mo
 					      bool indicant = false, bool external = false,
 					      const char *extern_symbol = NULL);
 tree a68_make_formal_hole_decl (NODE_T *p, const char *extern_symbol);
+tree a68_make_proc_formal_hole_decl (NODE_T *p, const char *extern_symbol);
 tree a68_make_anonymous_routine_decl (MOID_T *mode);
 tree a68_get_skip_tree (MOID_T *m);
 tree a68_get_empty (void);
-- 
2.39.5