[COMMITTED] a68: deduplicate modes imported from definition modules

Jose E. Marchesi jemarch@gnu.org
Wed Nov 19 23:24:07 GMT 2025


---
 gcc/algol68/a68-imports.cc                    | 70 +++++++++++++++++--
 gcc/algol68/a68-parser-extract.cc             | 31 ++++----
 gcc/algol68/a68-parser-modes.cc               | 17 ++++-
 gcc/algol68/a68.h                             |  1 +
 .../algol68/execute/modules/module13.a68      |  5 ++
 .../algol68/execute/modules/module14.a68      |  5 ++
 .../algol68/execute/modules/module15.a68      |  8 +++
 .../algol68/execute/modules/program-15.a68    |  3 +
 8 files changed, 116 insertions(+), 24 deletions(-)
 create mode 100644 gcc/testsuite/algol68/execute/modules/module13.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/module14.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/module15.a68
 create mode 100644 gcc/testsuite/algol68/execute/modules/program-15.a68

diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc
index c8b945c4956..8e6e297f6e0 100644
--- a/gcc/algol68/a68-imports.cc
+++ b/gcc/algol68/a68-imports.cc
@@ -41,8 +41,6 @@
 #include "dwarf2asm.h"
 
 #include <string>
-#include <vector> /* XXX use GCC vec instead.  */
-#include <algorithm>
 
 #include "a68.h"
 
@@ -619,17 +617,27 @@ complete_encoded_mode (encoded_modes_map_t &encoded_modes, uint64_t offset)
 	}
       break;
     case GA68_MODE_NAME:
+      /* For recursive declarations.  */
+      em->moid = a68_create_mode (REF_SYMBOL, 0, NO_NODE, M_ERROR, NO_PACK);
       sub = complete_encoded_mode (encoded_modes, em->data.name.sub_offset);
       if (sub == NO_MOID)
-	return  NO_MOID;
-      em->moid = a68_create_mode (REF_SYMBOL, 0, NO_NODE, sub, NO_PACK);
+	{
+	  /* Free em->moid */
+	  return NO_MOID;
+	}
+      SUB (em->moid) = sub;
       break;
     case GA68_MODE_ROW:
       /* XXX how to convey actual bounds.  */
+      /* For recursive declarations.  */
+      em->moid = a68_create_mode (ROW_SYMBOL, 0, NO_NODE, M_ERROR, NO_PACK);
       sub = complete_encoded_mode (encoded_modes, em->data.row.sub_offset);
       if (sub == NO_MOID)
-	return  NO_MOID;
-      em->moid = a68_create_mode (ROW_SYMBOL, em->data.row.ndims, NO_NODE, sub, NO_PACK);
+	{
+	  /* Free em->moid */
+	  return  NO_MOID;
+	}
+      SUB (em->moid) = sub;
       if (em->data.row.flex)
 	{
 	  // XXX we need to add the referred em->moid somewhere.
@@ -783,6 +791,36 @@ dump_encoded_mode (struct encoded_mode *em)
     }
 }
 
+/* Substitute any reference to mode M in T to R.  */
+
+static void
+a68_replace_submode (MOID_T *t, MOID_T *m, MOID_T *r)
+{
+  if (SUB (t) == m)
+    SUB (t) = r;
+
+  for (PACK_T *p = PACK (t); p != NO_PACK; FORWARD (p))
+    {
+      if (MOID (p) == m)
+	MOID (p) = r;
+    }
+}
+
+/* Substitute mode M with mode R in all modes in MODES_LIST.
+   The entry for M in MODES_LIST is set to NO_MOID.  */
+
+static void
+a68_replace_equivalent_mode (vec<MOID_T*> mode_list, MOID_T *m, MOID_T *r)
+{
+  for (size_t i = 0; i < mode_list.length (); ++i)
+    {
+      if (mode_list[i] == m)
+	mode_list[i] = NO_MOID;
+      else if (mode_list[i] != NO_MOID)
+	a68_replace_submode (mode_list[i], m, r);
+    }
+}
+
 /* Decode a modes table at DATA + POS.  */
 
 static bool
@@ -937,6 +975,26 @@ a68_decode_modes (MOIF_T *moif, encoded_modes_map_t &encoded_modes,
       MODES (moif).safe_push (em->moid);
     }
 
+  /* Next step is to see if equivalent modes the any of the modes in the moif
+      DIM already exist in the compiler's mode list.  In that case, replace the
+      DIM moif's mode with the existing mode anywhere in the moif.  */
+  for (MOID_T *m : MODES (moif))
+    {
+      MOID_T *r = a68_search_equivalent_mode (m);
+      if (r != NO_MOID)
+	{
+	  a68_replace_equivalent_mode (MODES (moif), m, r);
+
+	  /* Update encoded_modes to reflect the replacement.  */
+	  for (auto entry : encoded_modes)
+	    {
+	      struct encoded_mode *em = entry.second;
+	      if (em->moid == m)
+		em->moid = r;
+	    }
+	}
+    }
+
   *errstr = NULL;
   *ppos = pos;
   return true;
diff --git a/gcc/algol68/a68-parser-extract.cc b/gcc/algol68/a68-parser-extract.cc
index ae26f0fda31..8d0265fd7ed 100644
--- a/gcc/algol68/a68-parser-extract.cc
+++ b/gcc/algol68/a68-parser-extract.cc
@@ -203,27 +203,23 @@ extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED)
     }
   MOIF (tag) = moif; // XXX add to existing list of moifs.
 
