a68: avoid indirect calls to publicized C functions

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.

diff --git a/gcc/algol68/a68-low-units.cc b/gcc/algol68/a68-low-units.cc
index 4584ff10933bcaf7a7a77ad3342c8aa00e0052c7..4002a4b608ae61e6973eb1b71b3abfe57a068383 100644 (file)
--- 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 dee1a6d26c53afd0fc0e7d24f1dbb376492e29ca..1f341aaa977da71b2c7377262ae8c5bc9813c911 100644 (file)
--- 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 4779d3915f4a87b4f7f631dc92bd75738e26b7c2..32a9933bd723aa61e08167f6ac2ef06d900e05a3 100644 (file)
--- 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 cb8bcef4950367b7c040f4f0a0dbe6db68338bbc..c0fc8bedb94a39fa524492cc4cf4dfa42afe4124 100644 (file)
--- 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);