Hello James.
I have committed the patch on your behalf with a small but important modification: - Copyright (C) 2009-2026 Free Software Foundation, Inc. + Copyright (C) 2026 James Bohl. Thanks, and welcome to GCC! :) > This patch sorts union packs in the a68-parser function so that > equivalent unions defined in different packets are assigned the same > mapping of mode to overhead value. > > Signed-off-by: James Bohl <[email protected]> > > gcc/algol68/ChangeLog > > PR algol68/124049 > * Make-lang.in (ALGOL68_OBJS): Add algol68/a68-moids-sorting.o. > * a68.h: Add prototype for a68_sort_union_packs. > * a68-moids-sorting.cc: New file. > * a68-parser-modes.cc (a68_make_moid_list): Call a68_sort_union_packs. > * ga68-exports.pk (ga68_mode_64): Add comment on union mode ordering. > > gcc/testsuite/ChangeLog > > PR algol68/124049 > * algol68/execute/modules/program-25.a68: New test. > * algol68/execute/modules/module25a.a68: New file. > * algol68/execute/modules/module25b.a68: New file. > --- > gcc/algol68/Make-lang.in | 1 + > gcc/algol68/a68-moids-sorting.cc | 187 ++++++++++++++++++ > gcc/algol68/a68-parser-modes.cc | 1 + > gcc/algol68/a68.h | 4 + > gcc/algol68/ga68-exports.pk | 77 ++++++++ > .../algol68/execute/modules/module25a.a68 | 10 + > .../algol68/execute/modules/module25b.a68 | 10 + > .../algol68/execute/modules/program-25.a68 | 9 + > 8 files changed, 299 insertions(+) > create mode 100644 gcc/algol68/a68-moids-sorting.cc > create mode 100644 gcc/testsuite/algol68/execute/modules/module25a.a68 > create mode 100644 gcc/testsuite/algol68/execute/modules/module25b.a68 > create mode 100644 gcc/testsuite/algol68/execute/modules/program-25.a68 > > diff --git a/gcc/algol68/Make-lang.in b/gcc/algol68/Make-lang.in > index 54b5381cb81..392818b6cb7 100644 > --- a/gcc/algol68/Make-lang.in > +++ b/gcc/algol68/Make-lang.in > @@ -61,6 +61,7 @@ ALGOL68_OBJS = algol68/a68-lang.o \ > algol68/a68-unistr.o \ > algol68/a68-moids-diagnostics.o \ > algol68/a68-moids-misc.o \ > + algol68/a68-moids-sorting.o \ > algol68/a68-moids-to-string.o \ > algol68/a68-postulates.o \ > algol68/a68-diagnostics.o \ > diff --git a/gcc/algol68/a68-moids-sorting.cc > b/gcc/algol68/a68-moids-sorting.cc > new file mode 100644 > index 00000000000..e5ae4e206b9 > --- /dev/null > +++ b/gcc/algol68/a68-moids-sorting.cc > @@ -0,0 +1,187 @@ > +/* MOID sorting routines. > + Copyright (C) 2009-2026 Free Software Foundation, Inc. > + > + This file is part of GCC. > + > + GCC is free software; you can redistribute it and/or modify it > + under the terms of the GNU General Public License as published by > + the Free Software Foundation; either version 3, or (at your option) > + any later version. > + > + GCC is distributed in the hope that it will be useful, but WITHOUT > + ANY WARRANTY; without even the implied warranty of MERCHANTABILITY > + or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public > + License for more details. > + > + You should have received a copy of the GNU General Public License > + along with GCC; see the file COPYING3. If not see > + <http://www.gnu.org/licenses/>. */ > + > +#include "config.h" > +#include "system.h" > +#include "coretypes.h" > + > +#include "a68.h" > + > +/* > + * Routines for ordering modes. > + */ > + > +/* Forward references. */ > + > +static int mode_ordering (MOID_T *a,MOID_T *b); > +static PACK_T * sort_union_pack (PACK_T *u); > + > +/* Returns a negative value if 'a' should be ordered after 'b'. > + Returns a positive value if 'a' should be ordered before 'b'. > + Returns zero if 'a' and 'b' are equivalent. */ > + > +static int > +packs_ordering (PACK_T *a, PACK_T *b, bool compare_names = true) > +{ > + for (; a != NO_PACK && b != NO_PACK; FORWARD (a), FORWARD (b)) > + { > + int order = mode_ordering (MOID (a), MOID (b)); > + if (order != 0) > + return order; > + if (compare_names) > + { > + if (TEXT (a) != TEXT (b)) > + { > + if (TEXT (a) == NO_TEXT) > + return 1; > + if (TEXT (b) == NO_TEXT) > + return -1; > + return -strcmp (TEXT (a), TEXT (b)); > + } > + } > + } > + return 0; > +} > + > +/* Returns a negative value if 'a' should be ordered after 'b'. > + Returns a positive value if 'a' should be ordered before 'b'. > + Returns zero if 'a' and 'b' are equivalent. */ > + > +static int > +mode_ordering (MOID_T *a, MOID_T *b) > +{ > + if (a == b) > + return 0; > + int r = ATTRIBUTE (a) - ATTRIBUTE (b); > + if (r != 0) > + return r; > + r = DIM (a) - DIM (b); > + if (r != 0) > + return r; > + if (IS (a, STANDARD)) > + return strcmp (NSYMBOL (NODE (a)), NSYMBOL (NODE (b))); > + else if (EQUIVALENT (a) == b || EQUIVALENT (b) == a) > + return 0; > + else if (a68_is_postulated_pair (A68 (top_postulate), a, b) > + || a68_is_postulated_pair (A68 (top_postulate), b, a)) > + return 0; > + else if (IS (a, INDICANT)) > + { > + if (NODE (a) == NO_NODE) > + return 1; > + if (NODE (b) == NO_NODE) > + return -1; > + if (NODE (a) == NODE (b)) > + return 0; > + return strcmp (NSYMBOL (NODE (a)), NSYMBOL (NODE (b))); > + } > + else if (IS (a, REF_SYMBOL)) > + return mode_ordering (SUB (a), SUB (b)); > + else if (IS (a, ROW_SYMBOL)) > + return mode_ordering (SUB (a), SUB (b)); > + else if (IS (a, FLEX_SYMBOL)) > + return mode_ordering (SUB (a), SUB (b)); > + else if (IS (a, STRUCT_SYMBOL)) > + { > + POSTULATE_T *save = A68 (top_postulate); > + a68_make_postulate (&A68 (top_postulate), a, b); > + r = packs_ordering (PACK (a), PACK (b)); > + a68_free_postulate_list (A68 (top_postulate), save); > + A68 (top_postulate) = save; > + return r; > + } > + else if (IS (a, UNION_SYMBOL)) > + { > + PACK (a) = sort_union_pack (PACK (a)); > + PACK (b) = sort_union_pack (PACK (b)); > + return packs_ordering (PACK (a), PACK (b), false); > + } > + else if (IS (a, PROC_SYMBOL)) > + { > + POSTULATE_T *save = A68 (top_postulate); > + a68_make_postulate (&A68 (top_postulate), a, b); > + r = mode_ordering (SUB (a), SUB (b)); > + if (r == 0) > + r = packs_ordering (PACK (a), PACK (b), false); > + a68_free_postulate_list (A68 (top_postulate), save); > + A68 (top_postulate) = save; > + return r; > + } > + else if (IS (a, SERIES_MODE) || IS (a, STOWED_MODE)) > + return packs_ordering (PACK (a), PACK (b), false); > + return 0; > +} > + > +/* Add a moid to a sorted pack, maybe with a (field) name. */ > + > +static void > +add_mode_to_pack_sorted (PACK_T **p, MOID_T *m, const char *text, NODE_T > *node) > +{ > + PACK_T *z = a68_new_pack (); > + > + MOID (z) = m; > + TEXT (z) = text; > + NODE (z) = node; > + > + PACK_T *next = (*p); > + PACK_T *previous = NO_PACK; > + while (next != NO_PACK) > + { > + int order = mode_ordering (m,MOID (next)); > + if (order > 0) > + break; > + previous = next; > + FORWARD (next); > + } > + NEXT (z) = next; > + PREVIOUS (z) = previous; > + > + if (previous == NO_PACK) > + *p = z; > + else > + NEXT (previous) = z; > + > + if (next != NO_PACK) > + PREVIOUS (next) = z; > +} > + > +/* Sort modes in a UNION pack. */ > + > +static PACK_T * > +sort_union_pack (PACK_T *u) > +{ > + PACK_T *z = NO_PACK; > + for (PACK_T *t = u; t != NO_PACK; FORWARD (t)) > + { > + (void) add_mode_to_pack_sorted (&z, MOID (t), NO_TEXT, NODE (t)); > + } > + return z; > +} > + > +/* Sort modes in UNION packs. */ > + > +void > +a68_sort_union_packs (MOID_T *m) > +{ > + for (; m != NO_MOID; FORWARD (m)) > + { > + if (IS (m, UNION_SYMBOL)) > + PACK (m) = sort_union_pack (PACK (m)); > + } > +} > diff --git a/gcc/algol68/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc > index 5842d1325f0..ed010ded774 100644 > --- a/gcc/algol68/a68-parser-modes.cc > +++ b/gcc/algol68/a68-parser-modes.cc > @@ -1349,4 +1349,5 @@ a68_make_moid_list (MODULE_T *mod) > > compute_derived_modes (mod); > a68_init_postulates (); > + a68_sort_union_packs(TOP_MOID (mod)); > } > diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h > index 2492aea6e2a..17c419a6881 100644 > --- a/gcc/algol68/a68.h > +++ b/gcc/algol68/a68.h > @@ -483,6 +483,10 @@ bool a68_is_c_mode (MOID_T *m, int level = 0); > > #define A68_IF_MODE_IS_WELL(n) (! ((n) == M_ERROR || (n) == M_UNDEFINED)) > > +/* a68-moids-sorting.cc */ > + > +void a68_sort_union_packs (MOID_T* m); > + > /* a68-parser-scope.cc */ > > void a68_scope_checker (NODE_T *p); > diff --git a/gcc/algol68/ga68-exports.pk b/gcc/algol68/ga68-exports.pk > index 233c6987def..aeb527326d8 100644 > --- a/gcc/algol68/ga68-exports.pk > +++ b/gcc/algol68/ga68-exports.pk > @@ -175,6 +175,83 @@ type ga68_mode_64 = > field[nfields] fields; > } sct : kind == GA68_MODE_STRUCT; > > + /* When assigning overhead values to union modes, the list of > + united modes is ordered so that overhead values are assigned > + consistently across compilation units. Overhead values are > + assigned to the modes in the ordered list in ascending order > + starting from zero. > + > + Modes are ordered in the following order: > + > + UNION > + STRUCT > + STANDARD > + ROWS > + REF > + PROC > + FLEX > + > + A STANDARD mode is one of the following: (VOID, STRING, REAL, > + INT, COMPL, CHAR, BYTES, BOOL, BITS) > + > + When two modes occupy the same row in the list above, the > + ordering is determined as follows: > + > + UNION: > + > + The union with greater number of united modes is ordered > + first. Unions having an equal number of united modes are > + ordered based on the ordering of their first non-equivalent > + mode. > + > + STRUCT: > + > + The struct with the largest number of fields is ordered first. > + Structs having an equal number of fields are ordered based > + on the first field that has non-equivalent modes or > + non-matching field selectors. If the modes are not equivalent, > + the structs are ordered in the ordering of those modes. > + Otherwise, the struct are ordered in the lexicographical > + order of the field selectors. > + > + STANDARD: > + > + The mode with the greatest size of longsety and smaller size > + of shortsety is ordered first. If the size of shortsety and > + longsety are equal, the modes are ordered as follows: > + > + VOID > + STRING > + REAL > + INT > + COMPL > + CHAR > + BYTES > + BOOL > + BITS > + > + ROWS: > + > + The mode with greater number of dimensions is ordered first. > + Otherwise, the ordering of the modes of the elements is used. > + > + REF: > + > + The ordering is the ordering of the referred mode. > + > + PROC: > + > + The ordering is the ordering of the mode of the value yielded > + by the procedure. If the procedure yields values of the the > + same mode, the procedure with greater number of arguments is > + ordered first. If the number of arguments is equal, the > + ordering is the ordering of the modes of the first arguments > + having non-equivalent modes. > + > + FLEX: > + > + The ordering is the ordering of the referred mode. */ > + > struct > { > uint<8> nmodes; > diff --git a/gcc/testsuite/algol68/execute/modules/module25a.a68 > b/gcc/testsuite/algol68/execute/modules/module25a.a68 > new file mode 100644 > index 00000000000..95950ba1c1c > --- /dev/null > +++ b/gcc/testsuite/algol68/execute/modules/module25a.a68 > @@ -0,0 +1,10 @@ > +module Module_25a = > +def > + pub mode Union_a = union (int,real); > + pub proc union_a_string = (Union_a x) string: > + case x > + in (int): "int", > + (real): "real" > + esac; > + skip > +fed > diff --git a/gcc/testsuite/algol68/execute/modules/module25b.a68 > b/gcc/testsuite/algol68/execute/modules/module25b.a68 > new file mode 100644 > index 00000000000..9a05b2ae0dc > --- /dev/null > +++ b/gcc/testsuite/algol68/execute/modules/module25b.a68 > @@ -0,0 +1,10 @@ > +module Module_25b = > +def > + pub mode Union_b = union (real,int); > + pub proc union_b_string = (Union_b x) string: > + case x > + in (int): "int", > + (real): "real" > + esac; > + skip > +fed > diff --git a/gcc/testsuite/algol68/execute/modules/program-25.a68 > b/gcc/testsuite/algol68/execute/modules/program-25.a68 > new file mode 100644 > index 00000000000..4a62a6fbcb1 > --- /dev/null > +++ b/gcc/testsuite/algol68/execute/modules/program-25.a68 > @@ -0,0 +1,9 @@ > +{ dg-modules "module25a module25b" } > +access Module_25a,Module_25b begin > + Union_a a = 1; > + Union_b b = 1; > + assert(union_a_string(a) = "int"); > + assert(union_a_string(b) = "int"); > + assert(union_b_string(a) = "int"); > + assert(union_b_string(b) = "int") > +end
