https://gcc.gnu.org/g:f3d9820d2b50668b1a9515e748e462a02bf09621
commit r16-6415-gf3d9820d2b50668b1a9515e748e462a02bf09621 Author: Jose E. Marchesi <[email protected]> Date: Sat Dec 27 21:09:20 2025 +0100 a68: support for publicized modules This commit adds support for modules publicizing the exports of other modules. For example: module GRAMP = access pub GRAMP_Symbol, pub GRAMP_Word, pub GRAMP_Alphabet def pub string libgramp_version = "1.0"; skip fed Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * a68-parser-taxes.cc (tax_module_dec): Do not handle DEFINING_MODULE_INDICANT. * a68-exports.cc (a68_add_module_to_moif): Do not mangle module names in module extracts. (add_pub_revelations_to_moif): New function. (a68_do_exports): Simplify and call add_pub_revelations_to_moif. * a68-imports.cc (a68_decode_moifs): Add all decoded moifs to the global list TOP_MOIF. * a68-parser-extract.cc (extract_revelation): Recurse to import extracts from publicized modules. (a68_extract_indicants): Do not add symbol table entries for defining modules. * a68-types.h (struct TAG_T): Remove field EXPORTED. (EXPORTED): Remove macro. (TOP_MOIF): Define. * a68-parser.cc (a68_parser): Initialize global list of moifs. (a68_new_tag): Do not initialize EXPORTED. gcc/testsuite/ChangeLog * algol68/execute/modules/module22bar.a68: New test. * algol68/execute/modules/module22foo.a68: Likewise. * algol68/execute/modules/program-22.a68: Likewise. * algol68/compile/modules/program-11.a68: Adjust test to publicized modules. * algol68/compile/modules/program-error-multiple-delaration-module-1.a68: Likewise. Diff: --- gcc/algol68/a68-exports.cc | 131 +++++++++++---------- gcc/algol68/a68-imports.cc | 40 +++++-- gcc/algol68/a68-parser-extract.cc | 46 +++++--- gcc/algol68/a68-parser-taxes.cc | 12 -- gcc/algol68/a68-parser.cc | 2 +- gcc/algol68/a68-types.h | 8 +- .../algol68/compile/modules/program-11.a68 | 3 +- .../program-error-multiple-delaration-module-1.a68 | 4 +- .../algol68/execute/modules/module22bar.a68 | 7 ++ .../algol68/execute/modules/module22foo.a68 | 4 + .../algol68/execute/modules/program-22.a68 | 6 + 11 files changed, 152 insertions(+), 111 deletions(-) diff --git a/gcc/algol68/a68-exports.cc b/gcc/algol68/a68-exports.cc index ff4561f54a71..469e945cb425 100644 --- a/gcc/algol68/a68-exports.cc +++ b/gcc/algol68/a68-exports.cc @@ -131,10 +131,7 @@ static void a68_add_module_to_moif (MOIF_T *moif, TAG_T *tag) { EXTRACT_T *e = ggc_alloc<EXTRACT_T> (); - /* Module tags are not associated with declarations, so we have to do the - mangling here. */ - tree id = a68_get_mangled_indicant (NSYMBOL (NODE (tag)), NAME (moif)); - const char *tag_symbol = IDENTIFIER_POINTER (id); + const char *tag_symbol = NSYMBOL (NODE (tag)); EXTRACT_KIND (e) = GA68_EXTRACT_MODU; EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol); @@ -525,6 +522,26 @@ a68_asm_output_moif (MOIF_T *moif) } } +/* Add module exports for publicized module revelations. */ + +static void +add_pub_revelations_to_moif (MOIF_T *moif, NODE_T *p) +{ + for (; p != NO_NODE; FORWARD (p)) + { + if (IS (p, PUBLIC_SYMBOL)) + { + gcc_assert (IS (NEXT (p), MODULE_INDICANT)); + TAG_T *tag = a68_new_tag (); + NODE (tag) = NEXT (p); + a68_add_module_to_moif (moif, tag); + FORWARD (p); + } + else + add_pub_revelations_to_moif (moif, SUB (p)); + } +} + /* Emit export information for the module definition in the parse tree P. */ void @@ -534,65 +551,59 @@ a68_do_exports (NODE_T *p) { if (IS (p, DEFINING_MODULE_INDICANT)) { - // XXX only do this if the defining module is to be - // exported. Accessed modules without PUB are not exported. */ - TAG_T *tag = a68_find_tag_global (TABLE (p), MODULE_SYMBOL, NSYMBOL (p)); - gcc_assert (tag != NO_TAG); + tree module_id = a68_get_mangled_indicant (NSYMBOL (p)); + MOIF_T *moif = a68_moif_new (IDENTIFIER_POINTER (module_id)); + char *prelude = xasprintf ("%s__prelude", IDENTIFIER_POINTER (module_id)); + char *postlude = xasprintf ("%s__postlude", IDENTIFIER_POINTER (module_id)); + PRELUDE (moif) = ggc_strdup (prelude); + POSTLUDE (moif) = ggc_strdup (postlude); + free (prelude); + free (postlude); + + NODE_T *module_text = NEXT (NEXT (p)); + gcc_assert (IS (module_text, MODULE_TEXT)); + + /* Get modules exports from the revelation part. */ + if (IS (SUB (module_text), REVELATION_PART)) + { + NODE_T *revelation_part = SUB (module_text); + add_pub_revelations_to_moif (moif, SUB (revelation_part)); + } - if (EXPORTED (tag)) + NODE_T *def_part = (IS (SUB (module_text), REVELATION_PART) + ? NEXT_SUB (module_text) + : SUB (module_text)); + gcc_assert (IS (def_part, DEF_PART)); + TABLE_T *table = TABLE (SUB (def_part)); + gcc_assert (PUBLIC_RANGE (table)); + + for (TAG_T *t = INDICANTS (table); t != NO_TAG; FORWARD (t)) { - tree module_id = a68_get_mangled_indicant (NSYMBOL (p)); - MOIF_T *moif = a68_moif_new (IDENTIFIER_POINTER (module_id)); - char *prelude = xasprintf ("%s__prelude", IDENTIFIER_POINTER (module_id)); - char *postlude = xasprintf ("%s__postlude", IDENTIFIER_POINTER (module_id)); - PRELUDE (moif) = ggc_strdup (prelude); - POSTLUDE (moif) = ggc_strdup (postlude); - free (prelude); - free (postlude); - - NODE_T *module_text = NEXT (NEXT (p)); - gcc_assert (IS (module_text, MODULE_TEXT)); - NODE_T *def_part = (IS (SUB (module_text), REVELATION_PART) - ? NEXT_SUB (module_text) - : SUB (module_text)); - gcc_assert (IS (def_part, DEF_PART)); - TABLE_T *table = TABLE (SUB (def_part)); - gcc_assert (PUBLIC_RANGE (table)); - - for (TAG_T *t = MODULES (table); t != NO_TAG; FORWARD (t)) - { - if (PUBLICIZED (t)) - a68_add_module_to_moif (moif, t); - } - - for (TAG_T *t = INDICANTS (table); t != NO_TAG; FORWARD (t)) - { - if (PUBLICIZED (t)) - a68_add_indicant_to_moif (moif, t); - } - - for (TAG_T *t = IDENTIFIERS (table); t != NO_TAG; FORWARD (t)) - { - if (PUBLICIZED (t)) - a68_add_identifier_to_moif (moif, t); - } - - for (TAG_T *t = PRIO (table); t != NO_TAG; FORWARD (t)) - { - if (PUBLICIZED (t)) - a68_add_prio_to_moif (moif, t); - } - - for (TAG_T *t = OPERATORS (table); t != NO_TAG; FORWARD (t)) - { - if (PUBLICIZED (t)) - a68_add_operator_to_moif (moif, t); - } - - a68_asm_output_moif (moif); - if (flag_a68_dump_moif) - a68_dump_moif (moif); + if (PUBLICIZED (t)) + a68_add_indicant_to_moif (moif, t); } + + for (TAG_T *t = IDENTIFIERS (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_identifier_to_moif (moif, t); + } + + for (TAG_T *t = PRIO (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_prio_to_moif (moif, t); + } + + for (TAG_T *t = OPERATORS (table); t != NO_TAG; FORWARD (t)) + { + if (PUBLICIZED (t)) + a68_add_operator_to_moif (moif, t); + } + + a68_asm_output_moif (moif); + if (flag_a68_dump_moif) + a68_dump_moif (moif); } else a68_do_exports (SUB (p)); diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc index 775d58c07150..ff117163e155 100644 --- a/gcc/algol68/a68-imports.cc +++ b/gcc/algol68/a68-imports.cc @@ -1286,11 +1286,11 @@ a68_decode_extracts (MOIF_T *moif, encoded_modes_map_t &encoded_modes, return false; } -/* Decode the given exports data into a linked list of moifs. If there is a - decoding error then put an explicative mssage in *ERRSTR and return - NULL. */ +/* Decode the given exports data into moifs, add them to the TOP_MOIF list, and + return true. If there is a decoding error then put an explicative message + in *ERRSTR and return false. */ -static MOIF_T * +static bool a68_decode_moifs (const char *data, size_t size, const char **errstr) { MOIF_T *moif_list = NO_MOIF; @@ -1349,12 +1349,25 @@ a68_decode_moifs (const char *data, size_t size, const char **errstr) } } - /* Got some juicy exports for youuuuuu... */ - return moif_list; + /* Add the moifs in moif_list to the global list of moifs. */ + /* XXX error and fail on duplicates? */ + { + MOIF_T *end = TOP_MOIF (&A68_JOB); + if (end == NO_MOIF) + TOP_MOIF (&A68_JOB) = moif_list; + else + { + while (NEXT (end) != NO_MOIF) + FORWARD (end); + NEXT (end) = moif_list; + } + } + + return true; decode_error: if (*errstr == NULL) *errstr = "premature end of data"; - return NULL; + return false; } /* Get a moif with the exports for module named MODULE. If no exports can be @@ -1395,11 +1408,16 @@ a68_open_packet (const char *module) /* Got some data. Decode it into a list of moif. */ const char *errstr = NULL; - MOIF_T *moif = a68_decode_moifs (exports_data, exports_data_size, &errstr); + if (!a68_decode_moifs (exports_data, exports_data_size, &errstr)) + { + a68_error (NO_NODE, "%s", errstr); + return NULL; + } - /* The moif we are looking for must be in the list. Note these are garbage - collected. */ + /* The androids we are looking for are likely to be now in the global + list. */ + MOIF_T *moif = TOP_MOIF (&A68_JOB); while (moif != NO_MOIF && strcmp (NAME (moif), module) != 0) - moif = NEXT (moif); + FORWARD (moif); return moif; } diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc index 51ccc89986cf..f02ae6db322c 100644 --- a/gcc/algol68/a68-parser-extract.cc +++ b/gcc/algol68/a68-parser-extract.cc @@ -185,23 +185,30 @@ skip_pack_declarer (NODE_T *p) return p; } -/* Extract a revelation. */ +/* Extract the revelation associated with the module MODULE. The node Q is + used for symbol table and diagnostic purposes. Publicized modules are + recursively extracted as well. This call may result in one or more + errors. */ static void -extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED) +extract_revelation (NODE_T *q, const char *module, TAG_T *tag) { - /* Store in the symbol table. */ - TAG_T *tag = a68_add_tag (TABLE (q), MODULE_SYMBOL, q, NO_MOID, STOP); - gcc_assert (tag != NO_TAG); - EXPORTED (tag) = false; // XXX depends on PUB! /* Import the MOIF and install it in the tag. */ - MOIF_T *moif = a68_open_packet (NSYMBOL (q)); + MOIF_T *moif = a68_open_packet (module); if (moif == NULL) { - a68_error (q, "cannot find module Z", NSYMBOL (q)); + a68_error (q, "cannot find module Z", module); return; } - MOIF (tag) = moif; // XXX add to existing list of moifs. + + if (tag != NO_TAG) + MOIF (tag) = moif; + + /* First thing to do is to extract the revelations of publicized modules in + this moif. This leads to recursive calls of this function. */ + + for (EXTRACT_T *e : MODULES (moif)) + extract_revelation (q, EXTRACT_SYMBOL (e), NO_TAG); /* Store all the modes from the MOIF in the moid list. @@ -345,18 +352,26 @@ a68_extract_indicants (NODE_T *p) FORWARD (q); if (q != NO_NODE) { + NODE_T *bold_tag = NO_NODE; + if (IS (q, BOLD_TAG)) { - extract_revelation (q, false /* is_public */); + bold_tag = q; FORWARD (q); } else if (a68_whether (q, PUBLIC_SYMBOL, BOLD_TAG, STOP)) { - NODE_T *pub_node = q; - extract_revelation (NEXT (pub_node), true /* is_public */); + bold_tag = NEXT (q); FORWARD (q); FORWARD (q); } + + if (bold_tag != NO_NODE) + { + TAG_T *tag = a68_add_tag (TABLE (bold_tag), MODULE_SYMBOL, bold_tag, NO_MOID, STOP); + gcc_assert (tag != NO_TAG); + extract_revelation (bold_tag, NSYMBOL (bold_tag), tag); + } } } while (q != NO_NODE && IS (q, COMMA_SYMBOL)); @@ -370,14 +385,7 @@ a68_extract_indicants (NODE_T *p) detect_redefined_keyword (q, MODULE_DECLARATION); if (a68_whether (q, BOLD_TAG, EQUALS_SYMBOL, STOP)) { - /* Store in the symbol table. - XXX also add to global list of modules? - Position of definition (q) connects to this lexical - level! */ ATTRIBUTE (q) = DEFINING_MODULE_INDICANT; - TAG_T *tag = a68_add_tag (TABLE (p), MODULE_SYMBOL, q, NO_MOID, STOP); - gcc_assert (tag != NO_TAG); - EXPORTED (tag) = true; FORWARD (q); ATTRIBUTE (q) = EQUALS_SYMBOL; /* XXX why not ALT_EQUALS_SYMBOL */ if (NEXT (q) != NO_NODE && IS (NEXT (q), ACCESS_SYMBOL)) diff --git a/gcc/algol68/a68-parser-taxes.cc b/gcc/algol68/a68-parser-taxes.cc index e5fde05e4fd8..365cb66d59ab 100644 --- a/gcc/algol68/a68-parser-taxes.cc +++ b/gcc/algol68/a68-parser-taxes.cc @@ -1188,18 +1188,6 @@ tax_module_dec (NODE_T *p) { tax_module_dec (NEXT (p)); } - else if (IS (p, DEFINING_MODULE_INDICANT)) - { - TAG_T *entry = MODULES (TABLE (p)); - while (entry != NO_TAG && NODE (entry) != p) - FORWARD (entry); - MOID (p) = NO_MOID; - TAX (p) = entry; - HEAP (entry) = LOC_SYMBOL; - MOID (entry) = NO_MOID; - PUBLICIZED (entry) = PUBLICIZED (p); - tax_module_dec (NEXT (p)); - } else { tax_tags (p); diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc index e49e0873b217..725a8fc44dec 100644 --- a/gcc/algol68/a68-parser.cc +++ b/gcc/algol68/a68-parser.cc @@ -446,6 +446,7 @@ a68_parser (const char *filename) A68_PARSER (error_tag) = (TAG_T *) a68_new_tag (); TOP_NODE (&A68_JOB) = NO_NODE; TOP_MOID (&A68_JOB) = NO_MOID; + TOP_MOIF (&A68_JOB) = NO_MOIF; TOP_LINE (&A68_JOB) = NO_LINE; STANDENV_MOID (&A68_JOB) = NO_MOID; a68_set_up_tables (); @@ -784,7 +785,6 @@ a68_new_tag (void) VARIABLE (z) = false; IS_RECURSIVE (z) = false; PUBLICIZED (z) = true; /* XXX */ - EXPORTED (z) = false; ASCRIBED_ROUTINE_TEXT (z) = false; LOWERER (z) = NO_LOWERER; TAX_TREE_DECL (z) = NULL_TREE; diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h index 859f4148266a..788e7230f928 100644 --- a/gcc/algol68/a68-types.h +++ b/gcc/algol68/a68-types.h @@ -585,9 +585,6 @@ struct GTY(()) TABLE_T PUBLICIZED is set for tags that are marked as public and therefore shall be exported as part of a module interface. - EXPORTED is set for DEFINING_MODULEs whose module interface is to be - exported. - ASCRIBED_ROUTINE_TEXT is set when the defining identifier is ascribed a routine-text in an identity declaration. @@ -621,7 +618,7 @@ struct GTY((chain_next ("%h.next"))) TAG_T NODE_T *node, *unit; const char *value; bool scope_assigned, use, in_proc, loc_assigned, portable, variable; - bool ascribed_routine_text, is_recursive, publicized, exported; + bool ascribed_routine_text, is_recursive, publicized; int priority, heap, scope, youngest_environ, number; STATUS_MASK_T status; tree tree_decl; @@ -645,6 +642,7 @@ struct GTY(()) MODULE_T int error_count, warning_count, source_scan; LINE_T *top_line; MOID_T *top_moid, *standenv_moid; + MOIF_T *top_moif; NODE_T *top_node; OPTIONS_T options; FILE * GTY ((skip)) file_source_fd; @@ -930,7 +928,6 @@ struct GTY(()) A68_T #define EQUIVALENT(p) ((p)->equivalent_mode) #define EQUIVALENT_MODE(p) ((p)->equivalent_mode) #define ERROR_COUNT(p) ((p)->error_count) -#define EXPORTED(p) ((p)->exported) #define EXTERN_SYMBOL(p) ((p)->extern_symbol) #define EXTRACT_IN_PROC(p) ((p)->in_proc) #define EXTRACT_KIND(p) ((p)->kind) @@ -1097,6 +1094,7 @@ struct GTY(()) A68_T #define TEXT(p) ((p)->text) #define TOP_LINE(p) ((p)->top_line) #define TOP_MOID(p) ((p)->top_moid) +#define TOP_MOIF(p) ((p)->top_moif) #define TOP_NODE(p) ((p)->top_node) #define TRANSIENT(p) ((p)->transient) #define TREE_LISTING_SAFE(p) ((p)->tree_listing_safe) diff --git a/gcc/testsuite/algol68/compile/modules/program-11.a68 b/gcc/testsuite/algol68/compile/modules/program-11.a68 index 9da676df7033..def57235c08d 100644 --- a/gcc/testsuite/algol68/compile/modules/program-11.a68 +++ b/gcc/testsuite/algol68/compile/modules/program-11.a68 @@ -4,8 +4,7 @@ inside controlled clauses in access clauses with several revelations. } -access Module10, - Module11, +access Module11, Module12 begin assert (foo = 10); assert (bar = "foo") { dg-error "" } diff --git a/gcc/testsuite/algol68/compile/modules/program-error-multiple-delaration-module-1.a68 b/gcc/testsuite/algol68/compile/modules/program-error-multiple-delaration-module-1.a68 index 39ce7fe2b0ff..562ec4cbd2b8 100644 --- a/gcc/testsuite/algol68/compile/modules/program-error-multiple-delaration-module-1.a68 +++ b/gcc/testsuite/algol68/compile/modules/program-error-multiple-delaration-module-1.a68 @@ -1,7 +1,9 @@ { dg-modules "module10 module11 module12" } +{ Note how Module11 also exports the foo from Module10. } + access Module10, - Module11, + Module11, { dg-error "multiple declaration.*foo" } Module11 { dg-error "multiple declaration.*bar" } begin assert (foo = 10); assert (bar = 20) diff --git a/gcc/testsuite/algol68/execute/modules/module22bar.a68 b/gcc/testsuite/algol68/execute/modules/module22bar.a68 new file mode 100644 index 000000000000..7e56a03b02a4 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module22bar.a68 @@ -0,0 +1,7 @@ +module Module22Bar = access pub Module22Foo +def + puts ("bar prelude'n"); + pub int bar = foo + 10; + skip +fed + diff --git a/gcc/testsuite/algol68/execute/modules/module22foo.a68 b/gcc/testsuite/algol68/execute/modules/module22foo.a68 new file mode 100644 index 000000000000..e4727e40e93d --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module22foo.a68 @@ -0,0 +1,4 @@ +module Module22Foo = +def pub int foo = 10; + skip +fed diff --git a/gcc/testsuite/algol68/execute/modules/program-22.a68 b/gcc/testsuite/algol68/execute/modules/program-22.a68 new file mode 100644 index 000000000000..3523366d26fb --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-22.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module22foo module22bar" } + +access Module22Bar +begin assert (foo = 10); + assert (bar = 20) +end
