[COMMITTED] algol68: support for pragmats and 'include' pragmat
Jose E. Marchesi
jemarch@gnu.org
Wed Mar 12 10:13:07 GMT 2025
This commit adds support for pragmat constructions in general, and for
the 'include' pragmat in particular. Source files can now be included
using either:
PR include "foo.a68" PR
or
PRAGMAT include "foo.a68" PRAGMAT
---
gcc/algol68/a68-parser-scanner.cc | 533 +++++++++++++++++++++++++++++-
gcc/algol68/a68-types.h | 6 +-
gcc/algol68/ga68.texi | 39 +++
3 files changed, 574 insertions(+), 4 deletions(-)
diff --git a/gcc/algol68/a68-parser-scanner.cc b/gcc/algol68/a68-parser-scanner.cc
index 915bee1a791..38fbbcf2d41 100644
--- a/gcc/algol68/a68-parser-scanner.cc
+++ b/gcc/algol68/a68-parser-scanner.cc
@@ -23,6 +23,7 @@
/* Context-dependent ALGOL 68 tokeniser. */
+
#define INCLUDE_MEMORY
#include "config.h"
#include "system.h"
@@ -32,6 +33,12 @@
#include "a68.h"
+#include <libgen.h> /* For dirname */
+
+/* A few forward references of static functions defined in this file. */
+
+static void include_files (LINE_T *top);
+
/* Standard prelude and postlude for source files. */
static const char *
@@ -91,7 +98,6 @@ postlude[] = {
while (0)
/* Read bytes from file into buffer. */
-/* XXX use gcc function instead. */
static ssize_t
io_read (FILE *file, void *buf, size_t n)
@@ -312,7 +318,9 @@ read_source_file (const char *filename)
/* Allocate A68_PARSER (scan_buf), which is an auxiliary buffer used by the
scanner known to be big enough to hold any string contained in the source
file. */
- A68_PARSER (scan_buf) = (char *) xmalloc (source_file_size + 1);
+ A68_PARSER (max_scan_buf_length) = source_file_size + 1;
+ A68_PARSER (max_scan_buf_length) += 1024; /* For the environment. */
+ A68_PARSER (scan_buf) = (char *) xmalloc (A68_PARSER (max_scan_buf_length));
/* Prelude. */
append_environ (prelude_start, &ref_l, &line_num, "prelude");
@@ -360,6 +368,9 @@ read_source_file (const char *filename)
/* Concatenate lines that end with \. */
concatenate_lines (TOP_LINE (&A68_JOB));
+ /* Include files. */
+ include_files (TOP_LINE (&A68_JOB));
+
done:
if (fclose (FILE_SOURCE_FD (&A68_JOB)) != 0)
gcc_unreachable ();
@@ -404,6 +415,520 @@ get_good_char (char *ref_c, LINE_T **ref_l, char **ref_s)
*ref_c = next_char (ref_l, ref_s, false);
}
+/* Determine whether u is bold tag v, independent of stropping regime. */
+
+static bool
+is_bold (char *u, const char *v)
+{
+ size_t len = strlen (v);
+ return (strncmp (u, v, len) == 0 && !ISUPPER (u[len]));
+}
+
+/* Skip a string denotation.
+
+ This function returns true if the end of the string denotation is found.
+ Returns false otherwise. */
+
+static bool
+skip_string (LINE_T **top, char **ch)
+{
+ LINE_T *u = *top;
+ char *v = *ch;
+ v++;
+ while (u != NO_LINE)
+ {
+ while (v[0] != NULL_CHAR)
+ {
+ if (v[0] == QUOTE_CHAR && v[1] != QUOTE_CHAR)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
+ else if (v[0] == QUOTE_CHAR && v[1] == QUOTE_CHAR)
+ {
+ v += 2;
+ }
+ else
+ {
+ v++;
+ }
+ }
+ FORWARD (u);
+ if (u != NO_LINE) {
+ v = &(STRING (u)[0]);
+ } else {
+ v = NO_TEXT;
+ }
+ }
+ return false;
+}
+
+/* Skip a comment.
+
+ This function returns true if the end of the comment is found. Returns
+ false otherwise. */
+
+static bool
+skip_comment (LINE_T **top, char **ch, int delim)
+{
+ LINE_T *u = *top;
+ char *v = *ch;
+ v++;
+ while (u != NO_LINE)
+ {
+ while (v[0] != NULL_CHAR)
+ {
+ if (is_bold (v, "COMMENT") && delim == BOLD_COMMENT_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
+ else if (is_bold (v, "CO") && delim == STYLE_I_COMMENT_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
+ else if (v[0] == '#' && delim == STYLE_II_COMMENT_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
+ else
+ {
+ v++;
+ }
+ }
+ FORWARD (u);
+ if (u != NO_LINE)
+ v = &(STRING (u)[0]);
+ else
+ v = NO_TEXT;
+ }
+
+ return false;
+}
+
+/* Skip rest of pragmat.
+
+ This function returns true if the end of the pragmat is found, false
+ otherwise. */
+
+static bool
+skip_pragmat (LINE_T **top, char **ch, int delim, bool whitespace)
+{
+ LINE_T *u = *top;
+ char *v = *ch;
+ while (u != NO_LINE)
+ {
+ while (v[0] != NULL_CHAR)
+ {
+ if (is_bold (v, "PRAGMAT") && delim == BOLD_PRAGMAT_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ }
+ else if (is_bold (v, "PR") && delim == STYLE_I_PRAGMAT_SYMBOL)
+ {
+ *top = u;
+ *ch = &v[1];
+ return true;
+ } else
+ {
+ if (whitespace && !ISSPACE (v[0]) && v[0] != NEWLINE_CHAR)
+ {
+ SCAN_ERROR (true, u, v, "error in pragment");
+ }
+ else if (ISUPPER (v[0]))
+ {
+ /* Skip a bold word as you may trigger on REPR, for
+ instance. */
+ while (ISUPPER (v[0]))
+ v++;
+ }
+ else
+ {
+ v++;
+ }
+ }
+ }
+
+ FORWARD (u);
+ if (u != NO_LINE)
+ v = &(STRING (u)[0]);
+ else
+ v = NO_TEXT;
+ }
+
+ return false;
+}
+
+/* Return pointer to next token within pragmat. */
+
+static char *
+get_pragmat_item (LINE_T **top, char **ch)
+{
+ LINE_T *u = *top;
+ char *v = *ch;
+ while (u != NO_LINE)
+ {
+ while (v[0] != NULL_CHAR)
+ {
+ if (!ISSPACE (v[0]) && v[0] != NEWLINE_CHAR)
+ {
+ *top = u;
+ *ch = v;
+ return v;
+ }
+ else
+ {
+ v++;
+ }
+ }
+ FORWARD (u);
+ if (u != NO_LINE)
+ v = &(STRING (u)[0]);
+ else
+ v = NO_TEXT;
+ }
+
+ return NO_TEXT;
+}
+
+/* Case insensitive strncmp for at most the number of chars in V. */
+
+static int
+streq (const char *u, const char *v)
+{
+ int diff;
+ for (diff = 0; diff == 0 && u[0] != NULL_CHAR && v[0] != NULL_CHAR; u++, v++)
+ diff = ((int) TOLOWER (u[0])) - ((int) TOLOWER (v[0]));
+ return diff;
+}
+
+/* Scan for the next pragmat and yield the first item within it. */
+
+static char *
+next_preprocessor_item (LINE_T **top, char **ch, int *delim)
+{
+ LINE_T *u = *top;
+ char *v = *ch;
+ *delim = 0;
+ while (u != NO_LINE)
+ {
+ while (v[0] != NULL_CHAR)
+ {
+ LINE_T *start_l = u;
+ char *start_c = v;
+
+ if (v[0] == QUOTE_CHAR)
+ {
+ /* Skip string denotation. */
+ SCAN_ERROR (!skip_string (&u, &v), start_l, start_c,
+ "unterminated string");
+ }
+ else if (is_bold (v, "COMMENT"))
+ {
+ /* Skip comment. */
+ SCAN_ERROR (!skip_comment (&u, &v, BOLD_COMMENT_SYMBOL), start_l, start_c,
+ "unterminated comment");
+ }
+ else if (is_bold (v, "CO"))
+ {
+ /* skip comment. */
+ SCAN_ERROR (!skip_comment (&u, &v, STYLE_I_COMMENT_SYMBOL), start_l, start_c,
+ "unterminated comment");
+ }
+ else if (v[0] == '#')
+ {
+ SCAN_ERROR (!skip_comment (&u, &v, STYLE_II_COMMENT_SYMBOL), start_l, start_c,
+ "unterminated comment");
+ }
+ else if (is_bold (v, "PRAGMAT") || is_bold (v, "PR"))
+ {
+ /* We caught a PRAGMAT. */
+ char *item;
+ if (is_bold (v, "PRAGMAT"))
+ {
+ *delim = BOLD_PRAGMAT_SYMBOL;
+ v = &v[strlen ("PRAGMAT")];
+ }
+ else if (is_bold (v, "PR"))
+ {
+ *delim = STYLE_I_PRAGMAT_SYMBOL;
+ v = &v[strlen ("PR")];
+ }
+ item = get_pragmat_item (&u, &v);
+ SCAN_ERROR (item == NO_TEXT, start_l, start_c,
+ "unterminated pragmat");
+
+ if (streq (item, "INCLUDE") == 0)
+ {
+ /* Item "INCLUDE" includes a file. */
+ *top = u;
+ *ch = v;
+ return item;
+ }
+ else
+ {
+ /* Unrecognised item - probably options handled later by the
+ tokeniser. */
+ SCAN_ERROR (!skip_pragmat (&u, &v, *delim, false), start_l, start_c,
+ "unterminated pragmat");
+ }
+ }
+ else if (ISUPPER (v[0]))
+ {
+ /* Skip a bold word as you may trigger on REPR, for instance. */
+ while (ISUPPER (v[0]))
+ v++;
+ }
+ else
+ {
+ v++;
+ }
+ }
+
+ FORWARD (u);
+ if (u != NO_LINE)
+ v = &(STRING (u)[0]);
+ else
+ v = NO_TEXT;
+ }
+
+ *top = u;
+ *ch = v;
+ return NO_TEXT;
+}
+
+/* Concatenate the two paths P1 and P2. */
+
+static char *
+a68_relpath (const char *p1, const char *p2, const char *fn)
+{
+ char q[PATH_MAX + 1];
+ a68_bufcpy (q, p1, PATH_MAX);
+ a68_bufcat (q, "/", PATH_MAX);
+ a68_bufcat (q, p2, PATH_MAX);
+ a68_bufcat (q, "/", PATH_MAX);
+ a68_bufcat (q, fn, PATH_MAX);
+ /* Home directory shortcut ~ is a shell extension. */
+ if (strchr (q, '~') != NO_TEXT) {
+ return NO_TEXT;
+ }
+ char *r = (char *) xmalloc (PATH_MAX + 1);
+ gcc_assert (r != NULL);
+ /* Error handling in the caller! */
+ errno = 0;
+ r = lrealpath (q);
+ return r;
+}
+
+/* Include files.
+ This function handles the INCLUDE pragmat in the source file. */
+
+static void
+include_files (LINE_T *top)
+{
+ /* syntax: PR include "filename" PR
+
+ The file gets inserted before the line containing the pragmat. In this way
+ correct line numbers are preserved which helps diagnostics. A file that
+ has been included will not be included a second time - it will be ignored.
+ A rigorous fail-safe, but there is no mechanism to prevent recursive
+ includes in A68 source code. User reports do not indicate sophisticated
+ use of INCLUDE, so this is fine for now.
+ */
+
+ bool make_pass = true;
+ while (make_pass)
+ {
+ LINE_T *s, *t, *u = top;
+ char *v = &(STRING (u)[0]);
+ make_pass = false;
+ errno = 0;
+ while (u != NO_LINE)
+ {
+ int pr_lim;
+ char *item = next_preprocessor_item (&u, &v, &pr_lim);
+ LINE_T *start_l = u;
+ char *start_c = v;
+ /* Search for PR include "filename" PR. */
+ if (item != NO_TEXT && streq (item, "INCLUDE") == 0)
+ {
+ FILE *fp;
+ int fd;
+ size_t fsize, k;
+ int n, linum, bytes_read;
+ char *fbuf, delim;
+ BUFFER fnb;
+ char *fn;
+ /* Skip to filename. */
+ while (ISALPHA (v[0]))
+ v++;
+ while (ISSPACE (v[0]))
+ v++;
+ /* Scan quoted filename. */
+ SCAN_ERROR ((v[0] != QUOTE_CHAR && v[0] != '\''), start_l, start_c,
+ "incorrect filename");
+ delim = (v++)[0];
+ n = 0;
+ fnb[0] = NULL_CHAR;
+ /* Scan Algol 68 string (note: "" denotes a ", while in C it
+ concatenates). */
+ do
+ {
+ SCAN_ERROR (EOL (v[0]), start_l, start_c,
+ "incorrect filename");
+ SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c,
+ "incorrect filename");
+ if (v[0] == delim)
+ {
+ while (v[0] == delim && v[1] == delim)
+ {
+ SCAN_ERROR (n == BUFFER_SIZE - 1, start_l, start_c,
+ "incorrect filename");
+ fnb[n++] = delim;
+ fnb[n] = NULL_CHAR;
+ v += 2;
+ }
+ }
+ else if (ISPRINT (v[0]))
+ {
+ fnb[n++] = *(v++);
+ fnb[n] = NULL_CHAR;
+ }
+ else
+ {
+ SCAN_ERROR (true, start_l, start_c,
+ "incorrect filename");
+ }
+ }
+ while (v[0] != delim);
+
+ /* Insist that the pragmat is closed properly. */
+ v = &v[1];
+ SCAN_ERROR (!skip_pragmat (&u, &v, pr_lim, true), start_l, start_c,
+ "unterminated pragmat");
+ SCAN_ERROR (n == 0, start_l, start_c,
+ "incorrect filename");
+
+ if (!IS_ABSOLUTE_PATH (fnb))
+ {
+ /* Make the name relative to the position of the source file
+ (C preprocessor standard). */
+ /* XXX Search in the include_path instead. */
+ if (FILENAME (u) != NO_TEXT)
+ {
+ char *sourcefile = xstrdup (FILENAME (u));
+ fn = a68_relpath (dirname (sourcefile), dirname (fnb), lbasename (fnb));
+ free (sourcefile);
+ }
+
+ /* Do not check errno, since errno may be undefined here
+ after a successful call. */
+ if (fn != NO_TEXT)
+ a68_bufcpy (fnb, fn, BUFFER_SIZE);
+ else
+ SCAN_ERROR (true, NO_LINE, NO_TEXT,
+ "error opening include file");
+ }
+
+ size_t fnwid = (int) strlen (fnb) + 1;
+ fn = (char *) xmalloc ((size_t) fnwid);
+ a68_bufcpy (fn, fnb, fnwid);
+
+ /* Ignore the file when included more than once. */
+ for (t = top; t != NO_LINE; t = NEXT (t))
+ {
+ if (strcmp (FILENAME (t), fn) == 0)
+ goto search_next_pragmat;
+ }
+ t = NO_LINE;
+
+ /* Access the file. */
+ errno = 0;
+ fp = fopen (fn, "r");
+ SCAN_ERROR (fp == NULL, start_l, start_c,
+ "error opening included file");
+ fd = fileno (fp);
+ errno = 0;
+ off_t off = lseek (fd, 0, SEEK_END);
+ gcc_assert (off >= 0);
+ fsize = (size_t) off;
+ SCAN_ERROR (errno != 0, start_l, start_c,
+ "error while reading file");
+ fbuf = (char *) xmalloc (8 + fsize);
+ errno = 0;
+ if (lseek (fd, 0, SEEK_SET) < 0)
+ gcc_unreachable ();
+ SCAN_ERROR (errno != 0, start_l, start_c,
+ "error while reading file");
+ errno = 0;
+ bytes_read = (int) io_read (fp, fbuf, (size_t) fsize);
+ SCAN_ERROR (errno != 0 || (size_t) bytes_read != fsize, start_l, start_c,
+ "error while reading file");
+
+ /* Buffer still usable?. */
+ if (fsize > A68_PARSER (max_scan_buf_length))
+ {
+ A68_PARSER (max_scan_buf_length) = fsize;
+ A68_PARSER (scan_buf) = (char *) xmalloc (8 + A68_PARSER (max_scan_buf_length));
+ }
+
+ /* Link all lines into the list. */
+ linum = 1;
+ s = u;
+ t = PREVIOUS (u);
+ k = 0;
+ if (fsize == 0)
+ {
+ /* If file is empty, insert single empty line. */
+ A68_PARSER (scan_buf)[0] = NEWLINE_CHAR;
+ A68_PARSER (scan_buf)[1] = NULL_CHAR;
+ append_source_line (A68_PARSER (scan_buf), &t, &linum, fn);
+ }
+ else
+ {
+ while (k < fsize)
+ {
+ n = 0;
+ A68_PARSER (scan_buf)[0] = NULL_CHAR;
+ while (k < fsize && fbuf[k] != NEWLINE_CHAR)
+ {
+ SCAN_ERROR ((ISCNTRL (fbuf[k]) && !ISSPACE (fbuf[k]))
+ || fbuf[k] == STOP_CHAR,
+ start_l, start_c,
+ "invalid characters in included file");
+ A68_PARSER (scan_buf)[n++] = fbuf[k++];
+ A68_PARSER (scan_buf)[n] = NULL_CHAR;
+ }
+ A68_PARSER (scan_buf)[n++] = NEWLINE_CHAR;
+ A68_PARSER (scan_buf)[n] = NULL_CHAR;
+ if (k < fsize)
+ k++;
+ append_source_line (A68_PARSER (scan_buf), &t, &linum, fn);
+ }
+ }
+
+ /* Conclude and go find another include directive, if any. */
+ NEXT (t) = s;
+ PREVIOUS (s) = t;
+ concatenate_lines (top);
+ if (fclose (fp) != 0)
+ gcc_unreachable ();
+ make_pass = true;
+ }
+ search_next_pragmat:
+ { (void) 0; };
+ }
+ }
+}
+
/* Handle a pragment (pragmat or comment). */
static char *
@@ -1337,8 +1862,10 @@ a68_lexical_analyser (const char *filename)
s = STRING (l);
tokenise_source (&root, 0, false, &l, &s, &start_l, &start_c);
- /* Note that A68_PARSER (scan_buf) is allocated by read_source_line. */
+ /* Note that A68_PARSER (scan_buf) and A68_PARSER (max_scan_buf_length) are
+ allocated by read_source_line. */
free (A68_PARSER (scan_buf));
A68_PARSER (scan_buf) = NULL;
+ A68_PARSER (max_scan_buf_length) = 0;
return true;
}
diff --git a/gcc/algol68/a68-types.h b/gcc/algol68/a68-types.h
index 6efb0153f94..20f151bd65a 100644
--- a/gcc/algol68/a68-types.h
+++ b/gcc/algol68/a68-types.h
@@ -658,10 +658,13 @@ struct MODE_CACHE_T
STOP_SCANNER is a control flag used exclusively by the main loop in
tokenise_source, which is recursive.
- SCAN_BUF is a scratch buffer used by the scanner for several purposes. Thsi
+ SCAN_BUF is a scratch buffer used by the scanner for several purposes. This
buffer is known to be big enough to hold any substring from the source file.
It is initialized in read_source_file.
+ MAX_SCAN_BUF_LENGTH is the useable size of SCAN_BUF. This is used by the
+ scanner to grow SCAN_BUF as it includes other files.
+
TAG_NUMBER is a global counter used by the parser to assign an unique number
to each tag it creates. It is used in a68_new_tag.
@@ -672,6 +675,7 @@ struct PARSER_T
{
TAG_T *error_tag;
bool stop_scanner;
+ size_t max_scan_buf_length;
char *scan_buf;
int tag_number;
jmp_buf bottom_up_crash_exit;
diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
index eb3618a34ba..8655ae678aa 100644
--- a/gcc/algol68/ga68.texi
+++ b/gcc/algol68/ga68.texi
@@ -92,6 +92,7 @@ bibliography.
@menu
* Invoking ga68:: How to run the compiler.
* Compilation units:: Programs, modules and compilation model.
+* Pragmats:: In-source directives for the compiler.
* Hardware representation:: Representation of programs.
* Standard prelude:: Standard modes, operators, etc.
* Extended prelude:: GNU extensions to the standard prelude.
@@ -316,6 +317,44 @@ system:
@noindent
Note that the enclosed clause doesn't have to be a closed clause.
+@node Pragmats
+@chapter Pragmats
+
+@cindex pragmat
+@dfn{Pragmats} (also known as @dfn{pragmas} in other programming
+languages) are directives and annotations for the compiler, and they
+impact the compilation process in several ways. A pragmat starts with
+either @code{@B{pragmat}} or @code{@B{pr}} and finished with either
+@code{@B{pragmat}} or @code{@B{pr}} respectively. Pragmats cannot be
+nested. For example:
+
+@example
+@B{pr} include "foo.a68" @B{pr}
+@end example
+
+The interpretation of pragmats is compiler-specific. This chapter
+documents the pragmats supported by GCC.
+
+@menu
+* pragmat include:: Include another source file.
+@end menu
+
+@node pragmat include
+@section pragmat include
+@cindex include
+
+An @dfn{include pragmat} has the form:
+
+@example
+@B{pr} include "PATH" @B{pr}
+@end example
+
+@noindent
+Where @code{PATH} is the path of the file whose contents are to be
+included at the location of the pragmat. If the provided path is
+relative then it is interpreted as relative to the directory
+containing the source file that contains the pragmat.
+
@node Hardware representation
@chapter Hardware representation
--
2.30.2
More information about the Algol68
mailing list