[PATCH v2] algol68: Fix assignment of union overhead values [PR algol68/124049]
Jose E. Marchesi
jemarch@gnu.org
Thu Feb 12 12:01:35 GMT 2026
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 <bohlj47@gmail.com>
>
> 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
More information about the Algol68
mailing list