https://gcc.gnu.org/g:6437f059af0ac0c709bef97db5890a4ff33b8a1d

commit r16-6371-g6437f059af0ac0c709bef97db5890a4ff33b8a1d
Author: Mohammad-Reza Nabipoor <[email protected]>
Date:   Tue Dec 23 21:10:51 2025 +0100

    a68: add import from .m68 file
    
    Signed-off-by: Mohammad-Reza Nabipoor <[email protected]>
    
    gcc/algol68/ChangeLog
    
            * a68.h (a68_file_size): Changed to use file descriptor.
            (a68_file_read): Likewise.
            * a68-parser-scanner.cc (a68_file_size): Likewise.
            (a68_file_read): Likewise.
            (read_source_file): Adapt `a68_file_{size,read}'.
            (include_files): Likewise.
            * a68-lang.cc (a68_handle_option): Likewise.
            * a68-imports.cc (a68_find_export_data): Implement
            reading from module's .m68 file if available.
    
    gcc/testsuite/ChangeLog
    
            * algol68/compile/modules/compile.exp (dg-data): New procedure
            for writing binary test data to disk.
            * algol68/compile/modules/program-m68-lp64.a68: New test which
            embeds binary module data.
            * algol68/compile/modules/program-m68-llp64.a68: Likewise.
            * algol68/compile/modules/program-m68-ilp32.a68: Likewise.
            * algol68/compile/modules/program-m68-lp64-be.a68: Likewise.
            * algol68/compile/modules/program-m68-llp64-be.a68: Likewise.

Diff:
---
 gcc/algol68/a68-imports.cc                         | 51 +++++++++++++++++++---
 gcc/algol68/a68-lang.cc                            |  4 +-
 gcc/algol68/a68-parser-scanner.cc                  | 25 +++++------
 gcc/algol68/a68.h                                  |  4 +-
 gcc/testsuite/algol68/compile/modules/compile.exp  | 16 +++++++
 .../algol68/compile/modules/program-m68-ilp32.a68  | 14 ++++++
 .../compile/modules/program-m68-llp64-be.a68       | 14 ++++++
 .../algol68/compile/modules/program-m68-llp64.a68  | 14 ++++++
 .../compile/modules/program-m68-lp64-be.a68        | 14 ++++++
 .../algol68/compile/modules/program-m68-lp64.a68   | 14 ++++++
 10 files changed, 148 insertions(+), 22 deletions(-)

diff --git a/gcc/algol68/a68-imports.cc b/gcc/algol68/a68-imports.cc
index d8c1f1f7ba92..6c76e921f139 100644
--- a/gcc/algol68/a68-imports.cc
+++ b/gcc/algol68/a68-imports.cc
@@ -271,15 +271,57 @@ a68_find_export_data (const std::string &filename, int 
fd, size_t *psize)
     }
 
   char buf[A68_EXPORT_MAGIC_LEN];
-  ssize_t c = ::read(fd, buf, A68_EXPORT_MAGIC_LEN);
+  ssize_t c = read (fd, buf, A68_EXPORT_MAGIC_LEN);
   if (c < A68_EXPORT_MAGIC_LEN)
     return NULL;
 
+  if (lseek (fd, 0, SEEK_SET) < 0)
+    {
+      a68_error (NO_NODE, "lseek Z failed", filename.c_str ());
+      return NULL;
+    }
+
   /* Check for a file containing nothing but Algol 68 export data.  */
-  if (buf[0] == '\x0a' && buf[1] == '\xad')
+  if (buf[0] == '\x0a' && buf[1] == '\x68')
     {
-      /* XXX read whole file.  */
-      return exports;
+      /* read whole file.  */
+
+      char *buf;
+      ssize_t len, nread;
+
+      len = a68_file_size (fd);
+      if (len == -1)
+        {
+          a68_error (NO_NODE, "a68_file_size failed for Z",
+                     filename.c_str ());
+          return NULL;
+        }
+
+      buf = XNEWVEC (char, len);
+      if (buf == NULL)
+        {
+          a68_error (NO_NODE,
+                     "memory allocation failed while reading export data");
+          return NULL;
+        }
+
+      nread = a68_file_read (fd, buf, len);
+      if (nread < 0)
+        {
+          free (buf);
+          a68_error (NO_NODE, "read failed while reading export data");
+          return NULL;
+        }
+
+      if (nread < len)
+        {
+          free (buf);
+          a68_error (NO_NODE, "short read while reading export data");
+          return NULL;
+        }
+
+      *psize = len;
+      return buf;
     }
 
 #if 0
@@ -289,7 +331,6 @@ a68_find_export_data (const std::string &filename, int fd, 
size_t *psize)
 #endif
 
   return NULL;
-
 }
 
 /* Given *PFILENAME, where *PFILENAME does not exist, try various suffixes.  If
diff --git a/gcc/algol68/a68-lang.cc b/gcc/algol68/a68-lang.cc
index adcf12cfaa41..3fa7897d2369 100644
--- a/gcc/algol68/a68-lang.cc
+++ b/gcc/algol68/a68-lang.cc
@@ -533,14 +533,14 @@ a68_handle_option (size_t scode,
          fatal_error (UNKNOWN_LOCATION,
                       "cannot open modules map file %<%s%>", arg);
        
-       ssize_t ssize = a68_file_size (file);
+       ssize_t ssize = a68_file_size (fileno (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);
+       size_t bytes_read = a68_file_read (fileno (file), buffer, fsize);
        if (bytes_read != fsize)
          fatal_error (UNKNOWN_LOCATION,
                       "cannot read contents of modules map file %<%s%>", arg);
diff --git a/gcc/algol68/a68-parser-scanner.cc 
b/gcc/algol68/a68-parser-scanner.cc
index 94647d528829..49f8dee3ac11 100644
--- a/gcc/algol68/a68-parser-scanner.cc
+++ b/gcc/algol68/a68-parser-scanner.cc
@@ -119,37 +119,36 @@ supper_postlude[] = {
     }                                                                  \
   while (0)
 
-/* Get the size of a file given a stream pointer FILE.  In case the size of
+/* Get the size of a file given a file descriptor FD.  In case the size of
    the file cannot be determined then this function returns -1.  */
 
 ssize_t
-a68_file_size (FILE *file)
+a68_file_size (int fd)
 {
   ssize_t fsize;
   off_t off, save;
 
-  save = ftell (file);
-  if (save == -1)
+  save = lseek (fd, 0, SEEK_CUR);
+  if (save == (off_t) -1)
     return -1;
 
-  off = lseek (fileno (file), 0, SEEK_END);
+  off = lseek (fd, 0, SEEK_END);
   if (off == (off_t) -1)
     return -1;
   fsize = (ssize_t) off;
 
-  off = lseek (fileno (file), save, SEEK_SET);
+  off = lseek (fd, save, SEEK_SET);
   if (off == (off_t) -1)
     return -1;
 
   return fsize;
 }
 
-/* Read bytes from file into buffer.  */
+/* Read bytes from file into buffer given a file descriptor.  */
 
 ssize_t
-a68_file_read (FILE *file, void *buf, size_t n)
+a68_file_read (int fd, void *buf, size_t n)
 {
-  int fd = fileno (file);
   size_t to_do = n;
   int restarts = 0;
   char *z = (char *) buf;
@@ -344,7 +343,7 @@ read_source_file (const char *filename)
     fatal_error (UNKNOWN_LOCATION, "specified file %s is a directory",
                 filename);
 
-  l = a68_file_size (f);
+  l = a68_file_size (fileno (f));
   if (l < 0)
     error ("could not get size of source file");
   source_file_size = l;
@@ -364,7 +363,7 @@ read_source_file (const char *filename)
   /* Read the file into a single buffer, so we save on system calls.  */
   line_num = 1;
   buffer = (char *) xmalloc (8 + source_file_size);
-  bytes_read = a68_file_read (f, buffer, source_file_size);
+  bytes_read = a68_file_read (fileno (f), buffer, source_file_size);
   gcc_assert (bytes_read == source_file_size);
 
   /* Link all lines into the list.  */
@@ -1078,12 +1077,12 @@ include_files (LINE_T *top)
              fp = fopen (fn, "r");
              SCAN_ERROR (fp == NULL, start_l, start_c,
                          "error opening included file");
-             ssize = a68_file_size (fp);
+             ssize = a68_file_size (fileno (fp));
              SCAN_ERROR (ssize < 0, start_l, start_c,
                          "error getting included file size");
              fsize = ssize;
              fbuf = (char *) xmalloc (8 + fsize);
-             bytes_read = (int) a68_file_read (fp, fbuf, (size_t) fsize);
+             bytes_read = (int) a68_file_read (fileno (fp), fbuf, (size_t) 
fsize);
              SCAN_ERROR ((size_t) bytes_read != fsize, start_l, start_c,
                          "error while reading file");
 
diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
index 98730973bc77..dc73277038c9 100644
--- a/gcc/algol68/a68.h
+++ b/gcc/algol68/a68.h
@@ -281,8 +281,8 @@ 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_file_size (FILE *file);
-ssize_t a68_file_read (FILE *file, void *buf, size_t n);
+ssize_t a68_file_size (int fd);
+ssize_t a68_file_read (int fd, void *buf, size_t n);
 
 /* a68-parser.cc  */
 
diff --git a/gcc/testsuite/algol68/compile/modules/compile.exp 
b/gcc/testsuite/algol68/compile/modules/compile.exp
index a843940169ec..41bd2f7cccde 100644
--- a/gcc/testsuite/algol68/compile/modules/compile.exp
+++ b/gcc/testsuite/algol68/compile/modules/compile.exp
@@ -20,6 +20,22 @@
 
 load_lib algol68-dg.exp
 
+proc dg-data { args } {
+  global objdir
+
+  if { [llength $args] != 3 } {
+      error "[lindex $args 0]: invalid arguments"
+  }
+
+  set filename $objdir/[lindex $args 1]
+  set bytes [lindex $args 2]
+
+  set fd [open $filename w]
+  fconfigure $fd -translation binary
+  puts -nonewline $fd [binary format c* $bytes]
+  close $fd
+}
+
 # Initialize `dg'.
 dg-init
 
