https://gcc.gnu.org/g:dc46237d10da999186ab0f36bb330ba3dbe8ce2d
commit r16-6169-gdc46237d10da999186ab0f36bb330ba3dbe8ce2d Author: Jose E. Marchesi <[email protected]> Date: Sun Dec 14 11:22:35 2025 +0100 a68: support for -fmodules-map and -fmodules-map-file This commit adds support for two new command-line options for the Algol 68 front-end: -fmodules-map=<string> -fmodules-map-file=<filename> These options are used in order to specify a mapping from module indicants to file basenames. The compiler will base its search for the modules on these basenames rather on the default schema of deriving the basename from the module indicant. Signed-off-by: Jose E. Marchesi <[email protected]> gcc/algol68/ChangeLog * lang.opt (-fmodules-map): New option. (-fmodules-map-file): Likewise. * a68.h: Add prototype for a68_process_module_map. * a68-imports.cc (SKIP_WHITESPACES): Define. (PARSE_BASENAME): Likewise. (PARSE_INDICANT): Likewise. (a68_process_module_map): New function. * a68-lang.cc: (a68_init): Move initialization of A68_MODULE_FILES from there... (a68_init_options): to here. (a68_handle_option): Handle OPT_fmodules_map and OPT_fmodules_map_. * a68-parser-pragmat.cc (handle_access_in_pragmat): Normalize module indicants to upper case. * ga68.texi (Module search options): New section. Diff: --- gcc/algol68/a68-imports.cc | 100 +++++++++++++++++++++ gcc/algol68/a68-lang.cc | 43 +++++++-- gcc/algol68/a68-parser-pragmat.cc | 5 ++ gcc/algol68/a68.h | 3 +- gcc/algol68/ga68.texi | 40 +++++++++ gcc/algol68/lang.opt | 18 ++++ .../algol68/execute/modules/Modules20.map | 2 + .../algol68/execute/modules/module-bar.a68 | 1 + .../algol68/execute/modules/module-foo.a68 | 1 + .../algol68/execute/modules/program-19.a68 | 6 ++ .../algol68/execute/modules/program-20.a68 | 6 ++ 11 files changed, 219 insertions(+), 6 deletions(-) diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc index 9cd6615b7a4a..9b367dac4c51 100644 --- a/gcc/algol68/a68-imports.cc +++ b/gcc/algol68/a68-imports.cc @@ -45,6 +45,106 @@ #include "a68.h" +/* A few macros to aid parsing of module map strings below. */ + +#define SKIP_WHITESPACES(P) while (ISSPACE (*(P))) (P)++ + +#define PARSE_BASENAME(P,W) \ + do \ + { \ + (W) = (char *) alloca (strlen ((P))); \ + size_t i = 0; \ + while ((*(P)) != '=' && !ISSPACE (*(P)) && ((*(P)) != '\0')) \ + (W)[i++] = *((P)++); \ + (W)[i] = '\0'; \ + } while (0) + +#define PARSE_INDICANT(P,W) \ + do \ + { \ + (W) = (char *) alloca (strlen ((P))); \ + size_t i = 0; \ + if (ISALPHA (*(P))) \ + { \ + (W)[i++] = *((P)++); \ + while (ISALPHA (*(P)) || ISDIGIT(*(P)) || (*(P)) == '_') \ + { \ + if ((*(P)) != '_') \ + (W)[i++] = *((P)++); \ + } \ + } \ + (W)[i] = '\0'; \ + } while (0) + +/* Parse module map information in MAP and add entries to A68_MODULE_FILES + accordingly. Existing entries in the map are overriden without warning. + + If MAP is not a valid module map specification then this function returns + `false' and sets *ERRMSG to some explanatory message. Otherwise it returns + `true' and sets *ERRMSG to NULL. */ + +bool +a68_process_module_map (const char *map, const char **errmsg) +{ + const char *p = map; + + while (*p != '\0') + { + char *filename; + SKIP_WHITESPACES (p); + PARSE_BASENAME (p, filename); + + if (p[0] != '=') + { + *errmsg = "expected = after filename"; + goto error; + } + p++; + + /* Parse one or more joined module indicants. */ + while (p[0] != ':' && p[0] != '\0') + { + char *module; + SKIP_WHITESPACES (p); + PARSE_INDICANT (p, module); + if (module[0] == '\0') + { + *errmsg = "expected module indicant"; + goto error; + } + + SKIP_WHITESPACES (p); + if (p[0] != ',' && p[0] != ':' && p[0] != '\0') + { + *errmsg = "expected comma or end of string after module indicant"; + goto error; + } + + for (char *q = module; *q; ++q) + *q = TOUPPER (*q); + A68_MODULE_FILES->put (ggc_strdup (module), ggc_strdup (filename)); + + if (p[0] == ',') + p++; + } + + SKIP_WHITESPACES (p); + if (p[0] != ':' && p[0] != '\0') + { + *errmsg = "expected semicolon or end of string"; + goto error; + } + + if (p[0] == ':') + p++; + } + + *errmsg = NULL; + return true; + error: + return false; +} + /* Read exports from an object file. FD is a file descriptor open for reading. diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc index f5f316a3fdb1..adcf12cfaa41 100644 --- a/gcc/algol68/a68-lang.cc +++ b/gcc/algol68/a68-lang.cc @@ -239,10 +239,6 @@ a68_init (void) else size_type_node = long_unsigned_type_node; - /* Create an empty module files map. */ - A68_MODULE_FILES = hash_map<nofree_string_hash,const char*>::create_ggc (16); - A68_MODULE_FILES->empty (); - return true; } @@ -445,7 +441,9 @@ static void a68_init_options (unsigned int argc ATTRIBUTE_UNUSED, cl_decoded_option *decoded_options ATTRIBUTE_UNUSED) { - /* Nothing to do here for now. */ + /* Create an empty module files map. */ + A68_MODULE_FILES = hash_map<nofree_string_hash,const char*>::create_ggc (16); + A68_MODULE_FILES->empty (); } #undef LANG_HOOKS_INIT_OPTIONS @@ -519,6 +517,41 @@ a68_handle_option (size_t scode, switch (code) { + case OPT_fmodules_map: + case OPT_fmodules_map_: + { + const char *errmsg; + if (!a68_process_module_map (arg, &errmsg)) + error ("invalid argument for %<-fmodules-map%>: %s", errmsg); + break; + } + case OPT_fmodules_map_file: + case OPT_fmodules_map_file_: + { + FILE *file = fopen (arg, "r"); + if (file == NULL) + fatal_error (UNKNOWN_LOCATION, + "cannot open modules map file %<%s%>", arg); + + ssize_t ssize = a68_file_size (file); + if (ssize < 0) + fatal_error (UNKNOWN_LOCATION, + "cannot determine size of modules map file %<%s%>", arg); + size_t fsize = ssize; + + char *buffer = (char *) xmalloc (fsize + 1); + size_t bytes_read = a68_file_read (file, buffer, fsize); + if (bytes_read != fsize) + fatal_error (UNKNOWN_LOCATION, + "cannot read contents of modules map file %<%s%>", arg); + buffer[fsize] = '\0'; + + const char *errmsg; + if (!a68_process_module_map (buffer, &errmsg)) + fatal_error (UNKNOWN_LOCATION, "%s: %s", arg, errmsg); + free (buffer); + break; + } case OPT_std_algol68: OPTION_STRICT (&A68_JOB) = 1; break; diff --git a/gcc/algol68/a68-parser-pragmat.cc b/gcc/algol68/a68-parser-pragmat.cc index 2407eaa1b721..a31d509b404a 100644 --- a/gcc/algol68/a68-parser-pragmat.cc +++ b/gcc/algol68/a68-parser-pragmat.cc @@ -118,6 +118,11 @@ handle_access_in_pragmat (NODE_T *p, const char *pragmat, size_t pos) found); return NULL; } + + /* Normalize module indicant to upper-case. */ + for (char *q = module; *q; ++q) + *q = TOUPPER (*q); + /* Add entry in the module files map. */ const char **pmodule = A68_MODULE_FILES->get (module); if (pmodule != NULL) diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h index ed4508365c41..98730973bc77 100644 --- a/gcc/algol68/a68.h +++ b/gcc/algol68/a68.h @@ -281,7 +281,7 @@ void a68_scan_error (LINE_T *u, char *v, const char *txt, ...); /* a68-parser-scanner.cc */ bool a68_lexical_analyser (const char *filename, bool *empty_file); -ssize_t a68_get_file_size (FILE *file); +ssize_t a68_file_size (FILE *file); ssize_t a68_file_read (FILE *file, void *buf, size_t n); /* a68-parser.cc */ @@ -1109,6 +1109,7 @@ void a68_do_exports (NODE_T *p); /* a68-imports.cc */ MOIF_T *a68_open_packet (const char *module); +bool a68_process_module_map (const char *map, const char **errmsg); /* a68-parser-debug.cc */ diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi index d3b86b2ac67c..4ed4ecfa55f7 100644 --- a/gcc/algol68/ga68.texi +++ b/gcc/algol68/ga68.texi @@ -155,6 +155,7 @@ This manual only documents the options specific to @command{ga68}. @menu * Dialect options:: Options controlling the accepted language. * Directory options:: Options influencing where to find source files. +* Module search options:: Options influencing where to look for modules. * Warnings options:: Options controlling warnings specific to ga68 * Runtime options:: Options controlling runtime behavior * Linking options:: Options influencing the linking step @@ -224,6 +225,40 @@ will also be added to the list of library search directories, as with @end table +@node Module search options +@section Module search options +@cindex options, modules +@cindex modules + +The following options can be used to tell the compiler where to look +for certain modules. + +@table @gcctabopt +@opindex fmodules-map +@item -fmodules-map=@var{string} +Use the mapping between module indicants and module base filenames +specified in @var{string}, which must contain a sequence of entries +with form +@code{@var{basename}=@var{moduleindicant}[,@var{moduleindicant}]...} +separated by colon (@code{:}) characters. + +When a module @var{moduleindicant} is accessed, the compiler will look +for exports information for it in files @file{@var{basename}.m68}, +@file{lib@var{basename}.so}, @file{lib@var{basename}.a}, +@file{@var{basename}.o}, in that order. + +This option is used to avoid the default behavior, in which the +basename used to search for an accessed module is implicitly derived +from its indicant, by transforming it to lower case. + +The effect of this option is accumulative. + +@opindex fmodules-map-file +@item -fmodules-map-file=@var{<filename>} +Like @option{-fmodules-map}, but read the mapping information from the +file @var{<filename>}. +@end table + @node Warnings options @section Warnings options @cindex options, warnings @@ -850,6 +885,11 @@ XXX XXX +As we have seen modules are accessed by referring to them in +access-clauses, using the same sort of bold-word indicants that +identify user-defined modes and operators, such as @code{JSON}, +@code{Transput} or @code{LEB128_Arithmetic}. + @node Modules and protection @subsection Modules and protection @cindex protection diff --git a/gcc/algol68/lang.opt b/gcc/algol68/lang.opt index d1af4aeda2e5..d7eec0768f3c 100644 --- a/gcc/algol68/lang.opt +++ b/gcc/algol68/lang.opt @@ -123,4 +123,22 @@ Enum(stropping_regime) String(upper) Value(0) EnumValue Enum(stropping_regime) String(supper) Value(1) +; Module maps + +fmodules-map +Algol68 Separate RejectNegative +-fmodules-map=<mapstring> Association between module indicants and files. + +fmodules-map= +Algol68 Joined RejectNegative +-fmodules-map=<mapstring> Association between module indicants and files. + +fmodules-map-file +Algol68 Separate RejectNegative +-fmodules-map-file=<filename> File containing modules map. + +fmodules-map-file= +Algol68 Joined RejectNegative +-fmodules-map-file=<filename> File containing modules map. + ; This comment is to ensure we retain the blank line above. diff --git a/gcc/testsuite/algol68/execute/modules/Modules20.map b/gcc/testsuite/algol68/execute/modules/Modules20.map new file mode 100644 index 000000000000..4bcb669570eb --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/Modules20.map @@ -0,0 +1,2 @@ +module-foo=Foo: +module-bar=Bar diff --git a/gcc/testsuite/algol68/execute/modules/module-bar.a68 b/gcc/testsuite/algol68/execute/modules/module-bar.a68 new file mode 100644 index 000000000000..702dc442b89f --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module-bar.a68 @@ -0,0 +1 @@ +module Bar = def pub int bar = 20; skip fed diff --git a/gcc/testsuite/algol68/execute/modules/module-foo.a68 b/gcc/testsuite/algol68/execute/modules/module-foo.a68 new file mode 100644 index 000000000000..9154b9193c3c --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/module-foo.a68 @@ -0,0 +1 @@ +module Foo = def pub int foo = 10; skip fed diff --git a/gcc/testsuite/algol68/execute/modules/program-19.a68 b/gcc/testsuite/algol68/execute/modules/program-19.a68 new file mode 100644 index 000000000000..0dd10b5e6d60 --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-19.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module-foo module-bar" } +{ dg-options {-fmodules-map=module-foo=Foo:module-bar=Bar} } + +begin access Foo (assert (foo = 10)); + access Bar (assert (bar = 20)) +end diff --git a/gcc/testsuite/algol68/execute/modules/program-20.a68 b/gcc/testsuite/algol68/execute/modules/program-20.a68 new file mode 100644 index 000000000000..138c452b4dca --- /dev/null +++ b/gcc/testsuite/algol68/execute/modules/program-20.a68 @@ -0,0 +1,6 @@ +{ dg-modules "module-foo module-bar" } +{ dg-options "-fmodules-map-file=$srcdir/algol68/execute/modules/Modules20.map" } + +begin access Foo (assert (foo = 10)); + access Bar (assert (bar = 20)) +end
