--- /dev/null
+/* Exporting Algol 68 module interfaces.
+ Copyright (C) 2025 Jose E. Marchesi.
+ Copyright (C) 2010-2025 Free Software Foundation, Inc.
+
+ Written by Jose E. Marchesi.
+
+ 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/>. */
+
+#define INCLUDE_MEMORY
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "tree.h"
+#include "target.h"
+#include "tm_p.h"
+#include "simple-object.h"
+#include "varasm.h"
+#include "intl.h"
+#include "output.h" /* for assemble_string */
+#include "common/common-target.h"
+#include "dwarf2asm.h"
+
+#include <algorithm>
+
+#include "a68.h"
+
+#ifndef TARGET_AIX_OS
+#define TARGET_AIX_OS 0
+#endif
+
+/* The size of the target's pointer type. */
+#ifndef PTR_SIZE
+#define PTR_SIZE (POINTER_SIZE / BITS_PER_UNIT)
+#endif
+
+/* Create a new module interface, initially with no modes and no
+ extracts. MODULE_NAME is the name of the module as it is accessed at the
+ source level, which corresponds to a bold word. */
+
+MOIF_T *
+a68_moif_new (const char *module_name)
+{
+ MOIF_T *moif = ggc_cleared_alloc<MOIF_T> ();
+
+ VERSION (moif) = GA68_EXPORTS_VERSION;
+ NAME (moif) = (module_name == NULL ? NULL : ggc_strdup (module_name));
+ PRELUDE (moif) = NULL;
+ POSTLUDE (moif) = NULL;
+ vec_alloc (MODES (moif), 16);
+ vec_alloc (MODULES (moif), 16);
+ vec_alloc (IDENTIFIERS (moif), 16);
+ vec_alloc (INDICANTS (moif), 16);
+ vec_alloc (PRIOS (moif), 16);
+ vec_alloc (OPERATORS (moif), 16);
+ return moif;
+}
+
+/* Add a new mode to a module interface. */
+
+static void
+a68_add_moid_to_moif (MOIF_T *moif, MOID_T *m)
+{
+ if (! MODES(moif)->contains (m))
+ vec_safe_push (MODES (moif), m);
+}
+
+/* Add a new identifier extract to a module interface. */
+
+void
+a68_add_identifier_to_moif (MOIF_T *moif, TAG_T *tag)
+{
+ EXTRACT_T *e = ggc_alloc<EXTRACT_T> ();
+ const char *tag_symbol = IDENTIFIER_POINTER (DECL_NAME (TAX_TREE_DECL (tag)));
+
+ EXTRACT_KIND (e) = GA68_EXTRACT_IDEN;
+ EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
+ EXTRACT_MODE (e) = MOID (tag);
+ EXTRACT_PRIO (e) = 0;
+ EXTRACT_VARIABLE (e) = VARIABLE (tag);
+ EXTRACT_IN_PROC (e) = IN_PROC (tag);
+
+ if (! IDENTIFIERS (moif)->contains (e))
+ {
+ a68_add_moid_to_moif (moif, MOID (tag));
+ vec_safe_push (IDENTIFIERS (moif), e);
+ }
+}
+
+/* Add a new mode indicant extract to a module interface. */
+
+static void
+a68_add_indicant_to_moif (MOIF_T *moif, TAG_T *tag)
+{
+ EXTRACT_T *e = ggc_alloc<EXTRACT_T> ();
+ /* Mode 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);
+
+ EXTRACT_KIND (e) = GA68_EXTRACT_MODE;
+ EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
+ EXTRACT_MODE (e) = MOID (tag);
+ EXTRACT_PRIO (e) = 0;
+ EXTRACT_VARIABLE (e) = false;
+ EXTRACT_IN_PROC (e) = false;
+
+ if (! INDICANTS (moif)->contains (e))
+ {
+ a68_add_moid_to_moif (moif, MOID (tag));
+ vec_safe_push (INDICANTS (moif), e);
+ }
+}
+
+/* Add a new module extract to a module interface. */
+
+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);
+
+ EXTRACT_KIND (e) = GA68_EXTRACT_MODU;
+ EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
+ EXTRACT_MODE (e) = NO_MOID;
+ EXTRACT_PRIO (e) = 0;
+ EXTRACT_VARIABLE (e) = false;
+ EXTRACT_IN_PROC (e) = false;
+
+ if (! MODULES (moif)->contains (e))
+ vec_safe_push (MODULES (moif), e);
+}
+
+/* Add a new priority extract to a module interface. */
+
+static void
+a68_add_prio_to_moif (MOIF_T *moif, TAG_T *tag)
+{
+ EXTRACT_T *e = ggc_alloc<EXTRACT_T> ();
+ /* Priority 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);
+
+ EXTRACT_KIND (e) = GA68_EXTRACT_PRIO;
+ EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
+ EXTRACT_MODE (e) = NO_MOID;
+ EXTRACT_PRIO (e) = PRIO (tag);
+ EXTRACT_VARIABLE (e) = false;
+ EXTRACT_IN_PROC (e) = false;
+
+ if (! PRIOS (moif)->contains (e))
+ vec_safe_push (PRIOS (moif), e);
+}
+
+/* Add a new operator extract to a module interface. */
+
+static void
+a68_add_operator_to_moif (MOIF_T *moif, TAG_T *tag)
+{
+ EXTRACT_T *e = ggc_alloc<EXTRACT_T> ();
+ const char *tag_symbol = IDENTIFIER_POINTER (DECL_NAME (TAX_TREE_DECL (tag)));
+
+ EXTRACT_KIND (e) = GA68_EXTRACT_OPER;
+ EXTRACT_SYMBOL (e) = ggc_strdup (tag_symbol);
+ EXTRACT_MODE (e) = MOID (tag);
+ EXTRACT_PRIO (e) = 0;
+ EXTRACT_VARIABLE (e) = EXTRACT_VARIABLE (tag);
+ /* There are no operatorvariable-declarations */
+ gcc_assert (EXTRACT_VARIABLE (e) == false);
+ EXTRACT_IN_PROC (e) = IN_PROC (tag);
+
+ if (! OPERATORS (moif)->contains (e))
+ {
+ a68_add_moid_to_moif (moif, MOID (tag));
+ vec_safe_push (OPERATORS (moif), e);
+ }
+}
+
+/* Make the exports section the asm_out_file's new current section. */
+
+static void
+a68_switch_to_export_section (void)
+{
+ static section *exports_sec;
+
+ if (exports_sec == NULL)
+ {
+ gcc_assert (targetm_common.have_named_sections);
+#ifdef OBJECT_FORMAT_MACHO
+ exports_sec
+ = get_section (A68_EXPORT_SEGMENT_NAME "," A68_EXPORT_SECTION_NAME,
+ SECTION_DEBUG, NULL);
+#else
+ exports_sec = get_section (A68_EXPORT_SECTION_NAME,
+ TARGET_AIX_OS ? SECTION_EXCLUDE : SECTION_DEBUG,
+ NULL);
+#endif
+ }
+
+ switch_to_section (exports_sec);
+}
+
+/* Output a sized string. */
+
+static void
+a68_asm_output_string (const char *s, const char *comment)
+{
+ dw2_asm_output_data (2, strlen (s) + 1, comment);
+ assemble_string (s, strlen (s) + 1);
+}
+
+/* Output a mode to the exports section if it hasn't been emitted already. */
+
+static void
+a68_asm_output_mode (MOID_T *m, const char *module_label)
+{
+ /* Do nothing if the mode has been already emitted and therefore there is
+ already a label to access it. */
+ if (ASM_LABEL (m) != NULL)
+ return;
+
+ /* Mode indicants are not emitted in the mode table, but as mode extracts in
+ the extracts table. Still we have to emit the named mode. */
+ if (IS (m, INDICANT))
+ m = MOID (NODE (m));
+
+ /* Collection of modes. */
+ if (IS (m, SERIES_MODE) || IS (m, STOWED_MODE))
+ {
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ a68_asm_output_mode (MOID (p), module_label);
+ return;
+ }
+
+ /* Ok we got a mode to output. */
+
+ /* First emit referred modes and sub-modes. Note how we have to create a
+ label for the mode and install it in the NODE_T in order to avoid infinite
+ recursion in case of ref-induced recursive mode definitions. */
+
+ static long int cnt;
+ static char label[100];
+ ASM_GENERATE_INTERNAL_LABEL (label, "LM", cnt++);
+ ASM_LABEL (m) = ggc_strdup (label);
+
+ if (IS_REF(m) || IS_FLEX (m))
+ a68_asm_output_mode (SUB (m), module_label);
+ else if (m != M_STRING && IS_FLEXETY_ROW (m))
+ a68_asm_output_mode (SUB (m), module_label);
+ else if (!IS_COMPLEX (m) && (IS_STRUCT (m) || IS_UNION (m)))
+ {
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ a68_asm_output_mode (MOID (p), module_label);
+ }
+ else if (IS (m, PROC_SYMBOL))
+ {
+ a68_asm_output_mode (SUB (m), module_label);
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ a68_asm_output_mode (MOID (p), module_label);
+ }
+
+ /* No recursion below this point pls. */
+
+ /* Emit a label for this mode. */
+ ASM_OUTPUT_LABEL (asm_out_file, ASM_LABEL (m));
+
+ /* Now emit assembly for the mode entry. */
+ if (m == M_VOID)
+ dw2_asm_output_data (1, GA68_MODE_VOID, "void");
+ else if (m == M_CHAR)
+ dw2_asm_output_data (1, GA68_MODE_CHAR, "char");
+ else if (m == M_BOOL)
+ dw2_asm_output_data (1, GA68_MODE_BOOL, "bool");
+ else if (m == M_STRING)
+ dw2_asm_output_data (1, GA68_MODE_STRING, "string");
+ else if (IS_INTEGRAL (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_INT, "int");
+ dw2_asm_output_data (1, DIM (m), "sizety");
+ }
+ else if (IS_REAL (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_REAL, "real");
+ dw2_asm_output_data (1, DIM (m), "sizety");
+ }
+ else if (IS_BITS (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_BITS, "bits");
+ dw2_asm_output_data (1, DIM (m), "sizety");
+ }
+ else if (IS_BYTES (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_BYTES, "bytes");
+ dw2_asm_output_data (1, DIM (m), "sizety");
+ }
+ else if (IS_COMPLEX (m))
+ {
+ /* Complex is a struct of two reals of the right sizety. */
+ int dim = DIM (MOID (PACK (m)));
+ dw2_asm_output_data (1, GA68_MODE_CMPL, "compl");
+ dw2_asm_output_data (1, dim, "sizety");
+ }
+ else if (IS_REF (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_NAME, "ref");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "referred mode");
+ }
+ else if (IS_FLEX (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_FLEX, "flex");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "flexible row mode");
+ }
+ else if (IS_ROW (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_ROW, "row");
+ dw2_asm_output_data (1, DIM (m), "dim");
+ /* XXX for now emit zeroes as triplets. */
+ for (int i = 0; i < DIM (m); ++i)
+ {
+ dw2_asm_output_data (PTR_SIZE, 0, "lb");
+ dw2_asm_output_data (PTR_SIZE, 0, "ub");
+ }
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "row of");
+ }
+ else if (IS_STRUCT (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_STRUCT, "struct");
+ dw2_asm_output_data (2, DIM (m), "nfields");
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ {
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "field mode");
+ if (TEXT (p) != NO_TEXT)
+ a68_asm_output_string (TEXT (p), "field name");
+ else
+ a68_asm_output_string ("", "field name");
+ }
+ }
+ else if (IS_UNION (m))
+ {
+ dw2_asm_output_data (1, GA68_MODE_UNION, "union");
+ dw2_asm_output_data (2, DIM (m), "nmodes");
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "united mode");
+ }
+ else if (IS (m, PROC_SYMBOL))
+ {
+ dw2_asm_output_data (1, GA68_MODE_PROC, "proc");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (SUB (m)), module_label, "ret mode");
+ dw2_asm_output_data (1, DIM (m), "nargs");
+ for (PACK_T *p = PACK (m); p != NO_PACK; FORWARD (p))
+ {
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (MOID (p)), module_label, "arg mode");
+ if (TEXT (p) != NO_TEXT)
+ a68_asm_output_string (TEXT (p), "arg name");
+ else
+ a68_asm_output_string ("", "arg name");
+ }
+ }
+ else
+ dw2_asm_output_data (1, GA68_MODE_UNKNOWN, "unknown mode %s",
+ a68_moid_to_string (m, 80, NO_NODE, false));
+}
+
+/* Output an extract for a given tag to the extracts section. */
+
+static void
+a68_asm_output_extract (const char *module_label, int kind,
+ const char *symbol, MOID_T *mode, int prio,
+ bool variable, bool in_proc)
+{
+ static char begin_label[100];
+ static char end_label[100];
+ static long int cnt;
+
+ ASM_GENERATE_INTERNAL_LABEL (begin_label, "LEBL", cnt);
+ ASM_GENERATE_INTERNAL_LABEL (end_label, "LEEL", cnt);
+ cnt++;
+
+ dw2_asm_output_delta (PTR_SIZE, end_label, begin_label, "extract size");
+ ASM_OUTPUT_LABEL (asm_out_file, begin_label);
+
+ bool encode_mdextra = false;
+ switch (kind)
+ {
+ case GA68_EXTRACT_MODU:
+ dw2_asm_output_data (1, GA68_EXTRACT_MODU, "module extract %s", symbol);
+ a68_asm_output_string (symbol, "module indication");
+ break;
+ case GA68_EXTRACT_MODE:
+ dw2_asm_output_data (1, GA68_EXTRACT_MODE, "mode extract %s", symbol);
+ a68_asm_output_string (symbol, "mode indication");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode");
+ break;
+ case GA68_EXTRACT_IDEN:
+ dw2_asm_output_data (1, GA68_EXTRACT_IDEN, "identifier extract %s", symbol);
+ a68_asm_output_string (symbol, "name");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode");
+ encode_mdextra = true;
+ break;
+ case GA68_EXTRACT_PRIO:
+ dw2_asm_output_data (1, GA68_EXTRACT_PRIO, "prio extract %s", symbol);
+ a68_asm_output_string (symbol, "opname");
+ dw2_asm_output_data (1, prio, "priority");
+ break;
+ case GA68_EXTRACT_OPER:
+ dw2_asm_output_data (1, GA68_EXTRACT_OPER, "operator extract %s", symbol);
+ a68_asm_output_string (symbol, "opname");
+ dw2_asm_output_delta (PTR_SIZE, ASM_LABEL (mode), module_label, "mode");
+ encode_mdextra = true;
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (encode_mdextra)
+ {
+ dw2_asm_output_data (PTR_SIZE, 2, "mdextra size");
+ dw2_asm_output_data (1, variable, "variable");
+ dw2_asm_output_data (1, in_proc, "in_proc");
+ }
+ else
+ dw2_asm_output_data (PTR_SIZE, 0, "mdextra size");
+
+ ASM_OUTPUT_LABEL (asm_out_file, end_label);
+}
+
+/* Output a module interface. */
+
+static void
+a68_asm_output_moif (MOIF_T *moif)
+{
+ a68_switch_to_export_section ();
+
+ static char module_label[100];
+ static long int moifcnt;
+ ASM_GENERATE_INTERNAL_LABEL (module_label, "LMOIF", moifcnt++);
+ ASM_OUTPUT_LABEL (asm_out_file, module_label);
+
+ if (flag_debug_asm)
+ {
+ fputs (ASM_COMMENT_START " MODIF START ", asm_out_file);
+ fputs (NAME (moif), asm_out_file);
+ fputc ('\n', asm_out_file);
+ }
+
+ dw2_asm_output_data (1, A68_EXPORT_MAGIC1, "magic1");
+ dw2_asm_output_data (1, A68_EXPORT_MAGIC2, "magic2");
+ dw2_asm_output_data (2, VERSION (moif), "exports version");
+ a68_asm_output_string (NAME (moif), "module name");
+ a68_asm_output_string (PRELUDE (moif) ? PRELUDE (moif) : "", "prelude symbol");
+ a68_asm_output_string (POSTLUDE (moif) ? POSTLUDE (moif) : "", "postlude symbol");
+
+ /* Modes table. */
+ static char modes_begin_label[100];
+ static char modes_end_label[100];
+ static long int modescnt;
+ ASM_GENERATE_INTERNAL_LABEL (modes_begin_label, "LMTL", modescnt++);
+ ASM_GENERATE_INTERNAL_LABEL (modes_end_label, "LMTL", modescnt++);
+
+ if (flag_debug_asm)
+ fputs ("\t" ASM_COMMENT_START " modes table\n", asm_out_file);
+ dw2_asm_output_delta (PTR_SIZE, modes_end_label, modes_begin_label,
+ "modes size");
+ ASM_OUTPUT_LABEL (asm_out_file, modes_begin_label);
+ for (MOID_T *m : MODES (moif))
+ a68_asm_output_mode (m, module_label);
+ ASM_OUTPUT_LABEL (asm_out_file, modes_end_label);
+
+ /* Extracts table. */
+ static char extracts_begin_label[100];
+ static char extracts_end_label[100];
+ static long int extractscnt;
+ ASM_GENERATE_INTERNAL_LABEL (extracts_begin_label, "LETL", extractscnt++);
+ ASM_GENERATE_INTERNAL_LABEL (extracts_end_label, "LETL", extractscnt++);
+
+ if (flag_debug_asm)
+ fputs ("\t" ASM_COMMENT_START " extracts table\n", asm_out_file);
+ dw2_asm_output_delta (PTR_SIZE, extracts_end_label, extracts_begin_label,
+ "extracts size");
+ ASM_OUTPUT_LABEL (asm_out_file, extracts_begin_label);
+ for (EXTRACT_T *e : MODULES (moif))
+ a68_asm_output_extract (module_label, GA68_EXTRACT_MODU,
+ EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e),
+ EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e));
+ for (EXTRACT_T *e : INDICANTS (moif))
+ a68_asm_output_extract (module_label, GA68_EXTRACT_MODE,
+ EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e),
+ EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e));
+ for (EXTRACT_T *e : IDENTIFIERS (moif))
+ a68_asm_output_extract (module_label, GA68_EXTRACT_IDEN,
+ EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e),
+ EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e));
+ for (EXTRACT_T *e : PRIOS (moif))
+ a68_asm_output_extract (module_label, GA68_EXTRACT_PRIO,
+ EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e),
+ EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e));
+ for (EXTRACT_T *e : OPERATORS (moif))
+ a68_asm_output_extract (module_label, GA68_EXTRACT_OPER,
+ EXTRACT_SYMBOL (e), EXTRACT_MODE (e), EXTRACT_PRIO (e),
+ EXTRACT_VARIABLE (e), EXTRACT_IN_PROC (e));
+ ASM_OUTPUT_LABEL (asm_out_file, extracts_end_label);
+
+ if (flag_debug_asm)
+ {
+ fputs (ASM_COMMENT_START " MODIF END ", asm_out_file);
+ fputs (NAME (moif), asm_out_file);
+ fputc ('\n', asm_out_file);
+ }
+}
+
+/* Emit export information for the module definition in the parse tree P. */
+
+void
+a68_do_exports (NODE_T *p)
+{
+ for (;p != NO_NODE; FORWARD (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);
+
+ if (EXPORTED (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));
+ 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);
+ }
+ }
+ else
+ a68_do_exports (SUB (p));
+ }
+}
--- /dev/null
+/* ga68-exports.pk - GCC Algol 68 exports format.
+
+ Copyright (C) 2025 Jose E. Marchesi
+
+ This program 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 of the License, or
+ (at your option) any later version.
+
+ This program 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 this program. If not, see <http://www.gnu.org/licenses/>. */
+
+/* GNU Algol 68 source files (compilation units, or "packets") may
+ contain either a single particular-program or a set of one or more
+ module definitions.
+
+ When compiling a compilation unit containing module definitions,
+ the ga68 compiler emits an ELF section called .a68_exports along
+ with the usual compiled object code. This section contains
+ information that reflects the PUBlicized identifiers exported by
+ module definitions: modes, operators, procedures, identifiers,
+ other module definitions, etc. This interface is complete enough
+ to allow other compilation units to access these declarations.
+
+ The information that is in a module interface is defined in the MR
+ document using a sort of grammar. It is:
+
+ module interface :
+ unique code & external symbol & hole description option &
+ mode table & definition summary.
+
+ definition summary :
+ set of definition groups.
+
+ definition group :
+ module identity & set of definition extracts.
+
+ definition extract :
+ mode extract ;
+ operation extract ;
+ priority extract ;
+ identifier extract ;
+ definition module extract ;
+ invocation extract.
+
+ mode extract :
+ mode marker & mode indication & mode & mdextra.
+
+ operation extract :
+ operation marker & operator & mode & mdextra.
+
+ priority extract :
+ priority marker & operator & integer priority & mdextra.
+
+ identifier extract :
+ identifier marker & identifier & mode & mdextra.
+
+ definition module extract :
+ definition module marker & definition module indication &
+ definition summary & mdextra.
+
+ invocation extract :
+ module identity.
+
+ mdextra :
+ extra machine-dependent information.
+
+ This pickle precisely describes how the module interfaces are
+ encoded in the .a68_exports ELF section, which are of type PROGBITS
+ and thus are concatenated by ELF linkers. This works well because
+ each compilation unit may contain several module definitions, but a
+ module definition cannot be splitted among several compilation
+ units. */
+
+/* The exports format is versioned. A bump in the format version
+ number indicates the presence of a backward incompatibility. This
+ is important because .ga68_exports section may contain module
+ definition interfaces having different versions, so compilers and
+ tools designed to operate on version "n" must ignore, or error on,
+ modules definition interfaces with later versions. */
+
+var ga68_exports_ver = 1;
+
+/* References other sections and the .ga68_export section itself are
+ realized via link-time relocations:
+
+ References to code addresses are relative to some text section.
+ References to data in .ga68_export are relative to the start of the
+ section. */
+
+load elf;
+
+type ga68_text_reloc = Elf64_Addr;
+type ga68_data_reloc = Elf64_Addr;
+
+/* Strings are encoded in-place and are both pre-sized and
+ NULL-terminated. This is to ease reading them quickly and
+ efficiently. Note that the size includes the final NULL
+ character. */
+
+type ga68_str =
+ struct
+ {
+ offset<uint<16>,B> len;
+ string s: s'size == len;
+ };
+
+/* Each module definition interface includes a table of modes, that
+ contains not only the modes for which mode extracts exist, but also
+ the indirectly referred modes: since Algol 68 used structural
+ equivalence of modes, each mode has to be defined fully. The
+ encoding therefore tries to be as compact as possible while
+ allowing being read with a reasonable level of performance and
+ convenience. */
+
+var GA68_MODE_UNKNOWN = 0UB,
+ GA68_MODE_VOID = 1UB,
+ GA68_MODE_INT = 2UB,
+ GA68_MODE_REAL = 3UB,
+ GA68_MODE_BITS = 4UB,
+ GA68_MODE_BYTES = 5UB,
+ GA68_MODE_CHAR = 6UB,
+ GA68_MODE_BOOL = 7UB,
+ GA68_MODE_CMPL = 8UB,
+ GA68_MODE_ROW = 9UB,
+ GA68_MODE_STRUCT = 10UB,
+ GA68_MODE_UNION = 11UB,
+ GA68_MODE_NAME = 12UB,
+ GA68_MODE_PROC = 13UB,
+ GA68_MODE_STRING = 14UB,
+ GA68_MODE_FLEX = 15UB;
+
+type ga68_mode =
+ struct
+ {
+ uint<8> kind : kind in [GA68_MODE_VOID, GA68_MODE_INT,
+ GA68_MODE_REAL, GA68_MODE_BITS,
+ GA68_MODE_BYTES, GA68_MODE_CHAR,
+ GA68_MODE_CMPL, GA68_MODE_ROW,
+ GA68_MODE_STRUCT, GA68_MODE_UNION,
+ GA68_MODE_NAME, GA68_MODE_PROC,
+ GA68_MODE_FLEX];
+
+ union
+ {
+ int<8> sizety : kind in [GA68_MODE_INT, GA68_MODE_REAL,
+ GA68_MODE_CMPL, GA68_MODE_BITS,
+ GA68_MODE_BYTES];
+ struct
+ {
+ ga68_data_reloc mode;
+ } name : kind == GA68_MODE_NAME || kind == GA68_MODE_FLEX;
+
+ struct
+ {
+ type triplet = struct { ga68_text_reloc lb; ga68_text_reloc ub; };
+
+ uint<8> ndims;
+ triplet[ndims] dims;
+ ga68_data_reloc row_of;
+ } row : kind == GA68_MODE_ROW;
+
+ struct
+ {
+ type field = struct { ga68_data_reloc mode; ga68_str name; };
+
+ uint<16> nfields;
+ field[nfields] fields;
+ } sct : kind == GA68_MODE_STRUCT;
+
+ struct
+ {
+ uint<8> nmodes;
+ ga68_data_reloc[nmodes] modes;
+ } uni : kind == GA68_MODE_UNION;
+
+ struct
+ {
+ type arg = struct { ga68_data_reloc mode; ga68_str name; };
+
+ ga68_data_reloc ret_mode;
+ uint<8> nargs;
+ arg[nargs] args;
+ } routine : kind == GA68_MODE_PROC;
+
+ struct { } _ : kind in [GA68_MODE_UNKNOWN, GA68_MODE_VOID,
+ GA68_MODE_CHAR, GA68_MODE_BOOL,
+ GA68_MODE_STRING];
+
+ } data;
+ };
+
+/* Each module definition interface includes a table of "extracts",
+ one per identifier PUBlicized by the module definition.
+
+ Mode extracts represent declarations of mode indications, like for
+ example `mode Foo = struct (int i, real r)'.
+
+ Identifier extracts represent declarations of constans, variables,
+ procedures and operators. Examples are `real pi = 3.14', `int
+ counter', `proc double = (int a) int : a * 2' and `op // = (int a,
+ b) int: a % b'.
+
+ Priority extracts represent declarations of priorities for dyadic
+ operators, like for example `prio // = 9'.
+
+ Finally, module extracts represent the PUBlication of some other
+ module definition. For example, the module definition `mode Foo =
+ access A, B def ... fed' will include module extracts for both "A"
+ and "B" in its interface.
+
+ Some of the extracts may need some additional compiler-specific or
+ machine-specific information, whose contents are not specified
+ here. */
+
+var GA68_EXTRACT_MODU = 0UB,
+ GA68_EXTRACT_IDEN = 1UB,
+ GA68_EXTRACT_MODE = 2UB,
+ GA68_EXTRACT_PRIO = 3UB,
+ GA68_EXTRACT_OPER = 4UB;
+
+type ga68_extract =
+ struct
+ {
+ Elf64_Off extract_size;
+ union
+ {
+ struct
+ {
+ uint<8> mark : mark == GA68_EXTRACT_MODU;
+ ga68_str module_indication;
+ } module;
+
+ struct
+ {
+ uint<8> mark : mark == GA68_EXTRACT_IDEN;
+ ga68_str name;
+ ga68_data_reloc mode;
+ } identifier;
+
+ struct
+ {
+ uint<8> mark : mark == GA68_EXTRACT_MODE;
+ ga68_str mode_indication;
+ ga68_data_reloc mode;
+ } mode;
+
+ struct
+ {
+ uint<8> mark : mark == GA68_EXTRACT_PRIO;
+ ga68_str opname;
+ uint<8> prio;
+ } prio;
+
+ struct
+ {
+ uint<8> mark : mark == GA68_EXTRACT_OPER;
+ ga68_str opname;
+ ga68_mode mode;
+ } oper;
+
+ } extract : extract'size == extract_size;
+
+ Elf64_Off mdextra_size;
+ uint<8>[mdextra_size] data;
+ };
+
+/* The contents of the .ga68_exports section can be mapped as a
+ ga68_module[sec.sh_size] */
+
+type ga68_module =
+ struct
+ {
+ uint<8>[2] magic : magic == [0x0aUB, 0xadUB];
+ uint<16> version : version == ga68_exports_ver;
+
+ /* Module identification.
+ Add a hash or UUID? */
+ ga68_str name;
+
+ /* Entry points. */
+ ga68_str prelude;
+ ga68_str poslude;
+
+ /* Table of modes. */
+ Elf64_Off modes_size;
+ ga68_mode[modes_size] modes;
+
+ /* Table of extracts. */
+ Elf64_Off extracts_size;
+ ga68_extract[extracts_size] extracts;
+ };
projects / thirdparty / gcc.git / commitdiff
