Hello James. Thanks for the patch.
This seems to be your first contribution to GCC (apologies if not). In that case, please note you can contribute non-trivial changes by either assigning the copyright of the contributions to the FSf, or by using DCO (Developer Certificate of Origin). Please see https://gcc.gnu.org/dco.html. Seems like you want to use DCO as you included a Signed-off-by, but just in case :) > 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. Yeah I was afraid it was just a matter of time we would need to have a total order of modes. Thanks for forwing on this! Please see some comments below. > Signed-off-by: James Bohl <[email protected]> > > gcc/algol68/ChangeLog > > PR algol68/124049 > * a68.h: Prototype for a68_sort_union_packs. > * a68-parser-modes.cc (packs_ordering): New function. > (mode_ordering): Likewise. > (add_mode_to_pack_sorted): Likewise. > (sort_union_pack): Likewise. > (a68_sort_union_packs): Likewise. > * a68-parser.cc (a68_parser): Call a68_sort_union_packs. I wonder whether it wouldn't be better to put the mode ordering (a68_sort_union_packs and auxiliary functions) in its own source file, like a68-moids-sorting.cc. > 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/a68-parser-modes.cc | 156 ++++++++++++++++++ > gcc/algol68/a68-parser.cc | 7 + > gcc/algol68/a68.h | 1 + > .../algol68/execute/modules/module25a.a68 | 10 ++ > .../algol68/execute/modules/module25b.a68 | 10 ++ > .../algol68/execute/modules/program-25.a68 | 9 + > 6 files changed, 193 insertions(+) > 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/a68-parser-modes.cc b/gcc/algol68/a68-parser-modes.cc > index 5842d1325f0..09b88ad15c9 100644 > --- a/gcc/algol68/a68-parser-modes.cc > +++ b/gcc/algol68/a68-parser-modes.cc > @@ -32,6 +32,8 @@ > /* Few forward references. */ > > static MOID_T *get_mode_from_declarer (NODE_T *p); > +static int mode_ordering (MOID_T *a,MOID_T *b); > +static PACK_T * sort_union_pack (PACK_T *u); > > /* > * Mode service routines. > @@ -198,6 +200,160 @@ a68_add_mode (MOID_T **z, int att, int dim, NODE_T > *node, MOID_T *sub, PACK_T *p > return a68_register_extra_mode (z, new_mode); > } > > +/* 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; > +} The ordering implemented in mode_ordering and packs_ordering looks good. But since the ordering is now part of the exports ABI, we will need it documented in a comment in ga68-exports.pk. Since you are ordering by attribute number and these are basically arbitrary (the fact we are ordering attributes alphabetically in a68-parser-attrs.def should not be relevant IMO) this requires an explicit table. > +/* 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)); > + } > +} > + > /* Contract a UNION. */ > > void > diff --git a/gcc/algol68/a68-parser.cc b/gcc/algol68/a68-parser.cc > index 885b5f524d9..4070d3fa323 100644 > --- a/gcc/algol68/a68-parser.cc > +++ b/gcc/algol68/a68-parser.cc > @@ -599,6 +599,13 @@ a68_parser (const char *filename) > a68_serial_dsa (TOP_NODE (&A68_JOB)); > } > > + /* Sort union packs so overhead values are assigned in the same order for > + equivalent unions in different packets. */ > + if (ERROR_COUNT (&A68_JOB) == 0) > + { > + a68_sort_union_packs (TOP_MOID (&A68_JOB)); > + } > + What about having this done as part of a68_make_moid_list? After a68_init_postulates. > /* Finalise syntax tree. */ > if (ERROR_COUNT (&A68_JOB) == 0) > { > diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h > index 2492aea6e2a..565d1a4c72f 100644 > --- a/gcc/algol68/a68.h > +++ b/gcc/algol68/a68.h > @@ -410,6 +410,7 @@ PACK_T *a68_absorb_union_pack (PACK_T * u); > void a68_add_mode_to_pack (PACK_T **p, MOID_T *m, const char *text, NODE_T > *node); > void a68_add_mode_to_pack_end (PACK_T **p, MOID_T *m, const char *text, > NODE_T *node); > void a68_make_moid_list (MODULE_T *mod); > +void a68_sort_union_packs (MOID_T* m); > > void a68_renumber_moids (MOID_T *p, int n); > > 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