-  /* Store all the modes from the MOIF in the moid list.  */
+  /* Store all the modes from the MOIF in the moid list.
+
+     The front-end depends on being able to compare any two modes by pointer
+     value.  For example, the parser mode equivalence and coercion code relies
+     on this.  The lowerer also relies on this to make sure the same lowered
+     trees are used for the same modes.  */
+
   for (MOID_T *m : MODES (moif))
     {
-      MOID_T *r = a68_register_extra_mode (&TOP_MOID (&A68_JOB), m);
-      if (r != m)
+      /* Note that m == NO_MOID if the imported mode was already known to the
+	 compiler and has been replaced.  */
+      if (m != NO_MOID)
 	{
-	  /* The mode has been replaced by an equivalence.
-	     Install the replacement mode in all pertinent
-	     extract. */
-	  // XXX free original modes.
-	  for (EXTRACT_T *e : INDICANTS (moif))
-	    if (EXTRACT_MODE (e) == m)
-	      EXTRACT_MODE (e) = r;
-	  for (EXTRACT_T *e : IDENTIFIERS (moif))
-	    if (EXTRACT_MODE (e) == m)
-	      EXTRACT_MODE (e) = r;
-	  for (EXTRACT_T *e : OPERATORS (moif))
-	    if (EXTRACT_MODE (e) == m)
-	      EXTRACT_MODE (e) = r;
+	  MOID_T *r = a68_register_extra_mode (&TOP_MOID (&A68_JOB), m);
+	  if (r != m)
+	    gcc_unreachable ();
 	}
-      gcc_assert (r != NO_MOID);
     }
 
   /* Store mode indicants from the MOIF in the symbol table,
@@ -296,6 +292,7 @@ extract_revelation (NODE_T *q, bool is_public ATTRIBUTE_UNUSED)
       LINE (INFO (n)) = LINE (INFO (q));
       NCHAR_IN_LINE (n) = STRING (LINE (INFO (n)));
       TABLE (n) = TABLE (q);
+
       TAG_T *tag = a68_add_tag (TABLE (q), IDENTIFIER,
 				n, EXTRACT_MODE (e), NORMAL_IDENTIFIER);
       gcc_assert (tag != NO_TAG);
diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc
index e756f3fabf6..4a0128667ca 100644
--- a/gcc/algol68/a68-parser-modes.cc
+++ b/gcc/algol68/a68-parser-modes.cc
@@ -121,6 +121,21 @@ a68_renumber_moids (MOID_T *p, int n)
     }
 }
 
+/* See whether a mode equivalent to the mode M exists in the global mode table,
+   and return it.  Return NO_MOID if no equivalent mode is found.  */
+
+MOID_T *
+a68_search_equivalent_mode (MOID_T *m)
+{
+  for (MOID_T *head = TOP_MOID (&A68_JOB); head != NO_MOID; FORWARD (head))
+    {
+      if (a68_prove_moid_equivalence (head, m))
+	return head;
+    }
+
+  return NO_MOID;
+}
+
 /* Register mode in the global mode table, if mode is unique.  */
 
 MOID_T *
@@ -132,7 +147,7 @@ a68_register_extra_mode (MOID_T **z, MOID_T *u)
     {
       if (a68_prove_moid_equivalence (head, u))
 	return head;
-  }
+    }
 
   /* Link to chain and exit.  */
   NUMBER (u) = A68 (mode_count)++;
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index dd62a26de49..861ae41d1ec 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -424,6 +424,7 @@ void a68_victal_checker (NODE_T *p);
 int a68_count_pack_members (PACK_T *u);
 MOID_T *a68_register_extra_mode (MOID_T **z, MOID_T *u);
 MOID_T *a68_create_mode (int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack);
+MOID_T *a68_search_equivalent_mode (MOID_T *m);
 MOID_T *a68_add_mode (MOID_T **z, int att, int dim, NODE_T *node, MOID_T *sub, PACK_T *pack);
 void a68_contract_union (MOID_T *u);
 PACK_T *a68_absorb_union_pack (PACK_T * u);
diff --git a/gcc/testsuite/algol68/execute/modules/module13.a68 b/gcc/testsuite/algol68/execute/modules/module13.a68
new file mode 100644
index 00000000000..9d66fe15065
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module13.a68
@@ -0,0 +1,5 @@
+module Module_13 =
+def
+    pub mode JSON_Val = struct (int i);
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/module14.a68 b/gcc/testsuite/algol68/execute/modules/module14.a68
new file mode 100644
index 00000000000..bcb9d2cacd6
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module14.a68
@@ -0,0 +1,5 @@
+module Module14 =
+access Module13
+def pub proc getval = JSON_Val: skip;
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/module15.a68 b/gcc/testsuite/algol68/execute/modules/module15.a68
new file mode 100644
index 00000000000..5e4208433ec
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/module15.a68
@@ -0,0 +1,8 @@
+module Module15 =
+access Module13, Module14
+def pub proc foo = int:
+        begin JSON_Val val = getval;
+              i of val
+        end;
+    skip
+fed
diff --git a/gcc/testsuite/algol68/execute/modules/program-15.a68 b/gcc/testsuite/algol68/execute/modules/program-15.a68
new file mode 100644
index 00000000000..7b6abafdbaa
--- /dev/null
+++ b/gcc/testsuite/algol68/execute/modules/program-15.a68
@@ -0,0 +1,3 @@
+{ dg-modules "module13 module14 module15" }
+
+access Module15 (assert (foo = 0))
-- 
2.30.2



More information about the Algol68 mailing list