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 <[email protected]> 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
