TeamHeptaMirrors/gcc
1
0
Fork 1
mirror of https://github.com/gcc-mirror/gcc.git synced 2026-05-06 14:59:39 +02:00
Code Issues Packages Projects Releases Wiki Activity

a68: modules exports

Browse Source 
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 <jemarch@gnu.org>

gcc/ChangeLog

	* algol68/a68-exports.cc: New file.
	* algol68/ga68-exports.pk: Likewise.
This commit is contained in:
Jose E. Marchesi
2025-11-22 02:19:13 +01:00
parent 54d11abf26
commit 51b5a394d9
2 changed files with 895 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

598
gcc/algol68/a68-exports.cc Normal file
View File

@@ -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));
}
}

297
gcc/algol68/ga68-exports.pk Normal file
View File

@@ -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;
};