[COMMITTED] a68: support for publicized modules
Jose E. Marchesi
jose.marchesi@oracle.com
Sat Dec 27 23:55:46 GMT 2025
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 <jemarch@gnu.org>
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.
---
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 +-
...ram-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(-)
create mode 100644 gcc/testsuite/algol68/execute/modules/module22bar.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/module22foo.a68
create mode 100644 gcc/testsuite/algol68/execute/modules/program-22.a68
diff --git a/gcc/algol68/a68-exports.cc b/gcc/algol68/a68-exports.cc
index ff4561f54a7..469e945cb42 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 775d58c0715..ff117163e15 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 51ccc89986c..f02ae6db322 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 e5fde05e4fd..365cb66d59a 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 e49e0873b21..725a8fc44de 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 859f4148266..788e7230f92 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 9da676df703..def57235c08 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 39ce7fe2b0f..562ec4cbd2b 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 00000000000..7e56a03b02a
--- /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 00000000000..e4727e40e93
--- /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 00000000000..3523366d26f
--- /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
--
2.30.2
More information about the Algol68
mailing list