[PATCH] a68: Add lseek(3) to the POSIX prelude
Jose E. Marchesi
jemarch@gnu.org
Fri Nov 7 18:26:58 GMT 2025
Hi Pietro.
> Add lseek as a procedure in the POSIX prelude mapping it to the POSIX
> lseek(3) function. Add constants `seek set', `seek cur', `seek end`,
> `seek hole', and `seek data' mapping it to the POSIX defined constants
> `SEEK_SET', `SEEK_CUR', `SEEK_END', `SEEK_HOLE', and `SEEK_DATA'.
As of now we have a set of POSIX-like IO functions that work in terms of
CHARs, i.e. of Unicode characters:
putchar
puts
fputc
fputs
getchar
gets
fgetc
fgets
At some point we will probably want to add equivalent functions that
work on bytes (aka short short bits, with probably a suitable synonym
"byte") instead of chars. So I think it is useful to add lseek.
Just a couple of nits below.
> gcc/ChangeLog:
>
> * algol68/a68-low-posix.cc (a68_posix_lseek): New function.
> * algol68/a68-low-prelude.cc (a68_lower_posixlseek): New function.
> (a68_lower_posixseekcur): New function.
> (a68_lower_posixseekend): New function.
> (a68_lower_posixseekset): New function.
> (a68_lower_posixseekhole): New function.
> (a68_lower_posixseekdata): New function.
> * algol68/a68-low-runtime.cc (enum a68_libcall_type): Add
> LCT_LONGINT for the long int type.
> (get_libcall_type): Deal with LCT_LONGINT.
> * algol68/a68-low-runtime.def (POSIX_LSEEK): New definition.
> * algol68/a68-parser-prelude.cc (posix_prelude): Create
> definitions for `lseek', `seekcur', `seekend', `seekset',
> `seekhole', and `seekdata'.
> * algol68/a68.h (a68_posix_lseek): New prototype.
> (a68_row_malloc): XXX
?
> (a68_lower_posixlseek): New prototype.
> (a68_lower_posixseekcur): New prototype.
> (a68_lower_posixseekend): New prototype.
> (a68_lower_posixseekset): New prototype.
> (a68_lower_posixseekhole): New prototype.
> (a68_lower_posixseekdata): New prototype.
> * algol68/ga68.texi: Add documentation for lseek.
>
> ChangeLog:
>
> * libga68/config.h.in: Regenerate.
> * libga68/configure: Regenerate.
> * libga68/configure.ac: Test if the target supports SEEK_HOLE
> and SEEK_DATA.
> * libga68/ga68-posix.c: Include ga68.h before system headers
> to enable extensions.
> (A68_SEEK_CUR): New macro.
> (A68_SEEK_END): New macro.
> (A68_SEEK_SET): New macro.
> (A68_SEEK_HOLE): New macro.
> (A68_SEEK_DATA): New macro.
> (_libga68_posixlseek): New function.
> * libga68/ga68.h: Include the generated config.h.
> (_libga68_posixlseek): New prototype.
>
> gcc/testsuite/ChangeLog:
>
> * algol68/execute/posix-lseek.a68: New test.
>
> Signed-off-by: Pietro Monteiro <pietro@sociotechnical.xyz>
> ---
> gcc/algol68/a68-low-posix.cc | 6 ++
> gcc/algol68/a68-low-prelude.cc | 40 ++++++++++++
> gcc/algol68/a68-low-runtime.cc | 3 +
> gcc/algol68/a68-low-runtime.def | 1 +
> gcc/algol68/a68-parser-prelude.cc | 7 ++
> gcc/algol68/a68.h | 9 ++-
> gcc/algol68/ga68.texi | 34 +++++++++-
> gcc/testsuite/algol68/execute/posix-lseek.a68 | 11 ++++
> libga68/config.h.in | 6 ++
> libga68/configure | 64 +++++++++++++++++++
> libga68/configure.ac | 22 +++++++
> libga68/ga68-posix.c | 42 +++++++++++-
> libga68/ga68.h | 3 +
> 13 files changed, 244 insertions(+), 4 deletions(-)
> create mode 100644 gcc/testsuite/algol68/execute/posix-lseek.a68
>
> diff --git a/gcc/algol68/a68-low-posix.cc b/gcc/algol68/a68-low-posix.cc
> index fd30677757c..6b6ae76cf37 100644
> --- a/gcc/algol68/a68-low-posix.cc
> +++ b/gcc/algol68/a68-low-posix.cc
> @@ -329,6 +329,12 @@ a68_posix_fsize (void)
> return a68_get_libcall (A68_LIBCALL_POSIX_FSIZE);
> }
>
> +tree
> +a68_posix_lseek (void)
> +{
> + return a68_get_libcall (A68_LIBCALL_POSIX_LSEEK);
> +}
> +
> tree
> a68_posix_errno (void)
> {
> diff --git a/gcc/algol68/a68-low-prelude.cc b/gcc/algol68/a68-low-prelude.cc
> index 727dfd4e8ea..d7c779e9a55 100644
> --- a/gcc/algol68/a68-low-prelude.cc
> +++ b/gcc/algol68/a68-low-prelude.cc
> @@ -2010,6 +2010,46 @@ a68_lower_posixfsize (NODE_T *p ATTRIBUTE_UNUSED,
> return t;
> }
>
> +tree
> +a68_lower_posixlseek (NODE_T *p ATTRIBUTE_UNUSED,
> + LOW_CTX_T ctx ATTRIBUTE_UNUSED)
> +{
> + tree t = a68_posix_lseek ();
> + if (CAN_HAVE_LOCATION_P (t))
> + SET_EXPR_LOCATION (t, a68_get_node_location (p));
> + return t;
> +}
> +
> +tree
> +a68_lower_posixseekcur (NODE_T *p, LOW_CTX_T ctx)
> +{
> + return build_int_cst (a68_int_type, 0);
> +}
> +
> +tree
> +a68_lower_posixseekend (NODE_T *p, LOW_CTX_T ctx)
> +{
> + return build_int_cst (a68_int_type, 1);
> +}
> +
> +tree
> +a68_lower_posixseekset (NODE_T *p, LOW_CTX_T ctx)
> +{
> + return build_int_cst (a68_int_type, 2);
> +}
> +
> +tree
> +a68_lower_posixseekhole (NODE_T *p, LOW_CTX_T ctx)
> +{
> + return build_int_cst (a68_int_type, 3);
> +}
> +
> +tree
> +a68_lower_posixseekdata (NODE_T *p, LOW_CTX_T ctx)
> +{
> + return build_int_cst (a68_int_type, 4);
> +}
> +
> tree
> a68_lower_posixstdinfiledes (NODE_T *p ATTRIBUTE_UNUSED,
> LOW_CTX_T ctx ATTRIBUTE_UNUSED)
> diff --git a/gcc/algol68/a68-low-runtime.cc b/gcc/algol68/a68-low-runtime.cc
> index 4ea93e991e1..a5afaab890f 100644
> --- a/gcc/algol68/a68-low-runtime.cc
> +++ b/gcc/algol68/a68-low-runtime.cc
> @@ -61,6 +61,7 @@ enum a68_libcall_type
> LCT_SIZEPTR,
> LCT_UINT,
> LCT_INT,
> + LCT_LONGINT,
> LCT_LONGLONGINT,
> LCT_FLOAT,
> LCT_DOUBLE,
> @@ -107,6 +108,8 @@ get_libcall_type (a68_libcall_type type)
> libcall_types[type] = unsigned_type_node;
> else if (type == LCT_INT)
> libcall_types[type] = integer_type_node;
> + else if (type == LCT_LONGINT)
> + libcall_types[type] = long_integer_type_node;
> else if (type == LCT_LONGLONGINT)
> libcall_types[type] = long_long_integer_type_node;
> else if (type == LCT_FLOAT)
> diff --git a/gcc/algol68/a68-low-runtime.def b/gcc/algol68/a68-low-runtime.def
> index 21ec855947d..b31a6cd19f6 100644
> --- a/gcc/algol68/a68-low-runtime.def
> +++ b/gcc/algol68/a68-low-runtime.def
> @@ -80,6 +80,7 @@ DEF_A68_RUNTIME (POSIX_GETENV, "_libga68_posixgetenv", RT(VOID), P5(UNISTR,SIZE,
> DEF_A68_RUNTIME (POSIX_ERRNO, "_libga68_posixerrno", RT(INT), P0(), 0)
> DEF_A68_RUNTIME (POSIX_PERROR, "_libga68_posixperror", RT(VOID), P3(UNISTR,SIZE,SIZE), 0)
> DEF_A68_RUNTIME (POSIX_STRERROR, "_libga68_posixstrerror", RT(UNISTRPTR), P2(INT, SIZEPTR), 0)
> +DEF_A68_RUNTIME (POSIX_LSEEK, "_libga68_posixlseek", RT(LONGLONGINT), P3(INT,LONGINT,INT), 0)
> DEF_A68_RUNTIME (U32_CMP2, "_libga68_u32_cmp2", RT(INT), P6(UNISTR, SIZE, SIZE, UNISTR, SIZE, SIZE), 0)
>
> #undef P0
> diff --git a/gcc/algol68/a68-parser-prelude.cc b/gcc/algol68/a68-parser-prelude.cc
> index 6af51f37b31..23d9dc61b9a 100644
> --- a/gcc/algol68/a68-parser-prelude.cc
> +++ b/gcc/algol68/a68-parser-prelude.cc
> @@ -1406,6 +1406,13 @@ posix_prelude (void)
> /* Getting properties of files. */
> m = a68_proc (M_LONG_LONG_INT, M_INT, NO_MOID);
> a68_idf (A68_EXT, "fsize", m, a68_lower_posixfsize);
> + m = a68_proc (M_LONG_LONG_INT, M_INT, M_LONG_INT, M_INT, NO_MOID);
> + a68_idf (A68_EXT, "lseek", m, a68_lower_posixlseek);
> + a68_idf (A68_EXT, "seekcur", M_INT, a68_lower_posixseekcur);
> + a68_idf (A68_EXT, "seekend", M_INT, a68_lower_posixseekend);
> + a68_idf (A68_EXT, "seekset", M_INT, a68_lower_posixseekset);
> + a68_idf (A68_EXT, "seekhole", M_INT, a68_lower_posixseekhole);
> + a68_idf (A68_EXT, "seekdata", M_INT, a68_lower_posixseekdata);
> /* Sockets. */
> m = a68_proc (M_INT, M_STRING, M_INT, NO_MOID);
> a68_idf (A68_EXT, "fconnect", m, a68_lower_posixfconnect);
> diff --git a/gcc/algol68/a68.h b/gcc/algol68/a68.h
> index b74ad7b3ebd..a54355d7b2e 100644
> --- a/gcc/algol68/a68.h
> +++ b/gcc/algol68/a68.h
> @@ -553,6 +553,7 @@ tree a68_posix_fcreate (void);
> tree a68_posix_fopen (void);
> tree a68_posix_fclose (void);
> tree a68_posix_fsize (void);
> +tree a68_posix_lseek (void);
> tree a68_posix_errno (void);
> tree a68_posix_perror (void);
> tree a68_posix_strerror (void);
> @@ -664,7 +665,7 @@ tree a68_row_value_raw (tree type, tree descriptor,
> tree elements, tree elements_size);
> tree a68_row_malloc (tree type, int dim,
> tree elements, tree elements_size,
> - tree *lower_bound, tree *upper_bound);
> + tree *lower_bound, tree *upper_bound);
> tree a68_multiple_slice (NODE_T *p, tree multiple, bool slicing_name,
> int num_indexes, tree *indexes);
> tree a68_multiple_copy_elems (MOID_T *to_mode, tree to, tree from);
> @@ -1029,6 +1030,12 @@ tree a68_lower_posixfopen (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixfcreate (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixfclose (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixfsize (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixlseek (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixseekcur (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixseekend (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixseekset (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixseekhole (NODE_T *p, LOW_CTX_T ctx);
> +tree a68_lower_posixseekdata (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixstdinfiledes (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixstdoutfiledes (NODE_T *p, LOW_CTX_T ctx);
> tree a68_lower_posixstderrfiledes (NODE_T *p, LOW_CTX_T ctx);
> diff --git a/gcc/algol68/ga68.texi b/gcc/algol68/ga68.texi
> index 399baea0a40..b160c7f6f2c 100644
> --- a/gcc/algol68/ga68.texi
> +++ b/gcc/algol68/ga68.texi
> @@ -2906,6 +2906,38 @@ error condition, this procedure yields -1 and @code{errno} is set
> appropriately.
> @end deftypefn
>
> +@deftypefn Procedure {} {lseek} {= (@B{int} fd, @B{long int} offset, @B{int} whence) @B{long long int}}
> +Set the file offset of the file characterized by the file descriptor @code{fd}
> +depending on the values of @code{offset} and @code{whence}. On success, the
> +resulting offset, as measured in bytes from the beginning of the file, is
> +returned. Otherwise, -1 is returned, @code{errno} is set to indicate the error,
> +and the file offset remains unchanged. The effects of @code{offset} and
> +@code{whence} are:
> +@itemize
> +@item
> +If @code{whence} is @code{seek set}, the file offset is set to @code{offset}
> +bytes.
> +@item
> +If @code{whence} is @code{seek cur}, the file offset is set to its current
> +location plus @code{offset}.
> +@item
> +If @code{whence} is @code{seek end}, the file offset is set to the size of the
> +file plus @code{offset}.
> +@item
> +If @code{seek hole} is supported by your system as a value for @code{whence},
> +then setting @code{whence} to @code{seek hole} sets the file offset to the
> +smallest location of a byte within a hole and not less than @code{offset},
> +except if that offset falls beyond the last byte not within a hole, then the
> +file offset may be set to the file size instead. It is an error if
> +@code{offset} is greater than or equal to the size of the file.
This should say what happens if the system doesn't support
seekhole... presumably it is then a nop?
> +@item
> +If @code{seek data} is supported by your system as a value for @code{whence},
> +then setting @code{whence} to @code{seek data}, sets the file offset to the
> +smallest location of a byte not within a hole and not less than
> +@code{offset}. It is an error if no such byte exists.
Ditto.
> +@end itemize
> +@end deftypefn
> +
> @node POSIX sockets
> @section POSIX sockets
>
> @@ -2927,7 +2959,7 @@ appropriately.
>
> The following procedures read or write characters and strings from and
> to open files. The external encoding of the files is assumed to be
> -UTF-8. Since Algol 68 @code{@B{char}}s are USC-4, this means that
> +UTF-8. Since Algol 68 @code{@B{char}}s are UCS-4, this means that
> reading or writing a character may involve reading or writing more
> than one byte, depending on the particular Unicode code points
> involved.
> diff --git a/gcc/testsuite/algol68/execute/posix-lseek.a68 b/gcc/testsuite/algol68/execute/posix-lseek.a68
> new file mode 100644
> index 00000000000..f4d3141db3c
> --- /dev/null
> +++ b/gcc/testsuite/algol68/execute/posix-lseek.a68
> @@ -0,0 +1,11 @@
> +begin int fd = fopen ("../../ga68", file_o_default);
> + assert (fd /= -1);
> + long long int offset;
> + offset := lseek (fd, long 0, seek_cur);
> + assert (offset = long long 0);
> + offset := lseek (fd, long 0, seek_set);
> + assert (offset = long long 0);
> + offset := lseek (fd, long 0, seek_end);
> + long long int file_size = fsize (fd);
> + assert (offset = file_size)
> +end
> diff --git a/libga68/config.h.in b/libga68/config.h.in
> index 06421c483d9..3808a09eed4 100644
> --- a/libga68/config.h.in
> +++ b/libga68/config.h.in
> @@ -9,6 +9,12 @@
> /* Define to 1 if you have the <memory.h> header file. */
> #undef HAVE_MEMORY_H
>
> +/* Define if SEEK_DATA is supported. */
> +#undef HAVE_SEEK_DATA
> +
> +/* Define if SEEK_HOLE is supported. */
> +#undef HAVE_SEEK_HOLE
> +
> /* Define to 1 if you have the <stdint.h> header file. */
> #undef HAVE_STDINT_H
>
> diff --git a/libga68/configure b/libga68/configure
> index 328b22c5402..c95097cac40 100755
> --- a/libga68/configure
> +++ b/libga68/configure
> @@ -12886,6 +12886,70 @@ SPEC_LIBGA68_DEPS="$LIBS"
> libga68_VERSION=1:0:0
>
>
> +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEEK_DATA" >&5
> +$as_echo_n "checking for SEEK_DATA... " >&6; }
> +if ${ga68_cv_seek_data+:} false; then :
> + $as_echo_n "(cached) " >&6
> +else
> +
> + cat confdefs.h - <<_ACEOF >conftest.$ac_ext
> +/* end confdefs.h. */
> +
> +#include <unistd.h>
> +#ifdef SEEK_DATA
> +found
> +#endif
> +
> +_ACEOF
> +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
> + $EGREP "found" >/dev/null 2>&1; then :
> + ga68_cv_seek_data=yes
> +else
> + ga68_cv_seek_data=no
> +fi
> +rm -f conftest*
> +
> +fi
> +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ga68_cv_seek_data" >&5
> +$as_echo "$ga68_cv_seek_data" >&6; }
> +if test "x$ga68_cv_seek_data" = xyes; then
> +
> +$as_echo "#define HAVE_SEEK_DATA 1" >>confdefs.h
> +
> +fi
> +
> +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEEK_HOLE" >&5
> +$as_echo_n "checking for SEEK_HOLE... " >&6; }
> +if ${ga68_cv_seek_hole+:} false; then :
> + $as_echo_n "(cached) " >&6
> +else
> +
> + cat confdefs.h - <<_ACEOF >conftest.$ac_ext
> +/* end confdefs.h. */
> +
> +#include <unistd.h>
> +#ifdef SEEK_HOLE
> +found
> +#endif
> +
> +_ACEOF
> +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
> + $EGREP "found" >/dev/null 2>&1; then :
> + ga68_cv_seek_hole=yes
> +else
> + ga68_cv_seek_hole=no
> +fi
> +rm -f conftest*
> +
> +fi
> +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ga68_cv_seek_hole" >&5
> +$as_echo "$ga68_cv_seek_hole" >&6; }
> +if test "x$ga68_cv_seek_hole" = yes; then
> +
> +$as_echo "#define HAVE_SEEK_HOLE 1" >>confdefs.h
> +
> +fi
> +
> # The Boehm GC
>
> # Check whether --enable-algol68-gc was given.
> diff --git a/libga68/configure.ac b/libga68/configure.ac
> index 5adf132932d..ecc9035ba7a 100644
> --- a/libga68/configure.ac
> +++ b/libga68/configure.ac
> @@ -180,6 +180,28 @@ AC_SUBST(SPEC_LIBGA68_DEPS)
> libga68_VERSION=1:0:0
> AC_SUBST(libga68_VERSION)
>
> +AC_CACHE_CHECK(for SEEK_DATA, ga68_cv_seek_data, [
> + AC_EGREP_CPP(found, [
> +#include <unistd.h>
> +#ifdef SEEK_DATA
> +found
> +#endif
> + ], ga68_cv_seek_data=yes, ga68_cv_seek_data=no)])
> +if test "x$ga68_cv_seek_data" = xyes; then
> + AC_DEFINE(HAVE_SEEK_DATA, 1, [Define if SEEK_DATA is supported.])
> +fi
> +
> +AC_CACHE_CHECK(for SEEK_HOLE, ga68_cv_seek_hole, [
> + AC_EGREP_CPP(found, [
> +#include <unistd.h>
> +#ifdef SEEK_HOLE
> +found
> +#endif
> + ], ga68_cv_seek_hole=yes, ga68_cv_seek_hole=no)])
> +if test "x$ga68_cv_seek_hole" = yes; then
> + AC_DEFINE(HAVE_SEEK_HOLE, 1, [Define if SEEK_HOLE is supported.])
> +fi
> +
> # The Boehm GC
>
> AC_ARG_ENABLE(algol68-gc,
> diff --git a/libga68/ga68-posix.c b/libga68/ga68-posix.c
> index 51c92f1cdfe..8329568ef4e 100644
> --- a/libga68/ga68-posix.c
> +++ b/libga68/ga68-posix.c
> @@ -20,6 +20,8 @@
> COPYING3 and COPYING.RUNTIME respectively. If not, see
> <http://www.gnu.org/licenses/>. */
>
> +#include "ga68.h"
> +
> #include <stdlib.h>
> #include <stdio.h>
> #include <string.h>
> @@ -32,8 +34,6 @@
> #include <netdb.h> /* For gethostbyname. */
> #include <limits.h> /* For LLONG_MAX */
>
> -#include "ga68.h"
> -
> #define EOF_PSEUDO_CHARACTER -1
>
> /* Some Unicode code points used in this file. */
> @@ -404,3 +404,41 @@ _libga68_posixfsize (int fd)
>
> return (long int) stat.st_size;
> }
> +
> +/* Implementation of the posix prelude `lseek'. */
> +#define A68_SEEK_CUR 0
> +#define A68_SEEK_END 1
> +#define A68_SEEK_SET 2
> +#define A68_SEEK_HOLE 3
> +#define A68_SEEK_DATA 4
> +
> +long long int
> +_libga68_posixlseek (int fd, long int offset, int whence)
> +{
> + switch (whence)
> + {
> + case A68_SEEK_CUR:
> + whence = SEEK_CUR;
> + break;
> + case A68_SEEK_END:
> + whence = SEEK_END;
> + break;
> + case A68_SEEK_SET:
> + whence = SEEK_SET;
> + break;
> +#ifdef HAVE_SEEK_DATA
> + case A68_SEEK_DATA:
> + whence = SEEK_DATA;
> + break;
> +#endif
> +#ifdef HAVE_SEEK_HOLE
> + case A68_SEEK_HOLE:
> + whence = SEEK_HOLE;
> + break;
> +#endif
> + }
> +
> + off_t ret = lseek(fd, offset, whence);
> + _libga68_errno = errno;
> + return (long int) ret;
> +}
> diff --git a/libga68/ga68.h b/libga68/ga68.h
> index 4149d81c484..7e61fde8a14 100644
> --- a/libga68/ga68.h
> +++ b/libga68/ga68.h
> @@ -22,6 +22,8 @@
> #ifndef GA68_H
> #define GA68_H
>
> +#include "config.h"
> +
> #include <stddef.h> /* For size_t. */
> #include <stdint.h>
> #include <stdarg.h>
> @@ -97,6 +99,7 @@ uint32_t *_libga68_posixgets (int nchars, size_t *len);
>
> int _libga68_posixfconnect (uint32_t *str, size_t len, size_t stride,
> int port);
> +long long int _libga68_posixlseek (int fd, long int offset, int whence);
>
> /* ga68-unistr.c */
More information about the Algol68
mailing list