https://gcc.gnu.org/g:51b5a394d93348d1ef85de394604bb35bacf7aed
commit r16-5734-g51b5a394d93348d1ef85de394604bb35bacf7aed Author: Jose E. Marchesi <[email protected]> Date: Sat Nov 22 02:19:13 2025 +0100 a68: modules exports This commit adds the code that handles the exports information for the module definitions in prelude packets. The exports info is generated in a section in the output object file. A precise description of the binary format in which the exports are encoded is expressed in an included GNU poke pickle ga68-exports.pk. Signed-off-by: Jose E. Marchesi <[email protected]> gcc/ChangeLog * algol68/a68-exports.cc: New file. * algol68/ga68-exports.pk: Likewise. Diff: --- gcc/algol68/a68-exports.cc | 598 ++++++++++++++++++++++++++++++++++++++++++++ gcc/algol68/ga68-exports.pk | 297 ++++++++++++++++++++++ 2 files changed, 895 insertions(+) diff --git a/gcc/algol68/a68-exports.cc b/gcc/algol68/a68-exports.cc new file mode 100644 index 000000000000..58d04d5842bc --- /dev/null +++ b/gcc/algol68/a68-exports.cc @@ -0,0 +1,598 @@ +/* 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)); + } +} diff --git a/gcc/algol68/ga68-exports.pk b/gcc/algol68/ga68-exports.pk new file mode 100644 index 000000000000..86484b8d8893 --- /dev/null +++ b/gcc/algol68/ga68-exports.pk @@ -0,0 +1,297 @@ +/* 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; + };