diff --git a/gcc/testsuite/algol68/compile/modules/program-m68-ilp32.a68 
b/gcc/testsuite/algol68/compile/modules/program-m68-ilp32.a68
new file mode 100644
index 000000000000..4b64427a7791
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-m68-ilp32.a68
@@ -0,0 +1,14 @@
+{ dg-require-effective-target ilp32 }
+{ dg-require-effective-target le }
+{
+  { The following dg-data is representing this module: }
+  module Module_m68 =
+  def
+      pub mode Foo = struct (int i, long int l);
+      pub mode Bar = int;
+      skip
+  fed
+}
+{ dg-data modulem68.m68 {0x0a 0x68 0x01 0x00 0x0a 0x00 0x4d 0x4f 0x44 0x55 
0x4c 0x45 0x4d 0x36 0x38 0x00 0x13 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 
0x38 0x5f 0x5f 0x70 0x72 0x65 0x6c 0x75 0x64 0x65 0x00 0x14 0x00 0x4d 0x4f 0x44 
0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x5f 0x70 0x6f 0x73 0x74 0x6c 0x75 0x64 0x65 
0x00 0x17 0x00 0x00 0x00 0x02 0x00 0x02 0x01 0x0a 0x02 0x00 0x3f 0x00 0x00 0x00 
0x02 0x00 0x69 0x00 0x41 0x00 0x00 0x00 0x02 0x00 0x6c 0x00 0x3a 0x00 0x00 0x00 
0x19 0x00 0x00 0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 
0x5f 0x42 0x41 0x52 0x00 0x3f 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x19 0x00 0x00 
0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x46 0x4f 
0x4f 0x00 0x43 0x00 0x00 0x00 0x00 0x00 0x00 0x00} }
+
+access Module_m68 (Foo foo; i of foo)
diff --git a/gcc/testsuite/algol68/compile/modules/program-m68-llp64-be.a68 
b/gcc/testsuite/algol68/compile/modules/program-m68-llp64-be.a68
new file mode 100644
index 000000000000..d7e70a0e3db4
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-m68-llp64-be.a68
@@ -0,0 +1,14 @@
+{ dg-require-effective-target llp64 }
+{ dg-require-effective-target be }
+{
+  { The following dg-data is representing this module: }
+  module Module_m68 =
+  def
+      pub mode Foo = struct (int i, long int l);
+      pub mode Bar = int;
+      skip
+  fed
+}
+{ dg-data modulem68.m68 {0x0a 0x68 0x00 0x01 0x00 0x0a 0x4d 0x4f 0x44 0x55 
0x4c 0x45 0x4d 0x36 0x38 0x00 0x00 0x13 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 
0x38 0x5f 0x5f 0x70 0x72 0x65 0x6c 0x75 0x64 0x65 0x00 0x00 0x14 0x4d 0x4f 0x44 
0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x5f 0x70 0x6f 0x73 0x74 0x6c 0x75 0x64 0x65 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x1f 0x02 0x00 0x02 0x01 0x0a 0x00 0x02 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x43 0x00 0x02 0x69 0x00 0x00 0x00 0x00 0x00 
0x00 0x00 0x00 0x45 0x00 0x02 0x6c 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x52 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x21 0x02 0x00 0x0e 0x4d 0x4f 0x44 0x55 0x4c 
0x45 0x4d 0x36 0x38 0x5f 0x42 0x41 0x52 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x43 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x21 0x02 0x00 0x0e 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x46 0x4f 
0x4f 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x47 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00} }
+
+access Module_m68 (Foo foo; i of foo)
diff --git a/gcc/testsuite/algol68/compile/modules/program-m68-llp64.a68 
b/gcc/testsuite/algol68/compile/modules/program-m68-llp64.a68
new file mode 100644
index 000000000000..0367727fa198
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-m68-llp64.a68
@@ -0,0 +1,14 @@
+{ dg-require-effective-target llp64 }
+{ dg-require-effective-target le }
+{
+  { The following dg-data is representing this module: }
+  module Module_m68 =
+  def
+      pub mode Foo = struct (int i, long int l);
+      pub mode Bar = int;
+      skip
+  fed
+}
+{ dg-data modulem68.m68 {0x0a 0x68 0x01 0x00 0x0a 0x00 0x4d 0x4f 0x44 0x55 
0x4c 0x45 0x4d 0x36 0x38 0x00 0x13 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 
0x38 0x5f 0x5f 0x70 0x72 0x65 0x6c 0x75 0x64 0x65 0x00 0x14 0x00 0x4d 0x4f 0x44 
0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x5f 0x70 0x6f 0x73 0x74 0x6c 0x75 0x64 0x65 
0x00 0x1f 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x00 0x02 0x01 0x0a 0x02 0x00 
0x43 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x00 0x69 0x00 0x45 0x00 0x00 0x00 
0x00 0x00 0x00 0x00 0x02 0x00 0x6c 0x00 0x52 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x21 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 
0x45 0x4d 0x36 0x38 0x5f 0x42 0x41 0x52 0x00 0x43 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x21 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x46 0x4f 
0x4f 0x00 0x47 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00} }
+
+access Module_m68 (Foo foo; i of foo)
diff --git a/gcc/testsuite/algol68/compile/modules/program-m68-lp64-be.a68 
b/gcc/testsuite/algol68/compile/modules/program-m68-lp64-be.a68
new file mode 100644
index 000000000000..aa3fb73afd88
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-m68-lp64-be.a68
@@ -0,0 +1,14 @@
+{ dg-require-effective-target lp64 }
+{ dg-require-effective-target be }
+{
+  { The following dg-data is representing this module: }
+  module Module_m68 =
+  def
+      pub mode Foo = struct (int i, long int l);
+      pub mode Bar = int;
+      skip
+  fed
+}
+{ dg-data modulem68.m68 {0x0a 0x68 0x00 0x01 0x00 0x0a 0x4d 0x4f 0x44 0x55 
0x4c 0x45 0x4d 0x36 0x38 0x00 0x00 0x13 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 
0x38 0x5f 0x5f 0x70 0x72 0x65 0x6c 0x75 0x64 0x65 0x00 0x00 0x14 0x4d 0x4f 0x44 
0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x5f 0x70 0x6f 0x73 0x74 0x6c 0x75 0x64 0x65 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x1f 0x02 0x00 0x02 0x01 0x0a 0x00 0x02 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x43 0x00 0x02 0x69 0x00 0x00 0x00 0x00 0x00 
0x00 0x00 0x00 0x45 0x00 0x02 0x6c 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x52 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x21 0x02 0x00 0x0e 0x4d 0x4f 0x44 0x55 0x4c 
0x45 0x4d 0x36 0x38 0x5f 0x42 0x41 0x52 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x43 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x21 0x02 0x00 0x0e 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x46 0x4f 
0x4f 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x47 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00} }
+
+access Module_m68 (Foo foo; i of foo)
diff --git a/gcc/testsuite/algol68/compile/modules/program-m68-lp64.a68 
b/gcc/testsuite/algol68/compile/modules/program-m68-lp64.a68
new file mode 100644
index 000000000000..dfcfa6f60f87
--- /dev/null
+++ b/gcc/testsuite/algol68/compile/modules/program-m68-lp64.a68
@@ -0,0 +1,14 @@
+{ dg-require-effective-target lp64 }
+{ dg-require-effective-target le }
+{
+  { The following dg-data is representing this module: }
+  module Module_m68 =
+  def
+      pub mode Foo = struct (int i, long int l);
+      pub mode Bar = int;
+      skip
+  fed
+}
+{ dg-data modulem68.m68 {0x0a 0x68 0x01 0x00 0x0a 0x00 0x4d 0x4f 0x44 0x55 
0x4c 0x45 0x4d 0x36 0x38 0x00 0x13 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 
0x38 0x5f 0x5f 0x70 0x72 0x65 0x6c 0x75 0x64 0x65 0x00 0x14 0x00 0x4d 0x4f 0x44 
0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x5f 0x70 0x6f 0x73 0x74 0x6c 0x75 0x64 0x65 
0x00 0x1f 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x00 0x02 0x01 0x0a 0x02 0x00 
0x43 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x00 0x69 0x00 0x45 0x00 0x00 0x00 
0x00 0x00 0x00 0x00 0x02 0x00 0x6c 0x00 0x52 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x21 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 
0x45 0x4d 0x36 0x38 0x5f 0x42 0x41 0x52 0x00 0x43 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x21 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x02 0x0e 0x00 0x4d 0x4f 0x44 0x55 0x4c 0x45 0x4d 0x36 0x38 0x5f 0x46 0x4f 
0x4f 0x00 0x47 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 
0x00 0x00} }
+
+access Module_m68 (Foo foo; i of foo)

Reply via email to