Linking to libraries in the ELF?

2021-01-29 Thread Maxime Devos
Hi guilers,

I've got this crazy idea a few days ago, about the FFI interface.
When a program written in C is compiled with some shared libraries,
these libraries are referred to in special [insert ELF terminology
here] of the binary.  I wonder if it would be reasonable and feasible
to do something similar for compiles guile modules?

C example:
$ readelf -d `which guile`
  TagType Name/Value
 0x0001 (NEEDED) Shared library: [libguile-3.0.so.1]
 0x0001 (NEEDED) Shared library: [libgc.so.1]
 0x0001 (NEEDED) Shared library: [libpthread.so.0]
 0x0001 (NEEDED) Shared library: [libffi.so.7]
 [snip]
 0x001d (RUNPATH)Library runpath: [[snip]]
 [snip]

Hypothetical Scheme example:
$ readelf -d 
$HOME/.guix-profile/lib/guile/3.0/site-ccache/chickadee/audio/vorbis.go
  TagType Name/Value
 0x0001 (NEEDED) Shared library: [libvorbisfile.so.3]
 0x001d (RUNPATH)Library runpath: [[snip]]
 0x37146003 (: 37146003) 0x302
 0x37146002 (: 37146002) 0xe8
 0x37146000 (: 37146000) 0x2
 0x37146001 (: 37146001) 0xaaa0
 0x000c (INIT)   0x6bd0
 0x37146004 (: 37146004) 0x15530
 0x (NULL)   0x0

This would require fleshing out some details though,
such as when to use RUNPATH and when not, cross-platform support,
where to find the libraries, some things I probably forgot.

WDYT?

Maxime


signature.asc
Description: PGP signature


Some non-standard O_* flags are missing

2021-01-31 Thread Maxime Devos
Hi guilers,

I noticed the following open flags are not defined:
O_NOFOLLOW, O_TMPFILE, O_IGNORE_CTTY, O_NOLINK,
O_SHLOCK, O_EXLOCK, O_ASYNC, O_NOATIME.

Some of these are Hurd-specific, Linux-specific
and BSD-specific.  I'm particularily interested
in O_NOFOLLOW, O_TMPFILE, O_IGNORE_CTTY, O_NOLINK
and O_NOATIME, the others don't matter for me,
though they may be useful for others.

Could extra O_* flags be exported to Guile (in libguile/filesys.c)
on systems where they are defined?

Greetings,
Maxime
-- 
Maxime Devos 
PGP Key: C1F3 3EE2 0C52 8FDB 7DD7  011F 49E3 EE22 1917 25EE
Freenode handle: mdevos


signature.asc
Description: This is a digitally signed message part


Re: Preventing file descriptor leak to execl'd processes

2021-03-06 Thread Maxime Devos
On Sat, 2021-03-06 at 17:55 +0100, Marius Bakke wrote:
> Hello Guilers,
> 
> [...]
> 
> It works great, except that the script filename (/tmp/test-shell) has
> an open file descriptor which leaks into the new process:
> 
> [...]
> 
> I've managed to work around it by setting FD_CLOEXEC on it:
> 
> [code using port-for-each and port-filename]
> 
> But it seems heavy-handed.  Is there an easier way to access the "script
> port"?  Perhaps Guile itself should make it FD_CLOEXEC by default?

Easy way to access the ‘script port’: the Scheme procedure current-load-port.
Take a look at the output of the attached script.

Greetings,
Maxime
#!/gnu/store/m5iprcg6pb5ch86r9agmqwd8v6kp7999-guile-3.0.5/bin/guile --no-auto-compile
!#
(eval-when (expand)
  (pk 'expand (current-load-port) (fileno (current-load-port
(eval-when (load)
  (pk 'load (current-load-port) (fileno (current-load-port
(eval-when (eval)
  (pk 'eval (current-load-port) (fileno (current-load-port
(eval-when (compile)
  (pk 'compile (current-load-port) (fileno (current-load-port


signature.asc
Description: This is a digitally signed message part


[PATCH] Add scm_remember_upto_here to functions using a port's fd.

2021-03-06 Thread Maxime Devos
This prevents a garbage collection cycle at an inopportune
time from closing a port while its file descriptor is still
required.

* libguile/filesys.c
  (scm_chown, scm_stat, scm_fcntl, scm_fsync, scm_sendfile)
  (scm_chmod): Add a scm_remember_upto_here after the system call
  is done with fhe file descriptor.
* libguile/fports.c
  (fport_input_waiting, fport_read, fport_write, fport_seek)
  (fport_truncate, fport_close, port_random_access_p)
  (fport_get_natural_buffer_sizes): Likewise.
* libguile/ioext.c
  (scm_dup_to_fdes, scm_dup2, scm_isatty_p)
  (scm_primitive_move_to_fdes): Likewise.
* libguile/posix.c
  (scm_ttyname, scm_tcgetpgrp, scm_tcsetpgrp, scm_flock): Likewise.
  (scm_piped_process): Likewise, and introduce the 'error_port',
  'output_port' and 'input_port' variables in order to be able
  to remember these later.
* libguile/rw.c
  (scm_read_string_x_partial, scm_write_string_partial): Likewise,
  and introduce a 'port' variable in order to be able to remember
  it later.
---
 THANKS |  1 +
 libguile/filesys.c |  6 ++
 libguile/fports.c  | 11 +++
 libguile/ioext.c   |  7 ++-
 libguile/posix.c   | 28 +---
 libguile/rw.c  | 26 --
 libguile/socket.c  | 17 ++---
 7 files changed, 75 insertions(+), 21 deletions(-)

diff --git a/THANKS b/THANKS
index aa4877e95..cdfa9e10d 100644
--- a/THANKS
+++ b/THANKS
@@ -78,6 +78,7 @@ For fixes or providing information which led to a fix:
   Brian Crowder
 Christopher Cramer
    Josh Datko
+ Maxime Devos
   David Diffenbaugh
   Hyper Division
Erik Dominikus
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 020c9cf7b..60311501e 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -177,6 +177,7 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
  SCM_FPORT_FDES (object) : scm_to_int (object));
 
   SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
@@ -546,6 +547,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
   SCM_VALIDATE_OPFPORT (1, object);
   fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
+  scm_remember_upto_here_1 (object);
 }
 
   if (rv == -1)
@@ -977,6 +979,7 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
   SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
   if (rv == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1004,6 +1007,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
 
   if (fsync (fdes) == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1225,6 +1229,7 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 
   }
 
+  scm_remember_upto_here_2 (in, out);
   return scm_from_size_t (total);
 
 #undef VALIDATE_FD_OR_PORT
@@ -1418,6 +1423,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
   else
fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
diff --git a/libguile/fports.c b/libguile/fports.c
index 4a3c30b88..5c59f0958 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -480,6 +480,7 @@ fport_input_waiting (SCM port)
   if (poll (&pollfd, 1, 0) < 0)
 scm_syserror ("fport_input_waiting");
 
+  scm_remember_upto_here_1 (port);
   return pollfd.revents & POLLIN ? 1 : 0;
 }
 
@@ -606,6 +607,7 @@ fport_read (SCM port, SCM dst, size_t start, size_t count)
 return -1;
   scm_syserror ("fport_read");
 }
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -630,6 +632,7 @@ fport_write (SCM port, SCM src, size_t start, size_t count)
   scm_syserror ("fport_write");
 }
 
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -640,6 +643,7 @@ fport_seek (SCM port, scm_t_off offset, int whence)
   scm_t_off result;
 
   result = lseek (fp->fdes, offset, whence);
+  scm_remember_upto_here_1 (port);
 
   if (result == -1)
 scm_syserror ("fport_seek");
@@ -654,6 +658,8 @@ fport_truncate (SCM port, scm_t_off length)
 
   if (ftruncate (fp->fdes, length) == -1)
 scm_syserror ("ftruncate");
+
+  scm_remember_upto_here_1 (port);
 }
 
 static void
@@ -673,6 +679,8 @@ fport_close (SCM port)
Instead just throw an error if close fails, trusting that the fd
was cleaned up.  */
 scm_syserror ("fport_close");
+
+  scm_remember_upto_here_1 (port);
 }
 
 static int
@@ -686,6 +694,7 @@ fport_random_access_p (SCM port)
   if (lseek (fp->fdes, 0, SEEK_CUR) == -1)
 return 0;
 
+  scm_remember_upto_here_1 (port);
   return 1;
 }
 

[PATCH] Add scm_remember_upto_here to functions using a port's fd.

2021-03-06 Thread Maxime Devos
Oops, I forgot to add myself to THANKS.
Seems rather presumptive of me, but it's
recommended by HACKING ...
From b3fe19e393b88a5227f9f1b9e1f5de09985c4e3d Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Sat, 6 Mar 2021 21:39:52 +0100
Subject: [PATCH] Add scm_remember_upto_here to functions using a port's fd.

This prevents a garbage collection cycle at an inopportune
time from closing a port while its file descriptor is still
required.

* libguile/filesys.c
  (scm_chown, scm_stat, scm_fcntl, scm_fsync, scm_sendfile)
  (scm_chmod): Add a scm_remember_upto_here after the system call
  is done with fhe file descriptor.
* libguile/fports.c
  (fport_input_waiting, fport_read, fport_write, fport_seek)
  (fport_truncate, fport_close, port_random_access_p)
  (fport_get_natural_buffer_sizes): Likewise.
* libguile/ioext.c
  (scm_dup_to_fdes, scm_dup2, scm_isatty_p)
  (scm_primitive_move_to_fdes): Likewise.
* libguile/posix.c
  (scm_ttyname, scm_tcgetpgrp, scm_tcsetpgrp, scm_flock): Likewise.
  (scm_piped_process): Likewise, and introduce the 'error_port',
  'output_port' and 'input_port' variables in order to be able
  to remember these later.
* libguile/rw.c
  (scm_read_string_x_partial, scm_write_string_partial): Likewise,
  and introduce a 'port' variable in order to be able to remember
  it later.
* THANKS: Add patch author.
---
 THANKS |  1 +
 libguile/filesys.c |  6 ++
 libguile/fports.c  | 11 +++
 libguile/ioext.c   |  7 ++-
 libguile/posix.c   | 28 +---
 libguile/rw.c  | 26 --
 libguile/socket.c  | 17 ++---
 7 files changed, 75 insertions(+), 21 deletions(-)

diff --git a/THANKS b/THANKS
index aa4877e95..cdfa9e10d 100644
--- a/THANKS
+++ b/THANKS
@@ -78,6 +78,7 @@ For fixes or providing information which led to a fix:
   Brian Crowder
 Christopher Cramer
Josh Datko
+ Maxime Devos
   David Diffenbaugh
   Hyper Division
Erik Dominikus
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 020c9cf7b..60311501e 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -177,6 +177,7 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 		  SCM_FPORT_FDES (object) : scm_to_int (object));
 
   SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
@@ -546,6 +547,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
   SCM_VALIDATE_OPFPORT (1, object);
   fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
+  scm_remember_upto_here_1 (object);
 }
 
   if (rv == -1)
@@ -977,6 +979,7 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
   SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
   if (rv == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1004,6 +1007,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
 
   if (fsync (fdes) == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1225,6 +1229,7 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 
   }
 
+  scm_remember_upto_here_2 (in, out);
   return scm_from_size_t (total);
 
 #undef VALIDATE_FD_OR_PORT
@@ -1418,6 +1423,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
   else
 	fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
diff --git a/libguile/fports.c b/libguile/fports.c
index 4a3c30b88..5c59f0958 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -480,6 +480,7 @@ fport_input_waiting (SCM port)
   if (poll (&pollfd, 1, 0) < 0)
 scm_syserror ("fport_input_waiting");
 
+  scm_remember_upto_here_1 (port);
   return pollfd.revents & POLLIN ? 1 : 0;
 }
 
@@ -606,6 +607,7 @@ fport_read (SCM port, SCM dst, size_t start, size_t count)
 return -1;
   scm_syserror ("fport_read");
 }
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -630,6 +632,7 @@ fport_write (SCM port, SCM src, size_t start, size_t count)
   scm_syserror ("fport_write");
 }
 
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -640,6 +643,7 @@ fport_seek (SCM port, scm_t_off offset, int whence)
   scm_t_off result;
 
   result = lseek (fp->fdes, offset, whence);
+  scm_remember_upto_here_1 (port);
 
   if (result == -1)
 scm_syserror ("fport_seek");
@@ -654,6 +658,8 @@ fport_truncate (SCM port, scm_t_off length)
 
   if (ftruncate (fp->fdes, length) == -1)
 scm_syserror ("ftruncate");
+
+  scm_remember_upto_here_1 (port);
 }
 
 static void
@@ -673,6 +679,8 @@ fport_close (SCM port)
Instead just throw an error if close fails, trusting that th

Re: Some non-standard O_* flags are missing

2021-03-09 Thread Maxime Devos
On Tue, 2021-03-09 at 21:36 +0100, Andy Wingo wrote:
> Hi :)  Sure, would be happy to accept a patch for these.
See 
and messages above.  I'll look at updating NEWS and the manual
later.

>   It's adding
> more definitions to the base environment, which is usually a negative,
> but we'll have to find some kind of module solution for all of these
> flags at some point.

Would defining O_* in a new module (ice-9 open-flags)
(or the existing module (ice-9 posix) maybe?) be acceptable?
Or alternatively, a syntax (open-flag SYMBOL) that expands to
the flag's value --

the last one might be tricky in a
cross-compilation context, but I suppose it would be possible
to define some script "c-snarf" for gathering #define values
from some C include headers to generate a target-architecture specific
table "???/lib/guile/$VERSION/c-defines/$SYSTEM/open-flags.alist",
or something like that.

(Perhaps not really ideal for non-Scheme languages that don't
use Scheme's macro system, but on the plus side the flags would
be inlined in the .go.)

-- Well, that's a little complicated for this patch (-:.
But something to think about perhaps, for eventual native
compilation.  (IIRC Racket and Common Lisp have a FFI
that understands C include files to some degree.)

>   If you do send a patch, please update the manual
> and NEWS also.

The manual only documents O_RDONLY, O_WRONLY, O_RDWR,
O_APPEND and O_CREAT currently, and points the reader
at glibc's manual for additional flags.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


[PATCH] Bindings to *at functions & allowing more functions to operate on ports

2021-03-12 Thread Maxime Devos
Hi guilers!

This patch series defines:
* More AT_* and O_* flags.
* Bindings to *at functions (e.g. mkdirat, fchmodat).
* Bindings to f* functions (e.g. fchdir).
  (No new functions, the old functions just accept more types.)

It also sprinkles some scm_remember_upto_here's in
some procedures operating on ports where I think it's needed.

I haven't assigned copyright to the FSF, how would this work?

Greetings,
Maxime
From e4deaca45606a9ade686e7cf447c9cec93e8c9e2 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Sat, 6 Mar 2021 21:39:52 +0100
Subject: [PATCH 01/17] Add scm_remember_upto_here to functions using a port's
 fd.

This prevents a garbage collection cycle at an inopportune
time from closing a port while its file descriptor is still
required.

* libguile/filesys.c
  (scm_chown, scm_stat, scm_fcntl, scm_fsync, scm_sendfile)
  (scm_chmod): Add a scm_remember_upto_here after the system call
  is done with fhe file descriptor.
* libguile/fports.c
  (fport_input_waiting, fport_read, fport_write, fport_seek)
  (fport_truncate, fport_close, port_random_access_p)
  (fport_get_natural_buffer_sizes): Likewise.
* libguile/ioext.c
  (scm_dup_to_fdes, scm_dup2, scm_isatty_p)
  (scm_primitive_move_to_fdes): Likewise.
* libguile/posix.c
  (scm_ttyname, scm_tcgetpgrp, scm_tcsetpgrp, scm_flock): Likewise.
  (scm_piped_process): Likewise, and introduce the 'error_port',
  'output_port' and 'input_port' variables in order to be able
  to remember these later.
* libguile/rw.c
  (scm_read_string_x_partial, scm_write_string_partial): Likewise,
  and introduce a 'port' variable in order to be able to remember
  it later.
* THANKS: Add patch author.
---
 THANKS |  1 +
 libguile/filesys.c |  6 ++
 libguile/fports.c  | 11 +++
 libguile/ioext.c   |  7 ++-
 libguile/posix.c   | 28 +---
 libguile/rw.c  | 26 --
 libguile/socket.c  | 17 ++---
 7 files changed, 75 insertions(+), 21 deletions(-)

diff --git a/THANKS b/THANKS
index aa4877e95..cdfa9e10d 100644
--- a/THANKS
+++ b/THANKS
@@ -78,6 +78,7 @@ For fixes or providing information which led to a fix:
   Brian Crowder
     Christopher Cramer
Josh Datko
+ Maxime Devos
   David Diffenbaugh
   Hyper Division
Erik Dominikus
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 666bcb8c3..b97614498 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -177,6 +177,7 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 		  SCM_FPORT_FDES (object) : scm_to_int (object));
 
   SCM_SYSCALL (rv = fchown (fdes, scm_to_int (owner), scm_to_int (group)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
@@ -581,6 +582,7 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
   SCM_VALIDATE_OPFPORT (1, object);
   fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fstat_or_fstat64 (fdes, &stat_temp));
+  scm_remember_upto_here_1 (object);
 }
 
   if (rv == -1)
@@ -1012,6 +1014,7 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
   SCM_SYSCALL (rv = fcntl (fdes, scm_to_int (cmd), ivalue));
   if (rv == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return scm_from_int (rv);
 }
 #undef FUNC_NAME
@@ -1039,6 +1042,7 @@ SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
 
   if (fsync (fdes) == -1)
 SCM_SYSERROR;
+  scm_remember_upto_here_1 (object);
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -1260,6 +1264,7 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3, 1, 0,
 
   }
 
+  scm_remember_upto_here_2 (in, out);
   return scm_from_size_t (total);
 
 #undef VALIDATE_FD_OR_PORT
@@ -1453,6 +1458,7 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
   else
 	fdes = SCM_FPORT_FDES (object);
   SCM_SYSCALL (rv = fchmod (fdes, scm_to_int (mode)));
+  scm_remember_upto_here_1 (object);
 }
   else
 #endif
diff --git a/libguile/fports.c b/libguile/fports.c
index 4a3c30b88..5c59f0958 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -480,6 +480,7 @@ fport_input_waiting (SCM port)
   if (poll (&pollfd, 1, 0) < 0)
 scm_syserror ("fport_input_waiting");
 
+  scm_remember_upto_here_1 (port);
   return pollfd.revents & POLLIN ? 1 : 0;
 }
 
@@ -606,6 +607,7 @@ fport_read (SCM port, SCM dst, size_t start, size_t count)
 return -1;
   scm_syserror ("fport_read");
 }
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -630,6 +632,7 @@ fport_write (SCM port, SCM src, size_t start, size_t count)
   scm_syserror ("fport_write");
 }
 
+  scm_remember_upto_here_1 (port);
   return ret;
 }
 
@@ -640,6 +643,7 @@ fport_seek (SCM port, scm_t_off offset, int whence)
   scm_t_off result;
 
   result = lseek (fp->fdes, offset, whence);
+  scm_remember_upto_here_1 (port);
 
   if (result == -1)

Re: [PATCH] Bindings to *at functions & allowing more functions to operate on ports

2021-03-27 Thread Maxime Devos
Hi,

[CC'ing some Guile and Guix maintainers because this is
important for the security of Guix System.]

I want to explain why these patches (and the O_FLAGS (*)
patch) should be included in Guile.  Functions like "openat"
are important to avoid TOCTTOU (time-of-check to time-of-use)
vulnerabilities involving symbolic links.

For example, suppose we have a web server implemented in
Guile.  Suppose the address is https://web.gnu.  It allows
a local user U (and some others) to define their own web
pages to host at http://web.gnu/~U, by writing files to
/home/U/www.  As there are multiple users, the server has
to run as root.

Now suppose U is the malicious kind of user.  Then $U
could create a symlink at /home/U/www/maliciousity pointing
to /home/other-user/.gnupg/private-keys-v1.d/FINGERPRINT.key.

Now U could download other-user's gpg key, for example
with "wget http://web.gnu/~U/maliciousity";.  Oops!

How can this vulnerability be avoided?

* Use O_NOFOLLOW to *not* follow the symbolic link.
  Patch for adding O_NOFOLLOW to guile:
  .

And why do we need openat?  Well, suppose the web server
is not read-only, and supports (say) WebDAV or FTP for
modifying files remotely (I mean U can remotely modify
http://web.gnu/~U).  Then U could create a symlink
at /home/U/www/maliciousity pointing to /home/other-user.
Now U can peek into other-user's home directory and overwrite
files.  Oops!

How can the web server avoid this?

* First open "/home/U" as usual, resulting in a port $1.
  Then use (openat $1 "maliciousity" O_NOFOLLOW), resulting
  in a port $2.  Use (stat $2) to see if $2 is a directory
  or a regular file **and** to see if $2 is owned by $2!
  If necessary, recurse, etc.  Display a directory listing
  or display the file, etc.

How does this matter for Guix?

Guix has a TOCTTOU race:
.
It has been partially fixed:
.
However, a complete fix requires bindings to "openat".

I found another similar issue in Guix lately (not yet disclosed publicly).
While I think the conditions for this other potential security issue
to be exploitable don't ever happen in practice, I would still like
to fix this issue, and to be able to prevent similar issues from appearing
in the future.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Allow null bytes in UNIX sockets.

2021-03-29 Thread Maxime Devos
On Mon, 2021-03-29 at 17:37 +0200, Leo Prikler wrote:
> The current socket address constructors all assume, that there are no
> null bytes in the socket path.  This assumption does not hold in Linux,
> which uses an initial null byte to demarcate abstract sockets and
> ignores all further null bytes [1].
> 
> [1] https://www.man7.org/linux/man-pages/man7/unix.7.html
> 

This is necessary to connect to dbus (I forgot the proper capitalisation)
in some set-ups.  I tried implementing this at some point, but Guile
crashed and I gave up.

Thank you for looking into this!  One comment below.

> [...]
> diff --git a/test-suite/tests/00-socket.test b/test-suite/tests/00-socket.test
> index 027bd8519..5196b4b7d 100644
> --- a/test-suite/tests/00-socket.test
> +++ b/test-suite/tests/00-socket.test
> @@ -128,10 +128,15 @@
>  (= (sockaddr:flowinfo sa*) 1)
>  
>(if (defined? 'AF_UNIX)
> -  (pass-if "AF_UNIX"
> - (let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
> -   (and (= (sockaddr:fam sa) AF_UNIX)
> -(string=? (sockaddr:path sa) "/tmp/unix-socket"))
> +  (begin
> +(pass-if "AF_UNIX"
> +   (let ((sa (make-socket-address AF_UNIX "/tmp/unix-socket")))
> + (and (= (sockaddr:fam sa) AF_UNIX)
> +  (string=? (sockaddr:path sa) "/tmp/unix-socket"
> +(pass-if "AF_UNIX abstract"
> +  (let ((sa (make-socket-address AF_UNIX 
> "\x00/tmp/abstract-socket")))
> + (and (= (sockaddr:fam sa) AF_UNIX)
> +  (string=? (sockaddr:path sa) "\x00/tmp/abstract-socket")))

Shouldn't this code use $TMPDIR or some variable like that?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] srfi-64: fix unused variable warnings

2021-04-01 Thread Maxime Devos
On Wed, 2021-03-31 at 23:11 -0700, Aleix Conchillo Flaqué wrote:
> * module/srfi/srfi-64/testing.scm: remove unused name variable and use
> let instead of let*.
> 

I don't think this is the correct approach with respect to side effects.
For example, in:

>  (define (%test-comp2 comp x)
>  (syntax-case (list x (list (syntax quote) (%test-source-line2 x)) comp) 
> ()
>(((mac tname expected expr) line comp)
> (syntax
> - (let* ((r (test-runner-get))
> -(name tname))
> + (let ((r (test-runner-get)))
> (test-result-alist! r (cons (cons 'test-name tname) line))
> (%test-comp2body r comp expected expr

I would keep the let* (but reverse the binding order), but change 'tname'
with 'name' in the call to 'test-result-alist!', such that 'test-X' macros
behave somewhat more like procedure calls (except for installing exeption
handlers and having access to the s-expression of the code that will be run,
of course).  It's largely a matter of taste, though.

In any case, it is good that 'tname' is now evaluated only once, as per
SRFI-64 (notice ***It is evaluated only once.*** (markup mine)):

 (test-assert [test-name] expression)

 This evaluates the expression. The test passes if the result is true;
 if the result is false, a test failure is reported. The test also fails
 if an exception is raised, assuming the implementation has a way to catch
 exceptions. How the failure is reported depends on the test runner environment.
 The test-name is a string that names the test case. (Though the test-name is
 a string literal in the examples, it is an expression. ***It is evaluated only 
once.***)
 It is used when reporting errors, and also when skipping tests, as described 
below.
 It is an error to invoke test-assert if there is no current test runner.

(My suggestion would be to also evaluate 'test-name' at least once, even if 
there
is no test runner, which seems a bit stricter than SRFI-64 demands, but seems 
like
a nice property to have and easy to achieve.)

As this patch does not ‘merely’ fix a warnings, but fixes a bug, could you 
change
the patch message accordingly?  Something like

  srfi-64: fix double evaluation of test-name.

perhaps?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] srfi-64: fix unused variable warnings

2021-04-01 Thread Maxime Devos
On Thu, 2021-04-01 at 23:12 -0700, Aleix Conchillo Flaqué wrote:
> Hi Maxime,
> 
> Thank you for your comments!
> 
> On Thu, Apr 1, 2021 at 4:37 AM Maxime Devos  wrote:
> 
> > For example, in:
> > 
> > >  (define (%test-comp2 comp x)
> > >  (syntax-case (list x (list (syntax quote) (%test-source-line2 x)) 
> > > comp) ()
> > >(((mac tname expected expr) line comp)
> > > (syntax
> > > - (let* ((r (test-runner-get))
> > > -(name tname))
> > > + (let ((r (test-runner-get)))
> > > (test-result-alist! r (cons (cons 'test-name tname) line))
> > > (%test-comp2body r comp expected expr
> > 
> > I would keep the let* (but reverse the binding order), but change 'tname'
> > with 'name' in the call to 'test-result-alist!', such that 'test-X' macros
> > behave somewhat more like procedure calls (except for installing exeption
> > handlers and having access to the s-expression of the code that will be run,
> > of course).  It's largely a matter of taste, though.
> > 
> 
> I've done this change. One thing I don't understand is the "reverse
> the binding order", I've done it as suggested but is this change the
> one you refer to as "matter of taste"?

Yes, that's the change I was referring to.  As to why: a procedural
equivalent of 'test-assert would look more or less like

;; (possibly more arguments are required)
(define* (test-assert* name thunk expression)
  ;; THUNK: when called, return something that will be
  ;;   used as true/false.
  ;; EXPRESSION: S-expression representing the body
  ;;  of THUNK
  (let ((r (test-runner-get)))
;; evaluate (thunk) here within some exception
;; handlers and use r
...))

(Similar equivalents to test-equal, test-eq ... can be written
as well.)

Suppose  '(test-assert* NAME (lambda () EXP) 'EXP) is evaluated.

Then first NAME is evaluated, which can have side-effects.  The
lambda expression and (quote EXP) are evaluated as well, but no
side-effects are possible here (aside for allocating some memory
for the thunk, which can lead to a 'out-of-memory exception, but
that's usually simply ignored).

Only after the arguments are evaluated will '(test-runner-get)
be evaluated.

However, for the original test-assert macro, the evaluation
order is different.  From a REPL:

> (use-modules (srfi srfi-26))
> ,expand (test-assert NAME EXP)
;; output manually cleaned up
$6 = (let* ((r (test-runner-get))
(name NAME))
   more code )

It should be clear that here 'NAME is evaluated *after*
'(test-runner-get) is evaluated, unlike for the 'test-assert*
procedure.

That said, SRFI-64 does not require NAME to be evaluated even
if trying to get the test runner fails for some reason, I
don't think anyone ever changes the test runner from within
a ‘call’ (not really a call as test-assert is a macro) to
test-assert, and in practice NAME is a constant, so in practice
it doesn't really matter in what order things are evaluated.

Also see next comment:

> > In any case, it is good that 'tname' is now evaluated only once, as per
> > SRFI-64 (notice ***It is evaluated only once.*** (markup mine)):
> > 
> > [...]
> Yes, this makes sense. Thanks again for pointing that out.

This is done correctly in the new patch (and the old patch IIRC).
Also, by reversing the binding order from

-   (let* ((r (test-runner-get))
-  (name tname))

to

+   (let* ((name tname)
+   (r (test-runner-get)))

the expression tname is also evaluated *at least* once,
thus TNAME is evaluated *exactly* once, which seems like
a nice property to have, though this is a bit stricter
than SRFI-64 demands IIUC.

Also, the formatting seems to have gone wrong.
Shouldn't this be

+   (let* ((name tname)
+  (r (test-runner-get)))

?  If in Emacs, I recommend scheme-mode, in which case pressing tab on the
second line would produce the desired formatting.  Alternatively, select
a region of text and presss tab.

> > As this patch does not ‘merely’ fix a warnings, but fixes a bug, could you 
> > change
> > the patch message accordingly?  Something like
> > 
> >   srfi-64: fix double evaluation of test-name.
> > 
> > perhaps?
> > 

The revised commit message looks good to me.

Greetings,
Maxime.
p.s: I'm not a guile maintainer so you will have to wait on
someone else to actually merge this.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Bindings to *at functions & allowing more functions to operate on ports

2021-05-05 Thread Maxime Devos
rob piko schreef op di 04-05-2021 om 18:58 [-0400]:
> Hello Maxime,
> 
> > * Use O_NOFOLLOW to *not* follow the symbolic link.
> >  Patch for adding O_NOFOLLOW to guile:
> 
> According to the man pages for the O_NOFOLLOW:
> 
> > If the trailing component (i.e., basename) of pathname is
> >   a symbolic link, then the open fails, with the error
> >   ELOOP.  Symbolic links in earlier components of the
> >   pathname will still be followed.
> 
> Sounds like O_NOFOLLOW would not fix the issue if the symlink is found in 
> other parts of the pathname outside of the basename?
Indeed! To avoid *all* symlinks, and not only a symlink in the trailing 
component,
you would need to call 'open' with O_NOFOLLOW in a loop.

Something like:
  (let* ((dir (open "/symlinks/acceptable-here" O_RDONLY))
 ;; Symlinks are not followed here.
 (dir* (openat dir "dir" (logior O_RDONLY O_NOFOLLOW)))
 (file (openat dir* "file" (logior O_RDONLY O_NOFOLLOW
(close dir)
(close dir*)
file)

It has been a while since I wrote the patch though, maybe the argument
order is a little different.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Add ‘expt’ to the list of effect-free primitives

2021-05-16 Thread Maxime Devos


From b9d0faf091c316d0811d73df9eea134dc23f8ed6 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Sun, 16 May 2021 20:32:34 +0200
Subject: [PATCH] =?UTF-8?q?Add=20=E2=80=98expt=E2=80=99=20to=20the=20list?=
 =?UTF-8?q?=20of=20effect-free=20primitives.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

I find myself writing code like (- (expt 2 32) 1)
lately. Let's allow constant-folding that.

* module/language/tree-il/primitives.scm
  (*interesting-primitive-names*, *effect-free-primitives*):
  Add 'expt'.
---
 module/language/tree-il/primitives.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 1cc7907a8..7f3746b4f 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -48,6 +48,7 @@
 memq memv
 = < > <= >= zero? positive? negative?
 + * - / 1- 1+ quotient remainder modulo exact->inexact
+expt
 ash logand logior logxor lognot logtest logbit?
 sqrt abs floor ceiling sin cos tan asin acos atan
 not
@@ -171,7 +172,7 @@
   `(values
 eq? eqv? equal?
 = < > <= >= zero? positive? negative?
-ash logand logior logxor lognot logtest logbit?
+expt ash logand logior logxor lognot logtest logbit?
 + * - / 1- 1+ sqrt abs quotient remainder modulo exact->inexact
 floor ceiling sin cos tan asin acos atan
 not
-- 
2.31.1



signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Remove unused variable.

2021-05-24 Thread Maxime Devos
Roel Janssen schreef op ma 24-05-2021 om 15:01 [+0200]:
> Hi Guilers,
> 
> While compiling Guile with "-Wall" I noticed this unused declaration.

I think you ned to modfy gnulib-local/lib/localcharset.c.diff
as well. It seems like the original localcharset.c comes from gnulib
and it has been patched for Guile. See attached (untested) diff.

LGTM otherwise (/me not Guile maintainer)

Greetings,
Maxime.
diff --git a/gnulib-local/lib/localcharset.c.diff b/gnulib-local/lib/localcharset.c.diff
index 04865a345..ec2816622 100644
--- a/gnulib-local/lib/localcharset.c.diff
+++ b/gnulib-local/lib/localcharset.c.diff
@@ -16,7 +16,7 @@ rationale.
 +environ_locale_charset (void)
 +{
 +  static char buf[2 + 10 + 1];
-+  const char *codeset, *aliases;
++  const char *codeset;
 +  const char *locale = NULL;
 +
 +  locale = getenv ("LC_ALL");


signature.asc
Description: This is a digitally signed message part


Re: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2021-06-17 Thread Maxime Devos
Linus Björnstam schreef op wo 16-06-2021 om 21:11 [+0200]:
> Hi there!
> 
> This patch updates some derived conditional forms (and do and and-let*)
> to support definitions in expression context. Meaning it makes this valid 
> code:
> 
> (cond 
>   ((pred? arg) 
> (define a (something arg))
> (when (error-case a)
>   (error "a is broken"))  [...]

This seems a useful change to me. However, this is not valid R6RS.
From :

(cond hcond clause1i hcond clause2i . . . ) syntax
=> auxiliary syntax
else auxiliary syntax
Syntax: Each hcond clausei must be of the form
(htesti hexpression1i . . . )
where htesti is an expression. Alternatively, a
hcond clausei may be of the form
(htesti => hexpressioni)

This seems a compatibility pitfall, so maybe note
in the documentation that using definitions in the clauses
is a Guile and Racket extension and not standard R6RS?

(I try to write Scheme code as R6RS / R7RS library & define-library
forms, importing mostly R6RS / R7RS & SRFI libraries, though I occasionally
use a Guile extension.)

Greetings,
Maxime


signature.asc
Description: This is a digitally signed message part


Re: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2021-06-17 Thread Maxime Devos
Linus Björnstam schreef op do 17-06-2021 om 14:57 [+0200]:
> Guile already does definitions in expression context in
> the bodies of lambda and let-variants. I think this is
> not a big problem since any valid r6rs code is still valid guile.

‘Guile already does definitions in expression context in [...]’:
good point.

> The discussion is in my opinion whether guile's r6rs modules should
> enforce this behaviour. That might be a good thing, even though we
> will provide 2 cons and case forms to do that.

Pro: if your code works when using r6rs modules (in Guile), then it should
work on any r6rs-conforming implementation.

Con: (@ (guile) cond) != (@ (rnrs base) cond), which can be surprising.

Con: ‘I know this usage isn't universally portable, but I'll cross that
bridge when needed. All the Scheme I care about do have this extension.
If a Scheme doesn't have this extension, I'll just patch that Scheme
(free software for the win!)’

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: thoughts on targetting the web

2021-06-20 Thread Maxime Devos
Andy Wingo schreef op za 19-06-2021 om 22:20 [+0200]:
>  5. Garbage collection.  *We should re-use the host GC*.  Although it
> would be possible to manage a heap in linear memory, that has
> retention problems due to cycles between the Guile heap and the JS
> heap.

I could be mistaken (and I haven't written any ECMAScript in a long time),
but I believe ECMAScript doesn't have guardians, gc hooks, weak vectors and
(key, value, key-value) weak hash tables. So, if we re-use the host GC,
that would mean those GC things cannot be used right?

In that case, it may be a good idea to raise an error at compile time
if some code tries to use these anyways. (I've been using guardians
and weak vectors lately.)

Greetings,
Maxime


signature.asc
Description: This is a digitally signed message part


Re: Ephemerons, self-referentality in weak hashtables

2021-06-20 Thread Maxime Devos
Christopher Lemmer Webber schreef op di 18-05-2021 om 11:46 [-0400]:
> Hello,
> 
> I'm finally taking some time to port Goblins to Guile, in-between other
> tasks anyway.  In Goblins there is a weak hashtable that maps current
> actor references to their current behavior.  I found that for
> self-referential actors, I needed ephemerons for GC stuff to work right.

Ephemeron SRFI: 

> In this old thread I found Wingo mentioning them:
> 
> Andy Wingo writes:
> 
> >   * If there is a possibility of a path from B to A, you need an
> > ephemeron table, and Guile doesn't do that right now.  But it
> > should!
> 
> Is there something ephemeron-like I should be doing?

Guile doesn't seem to have ephemerons, though it would be nice to
have them!

I've been looking at gc.h for how these could be implemented
(Guile uses BDW-GC for garbage collection).
The function GC_general_register_disappearing_link (void **link, const void 
*obj)
(https://github.com/ivmai/bdwgc/blob/master/include/gc.h#L1218) looks promising.
The idea is to have a C structure representing ephemerons

struct ephemeron {
  SCM key;
  SCM value; /* called ‘datum’in SRFI-124 */
}

do some magic to make ‘value’ and ‘keys’ ‘disguised pointers’ (i.e., tell 
BDW-GC that
‘key’ and ‘value’ doesn't really point to anything), and during construction
register ‘disappearing links’, such that ‘key’ and ‘value’ will be cleared
when ‘key’ becomes unreachable.

static void
initialise_ephemeron (struct ephemeron *eph, SCM key, SCM value)
{
  eph->key = key:
  eph->value = value;
  /* TODO: this can return an error */
  GC_general_register_disappearing_link (&eph->value, key);
  GC_general_register_disappearing_link (&eph->key, key);
}

Note that, according to the GC_general_register_disappearing_link docs,
reading eph->key and eph->value required holding th allocation lock,
so:

SCM
scm_ephemeron_key (SCM eph_scm)
{
  struct ephemeron *e = [type checks ...]
  SCM ret;
  [hold the lock]
  ret = e->key;
  [release the lock]
  return ret;
}

Likewise for ‘value’. Or maybe GC_general_register_disappearing_link
doesn't work that way ... requires testing!

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: thoughts on targetting the web

2021-06-20 Thread Maxime Devos
Chris Lemmer-Webber schreef op zo 20-06-2021 om 10:14 [-0400]:
> Weakmaps are a thing these days I think:
> https://developer.mozilla.org/en-US/docs/Web/JavaScript/Reference/Global_Objects/WeakMap

Nice, though it doesn't allow enumerating keys
(which is reasonable enough in practice)
and it doesn't support weak-value maps (where the reference
to the value is weak) and doubly-weak maps.

(I never used weak-value or doubly-weak maps though)

Also (unrelated), I have patch for ephemeral-key hash tables in Guile,
but it's buggy (the values sometimes become random heap objects
in some situations??) so I'll try to debug it first.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Ephemerons, self-referentality in weak hashtables

2021-06-21 Thread Maxime Devos
Maxime Devos schreef op zo 20-06-2021 om 17:01 [+0200]:
> Christopher Lemmer Webber schreef op di 18-05-2021 om 11:46 [-0400]:
> > Hello,
> > 
> > I'm finally taking some time to port Goblins to Guile, in-between other
> > tasks anyway.  In Goblins there is a weak hashtable that maps current
> > actor references to their current behavior.  I found that for
> > self-referential actors, I needed ephemerons for GC stuff to work right.
> 
> [bla bla on how this could be implemented in Guile]

This doesn't work because there is nothing preventing the
'value' from being freed. Trying to fix that now, using
the example implementation of "weak maps" in libgc.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: GC + Java finalization

2021-07-03 Thread Maxime Devos
Jonas Hahnfeld via Developers list for Guile, the GNU extensibility library 
schreef op za 03-07-2021 om 14:05 [+0200]:
> Hi Guile devs,
> 

Hi, I'm not really a Guile dev but I'll respond anyway.

> I'm hacking on GNU LilyPond and recently wondered if Guile could run
> without Java finalization that prevents collection of chains of
> unreachable objects.

Do you have an example where this is a problem?
I.e., did you encounter ‘chains of unreachable objects’ that were
uncollectable, and so, where?

> I found that the functionality is only needed once
> the first guardian is created, so it's possible to delay enabling the
> mode until then. This required some fixes to free functions that
> assumed dependent objects to be freed only later (see first two
> patches).
> The third patch delays ensuring Java finalization to scm_make_guardian,
> but doesn't disable it explicitly (it's on by default in bdwgc). This
> could now be done right after GC_INIT(), but it's not clear (at least
> to me) whether client applications actually rely it, so I think it's
> better if that's not done in Guile itself.
> 
> Please consider applying, the fixes potentially also to stable-2.2.
> 
> Thanks
> Jonas

I would need to look more closely at how ‘Java-style’ finalisation
works. Some comments anyway:

(first patch)

> * test-suite/standalone/test-smob-mark.c
>   (init_smob_type): Correct size of smob type.
>   (free_x): Clear smob data instead of local variable.
>   (test_scm_smob_mark): Put smobs in array to ensure marking.
>
> -  fprintf (stderr, "FAIL: SMOB mark function called for each SMOB\n");
> +  // Print pointer so it cannot be collected before.
> +  fprintf (stderr, "FAIL: SMOB mark function called for each SMOB (smobs 
> = %p)\n", smobs);
>exit (EXIT_FAILURE);

Normally scm_remember_upto_here is used for that.
Also, I believe "/* */"-style comments are used customarily used in Guile
instead of "//"-style comments.

> static void
> init_smob_type ()
> {
> -  x_tag = scm_make_smob_type ("x", sizeof (x_t));
> +  x_tag = scm_make_smob_type ("x", sizeof (x_t *));

This change seems to be a fix independent of the ‘do we want Java-style 
finalization’
question.

(third patch)

Note that guardians are used in (ice-9 popen).
They are also used by some guile libraries (e.g. guile-fibers),
so you can't use (ice-9 popen) or any library using guardians
if Java-style finalization is undesirable.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: GC + Java finalization

2021-07-03 Thread Maxime Devos
Jonas Hahnfeld schreef op za 03-07-2021 om 19:26 [+0200]:
> Sorry, I should have been clearer: Chains don't become uncollectable,
> but a chain of N objects takes N collections to be completely reclaimed
> (because Java finalization prepares for the possibility that a free
> function makes an object live again, as Guile does for guardians). This
> leads to unnecessary waste on the heap, and more work for the collector
> (even though I haven't been able to measure so far).

Disabling Java-style finalization would be an optimisation, ok!


signature.asc
Description: This is a digitally signed message part


Re: GC + Java finalization

2021-07-03 Thread Maxime Devos
Jonas Hahnfeld schreef op za 03-07-2021 om 19:26 [+0200]:

> > Normally scm_remember_upto_here is used for that.
> 
> I think I tried, but it wasn't available. Or I mistyped, not sure.

It is defined in .

Actually, the special case scm_remember_upto_here_1 would be prefered,
because it theoretically is more efficient.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Casts to pointer from integer of different size?

2021-07-06 Thread Maxime Devos
Hi guilers,

While debugging a build failure of guile on the core-updates branch
of guix (see https://isues.guix.gnu.org/49368) when build for
i686 (guix build --system=i686-linux), I noticed some following warnings
which look suspicious (plenty of tests are passing though, it is only
the test numbers.test that fails).

If they actually are harmless, can "vm-engine.c" be compiled with
-Wno-int-to-pointer-cast?

Greetings,
Maxime 

vm-engine.c: In function 'vm_regular_engine':
../libguile/scm.h:176:23: warning: cast to pointer from integer of different 
size [-Wint-to-pointer-cast]
  176 | # define SCM_PACK(x) ((SCM) (x))
  |   ^
../libguile/gc.h:49:72: note: in definition of macro 'SCM_GC_SET_CELL_OBJECT'
   49 | #define SCM_GC_SET_CELL_OBJECT(x, n, v) SCM *)SCM2PTR (x)) [n]) = 
(v))
  |^
../libguile/gc.h:51:38: note: in expansion of macro 'SCM_PACK'
   51 |   (SCM_GC_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
  |  ^~~~
../libguile/gc.h:67:36: note: in expansion of macro 'SCM_GC_SET_CELL_WORD'
   67 | #define SCM_SET_CELL_WORD(x, n, v) SCM_GC_SET_CELL_WORD ((x), (n), (v))
  |^~~~
vm-engine.c:1964:7: note: in expansion of macro 'SCM_SET_CELL_WORD'
 1964 |   SCM_SET_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx), SP_REF_U64 
(val));
  |   ^
../libguile/scm.h:176:23: warning: cast to pointer from integer of different 
size [-Wint-to-pointer-cast]
  176 | # define SCM_PACK(x) ((SCM) (x))
  |   ^
../libguile/gc.h:49:72: note: in definition of macro 'SCM_GC_SET_CELL_OBJECT'
   49 | #define SCM_GC_SET_CELL_OBJECT(x, n, v) SCM *)SCM2PTR (x)) [n]) = 
(v))
  |^
../libguile/gc.h:51:38: note: in expansion of macro 'SCM_PACK'
   51 |   (SCM_GC_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
  |  ^~~~
../libguile/gc.h:67:36: note: in expansion of macro 'SCM_GC_SET_CELL_WORD'
   67 | #define SCM_SET_CELL_WORD(x, n, v) SCM_GC_SET_CELL_WORD ((x), (n), (v))
  |^~~~
vm-engine.c:1996:7: note: in expansion of macro 'SCM_SET_CELL_WORD'
 1996 |   SCM_SET_CELL_WORD (SP_REF (obj), idx, SP_REF_U64 (val));
  |   ^
vm-engine.c: In function 'vm_debug_engine':
../libguile/scm.h:176:23: warning: cast to pointer from integer of different 
size [-Wint-to-pointer-cast]
  176 | # define SCM_PACK(x) ((SCM) (x))
  |   ^
../libguile/gc.h:49:72: note: in definition of macro 'SCM_GC_SET_CELL_OBJECT'
   49 | #define SCM_GC_SET_CELL_OBJECT(x, n, v) SCM *)SCM2PTR (x)) [n]) = 
(v))
  |^
../libguile/gc.h:51:38: note: in expansion of macro 'SCM_PACK'
   51 |   (SCM_GC_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
  |  ^~~~
../libguile/gc.h:67:36: note: in expansion of macro 'SCM_GC_SET_CELL_WORD'
   67 | #define SCM_SET_CELL_WORD(x, n, v) SCM_GC_SET_CELL_WORD ((x), (n), (v))
  |^~~~
vm-engine.c:1964:7: note: in expansion of macro 'SCM_SET_CELL_WORD'
 1964 |   SCM_SET_CELL_WORD (SP_REF (obj), SP_REF_U64 (idx), SP_REF_U64 
(val));
  |   ^
../libguile/scm.h:176:23: warning: cast to pointer from integer of different 
size [-Wint-to-pointer-cast]
  176 | # define SCM_PACK(x) ((SCM) (x))
  |   ^
../libguile/gc.h:49:72: note: in definition of macro 'SCM_GC_SET_CELL_OBJECT'
   49 | #define SCM_GC_SET_CELL_OBJECT(x, n, v) SCM *)SCM2PTR (x)) [n]) = 
(v))
  |^
../libguile/gc.h:51:38: note: in expansion of macro 'SCM_PACK'
   51 |   (SCM_GC_SET_CELL_OBJECT ((x), (n), SCM_PACK (v)))
  |  ^~~~
../libguile/gc.h:67:36: note: in expansion of macro 'SCM_GC_SET_CELL_WORD'
   67 | #define SCM_SET_CELL_WORD(x, n, v) SCM_GC_SET_CELL_WORD ((x), (n), (v))
  |^~~~
vm-engine.c:1996:7: note: in expansion of macro 'SCM_SET_CELL_WORD'
 1996 |   SCM_SET_CELL_WORD (SP_REF (obj), idx, SP_REF_U64 (val));


signature.asc
Description: This is a digitally signed message part


Fwd: [PATCH] Parse #{{}}# properly.

2021-07-18 Thread Maxime Devos
I sent this to the wrong address.
--- Begin Message ---
Hi guilers,

This fixes bug #49623.  I also added two additional test cases.
I'm rebuilding Guile right now and will re-run the entire test suite,
and I'll build the affected guile library with the fixed guile.

Greetings,
Maxime.
From 9fb7cff1a2544aae3827db1a781be6e5c367d8c0 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Sun, 18 Jul 2021 19:59:32 +0200
Subject: [PATCH] ice-9/read: Parse #{}}# properly.

This is a regression since Guile 3.0.2 and breaks compilation
of a Guile library.

* module/ice-9/read.scm
  (%read)[read-parenthesized]: When 'saw-brace?' is #t, do not
  reset 'saw-brace?' to #f if the current character is #\}.
* test-suite/tests/reader.test
  ("#{}#): Add two test cases.
---
 module/ice-9/read.scm| 5 -
 test-suite/tests/reader.test | 3 +++
 2 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index 72811fdb8..3fcc6ae50 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -570,7 +570,10 @@
(saw-brace?
 (if (eqv? ch #\#)
 '()
-(cons #\} (lp #f
+;; (eqv? ch #\}) is required instead of #f to allow for
+;; the trailing # to be preceded by two }, e.g.
+;; #{}}# or #{{a}}#.  See <https://bug.gnu.org/XXX>.
+(cons #\} (lp (eqv? ch #\})
((eqv? ch #\})
 (lp #t))
((eqv? ch #\\)
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index ef11a4abd..134cb5ec3 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -508,6 +508,9 @@
 
 (with-test-prefix "#{}#"
   (pass-if (equal? (read-string "#{}#") '#{}#))
+  ;; ??? bugs.gnu.org
+  (pass-if (equal? (read-string "#{{}}#") (string->symbol "{}")))
+  (pass-if (equal? (read-string "#{{}b}#") (string->symbol "{}b")))
   (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b
   (pass-if (equal? (read-string "#{a}#") 'a))
   (pass-if (equal? (read-string "#{a b}#") '#{a b}#))
-- 
2.32.0



signature.asc
Description: This is a digitally signed message part
--- End Message ---


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [PATCH] Parse #{{}}# properly.

2021-07-18 Thread Maxime Devos
It turns out that the test fails when the patch
is applies to guile@3.0.7.  I'll rebase and try
to figure things out.


signature.asc
Description: This is a digitally signed message part


[PATCH v2] Parse #{{}}# properly.

2021-07-20 Thread Maxime Devos
Maxime Devos schreef op zo 18-07-2021 om 21:47 [+0200]:
> It turns out that the test fails when the patch
> is applies to guile@3.0.7.  I'll rebase and try
> to figure things out.

With the revised patch, tests succeed and the Guile
library now compiles successfully.

Greetings,
Maxime.
From 40b0b29c05d521cd8901988fa2bc71547f917f48 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Sun, 18 Jul 2021 19:59:32 +0200
Subject: [PATCH] ice-9/read: Parse #{}}# properly.

This is a regression since Guile 3.0.2 and breaks compilation
of a Guile library.

* module/ice-9/read.scm
  (%read)[read-parenthesized]: When SAW-BRACE? is #t but CH isn't
  #\#, don't eat CH.
* test-suite/tests/reader.test
  ("#{}#): Add four test cases.
---
 module/ice-9/read.scm| 7 +--
 test-suite/tests/reader.test | 5 +
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/read.scm b/module/ice-9/read.scm
index ac407739f..283933064 100644
--- a/module/ice-9/read.scm
+++ b/module/ice-9/read.scm
@@ -556,12 +556,15 @@
 (string->symbol
  (list->string
   (let lp ((saw-brace? #f))
-(let ((ch (next-not-eof)))
+(let lp/inner ((ch (next-not-eof))
+   (saw-brace? saw-brace?))
   (cond
(saw-brace?
 (if (eqv? ch #\#)
 '()
-(cons #\} (lp #f
+;; Don't eat CH, see
+;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49623>.
+(cons #\} (lp/inner ch #f
((eqv? ch #\})
 (lp #t))
((eqv? ch #\\)
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 1481a0a5d..ad7c6d575 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -536,6 +536,11 @@
 
 (with-test-prefix "#{}#"
   (pass-if (equal? (read-string "#{}#") '#{}#))
+  ;; See <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=49623>
+  (pass-if (equal? (read-string "#{}}#") (string->symbol "}")))
+  (pass-if (equal? (read-string "#{}}}#") (string->symbol "}}")))
+  (pass-if (equal? (read-string "#{{}}#") (string->symbol "{}")))
+  (pass-if (equal? (read-string "#{{}b}#") (string->symbol "{}b")))
   (pass-if (not (equal? (read-string "(a #{.}# b)") '(a . b
   (pass-if (equal? (read-string "#{a}#") 'a))
   (pass-if (equal? (read-string "#{a b}#") '#{a b}#))
-- 
2.32.0



signature.asc
Description: This is a digitally signed message part


Re: Request to add *-resize! functions for contiguous mutable data structures.

2021-08-07 Thread Maxime Devos
Vijay Marupudi schreef op vr 06-08-2021 om 09:33 [-0500]:
> Hello!
> 
> I was curious if Guile would be willing to provide a series of
> new procedures for resizing contiguous memory regions.
> 
> (bytevector-resize!  new-size [fill])
> (vector-resize!  new-size [fill])
> 
> The [fill] parameter could be used if the new-size is bigger than
> the current size.
>
> This would make writing imperative code easier and more
> performant.

A problem is that this prevents optimisations and can currently
introduce bugs in concurrent code.  Consider the following code:

b.scm:
(use-modules (rnrs bytevectors))

(define (bv-first-two bv)
  (unless (bytevector? bv)
(error "not a bv"))
  (unless (>= (bytevector-length bv) 2) ; L6
(error "too small"))
  (values (bytevector-u8-ref bv 0)   ; L8
  (bytevector-u8-ref bv 1))) ; L9
bv-first-two


Compile it with optimisations enabled:

  guild compile b.scm -o b.go -O3 && guild disassemble b.go

(Unfortunately, guile cannot yet compile the bounds check at L8 and L9 away
even though we performed a bounds check at L6 away.)

I can't say I understand the disassembled code very well, but I do note
that the bounds checks (search for (jl ...), (jnl ...) and imm-u64 I acknowledge that it is not idiomatic Scheme to use
> mutable data structures, however this is useful to me for
> dealing with large amounts of text data, in which I need random
> access and flexible data storage. It would allow me to move off
> my custom C extension vector and allow me to use other
> vector-* functions.
> 
> Ideally, this would use libc's `realloc` to make the resize
> quick, so that it can avoid data copying whenever possible.

If you're very careful, you can use 'bytevector->pointer', 'pointer->bytevector'
and (foreign-library-function ... "malloc" ...),
(foreign-library-function ... "realloc" ...),
(foreign-library-function ... "free" ...).

(ice-9 vlist) and  might be interesting as well.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Request to add *-resize! functions for contiguous mutable data structures.

2021-08-09 Thread Maxime Devos
Vijay Marupudi schreef op zo 08-08-2021 om 23:02 [-0500]:
> Thank you for your responses Taylan and Maxime!
> 
> My initial reaction to the concern about multithreaded code is similar
> to Taylan. I'm not sure if Guile has multithreading concepts built into
> the compiler. If so, one can only check the length again after a mutex.
> 
> Appreciate the malloc, realloc, and free FFI solution. Ideally I
> wouldn't have to do that, but it does work. I have to manually free it
> though.

You can avoid explicit free by using GC_MALLOC_ATOMIC and GC_REALLOC from
bdw-gc (the C library Guile uses for garbage collection) instead of malloc
and realloc, see .

Greetings,
Maxme.


signature.asc
Description: This is a digitally signed message part


Re: Ephemerons, self-referentality in weak hashtables

2021-09-08 Thread Maxime Devos
Christine Lemmer-Webber schreef op wo 08-09-2021 om 12:18 [-0400]:
> Maxime Devos  writes:
> 
> > [[PGP Signed Part:Undecided]]
> > Maxime Devos schreef op zo 20-06-2021 om 17:01 [+0200]:
> > > Christopher Lemmer Webber schreef op di 18-05-2021 om 11:46 [-0400]:
> > > > Hello,
> > > > 
> > > > I'm finally taking some time to port Goblins to Guile, in-between other
> > > > tasks anyway.  In Goblins there is a weak hashtable that maps current
> > > > actor references to their current behavior.  I found that for
> > > > self-referential actors, I needed ephemerons for GC stuff to work right.
> > > 
> > > [bla bla on how this could be implemented in Guile]
> > 
> > This doesn't work because there is nothing preventing the
> > 'value' from being freed. Trying to fix that now, using
> > the example implementation of "weak maps" in libgc.
> > 
> > Greetings,
> > Maxime.
> 
> I fell off the radar on replying to this, but did path turn out to work?

The example implementation was a bit complicated and not well-documented.
The ‘disclaimer’ support is disabled by default, a configuration flag
needs to be set while compiling libgc to use disclaimers.  Guix (the distro I
use) doesn't set it.  I needed to be careful in libguile/weak-table.c to not
protect too much (otherwise it wouldn't be an ephemeral weak hash table) or
too little (otherwise ‘freed’ objects would be re-used).

I think it can be made to work, but I didn't succeed, and moved on to other
things.  If someone would like to implement this, I would recommend starting
with something like ‘ephemeral pairs’ before moving to ephemeral hash tables.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Fix for ‘,trace (method ()) --> no applicable method for ...’

2021-09-15 Thread Maxime Devos
Hi guile,

Attached is a fix for <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=50608>
and a similar issue for 'procedure-name'.

Greetings,
Maxime.
From fe518ed4fb2c7e55f69a229349e3183ccfdcfc97 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Wed, 15 Sep 2021 19:57:20 +0200
Subject: [PATCH 1/2] goops: Let 'write' succeed when objects are
 uninitialised.

* module/oop/goops.scm (generic-function-methods)[fold-upwards,fold-downward]:
Allow 'gfs' to be #f.
(write)[]: Allow 'spec' to be #f.
* test-suite/tests/goops.test ("writing uninitialised objects"): New test.
---
 module/oop/goops.scm| 18 +++---
 test-suite/tests/goops.test | 19 +++
 2 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index de5e8907d..4a4cdd034 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -3,6 +3,7 @@
  Copyright (C) 1998-2003,2006,2009-2011,2013-2015,2017-2018,2021
    Free Software Foundation, Inc.
  Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI 
+ Copyright (C) 2021 Maxime Devos 
 
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -1990,7 +1991,9 @@ function."
   (() method-lists)
   ((gf . gfs)
(lp (fold-upward (cons (slot-ref gf 'methods) method-lists) gf)
-   gfs)
+   gfs))
+  ;; See 'fold-downwards'.
+  (#f '()
  (else method-lists)))
   (define (fold-downward method-lists gf)
 (let lp ((method-lists (cons (slot-ref gf 'methods) method-lists))
@@ -1998,7 +2001,14 @@ function."
   (match gfs
 (() method-lists)
 ((gf . gfs)
- (lp (fold-downward method-lists gf) gfs)
+ (lp (fold-downward method-lists gf) gfs))
+;; 'write' may be called on an uninitialised 
+;; (e.g. from ,trace in a REPL) in which case
+;; 'generic-function-methods' will be called
+;; on a  whose 'extended-by' slot is #f.
+;; In that case, just return the empty list to make 'write'
+;; happy.
+(#f '()
   (unless (is-a? obj )
 (scm-error 'wrong-type-arg #f "Not a generic: ~S"
(list obj) #f))
@@ -2394,7 +2404,9 @@ function."
   (display (class-name meta) file)
   (display #\space file)
   (display (map* (lambda (spec)
-   (if (slot-bound? spec 'name)
+   ;; 'spec' is false if 'o' is not yet
+   ;; initialised
+   (if (and spec (slot-bound? spec 'name))
(slot-ref spec 'name)
spec))
  (method-specializers o))
diff --git a/test-suite/tests/goops.test b/test-suite/tests/goops.test
index b06ba98b2..f70c1e1e4 100644
--- a/test-suite/tests/goops.test
+++ b/test-suite/tests/goops.test
@@ -1,6 +1,7 @@
  goops.test --- test suite for GOOPS      -*- scheme -*-
 
  Copyright (C) 2001,2003,2004, 2006, 2008, 2009, 2011, 2012, 2014, 2015, 2017, 2021 Free Software Foundation, Inc.
+ Copyright (C) 2021 Maxime Devos 
  
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -761,3 +762,21 @@
   #:metaclass )))
   (pass-if-equal 123 (get-the-bar (make )))
   (pass-if-equal 123 (get-the-bar (make ))
+
+;; 'write' can be called on initialised objects, e.g. from
+;; ,trace in a REPL.  Make sure this doesn't result in any
+;; exceptions.  The exact output doesn't matter in this case.
+(with-test-prefix "writing uninitialised objects"
+  (define (make-uninitialised class)
+(allocate-struct class (length (class-slots class
+  (define (test class)
+(pass-if (class-name class)
+  (string? (object->string (make-uninitialised class)
+  (module-for-each
+   (lambda (name variable)
+ (define value (and (variable-bound? variable)
+(variable-ref variable)))
+ (when (and (is-a? value )
+(not (eq? value )))
+   (test value)))
+   (resolve-module '(oop goops
-- 
2.33.0

From 4e1c9e9d5f90f39f2bec033399c3e77127aa5e1f Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Wed, 15 Sep 2021 20:25:58 +0200
Subject: [PATCH 2/2] procedure-name: Allow uninitialised applicable structs.

* libguile/procproc.c (scm_procedure_name): Allow the procedure in an
applicable struct to be #f.
* test-suite/tests/procproc.test ("uninitialised applicable struct"):
Test it.
---
 libguile/procprop.c| 21 ++---
 test-suite/tests/

Re: new function

2021-09-23 Thread Maxime Devos
Damien Mattei schreef op do 23-09-2021 om 19:27 [+0200]:
> yes i know parsing the whole code is the only portable solution, but it is 
> slow,even on a few dozen of lines the slowing is visible ,so i can even think 
> of that on one thousand lines...
> 
> I finally succeed in Guile with simple piece of code to make my example run 
> with a single assignment operator <-  , here i define for variable the 
> assignment operator <$ , <- is working with arrays too:
> 
> Preview:
> 
> (define-syntax <$
>   
>   (lambda (s)
> 
> (syntax-case s ()
>   
>   ((_ var value)
>
>(case (syntax-local-binding #'var)
>
>  ((lexical) #'(begin
>   (display "<$ : lexical scope : ")
>   (display (quote var))
>   (newline)
>   (set! var value)))
>
>((displaced-lexical) #'(begin
> (display "<$ : displaced-lexical scope : ")
> (display (quote var))
> (newline)
> (set! var value)))
>
>  ((global) #'(begin
>  (display "<$ : global scope : ")
>  (display (quote var))
>  (newline)
>  (define var value)))
>
>  (else #'(begin
>  (display "<$ : unknow variable scope :")
>  (display (quote var))
>  (error "<$ : unknow variable scope : "
> 
> 
> it allows this Scheme+ code to run with a single assignment operator (note in 
> some case the operator is also a definition of variable,but it is invisible 
> for the programmer, it has the duality of define and set!):
> 
> Preview:
> 
> (define (subset-sum-guile L t)
> 
>   {ls <- (length L)}
>   {dyn <- dyna[ls t]}
> 
> ;; dyna[ls][t] means 0: unknown solution, 1: solution found, 2: no solution
>   
>   (condx [{dyn <> 0} (one? dyn)]
>[(null? L) {dyna[ls t] <- 2}  #f] ;; return #f
>
>[exec {c <- (first L)}] 
>;; c is the solution
>[{c = t} {dyna[ls t] <- 1}  #t]  ;; return #t
>
>[exec {R <- (rest L)}]  
>;; continue searching a solution in the rest
>[{c > t} {s <- (subset-sum-guile R t)}
> {dyna[ls t] <- (one-two s)}
> s] ;; return boolean value
>   
>;; else : c < t at this point
>;; c is part of a solution OR not part of a solution
>[else {s <- {(subset-sum-guile R {t - c}) or (subset-sum-guile R t)}}
>  {dyna[ls t] <- (one-two s)}
>  s])) ;; return boolean value
> 
>  
> 
> some people were sceptic about the possibility to make it, but it works, i do 
> not say it is portable code.
> 
> When i run the program with debug i see that:
> scheme@(guile-user)> (subset-sum-guile  L-init t-init)
> <$ : global scope : ls
> <$ : global scope : dyn
>  
> <$ : global scope : c
> <$ : global scope : R
> <$ : global scope : s
> <$ : global scope : ls
> <$ : global scope : dyn
>  
> <$ : global scope : c
>  hundreds of lines.
> #t
> 
> all variable are global,

No, they are local, even though syntax-local-binding returns 'global'.
'syntax-local-binding' doesn't know we will be defining a local variable
with the same name later, so it says 'global' instead of 'lexical' or
'displaced-lexical'.

There is no such thing as ‘global to the body of the function’, what you are
descrbing is local variables.

The macro <$ you have defined won't work for the "hello world" example I sent
you:

(define (#{hello/won't-work}# language)
  (cond ((equal? language "dutch")
 (<$ message "Hallo wereld"))
((equal? language "english")
 (<$ message "Hello world")))
  (display message)
  (newline))
While compiling expression:
Syntax error:
unknown file:70:9: definition in expression context, where definitions are not 
allowed, in form (define message "Hallo wereld")

The following does, however:

(define (hello language)
  (<$ message #f)
  (cond ((equal? language "dutch")
 (<$ message "Hallo wereld"))
((equal? language "english")
 (<$ message "Hello world")))
  (display message)
  (newline))

Possibly this limitation of <$ is acceptable to you though.

> but they are just global to the body of the function,not at toplevel,so there 
> is no risk of breaking the code logic it is just that if we want to see 
> lexical scope we need a more nested example,it is strange because i thought 
> that the condx macro creates nestled code for each conditional clauses...
> 
> to see the lexical scope we can use this example:
> scheme@(guile-user)> 
> (condx [exec {k <- 1}]
> [{k = 1} {k <- {k + 1}} {k + 1}]
> [else 'never])
> <$ : global scope : k
> <$ : lexical scope : k
> $3 = 3
> here the lexical scope is well visible :-)
> but if k had existed at toplevel it is not

[PATCH v2 02/14] Allow file ports in ‘readlink’.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect whether ‘readlinkat’ is defined.
* libguile/filesys.c (scm_readlink): Support file ports
  when ‘readlinkat’ exists.
  (scm_init_filesys): Provide ‘chdir-ports’ when it exists.
* doc/ref/posix.texi (File System): Document it.
* test-suite/tests/filesys.test ("readlink"): Test it.
---
 configure.ac  |  2 +-
 doc/ref/posix.texi|  9 --
 libguile/filesys.c| 52 +++--
 test-suite/tests/filesys.test | 61 +++
 4 files changed, 112 insertions(+), 12 deletions(-)

diff --git a/configure.ac b/configure.ac
index b7e4663f7..4888f880d 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,7 +484,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   sendfile - non-POSIX, found in glibc
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
-  fesetround ftime ftruncate fchown fchmod fchdir  \
+  fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
   getcwd geteuid getsid
\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 7555f9319..cd23240c4 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -757,8 +757,13 @@ file it points to.  @var{path} must be a string.
 
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
-Return the value of the symbolic link named by @var{path} (a
-string), i.e., the file that the link points to.
+Return the value of the symbolic link named by @var{path} (a string, or
+a port if supported by the system), i.e., the file that the link points
+to.
+
+To read a symbolic link represented by a port, the symbolic link must
+have been opened with the @code{O_NOFOLLOW} and @code{O_PATH} flags.
+@code{(provided? 'readlink-port)} reports whether ports are supported.
 @end deffn
 
 @findex fchown
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 2a9c36a12..c5bedec07 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1045,10 +1045,30 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYMLINK */
 
-SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0, 
+/* Static helper function for choosing between readlink
+   and readlinkat. */
+static int
+do_readlink (int fd, const char *c_path, char *buf, size_t size)
+{
+#ifdef HAVE_READLINKAT
+  if (fd != -1)
+return readlinkat (fd, c_path, buf, size);
+#else
+  (void) fd;
+#endif
+  return readlink (c_path, buf, size);
+}
+
+SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
 (SCM path),
-   "Return the value of the symbolic link named by @var{path} (a\n"
-   "string), i.e., the file that the link points to.")
+"Return the value of the symbolic link named by @var{path} (a\n"
+"string, or a port if supported by the system),\n"
+"i.e., the file that the link points to.\n"
+"To read a symbolic link represented by a port, the symbolic\n"
+"link must have been opened with the @code{O_NOFOLLOW} and\n"
+"@code{O_PATH} flags."
+"@code{(provided? 'readlink-port)} reports whether ports are\n"
+"supported.")
 #define FUNC_NAME s_scm_readlink
 {
   int rv;
@@ -1056,20 +1076,31 @@ SCM_DEFINE (scm_readlink, "readlink", 1, 0, 0,
   char *buf;
   SCM result;
   char *c_path;
-  
-  scm_dynwind_begin (0);
-
-  c_path = scm_to_locale_string (path);
-  scm_dynwind_free (c_path);
+  int fdes;
 
+  scm_dynwind_begin (0);
+#ifdef HAVE_READLINKAT
+  if (SCM_OPFPORTP (path))
+{
+  c_path = "";
+  fdes = SCM_FPORT_FDES (path);
+}
+  else
+#endif
+{
+  fdes = -1;
+  c_path = scm_to_locale_string (path);
+  scm_dynwind_free (c_path);
+}
   buf = scm_malloc (size);
 
-  while ((rv = readlink (c_path, buf, size)) == size)
+  while ((rv = do_readlink (fdes, c_path, buf, size)) == size)
 {
   free (buf);
   size *= 2;
   buf = scm_malloc (size);
 }
+  scm_remember_upto_here_1 (path);
   if (rv == -1)
 {
   int save_errno = errno;
@@ -2086,6 +2117,9 @@ scm_init_filesys ()
 #ifdef HAVE_FCHDIR
   scm_add_feature("chdir-port");
 #endif
+#ifdef HAVE_READLINKAT
+  scm_add_feature("readlink-port");
+#endif
 
 #include "filesys.x"
 }
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6b09a2ba0..7feb3492f 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -306,3 +306,64 @@
 
   (pass-if-exception "non-file port" exception:wrong-type-arg
 (chdir (open-input-string ""
+
+(with-test-prefix "readlink"
+  (false-if-exception (delete-file (test-symlink)))
+  (false-if-exception (delete-file (test-file)))
+  (call-with-output-file (test-file)
+(lambda (port)
+  (display "hello" port)

[PATCH v2 00/14] Bindings to *at functions

2021-11-16 Thread Maxime Devos
This is a v2 of
https://lists.gnu.org/archive/html/guile-devel/2021-03/msg0026.html,
with a lot more tests, a few less functions and more consistent documentation.
‘rename-file-at’ has been modified to support #f as one of the two directory
arguments, denoting the current working directory.

Maxime Devos (14):
  Allow file ports in ‘chdir’ when supported.
  Allow file ports in ‘readlink’.
  Allow file ports in ‘utime’.
  Define ‘symlinkat’ wrapper when supported.
  Define bindings to ‘mkdirat’ when the C function exists.
  Correct documentation of ‘mkdir’ w.r.t. the umask.
  Define AT_REMOVEDIR and others when available.
  Define a Scheme binding to ‘renameat’ when it exists.
  Define a Scheme binding to ‘fchmodat’ when it exists.
  Define a Scheme binding to ‘unlinkat’ when it exists.
  Define a Scheme binding to ‘fchownat’ when it exists.
  Define a Scheme binding to ‘fstatat’ when available.
  Define Scheme bindings to ‘openat’ when available.
  Update NEWS.

 NEWS  |  12 +
 configure.ac  |   9 +-
 doc/ref/guile.texi|   3 +-
 doc/ref/posix.texi|  97 +-
 libguile/filesys.c| 395 +++--
 libguile/filesys.h|   9 +
 libguile/posix.c  |  34 ++-
 libguile/posix.h  |   2 +-
 libguile/syscalls.h   |   2 +
 test-suite/tests/filesys.test | 536 ++
 test-suite/tests/posix.test   |  71 -
 11 files changed, 1120 insertions(+), 50 deletions(-)


base-commit: 6f1b620b829bc0a1852a43e9cb843fd719954a0f
-- 
2.30.2




[PATCH v2 10/14] Define a Scheme binding to ‘unlinkat’ when it exists.

2021-11-16 Thread Maxime Devos
‘unlinkat’ is used for both unlinking regular files
and removing empty directories.

* configure.ac: Detect if ‘unlinkat’ exists.
* doc/ref/posix.texi (File System): Document why there is no
  ‘rmdirat’ procedure, and document the ‘delete-file-at’ procedure.
* libguile/filesys.c
  (scm_rmdir): Adjust the docstring here as well.
  (scm_delete_file_at): Define a Scheme binding to ‘unlinkat’.
* libguile/filesys.h (scm_delete_file_at): Make ‘scm_delete_file_at’
  part of the C API.
---
 configure.ac  |  5 +--
 doc/ref/posix.texi| 12 +++
 libguile/filesys.c| 32 +++
 libguile/filesys.h|  1 +
 test-suite/tests/filesys.test | 59 +++
 5 files changed, 107 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index 2a5485990..e1c090321 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   truncate - not in mingw
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
-#   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat - 
POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
+#   unlinkat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -485,7 +486,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
-  fchmodat symlinkat mkdirat renameat getcwd geteuid getsid\
+  fchmodat symlinkat mkdirat renameat unlinkat getcwd geteuid getsid   \
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index ebb001581..ad10585d9 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -834,6 +834,18 @@ Deletes (or ``unlinks'') the file whose path is specified 
by
 @var{str}.
 @end deffn
 
+@findex unlinkat
+@deffn {Scheme Procedure} delete-file-at dir str [flags]
+@deffnx {C Function} scm_delete_file_at (dir, str, flags)
+Like @code{unlink}, but resolve @var{str} relative to the
+directory referred to by the file port @var{dir} instead.
+
+The optional @var{flags} argument can be @code{AT_REMOVEDIR},
+in which case @code{delete-file-at} will act like @code{rmdir} instead
+of @code{delete-file}.  Why doesn't POSIX have a @code{rmdirat} function
+for this instead?  No idea!
+@end deffn
+
 @deffn {Scheme Procedure} copy-file oldfile newfile
 @deffnx {C Function} scm_copy_file (oldfile, newfile)
 Copy the file specified by @var{oldfile} to @var{newfile}.
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 4dd9c7b48..7e6d89626 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1469,6 +1469,38 @@ SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_UNLINKAT
+SCM_DEFINE (scm_delete_file_at, "delete-file-at", 2, 1, 0,
+(SCM dir, SCM str, SCM flags),
+"Like @code{unlink}, but resolve @var{str} relative to the\n"
+"directory referred to by the file port @var{dir} instead.\n\n"
+"The optional @var{flags} argument can be @code{AT_REMOVEDIR},\n"
+"in which case @code{delete-file-at} will act like @code{rmdir} 
instead\n"
+"of @code{delete-file}.  Why doesn't POSIX have a @code{rmdirat} 
function\n"
+"for this instead?  No idea!")
+#define FUNC_NAME s_scm_delete_file_at
+{
+  int ans;
+  int dir_fdes;
+  int c_flags;
+
+  if (SCM_UNBNDP (flags))
+c_flags = 0;
+  else
+c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (str, c_str, ans = unlinkat (dir_fdes, c_str, c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (ans != 0)
+SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 SCM_DEFINE (scm_access, "access?", 2, 0, 0,
 (SCM path, SCM how),
"Test accessibility of a file under the real UID and GID of the\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 377a3795e..37d084cd5 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -51,6 +51,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
+SCM_API SCM scm_delete_file_at (SCM dir, SCM str, SCM flags);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
 SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
 SCM_API SCM scm_rmdir (SCM path);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/files

[PATCH v2 09/14] Define a Scheme binding to ‘fchmodat’ when it exists.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect existence of fchmodat.
* libguile/filesys.c (scm_chmodat): New procedure.
* libguile/filesys.h (scm_chmodat): Make it part of the API.
* test-suite/tests/filesys.test ("chmodat"): Test it.
---
 configure.ac  |  4 +--
 libguile/filesys.c| 36 
 libguile/filesys.h|  1 +
 test-suite/tests/filesys.test | 53 +++
 4 files changed, 92 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index e67892feb..2a5485990 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   truncate - not in mingw
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
-#   strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat - 
POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
-  symlinkat mkdirat renameat getcwd geteuid getsid 
\
+  fchmodat symlinkat mkdirat renameat getcwd geteuid getsid\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 9c63beaa8..4dd9c7b48 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1561,6 +1561,42 @@ SCM_DEFINE (scm_chmod, "chmod", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_FCHMODAT
+SCM_DEFINE (scm_chmodat, "chmodat", 3, 1, 0,
+   (SCM dir, SCM pathname, SCM mode, SCM flags),
+"Like @var{chmod}, but modify the permissions of the file named\n"
+"@var{pathname} in the directory referred to by the file port\n"
+"@var{dir} instead.\n"
+"The optional @var{flags} argument may be 0 or 
@code{AT_SYMLINK_NOFOLLOW},\n"
+"in which case @var{pathname} is not dereferenced if it is a 
symbolic link,\n"
+"i.e., the permissions of the symbolic link itself are 
modified.\n\n"
+"Note that @code{AT_SYMLINK_NOFOLLOW} is not supported on all 
systems\n"
+"and may result in @code{ENOTSUP}.")
+#define FUNC_NAME s_scm_chmodat
+{
+  int rv;
+  int c_flags;
+  int dir_fdes;
+
+  if (SCM_UNBNDP (flags))
+c_flags = 0;
+  else
+c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (pathname, c_pathname,
+  rv = fchmodat (dir_fdes, c_pathname,
+ scm_to_int (mode), c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (rv == -1)
+SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 SCM_DEFINE (scm_umask, "umask", 0, 1, 0, 
 (SCM mode),
"If @var{mode} is omitted, returns a decimal number representing 
the current\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 7e17cc585..377a3795e 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -40,6 +40,7 @@ SCM_API scm_t_bits scm_tc16_dir;
 
 SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
 SCM_API SCM scm_chmod (SCM object, SCM mode);
+SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
 SCM_API SCM scm_umask (SCM mode);
 SCM_API SCM scm_open_fdes (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index bbce2c858..204f3414c 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -271,6 +271,59 @@
 (false-if-exception (rmdir name))
 result)
 
+;;;
+;;; chmodat
+;;;
+
+(with-test-prefix "chmodat"
+  (call-with-output-file (test-file) (const #f))
+  (chmod (test-file) #o000)
+
+  (pass-if-equal "regular file"
+  #o300
+(unless (defined? 'chmodat)
+  (throw 'unsupported))
+(call-with-port
+ (open (dirname (test-file)) O_RDONLY)
+ (lambda (port)
+   (chmodat port (test-file) #o300)))
+(stat:perms (stat (test-file
+
+  (chmod (test-file) #o000)
+
+  (pass-if-equal "regular file, AT_SYMLINK_NOFOLLOW"
+  #o300
+(unless (and (defined? 'chmodat)
+ (defined? 'AT_SYMLINK_NOFOLLOW))
+  (throw 'unsupported))
+(call-with-port
+ (open (dirname (test-file)) O_RDONLY)
+ (lambda (port)
+   (catch 'system-error
+ (lambda ()
+   (chmodat port (basename (test-file)) #o300 AT_SYMLINK_NOFOLLOW))
+ (lambda args
+   (clos

[PATCH v2 04/14] Define ‘symlinkat’ wrapper when supported.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect whether ‘symlinkat’ exists.
* libguile/filesys.c (scm_symlinkat): Define a Scheme binding
  when it exists.
* libguile/filesys.h: Make the binding part of the public C API.
* doc/ref/posix.texi (File System): Document the binding.
* test-suite/tests/filesys.test ("symlinkat"): Test it.
---
 configure.ac  |  2 +-
 doc/ref/posix.texi|  6 ++
 libguile/filesys.c| 23 +++
 libguile/filesys.h|  1 +
 test-suite/tests/filesys.test | 27 +++
 5 files changed, 58 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index ddf330d96..b2e9ef3e9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
-  getcwd geteuid getsid
\
+  symlinkat getcwd geteuid getsid  
\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index b6deffd43..a329eec39 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -891,6 +891,12 @@ Create a symbolic link named @var{newpath} with the value 
(i.e., pointing to)
 @var{oldpath}.  The return value is unspecified.
 @end deffn
 
+@deffn {Scheme Procedure} symlinkat dir oldpath newpath
+@deffnx {C Function} scm_symlinkat (dir, oldpath, newpath)
+Like @code{symlink}, but resolve @var{newpath} relative to
+the directory referred to by the file port @var{dir}.
+@end deffn
+
 @deffn {Scheme Procedure} mkdir path [mode]
 @deffnx {C Function} scm_mkdir (path, mode)
 Create a new directory named by @var{path}.  If @var{mode} is omitted
diff --git a/libguile/filesys.c b/libguile/filesys.c
index c5bedec07..bfd223434 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1045,6 +1045,29 @@ SCM_DEFINE (scm_symlink, "symlink", 2, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_SYMLINK */
 
+#ifdef HAVE_SYMLINKAT
+SCM_DEFINE (scm_symlinkat, "symlinkat", 3, 0, 0,
+(SCM dir, SCM oldpath, SCM newpath),
+"Like @code{symlink}, but resolve @var{newpath} relative\n"
+"to the directory referred to by the file port @var{dir}.")
+#define FUNC_NAME s_scm_symlinkat
+{
+  int val;
+  int fdes;
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  fdes = SCM_FPORT_FDES (dir);
+  STRING2_SYSCALL (oldpath, c_oldpath,
+  newpath, c_newpath,
+  val = symlinkat (c_oldpath, fdes, c_newpath));
+  scm_remember_upto_here_1 (dir);
+  if (val != 0)
+SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_SYMLINKAT */
+
 /* Static helper function for choosing between readlink
and readlinkat. */
 static int
diff --git a/libguile/filesys.h b/libguile/filesys.h
index a3b257c12..d181aca52 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -62,6 +62,7 @@ SCM_API SCM scm_select (SCM reads, SCM writes, SCM excepts, 
SCM secs, SCM msecs)
 SCM_API SCM scm_fcntl (SCM object, SCM cmd, SCM value);
 SCM_API SCM scm_fsync (SCM object);
 SCM_API SCM scm_symlink (SCM oldpath, SCM newpath);
+SCM_API SCM scm_symlinkat (SCM dir, SCM oldpath, SCM newpath);
 SCM_API SCM scm_readlink (SCM path);
 SCM_API SCM scm_lstat (SCM str);
 SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 7feb3492f..64bf92333 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -367,3 +367,30 @@
 
   (false-if-exception (delete-file (test-symlink)))
   (false-if-exception (delete-file (test-file
+
+(with-test-prefix "symlinkat"
+  (pass-if-equal "create" (test-file)
+(unless (defined? 'symlinkat)
+  (throw 'unsupported))
+(call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+   (symlinkat port (test-file) (test-symlink))
+   (readlink (test-symlink)
+  (false-if-exception (delete-file (test-symlink)))
+
+  (pass-if-exception "not a port" exception:wrong-type-arg
+(unless (defined? 'symlinkat)
+  (throw 'unsupported))
+(symlinkat "bogus" (test-file) (test-symlink)))
+
+  (pass-if-exception "not a file port" exception:wrong-type-arg
+(unless (defined? 'symlinkat)
+  (throw 'unsupported))
+(symlinkat (open-input-string "") (test-file) (test-symlink)))
+
+  (pass-if-exception "closed port" exception:wrong-type-arg
+(unless (defined? 'symlinkat)
+  (throw 'unsupported))
+(symlinkat (call-with-port (open "." O_RDONLY) identity)
+   (test-file) (test-symlink
-- 
2.30.2




[PATCH v2 11/14] Define a Scheme binding to ‘fchownat’ when it exists.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect whether ‘fchownat’ is available.
* libguile/filesys.c (scm_chownat): Define a Scheme binding to
  ‘fchownat’ when available.
* libguile/filesys.h (scm_chownat): Make it part of the API.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac   |  4 ++--
 doc/ref/posix.texi | 11 +++
 libguile/filesys.c | 35 +++
 libguile/filesys.h |  1 +
 4 files changed, 49 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index e1c090321..dcb6bceb5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,14 +478,14 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat - POSIX.1-2008
+#   unlinkat, fchownat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
 #   sendfile - non-POSIX, found in glibc
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
-  fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
+  fesetround ftime ftruncate fchown fchownat fchmod fchdir readlinkat  \
   fchmodat symlinkat mkdirat renameat unlinkat getcwd geteuid getsid   \
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index ad10585d9..3d06f1c73 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -784,6 +784,17 @@ unsupported at present).  If @var{owner} or @var{group} is 
specified
 as @code{-1}, then that ID is not changed.
 @end deffn
 
+@findex fchownat
+@deffn {Scheme Procedure} chownat dir name owner group [flags]
+@deffnx {C Function} scm_chownat (dir, name, owner, group, flags)
+Like @code{chown}, but modify the owner and/or group of
+the file named @var{name} in the directory referred to
+by the file port @var{dir} instead.  The optional argument
+@var{flags} is a bitmask.  If @code{AT_SYMLINK_NOFOLLOW} is
+present, then @var{name} will not be dereferenced if it is a
+symbolic link.
+@end deffn
+
 @findex fchmod
 @deffn {Scheme Procedure} chmod object mode
 @deffnx {C Function} scm_chmod (object, mode)
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 7e6d89626..c257bb59c 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -193,6 +193,41 @@ SCM_DEFINE (scm_chown, "chown", 3, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_CHOWN */
 
+#ifdef HAVE_FCHOWNAT
+SCM_DEFINE (scm_chownat, "chown-at", 4, 1, 0,
+(SCM dir, SCM name, SCM owner, SCM group, SCM flags),
+"Like @code{chown}, but modify the owner and/or group of\n"
+"the file named @var{name} in the directory referred to\n"
+"by the file port @var{dir} instead.  The optional argument\n"
+"@var{flags} is a bitmask.  If @code{AT_SYMLINK_NOFOLLOW} is\n"
+"present, then @var{name} will not be dereferenced if it is a\n"
+"symbolic link.")
+#define FUNC_NAME s_scm_chownat
+{
+  int rv;
+  int dir_fdes;
+  int c_flags;
+
+  if (SCM_UNBNDP (flags))
+c_flags = 0;
+  else
+c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (name, c_name,
+  rv = fchownat (dir_fdes, c_name,
+ scm_to_int (owner), scm_to_int (group),
+ c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (rv == -1)
+SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_FCHOWNAT */
+
 
 
 SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0, 
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 37d084cd5..7673c8051 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -39,6 +39,7 @@ SCM_API scm_t_bits scm_tc16_dir;
 
 
 SCM_API SCM scm_chown (SCM object, SCM owner, SCM group);
+SCM_API SCM scm_chownat (SCM dir, SCM object, SCM owner, SCM group, SCM flags);
 SCM_API SCM scm_chmod (SCM object, SCM mode);
 SCM_API SCM scm_chmodat (SCM dir, SCM pathname, SCM mode, SCM flags);
 SCM_API SCM scm_umask (SCM mode);
-- 
2.30.2




[PATCH v2 06/14] Correct documentation of ‘mkdir’ w.r.t. the umask.

2021-11-16 Thread Maxime Devos
* doc/ref/posix.texi (mkdir): Note that the umask is applied even if the
  mode argument is set.
---
 doc/ref/posix.texi | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index d261ac8da..7f136376b 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -902,7 +902,8 @@ the directory referred to by the file port @var{dir}.
 Create a new directory named by @var{path}.  If @var{mode} is omitted
 then the permissions of the directory are set to @code{#o777}
 masked with the current umask (@pxref{Processes, @code{umask}}).
-Otherwise they are set to the value specified with @var{mode}.
+Otherwise they are set to the value specified with @var{mode}
+masked with the current umask.
 The return value is unspecified.
 @end deffn
 
-- 
2.30.2




[PATCH v2 13/14] Define Scheme bindings to ‘openat’ when available.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect if ‘openat’ is defined.
* libguile/filesys.c
  (flags_to_mode): Extract from ...
  (scm_mode): ... here.
  (scm_open_fdes_at, scm_openat): Define the Scheme bindings.
* libguile/filesys.h (scm_open_fdes_at, scm_openat): Make them part
  of the API.
* doc/ref/posix.texi (File System): Document them.
* test-suite/tests/filesys.test ("openat"): Test ‘openat’.
* libguile/syscalls.h (openat_or_openat64): Decide between ‘openat’
  and ‘openat64’.
---
 configure.ac  |  3 +-
 doc/ref/posix.texi| 13 +
 libguile/filesys.c| 96 +++
 libguile/filesys.h|  2 +
 libguile/syscalls.h   |  1 +
 test-suite/tests/filesys.test | 73 ++
 6 files changed, 167 insertions(+), 21 deletions(-)

diff --git a/configure.ac b/configure.ac
index e073e04f4..905e4d465 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,7 +478,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat, fchownat, fstatat - POSIX.1-2008
+#   unlinkat, fchownat, fstatat, openat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -495,6 +495,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid \
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp  \
   index bcopy memcpy rindex truncate isblank _NSGetEnviron  \
   strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \
+  openat \
   fstatat futimens sched_getaffinity sched_setaffinity sendfile])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index cdd03f141..3619ee2c3 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -296,12 +296,25 @@ Create the file if it does not already exist.
 for additional flags.
 @end deffn
 
+@deffn {Scheme Procedure} openat dir path flags [mode]
+@deffnx {C Function} scm_openat (dir, path, flags, mode)
+Similar to @code{open}, but resolve the file name @var{path}
+relative to the directory referred to by the file port @var{dir}
+instead.
+@end deffn
+
 @deffn {Scheme Procedure} open-fdes path flags [mode]
 @deffnx {C Function} scm_open_fdes (path, flags, mode)
 Similar to @code{open} but return a file descriptor instead of
 a port.
 @end deffn
 
+@deffn {Scheme Procedure} open-fdes-at dir path flags [mode]
+@deffnx {C Function} scm_open_fdes_at (dir, path, flags, mode)
+Similar to @code{openat}, but return a file descriptor instead
+of a port.
+@end deffn
+
 @deffn {Scheme Procedure} close fd_or_port
 @deffnx {C Function} scm_close (fd_or_port)
 Similar to @code{close-port} (@pxref{Ports, close-port}),
diff --git a/libguile/filesys.c b/libguile/filesys.c
index d045a672f..dadbe3393 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -249,6 +249,60 @@ SCM_DEFINE (scm_open_fdes, "open-fdes", 2, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_OPENAT
+SCM_DEFINE (scm_open_fdes_at, "open-fdes-at", 3, 1, 0,
+(SCM dir, SCM path, SCM flags, SCM mode),
+"Similar to @code{openat}, but return a file descriptor instead\n"
+"of a port.")
+#define FUNC_NAME s_scm_open_fdes_at
+{
+  int dir_fdes;
+  int fd;
+  int iflags;
+  int imode;
+
+  iflags = SCM_NUM2INT (SCM_ARG2, flags);
+  imode = SCM_NUM2INT_DEF (3, mode, 0666);
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (path, c_path,
+  fd = openat_or_openat64 (dir_fdes, c_path, iflags, imode));
+  scm_remember_upto_here_1 (dir);
+  if (fd == -1)
+SCM_SYSERROR;
+  return scm_from_int (fd);
+}
+#undef FUNC_NAME
+#endif /* HAVE_OPENAT */
+
+/* A helper function for converting some open flags to
+   what scm_fdes_to_port expects. */
+static char *
+flags_to_mode (int iflags)
+{
+  if ((iflags & O_RDWR) == O_RDWR)
+{
+  /* Opened read-write.  */
+  if (iflags & O_APPEND)
+   return "a+";
+  else if (iflags & O_CREAT)
+   return "w+";
+  else
+   return "r+";
+}
+  else
+{
+  /* Opened read-only or write-only.  */
+  if (iflags & O_APPEND)
+   return "a";
+  else if (iflags & O_WRONLY)
+   return "w";
+  else
+   return "r";
+}
+}
+
 SCM_DEFINE (scm_open, "open", 2, 1, 0, 
 (SCM path, SCM flags, SCM mode),
"Open the file named by @var{path} for reading and/or writing.\n"
@@ -285,31 +339,33 @@ SCM_DEFINE (scm_open, "open", 2, 1, 0,
   fd = scm_to_int (scm_open_fdes (path, flags, mode));
   iflags = SCM_NUM2INT (2, flags);
 
-  if ((iflags & O_RDWR) == O_RDWR)
-{
-  /* Opened read-write.  */
-  if (iflags & O_APPEND)
-   port_mode = "a+";
-  else if (iflags & O_CREAT)
-  

[PATCH v2 03/14] Allow file ports in ‘utime’.

2021-11-16 Thread Maxime Devos
Ports representing symbolic links are currently unsupported.

* configure.ac: Detect 'futimens'.
* doc/ref/posix.texi (utime): Update documentation.
* libguile/posix.c (scm_utime): Support ports.
* libguile/posix.h (scm_utime): Rename argument.
* test-suite/tests/posix.test ("utime"): Add more tests.
---
 configure.ac|  4 +--
 doc/ref/posix.texi  | 15 +---
 libguile/posix.c| 28 +++
 libguile/posix.h|  2 +-
 test-suite/tests/posix.test | 71 -
 5 files changed, 106 insertions(+), 14 deletions(-)

diff --git a/configure.ac b/configure.ac
index 4888f880d..ddf330d96 100644
--- a/configure.ac
+++ b/configure.ac
@@ -477,7 +477,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   truncate - not in mingw
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
-#   strcoll_l, newlocale, uselocale, utimensat - POSIX.1-2008
+#   strcoll_l, newlocale, uselocale, utimensat, futimens - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -494,7 +494,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid \
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp  \
   index bcopy memcpy rindex truncate isblank _NSGetEnviron  \
   strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \
-  sched_getaffinity sched_setaffinity sendfile])
+  futimens sched_getaffinity sched_setaffinity sendfile])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
 AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include ]])
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index cd23240c4..b6deffd43 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -796,14 +796,16 @@ the new permissions as a decimal number, e.g., 
@code{(chmod "foo" #o755)}.
 The return value is unspecified.
 @end deffn
 
-@deffn {Scheme Procedure} utime pathname [actime [modtime [actimens [modtimens 
[flags]
-@deffnx {C Function} scm_utime (pathname, actime, modtime, actimens, 
modtimens, flags)
+@deffn {Scheme Procedure} utime object [actime [modtime [actimens [modtimens 
[flags]
+@deffnx {C Function} scm_utime (object, actime, modtime, actimens, modtimens, 
flags)
 @code{utime} sets the access and modification times for the
-file named by @var{pathname}.  If @var{actime} or @var{modtime} is
+file named by @var{object}.  If @var{actime} or @var{modtime} is
 not supplied, then the current time is used.  @var{actime} and
 @var{modtime} must be integer time values as returned by the
 @code{current-time} procedure.
 
+@var{object} must be a file name or a port (if supported by the system).
+
 The optional @var{actimens} and @var{modtimens} are nanoseconds
 to add @var{actime} and @var{modtime}. Nanosecond precision is
 only supported on some combinations of file systems and operating
@@ -817,9 +819,14 @@ modification time to the current time.
 @vindex AT_SYMLINK_NOFOLLOW
 Last, @var{flags} may be either @code{0} or the
 @code{AT_SYMLINK_NOFOLLOW} constant, to set the time of
-@var{pathname} even if it is a symbolic link.
+@var{object} even if it is a symbolic link.
 @end deffn
 
+On GNU/Linux systems, at least when using the Linux kernel 5.10.46,
+if @var{object} is a port, it may not be a symbolic link,
+even if @code{AT_SYMLINK_NOFOLLOW} is set.  This is either a bug
+in Linux or Guile's wrappers.  The exact cause is unclear.
+
 @findex unlink
 @deffn {Scheme Procedure} delete-file str
 @deffnx {C Function} scm_delete_file (str)
diff --git a/libguile/posix.c b/libguile/posix.c
index 3ab12b99e..bd7f40ca8 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,5 +1,6 @@
 /* Copyright 1995-2014,2016-2019,2021
  Free Software Foundation, Inc.
+   Copyright 2021 Maxime Devos 
 
This file is part of Guile.
 
@@ -1648,13 +1649,14 @@ SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_utime, "utime", 1, 5, 0,
-(SCM pathname, SCM actime, SCM modtime, SCM actimens, SCM 
modtimens,
+(SCM object, SCM actime, SCM modtime, SCM actimens, SCM modtimens,
  SCM flags),
"@code{utime} sets the access and modification times for the\n"
-   "file named by @var{pathname}.  If @var{actime} or @var{modtime} 
is\n"
+   "file named by @var{object}.  If @var{actime} or @var{modtime} is\n"
"not supplied, then the current time is used.  @var{actime} and\n"
"@var{modtime} must be integer time values as returned by the\n"
"@code{current-time} procedure.\n\n"
+"@var{object} must be a file name or a port (if supported by the 
system).\n\n"
 "The optional @var{actimens} and @va

[PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.

2021-11-16 Thread Maxime Devos
* configure.ac: Check for ‘fchdir’.
* libguile/filesys.c
(scm_chdir): Support file ports.
(scm_init_filesys): Report support of file ports.
* doc/ref/posix.texi (Processes): Update accordingly.
* doc/ref/guile.texi: Add copyright line for new documentation in this
patch and later patches.
* test-suite/tests/filesys.test ("chdir"): Test it.
---
 configure.ac  |  3 ++-
 doc/ref/guile.texi|  3 ++-
 doc/ref/posix.texi|  5 -
 libguile/filesys.c| 23 +++-
 test-suite/tests/filesys.test | 41 +++
 5 files changed, 71 insertions(+), 4 deletions(-)

diff --git a/configure.ac b/configure.ac
index bd49bf162..b7e4663f7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -484,7 +484,8 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   sendfile - non-POSIX, found in glibc
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
-  fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid\
+  fesetround ftime ftruncate fchown fchmod fchdir  \
+  getcwd geteuid getsid
\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/guile.texi b/doc/ref/guile.texi
index 660b1ae90..48af1f820 100644
--- a/doc/ref/guile.texi
+++ b/doc/ref/guile.texi
@@ -14,7 +14,8 @@
 This manual documents Guile version @value{VERSION}.
 
 Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software Foundation,
-Inc.
+Inc. \\
+Copyright (C) 2021 Maxime Devos
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 7633bd5a3..7555f9319 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -2,6 +2,7 @@
 @c This is part of the GNU Guile Reference Manual.
 @c Copyright (C)  1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
 @c   2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software 
Foundation, Inc.
+@c Copyright (C)  2021 Maxime Devos 
 @c See the file guile.texi for copying conditions.
 
 @node POSIX
@@ -1605,7 +1606,9 @@ The return value is unspecified.
 @deffn {Scheme Procedure} chdir str
 @deffnx {C Function} scm_chdir (str)
 @cindex current directory
-Change the current working directory to @var{str}.
+Change the current working directory to @var{str}.  @var{str} can be a
+string containing a file name, or a port if supported by the system.
+@code{(provided? 'chdir-port)} reports whether ports are supported.
 The return value is unspecified.
 @end deffn
 
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 6247734e8..2a9c36a12 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,5 +1,6 @@
 /* Copyright 1996-2002,2004,2006,2009-2019,2021
  Free Software Foundation, Inc.
+   Copyright 2021 Maxime Devos 
 
This file is part of Guile.
 
@@ -621,12 +622,28 @@ SCM_DEFINE (scm_link, "link", 2, 0, 0,
 SCM_DEFINE (scm_chdir, "chdir", 1, 0, 0, 
 (SCM str),
"Change the current working directory to @var{str}.\n"
+"@var{str} can be a string containing a file name,\n"
+"or a port if supported by the system.\n"
+"@code{(provided? 'chdir-port)} reports whether ports "
+"are supported."
"The return value is unspecified.")
 #define FUNC_NAME s_scm_chdir
 {
   int ans;
 
-  STRING_SYSCALL (str, c_str, ans = chdir (c_str));
+#ifdef HAVE_FCHDIR
+  if (SCM_OPFPORTP (str))
+{
+  int fdes;
+  fdes = SCM_FPORT_FDES (str);
+  SCM_SYSCALL (ans = fchdir (fdes));
+  scm_remember_upto_here_1 (str);
+}
+  else
+#endif
+{
+  STRING_SYSCALL (str, c_str, ans = chdir (c_str));
+}
   if (ans != 0)
 SCM_SYSERROR;
   return SCM_UNSPECIFIED;
@@ -2066,5 +2083,9 @@ scm_init_filesys ()
 
   scm_dot_string = scm_from_utf8_string (".");
 
+#ifdef HAVE_FCHDIR
+  scm_add_feature("chdir-port");
+#endif
+
 #include "filesys.x"
 }
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 6fed981e5..6b09a2ba0 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -1,6 +1,7 @@
  filesys.test --- test file system functions -*- scheme -*-
  
  Copyright (C) 2004, 2006, 2013, 2019, 2021 Free Software Foundation, Inc.
+ Copyright (C) 2021 Maxime Devos 
  
  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
@@ -265,3 +266,43 @@
  (result   (eqv? 'directory (stat:type _stat
 (false-if-e

[PATCH v2 12/14] Define a Scheme binding to ‘fstatat’ when available.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect if ‘fstatat’ is defined.
* libguile/filesys.c (scm_statat): Define a Scheme binding to ‘fstatat’.
* libguile/filesys.h (scm_statat): Make it part of the C API.
* doc/ref/posix.texi (File System): Document it.
* libguile/syscalls.h (fstatat_or_fstatat64): Choose between ‘fstatat’
  and ‘fstatat64’.
---
 configure.ac  |  4 +-
 doc/ref/posix.texi|  8 
 libguile/filesys.c| 39 +
 libguile/filesys.h|  1 +
 libguile/syscalls.h   |  1 +
 test-suite/tests/filesys.test | 80 +++
 6 files changed, 131 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index dcb6bceb5..e073e04f4 100644
--- a/configure.ac
+++ b/configure.ac
@@ -478,7 +478,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #   isblank - available as a GNU extension or in C99
 #   _NSGetEnviron - Darwin specific
 #   strcoll_l, newlocale, uselocale, utimensat, futimens, fchmodat,
-#   unlinkat, fchownat - POSIX.1-2008
+#   unlinkat, fchownat, fstatat - POSIX.1-2008
 #   strtol_l - non-POSIX, found in glibc
 #   fork - unavailable on Windows
 #   sched_getaffinity, sched_setaffinity - GNU extensions (glibc)
@@ -495,7 +495,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid \
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp  \
   index bcopy memcpy rindex truncate isblank _NSGetEnviron  \
   strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \
-  futimens sched_getaffinity sched_setaffinity sendfile])
+  fstatat futimens sched_getaffinity sched_setaffinity sendfile])
 
 # The newlib C library uses _NL_ prefixed locale langinfo constants.
 AC_CHECK_DECLS([_NL_NUMERIC_GROUPING], [], [], [[#include ]])
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 3d06f1c73..cdd03f141 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -755,6 +755,14 @@ it will return information about a symbolic link itself, 
not the
 file it points to.  @var{path} must be a string.
 @end deffn
 
+@deffn {Scheme Procedure} statat dir filename [flags]
+@deffnx {C Function} scm_statat dir filename flags
+Like @code{stat}, but resolve @var{filename} relative to the directory
+referred to by the file port @var{dir} instead.  The optional argument
+@var{flags} argument can be @code{AT_SYMLINK_NOFOLLOW}, in which case
+@var{filename} will not be dereferenced even if it is a symbolic link.
+@end deffn
+
 @deffn {Scheme Procedure} readlink path
 @deffnx {C Function} scm_readlink (path)
 Return the value of the symbolic link named by @var{path} (a string, or
diff --git a/libguile/filesys.c b/libguile/filesys.c
index c257bb59c..d045a672f 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -601,6 +601,45 @@ SCM_DEFINE (scm_stat, "stat", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_FSTATAT
+SCM_DEFINE (scm_statat, "statat", 2, 1, 0,
+(SCM dir, SCM filename, SCM flags),
+"Like @code{stat}, but resolve @var{filename} relative to the\n"
+"directory referred to by the file port @var{dir} instead.\n\n"
+"The optional argument @var{flags} argument can be\n"
+"@code{AT_SYMLINK_NOFOLLOW}, in which case @var{filename} will\n"
+"not be dereferenced even if it is a symbolic link.")
+#define FUNC_NAME s_scm_statat
+{
+  int rv;
+  int dir_fdes;
+  int c_flags;
+  struct stat_or_stat64 stat_temp;
+
+  if (SCM_UNBNDP (flags))
+c_flags = 0;
+  else
+c_flags = scm_to_int (flags);
+
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (filename, c_filename,
+  rv = fstatat_or_fstatat64 (dir_fdes, c_filename,
+ &stat_temp, c_flags));
+  scm_remember_upto_here_1 (dir);
+  if (rv != 0)
+{
+  int en = errno;
+  SCM_SYSERROR_MSG ("~A: ~S",
+scm_list_2 (scm_strerror (scm_from_int (en)), 
filename),
+en);
+}
+  return scm_stat2scm (&stat_temp);
+}
+#undef FUNC_NAME
+#endif /* HAVE_FSTATAT */
+
 SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0, 
 (SCM str),
"Similar to @code{stat}, but does not follow symbolic links, 
i.e.,\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index 7673c8051..8af0f989a 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -48,6 +48,7 @@ SCM_API SCM scm_open (SCM path, SCM flags, SCM mode);
 SCM_API SCM scm_close (SCM fd_or_port);
 SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
+SCM_API SCM scm_statat (SCM dir, SCM filename, SCM flags);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
diff --git a/libguile/syscalls.h b/libguile/syscalls.h
index 30b99c193..37d532e60 100644
--- a/libguile/syscall

[PATCH v2 07/14] Define AT_REMOVEDIR and others when available.

2021-11-16 Thread Maxime Devos
* libguile/posix.c (scm_init_posix): Define (in Scheme)
  AT_REMOVEDIR and AT_EACCESS when defined (in C).
---
 libguile/posix.c | 6 ++
 1 file changed, 6 insertions(+)

diff --git a/libguile/posix.c b/libguile/posix.c
index bd7f40ca8..a6f7c9a0d 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -2503,6 +2503,12 @@ scm_init_posix ()
 #ifdef AT_EMPTY_PATH
   scm_c_define ("AT_EMPTY_PATH", scm_from_int (AT_EMPTY_PATH));
 #endif
+#ifdef AT_REMOVEDIR
+  scm_c_define ("AT_REMOVEDIR", scm_from_int (AT_REMOVEDIR));
+#endif
+#ifdef AT_EACCESS
+  scm_c_define ("AT_EACCESS", scm_from_int (AT_EACCESS));
+#endif
 
 #include "cpp-SIG.c"
 #include "posix.x"
-- 
2.30.2




[PATCH v2 05/14] Define bindings to ‘mkdirat’ when the C function exists.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect if ‘mkdirat’ exists.
* libguile/filesys.c (scm_mkdirat): Define the Scheme binding.
* doc/ref/posix.texi (File System): Document it.
---
 configure.ac  |  2 +-
 doc/ref/posix.texi|  6 ++
 libguile/filesys.c| 25 +++
 libguile/filesys.h|  1 +
 test-suite/tests/filesys.test | 38 +++
 5 files changed, 71 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index b2e9ef3e9..da8dfadd0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
-  symlinkat getcwd geteuid getsid  
\
+  symlinkat mkdirat getcwd geteuid getsid  \
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index a329eec39..d261ac8da 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -906,6 +906,12 @@ Otherwise they are set to the value specified with 
@var{mode}.
 The return value is unspecified.
 @end deffn
 
+@deffn {Scheme Procedure} mkdirat dir path [mode]
+@deffnx {C Function} scm_mkdirat (dir, path, mode)
+Like @code{mkdir}, but resolve @var{path} relative to the directory
+referred to by the file port @var{dir} instead.
+@end deffn
+
 @deffn {Scheme Procedure} rmdir path
 @deffnx {C Function} scm_rmdir (path)
 Remove the existing directory named by @var{path}.  The directory must
diff --git a/libguile/filesys.c b/libguile/filesys.c
index bfd223434..ee01b2e2c 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1364,6 +1364,31 @@ SCM_DEFINE (scm_mkdir, "mkdir", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_MKDIRAT
+SCM_DEFINE (scm_mkdirat, "mkdirat", 2, 1, 0,
+(SCM dir, SCM path, SCM mode),
+"Like @code{mkdir}, but resolve @var{path} relative to the 
directory\n"
+"referred to by the file port @var{dir} instead.")
+#define FUNC_NAME s_scm_mkdirat
+{
+  int rv;
+  int dir_fdes;
+  mode_t c_mode;
+
+  c_mode = SCM_UNBNDP (mode) ? 0777 : scm_to_uint (mode);
+  SCM_VALIDATE_OPFPORT (SCM_ARG1, dir);
+  dir_fdes = SCM_FPORT_FDES (dir);
+
+  STRING_SYSCALL (path, c_path, rv = mkdirat (dir_fdes, c_path, c_mode));
+  if (rv != 0)
+SCM_SYSERROR;
+
+  scm_remember_upto_here_1 (dir);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
+
 SCM_DEFINE (scm_rmdir, "rmdir", 1, 0, 0, 
 (SCM path),
"Remove the existing directory named by @var{path}.  The directory 
must\n"
diff --git a/libguile/filesys.h b/libguile/filesys.h
index d181aca52..f0dd35ede 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -50,6 +50,7 @@ SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
+SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
 SCM_API SCM scm_rmdir (SCM path);
 SCM_API SCM scm_directory_stream_p (SCM obj);
 SCM_API SCM scm_opendir (SCM dirname);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 64bf92333..4ea62d513 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -29,6 +29,8 @@
   (data-file-name "filesys-test.tmp"))
 (define (test-symlink)
   (data-file-name "filesys-test-link.tmp"))
+(define (test-directory)
+  (data-file-name "filesys-test-dir.tmp"))
 
 
 ;;;
@@ -394,3 +396,39 @@
   (throw 'unsupported))
 (symlinkat (call-with-port (open "." O_RDONLY) identity)
(test-file) (test-symlink
+
+(with-test-prefix "mkdirat"
+  (define (skip-if-unsupported)
+(unless (defined? 'mkdirat)
+  (throw 'unsupported)))
+  (define (maybe-delete-directory)
+(when (file-exists? (test-directory))
+  (rmdir (test-directory
+  (maybe-delete-directory)
+
+  (pass-if-equal "create" 'directory
+(skip-if-unsupported)
+(call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+   (mkdirat port (test-directory))
+   (stat:type (stat (test-directory))
+  (maybe-delete-directory)
+
+  (pass-if-equal "explicit perms" (logand #o111 (lognot (umask)))
+(skip-if-unsupported)
+(call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+   (mkdirat port (test-directory) #o111)
+   (stat:perms (stat (test-directory))
+  (maybe-delete-directory)
+
+  (pass-if-equal "create, implicit perms" (logand #o777 (lognot (umask)))
+(skip-if-unsupported)
+(call-with-port
+ (open "." O_RDONLY)
+ (lambda (port)
+   (mkdirat port (test-directory))
+   (stat:pe

[PATCH v2 08/14] Define a Scheme binding to ‘renameat’ when it exists.

2021-11-16 Thread Maxime Devos
* configure.ac: Detect if ‘renameat’ is defined.
* libguile/filesys.c (scm_renameat): Define a Scheme binding
  to the ‘renameat’ system call.
* doc/ref/posix.texi (File System): Document it.
* libguile/filesys.h (scm_renameat): Make it part of the C API.
* test-suite/tests/filesys.test ("rename-file-at"): New tests.
---
 configure.ac  |   2 +-
 doc/ref/posix.texi|   9 +++
 libguile/filesys.c|  34 +++
 libguile/filesys.h|   1 +
 test-suite/tests/filesys.test | 104 ++
 5 files changed, 149 insertions(+), 1 deletion(-)

diff --git a/configure.ac b/configure.ac
index da8dfadd0..e67892feb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -485,7 +485,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \
   fesetround ftime ftruncate fchown fchmod fchdir readlinkat   \
-  symlinkat mkdirat getcwd geteuid getsid  \
+  symlinkat mkdirat renameat getcwd geteuid getsid 
\
   gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod   \
   nice readlink rename rmdir setegid seteuid\
   setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64  \
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 7f136376b..ebb001581 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -877,6 +877,15 @@ Renames the file specified by @var{oldname} to 
@var{newname}.
 The return value is unspecified.
 @end deffn
 
+@findex renameat
+@deffn {Scheme Procedure} rename-file-at olddir oldname newdir newname
+@deffnx {C Function} scm_renameat (olddir, oldname, newdir, newname)
+Like @code{rename-file}, but when @var{olddir} or @var{newdir} is true,
+resolve @var{oldname} or @var{newname} relative to the directory
+specified by the file port @var{olddir} or @var{newdir} instead of the
+current working directory.
+@end deffn
+
 @deffn {Scheme Procedure} link oldpath newpath
 @deffnx {C Function} scm_link (oldpath, newpath)
 Creates a new name @var{newpath} in the file system for the
diff --git a/libguile/filesys.c b/libguile/filesys.c
index ee01b2e2c..9c63beaa8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1421,6 +1421,40 @@ SCM_DEFINE (scm_rename, "rename-file", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+#ifdef HAVE_RENAMEAT
+SCM_DEFINE (scm_renameat, "rename-file-at", 4, 0, 0,
+(SCM olddir, SCM oldname, SCM newdir, SCM newname),
+"Like @code{rename-file}, but when @var{olddir} or @var{newdir}\n"
+"is true, resolve @var{oldname} or @var{newname} relative to\n"
+"the directory specified by file port @var{olddir} or\n"
+"@var{newdir} instead of the current working directory.")
+#define FUNC_NAME s_scm_renameat
+{
+  int rv;
+  int old_fdes, new_fdes;
+
+  old_fdes = AT_FDCWD;
+  new_fdes = AT_FDCWD;
+
+  if (scm_is_true (olddir)) {
+SCM_VALIDATE_OPFPORT (SCM_ARG1, olddir);
+old_fdes = SCM_FPORT_FDES (olddir);
+  }
+  if (scm_is_true (newdir)) {
+SCM_VALIDATE_OPFPORT (SCM_ARG3, newdir);
+new_fdes = SCM_FPORT_FDES (newdir);
+  }
+
+  STRING2_SYSCALL (oldname, c_oldname,
+  newname, c_newname,
+  rv = renameat (old_fdes, c_oldname, new_fdes, c_newname));
+  scm_remember_upto_here_2 (olddir, newdir);
+  if (rv != 0)
+SCM_SYSERROR;
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif
 
 SCM_DEFINE (scm_delete_file, "delete-file", 1, 0, 0, 
(SCM str),
diff --git a/libguile/filesys.h b/libguile/filesys.h
index f0dd35ede..7e17cc585 100644
--- a/libguile/filesys.h
+++ b/libguile/filesys.h
@@ -48,6 +48,7 @@ SCM_API SCM scm_close_fdes (SCM fd);
 SCM_API SCM scm_stat (SCM object, SCM exception_on_error);
 SCM_API SCM scm_link (SCM oldpath, SCM newpath);
 SCM_API SCM scm_rename (SCM oldname, SCM newname);
+SCM_API SCM scm_renameat (SCM olddir, SCM oldname, SCM newdir, SCM newname);
 SCM_API SCM scm_delete_file (SCM str);
 SCM_API SCM scm_mkdir (SCM path, SCM mode);
 SCM_API SCM scm_mkdirat (SCM dir, SCM path, SCM mode);
diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test
index 4ea62d513..bbce2c858 100644
--- a/test-suite/tests/filesys.test
+++ b/test-suite/tests/filesys.test
@@ -31,6 +31,8 @@
   (data-file-name "filesys-test-link.tmp"))
 (define (test-directory)
   (data-file-name "filesys-test-dir.tmp"))
+(define (test-directory2)
+  (data-file-name "filesys-test-dir2.tmp"))
 
 
 ;;;
@@ -432,3 +434,105 @@
(mkdirat port (test-directory))
(stat:perms (stat (test-directory))
   (maybe-delete-directory))
+
+(with-test-prefix "rename-file-at"
+  (define (skip-if-unsupported)
+(unless (defined? 'rename-file-at)
+  (throw 'unsupported)))
+  (pass-if-equal "current working directory" '(#f "hello")
+(skip-if-unsupported)
+;; Create a file in the test directory
+(call-with-output-file "files

[PATCH v2 14/14] Update NEWS.

2021-11-16 Thread Maxime Devos
---
 NEWS | 12 
 1 file changed, 12 insertions(+)

diff --git a/NEWS b/NEWS
index 710b8ddda..922543a31 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,9 @@ Changes in 3.0.8 (since 3.0.7)
 ** Fix compilation of (ash x N), where N is a literal, at -O1 and below
 ** Texinfo and XML parsers are now thread-safe
()
+** Fix documentation of ‘mkdir’
+   Previously, the documentation implied the umask was ignored if the
+   mode was set explicitely.  However, this is not the case.
 
 * New deprecations
 
@@ -28,6 +31,15 @@ This function was undocumented.
 
 * New interfaces and functionality
 
+** Bindings to openat and friends
+
+The procedures `openat', `open-fdes-at', `statat', `chownat',
+`unlinkat', `chmodat', `renameat', `mkdirat' and `symlinkat' have been
+added.  They resolve file names relative to a directory passed as a file
+port.  The procedures `chdir' `readlink' and `utime' have been extended
+to support file ports.  The related flags `AT_REMOVEDIR' and
+`AT_EACCESS' have been added. See `File System' in the manual
+
 ** Typed vector copy functions
 
 The functions `u8vector-copy' `s8vector-copy' `u16vector-copy'
-- 
2.30.2




Re: [PATCH v2 14/14] Update NEWS.

2021-11-16 Thread Maxime Devos
Maxime Devos schreef op di 16-11-2021 om 11:06 [+]:
> [...]
> +** Fix documentation of ‘mkdir’
> +   Previously, the documentation implied the umask was ignored if
> the
> +   mode was set explicitely.  However, this is not the case.

As noted by Thien-Thi Nguyen, the spelling is ‘explicitly’, not
‘explicitely’. Revised patch is attached.
From 6aa21f7287f98c9a79fa7014688f3cfdf1803422 Mon Sep 17 00:00:00 2001
From: Maxime Devos 
Date: Mon, 15 Nov 2021 21:17:10 +
Subject: [PATCH] Update NEWS.

---
 NEWS | 12 
 1 file changed, 12 insertions(+)

diff --git a/NEWS b/NEWS
index 710b8ddda..298dbaabb 100644
--- a/NEWS
+++ b/NEWS
@@ -12,6 +12,9 @@ Changes in 3.0.8 (since 3.0.7)
 ** Fix compilation of (ash x N), where N is a literal, at -O1 and below
 ** Texinfo and XML parsers are now thread-safe
(<https://bugs.gnu.org/51264>)
+** Fix documentation of ‘mkdir’
+   Previously, the documentation implied the umask was ignored if the
+   mode was set explicitly.  However, this is not the case.
 
 * New deprecations
 
@@ -28,6 +31,15 @@ This function was undocumented.
 
 * New interfaces and functionality
 
+** Bindings to openat and friends
+
+The procedures `openat', `open-fdes-at', `statat', `chownat',
+`unlinkat', `chmodat', `renameat', `mkdirat' and `symlinkat' have been
+added.  They resolve file names relative to a directory passed as a file
+port.  The procedures `chdir' `readlink' and `utime' have been extended
+to support file ports.  The related flags `AT_REMOVEDIR' and
+`AT_EACCESS' have been added. See `File System' in the manual
+
 ** Typed vector copy functions
 
 The functions `u8vector-copy' `s8vector-copy' `u16vector-copy'
-- 
2.30.2



Re: [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.

2021-11-16 Thread Maxime Devos
Maxime Devos schreef op di 16-11-2021 om 11:06 [+]:
>  Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software
> Foundation,
> -Inc.
> +Inc. \\
> +Copyright (C) 2021 Maxime Devos


\\ doesn't work. I'll try something else




Re: [PATCH v2 01/14] Allow file ports in ‘chdir’ when supported.

2021-11-16 Thread Maxime Devos
Maxime Devos schreef op di 16-11-2021 om 12:18 [+]:
> Maxime Devos schreef op di 16-11-2021 om 11:06 [+]:
> >  Copyright (C) 1996-1997, 2000-2005, 2009-2021 Free Software
> > Foundation,
> > -Inc.
> > +Inc. \\
> > +Copyright (C) 2021 Maxime Devos
> 
> 
> \\ doesn't work. I'll try something else

@* instead of \\ appears to work. (to put it in a separate line, but
not a separate paragraph).




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op do 15-07-2021 om 20:44 [+0200]:
> From 33af6a98c6801e7b4880d1d3f78f7e2097c2174e Mon Sep 17 00:00:00
> 2001
> From: Jonas Hahnfeld 
> Date: Fri, 2 Jul 2021 23:03:17 +0200
> Subject: [PATCH 2/3] Avoid matching calls of scm_gc_free
> 
> There is no point in registering memory with the garbage collector
> if it doesn't need to do its job. In fact, calling scm_gc_free in
> a free function is wrong because it relies on Java finalization.
> 
> * libguile/random.c (scm_c_random_bignum): Replace matching calls of
>   scm_gc_calloc and scm_gc_free.
> * libguile/regex-posix.c (scm_make_regexp, regex_free): Avoid call
>   of scm_gc_free in free function.
> * test-suite/standalone/test-smob-mark.c (make_x, free_x): Avoid
>   call of scm_gc_free in free function.
> ---
>  THANKS | 1 +
>  libguile/random.c  | 8 ++--
>  libguile/regex-posix.c | 6 +++---
>  test-suite/standalone/test-smob-mark.c | 4 ++--
>  4 files changed, 8 insertions(+), 11 deletions(-)
> 
> diff --git a/THANKS b/THANKS
> index aa4877e95..786b65d1a 100644
> --- a/THANKS
> +++ b/THANKS
> @@ -13,6 +13,7 @@ Contributors since the last release:
>   Volker Grabsch
>   Julian Graham
>  Michael Gran
> +  Jonas Hahnfeld
>   Daniel Hartwig
>   No Itisnt
>     Neil Jerram
> diff --git a/libguile/random.c b/libguile/random.c
> index 63da7f5d6..ac400a9fd 100644
> --- a/libguile/random.c
> +++ b/libguile/random.c
> @@ -324,9 +324,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
>    /* we know the result will be this big */
>    mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
>  
> -  random_chunks =
> -    (uint32_t *) scm_gc_calloc (num_chunks * sizeof (uint32_t),
> - "random bignum chunks");
> +  random_chunks = (uint32_t *) scm_calloc (num_chunks * sizeof
> (uint32_t));
>  
>    do
>  {
> @@ -363,9 +361,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
>    /* if result >= m, regenerate it (it is important to
> regenerate
>    all bits in order not to get a distorted distribution) */
>  } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >=
> 0);
> -  scm_gc_free (random_chunks,
> -   num_chunks * sizeof (uint32_t),
> -   "random bignum chunks");
> +  free (random_chunks);

>From the manual (about scm_gc_calloc & friends):

‘Memory blocks allocated this way may
be released explicitly; however, this is not strictly needed, and we
recommend _not_ calling ‘scm_gc_free’.  All memory allocated with
‘scm_gc_malloc’ or ‘scm_gc_malloc_pointerless’ is automatically
reclaimed when the garbage collector no longer sees any live reference
to it(1).’

As such, I'd recommend simply dropping the scm_gc_free
(here and in other places), if the scm_gc_free was problematic
because of Java finalization reasons.


>    return scm_i_normbig (result);
>  }
>  
> diff --git a/libguile/regex-posix.c b/libguile/regex-posix.c
> index a08da02db..36bb639e0 100644
> --- a/libguile/regex-posix.c
> +++ b/libguile/regex-posix.c
> @@ -67,7 +67,7 @@ static size_t
>  regex_free (SCM obj)
>  {
>    regfree (SCM_RGX (obj));
> -  scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
> +  free (SCM_RGX (obj));
>    return 0;
>  }
>  
> @@ -164,7 +164,7 @@ SCM_DEFINE (scm_make_regexp, "make-regexp", 1, 0,
> 1,
>    flag = SCM_CDR (flag);
>  }
>  
> -  rx = scm_gc_malloc_pointerless (sizeof (regex_t), "regex");
> +  rx = scm_malloc (sizeof (regex_t));

If the regex why scm_gc_malloc_pointerless -> scm_malloc?
Is rx not pointerless? You coud simply ...


> -  scm_gc_free (rx, sizeof(regex_t), "regex");
> +  free (rx);

drop the scm_gc_free AFAIK.

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op do 15-07-2021 om 20:44 [+0200]:
> +  SCM *smobs = scm_gc_malloc (sizeof(SCM) * SMOBS_COUNT, "smobs");
> +
>    int i;
>    mark_call_count = 0;
>    for (i = 0; i < SMOBS_COUNT; i++)
> -    make_x ();
> +    smobs[i] = make_x ();
>    scm_gc ();

smobs doesn't need to be protected for the whole function call,
until after the scm_gc() should be sufficient I think. 

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op do 15-07-2021 om 20:44 [+0200]:
> +  /* For guardians, we use unordered finalization `a la Java. */

Maybe add the reasons why this is only done when a guardian is created?
E.g.,

/* Don't use unordered finalization when not using guardians,
    because Java finalization prevents fast collection of chains of
unreachable objects */

Not 100% about the exact purpose of avoiding Java-style finalization,
you might want to adjust the wording somewhat ...

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:32 [+0100]:
> > You coud simply ...
> > 
> > 
> > > -  scm_gc_free (rx, sizeof(regex_t), "regex");
> > > +  free (rx);
> > 
> > drop the scm_gc_free AFAIK.
> 
> No, I cannot as explained in the patch summary: If we use scm_gc_free
> in a free function of a Smob, this relies on Java finalization
> because
> the memory must not be reclaimed in the same cycle.

The suggestion was to remove scm_gc_free, and not introduce free.
I.e., don't free rx manually at all, let boehmgc decide:

 regex_free (SCM obj)
 {
   regfree (SCM_RGX (obj));
-  scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
   return 0;
 }

Greetings,
Maxime


Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:40 [+0100]:
> Am Freitag, dem 19.11.2021 um 13:35 + schrieb Maxime Devos:
> > Jonas Hahnfeld schreef op vr 19-11-2021 om 14:32 [+0100]:
> > > > You coud simply ...
> > > > 
> > > > 
> > > > > -  scm_gc_free (rx, sizeof(regex_t), "regex");
> > > > > +  free (rx);
> > > > 
> > > > drop the scm_gc_free AFAIK.
> > > 
> > > No, I cannot as explained in the patch summary: If we use
> > > scm_gc_free
> > > in a free function of a Smob, this relies on Java finalization
> > > because
> > > the memory must not be reclaimed in the same cycle.
> > 
> > The suggestion was to remove scm_gc_free, and not introduce free.
> > I.e., don't free rx manually at all, let boehmgc decide:
> > 
> >  regex_free (SCM obj)
> >  {
> >    regfree (SCM_RGX (obj));
> > -  scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
> >    return 0;
> >  }
> 
> This is dangerous because we still pass the memory to regfree, so it
> must not be freed before.

How can removing a call to a free function introduce new use-after-free
bugs or double-free bugs? AFAIK, ignoring memory leak concerns (which
don't seem to apply here because of boehmgc), freeing less stuff cannot
introduce new bugs.

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:32 [+0100]:
> > > -  rx = scm_gc_malloc_pointerless (sizeof (regex_t), "regex");
> > > +  rx = scm_malloc (sizeof (regex_t));
> > 
> > If the regex why scm_gc_malloc_pointerless -> scm_malloc?
> > Is rx not pointerless?
> 
> Not sure I understand the question. We don't know what contents libc
> will write into regex_t. It could be pointers which would be bad for
> the garbage collector.

OK, if that's the case, seems like a bug in the original code, not
related to Java-style finalisation, so I would do that in a separate
patch.  Though libc probably allocates stuff with malloc and frees it
with free, and we call regfree to tell libc, so I think we should be
fine?

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Maxime Devos schreef op vr 19-11-2021 om 13:44 [+]:
> Jonas Hahnfeld schreef op vr 19-11-2021 om 14:40 [+0100]:
> > Am Freitag, dem 19.11.2021 um 13:35 + schrieb Maxime Devos:
> > > Jonas Hahnfeld schreef op vr 19-11-2021 om 14:32 [+0100]:
> > > > > You coud simply ...
> > > > > 
> > > > > 
> > > > > > -  scm_gc_free (rx, sizeof(regex_t), "regex");
> > > > > > +  free (rx);
> > > > > 
> > > > > drop the scm_gc_free AFAIK.
> > > > 
> > > > No, I cannot as explained in the patch summary: If we use
> > > > scm_gc_free
> > > > in a free function of a Smob, this relies on Java finalization
> > > > because
> > > > the memory must not be reclaimed in the same cycle.
> > > 
> > > The suggestion was to remove scm_gc_free, and not introduce free.
> > > I.e., don't free rx manually at all, let boehmgc decide:
> > > 
> > >  regex_free (SCM obj)
> > >  {
> > >    regfree (SCM_RGX (obj));
> > > -  scm_gc_free (SCM_RGX (obj), sizeof(regex_t), "regex");
> > >    return 0;
> > >  }
> > 
> > This is dangerous because we still pass the memory to regfree, so
> > it
> > must not be freed before.
> 
> How can removing a call to a free function introduce new use-after-
> free
> bugs or double-free bugs? AFAIK, ignoring memory leak concerns (which
> don't seem to apply here because of boehmgc), freeing less stuff
> cannot
> introduce new bugs.

Unless scm_gc_free is called to act as scm_remember_upto_here,
such that the memory regex_t isn't freed until regfree has done what
it should?  But regfree is called with the regex_t, so
scm_remember_upto_here wouldn't be needed.

Unless it actually is because of how finalisation in boehmgc interacts
with how boehmgc keeps track of what can be collected and what not
(I don't know the details).


Greetings,
Maxime.





Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:53 [+0100]:
> [...]
> The straight-forward solution is to statically tie the lifetime of
> regex_t to that of the smob. Which we cannot do with GC, but simply
> with malloc+free - as implemented in the patch.

OK, but for clarity I recommend adding a comment like

/* When not using Java-style finalisation, we must make sure
   the memory for the regex_t is only freed after regfree.
   To do so, use scm_malloc+free instead of scm_gc_free such
   that boehmgc will only free the regex_t when we ask it to
   in regex_free, and it won't automatically free the regex_t
   too early. */

Otherwise, it would be easy to think ‘Hmm, this code would be
simpler if we just use scm_gc_malloc and remove the unnecessary
free’ and accidentally introduce a bug ...

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:55 [+0100]:
> Am Freitag, dem 19.11.2021 um 13:48 + schrieb Maxime Devos:
> > Jonas Hahnfeld schreef op vr 19-11-2021 om 14:32 [+0100]:
> > > > > -  rx = scm_gc_malloc_pointerless (sizeof (regex_t),
> > > > > "regex");
> > > > > +  rx = scm_malloc (sizeof (regex_t));
> > > > 
> > > > If the regex why scm_gc_malloc_pointerless -> scm_malloc?
> > > > Is rx not pointerless?
> > > 
> > > Not sure I understand the question. We don't know what contents
> > > libc
> > > will write into regex_t. It could be pointers which would be bad
> > > for
> > > the garbage collector.
> > 
> > OK, if that's the case, seems like a bug in the original code, not
> > related to Java-style finalisation, so I would do that in a
> > separate
> > patch.

>From your other responses, I now know it is actually related to (non-
)Java style finalisation, but my comment about ‘separate patch’ still
seems to apply:

> 
> Again, as replied in July to the same comment, it *is* a separate
> patch
> for exactly this reason.

More concretely, it is in the same patch as that modified
libguile/random.c.  The patch to libguile/random.c doesn't seem to
be for non-Java finalization reasons. Going by the commit message,
the only possible reason I could find is:

‘There is no point in registering memory with the garbage collector
if it doesn't need to do its job’

But I don't see any ‘registering memory’, only replacing
scm_gc_calloc+scm_gc_free by scm_calloc+free, and without any
finalisation in sight. Unless you mean with ‘registering memory’
the "random bignum chunks" argument. But that still seems unrelated
to non-Java finalization.

Greetings,
Maxime




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 14:35 [+0100]:
> Am Freitag, dem 19.11.2021 um 13:15 + schrieb Maxime Devos:
> > Jonas Hahnfeld schreef op do 15-07-2021 om 20:44 [+0200]:
> > > +  SCM *smobs = scm_gc_malloc (sizeof(SCM) * SMOBS_COUNT,
> > > "smobs");
> > > +
> > >    int i;
> > >    mark_call_count = 0;
> > >    for (i = 0; i < SMOBS_COUNT; i++)
> > > -    make_x ();
> > > +    smobs[i] = make_x ();
> > >    scm_gc ();
> > 
> > smobs doesn't need to be protected for the whole function call,
> > until after the scm_gc() should be sufficient I think. 
> 
> That's what the patch does, no? For reference, the whole function
> (after this patch) looks like:
> 
> SCM *smobs = scm_gc_malloc (sizeof(SCM) * SMOBS_COUNT, "smobs");
> 
> int i;
> mark_call_count = 0;
> for (i = 0; i < SMOBS_COUNT; i++)
>   smobs[i] = make_x (); 
> scm_gc (); 
> if (mark_call_count < SMOBS_COUNT)
>   {   
>     fprintf (stderr, "FAIL: SMOB mark function called for each
> SMOB\n");
>     exit (EXIT_FAILURE);
>   }   
> scm_remember_upto_here_1 (smobs);
> 
> While we could move the remember_upto_here immediately after the call
> to scm_gc(), the current version ensures that the memory is still
> available when the error is checked.

The error checking code (I'm thinking of the if (mark_call_count ...)
fprintf(...) exit(...) here) isn't using 'smobs', so the error checking
code doesn't need the memory to be available AFAIK.

Greetings,
Maxime Devos.




Re: GC + Java finalization

2021-11-19 Thread Maxime Devos
Jonas Hahnfeld schreef op vr 19-11-2021 om 15:52 [+0100]:
> Am Freitag, dem 19.11.2021 um 14:14 + schrieb Maxime Devos:
> > [...]
> > 
> > From your other responses, I now know it is actually related to
> > (non-
> > )Java style finalisation, but my comment about ‘separate patch’
> > still
> > seems to apply:
> > 
> > > 
> > > Again, as replied in July to the same comment, it *is* a separate
> > > patch for exactly this reason.
> > 
> > More concretely, it is in the same patch as that modified
> > libguile/random.c.  The patch to libguile/random.c doesn't seem to
> > be for non-Java finalization reasons. Going by the commit message,
> > the only possible reason I could find is:
> > 
> > ‘There is no point in registering memory with the garbage collector
> > if it doesn't need to do its job’
> > 
> > But I don't see any ‘registering memory’, only replacing
> > scm_gc_calloc+scm_gc_free by scm_calloc+free, and without any
> > finalisation in sight. Unless you mean with ‘registering memory’
> > the "random bignum chunks" argument. But that still seems unrelated
> > to non-Java finalization.
> 
> Any memory allocation through gc implicitly registers the memory.

I don't mean what you mean with ‘registering memory’. I don't
see that phrase anywhere at <https://www.hboehm.info/gc/#details>
or <https://www.hboehm.info/gc/faq.html>.  I only know about
registering finalisers, but not about registering memory.

Also, I'm not sure what you are trying to say here and in the following
paragraph.  Is this some kind of argument for why the change to
libguile/random.c should be in the same patch, or general explanation,
...?

> Both
> changes are unrelated to finalization, they are there to avoid this
> unnecessary registration.
Thanks for the clarification, though I have no idea what ‘registration’
is ...
>  My previous replies only tried to clarify why
> any other solution is worse.

... but what problem and what replies are you referring to here?
I haven't seen any e-mails explaining GC problems in libguile/random.c.
I only have seen replies about non-Java style finalisation, which
do not apply to libguile/random.c (no objects but the stack have a
reference to random_chunks anywhere and libguile/random.c is not
playing with finalizers).

> Another question: Do you actually have permission to apply my
> patches?
> You already reviewed my patches in July, but as they weren't applied
> back then, does this mean we need somebody else to actually get them
> in?

No, I don't have commit access. I noted in July
(<https://lists.gnu.org/archive/html/guile-devel/2021-07/msg2.html>)
that I'm not a guile dev.

Greetings,
Maxime.




Re: GC + Java finalization

2021-11-20 Thread Maxime Devos
Jonas Hahnfeld schreef op do 15-07-2021 om 20:44 [+0200]:
> diff --git a/libguile/random.c b/libguile/random.c
> index 63da7f5d6..ac400a9fd 100644
> --- a/libguile/random.c
> +++ b/libguile/random.c
> @@ -324,9 +324,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
>    /* we know the result will be this big */
>    mpz_realloc2 (SCM_I_BIG_MPZ (result), m_bits);
>  
> -  random_chunks =
> -    (uint32_t *) scm_gc_calloc (num_chunks * sizeof (uint32_t),
> - "random bignum chunks");
> +  random_chunks = (uint32_t *) scm_calloc (num_chunks * sizeof
> (uint32_t));
>  
>    do
>  {
> @@ -363,9 +361,7 @@ scm_c_random_bignum (scm_t_rstate *state, SCM m)
>    /* if result >= m, regenerate it (it is important to
> regenerate
>   all bits in order not to get a distorted distribution) */
>  } while (mpz_cmp (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (m)) >=
> 0);
> -  scm_gc_free (random_chunks,
> -   num_chunks * sizeof (uint32_t),
> -   "random bignum chunks");
> +  free (random_chunks);
>    return scm_i_normbig (result);
>  }

As I understand it, the idea of this change is to avoid boehmgc having
to track the memory random_chunks (‘memory registration’). However,
in-between the scm_calloc and free, mpz_import is called. Looking at
libguile/mini-gmp.c, this causes gmp_allocate_func to be called. This
variable is set by mp_set_memory_functions, which is called by
scm_init_number with the allocation function
custom_gmp_malloc/custom_gmp_realloc, which uses
scm_gc_malloc_pointerless/scm_gc_realloc.

Note that that these functions signal an error in case of out-of-memory
(at least, that's what 6.19.2 Memory Blocks states). As such, in the
following situation a memory leak can happen after the proposed patch:

(catch 'out-of-memory
  (lambda ()
;; have enough memory to allocate random_chunks,
;; but not enough for mpz_import
(random some-large-number))
  (lambda _
;; random_chunks won't ever be freed! 
(pk 'oops-not-enough-memory _)))

At least Artanis tries to behave somewhat nicely in case of OOM
(https://git.savannah.gnu.org/cgit/artanis.git/tree/artanis/server/ragnarok.scm#n659),
so I'd prefer to keep using scm_gc_calloc (+ scm_gc_free) instead of
scm_calloc + free.

Greetings,
Maxime.




Re: [PATCH] New function array-mutable?

2021-11-25 Thread Maxime Devos
lloda schreef op do 25-11-2021 om 17:40 [+0100]:
> [...]

Suggestion: add a few tests to test-suite/tests/arrays.test:

(pass-if-equal "new"
  #t
  (array-mutable? (make-array #f '(1 2) '(3 4

(pass-if-equal "empty (two-dimensional)"
  #t
  (array-mutable? (array-copy #1(

(pass-if-equal "empty (two-dimensional)"
  #t
  (array-mutable? (array-copy #2(() ()

(pass-if-equal "immutable copy"
  #f
  (array-mutable? (immutable-array-copy #2((h) (h)

This requires a currently non-existent procedure ‘make-immutable-
array’, copying an array into a new immutable array.

Greetings,
Maxime




Re: [PATCH] New function array-mutable?

2021-11-25 Thread Maxime Devos
lloda schreef op do 25-11-2021 om 17:40 [+0100]:
> +Arrays with empty roots are not considered immutable because
> +@code{array-set!} operations with valid indices won't fail (since
> there
> +are no valid indices).
> +
> +@example
> +(array-mutable? #()) @result{} #t
> +@end example
> +@end deffn

By this logic, shouldn't empty subarrays (*) with a possibly mutable
and non-empty root be considered mutable as well?

(*) called ‘shared arrays’ in the manual

Greetings,
Maxime




Re: [PATCH] New function array-mutable?

2021-12-09 Thread Maxime Devos
Hi,

lloda schreef op do 25-11-2021 om 20:08 [+0100]:
I think literal arrays are always immutable, and one could base the
test on that.
>
Is such a function useful in some other context? If one has an array which is 
already immutable, it can be referenced freely and copying it seems 
unnecessary. If one has a mutable array, is there any reason why one would want 
to make an immutable copy?

To avoid accidental mutation (though at the cost of making a copy).

Also, literals aren't necessarily immutable if 'eval' is used:

(let ((literal (make-array 0 1 1))) (eval `(array-set! ',literal #xff 0 0) 
(current-module)) literal)
;; output: #2((255))

As-is, this is a somewhat contrived example. But 'eval' is useful REPL-like 
things,
and if someone implements a REPL-like thing, they might want to ‘immutabilise’
all input first such that array-set! on literals will actually produce an 
exception
as one would expect.

An alternative method would be to compile the code before running
(which is what the standard REPL does IIUC), but _requiring_ this extra step 
seems
suboptimal to me.

Greetings,
Maxime.

p.s. Somehow, your e-mail ended up in spam, for no apparent reason.




Re: Java finalization & smobs?

2021-12-10 Thread Maxime Devos
Hi,

Han-Wen Nienhuys schreef op vr 10-12-2021 om 15:59 [+0100]:
> which is consistent with what we see. On the other hand, Guile sets
> up
> BDWGC with GC_java_finalization=1, which should keep GC dependencies

At least in Guile 3, that's done in scm_init_guardians.
While that's always called in scm_i_init_guile, maybe Guile 2 only
loads the guardian code when it's really needed and doesn't set up
Java-style finalisation?

Greetings,
Maxime (not a guile maintainer).




Re: Java finalization & smobs?

2021-12-10 Thread Maxime Devos
Han-Wen Nienhuys schreef op vr 10-12-2021 om 15:59 [+0100]:
> We can change our mark routines to avoid the crash, but it's unclear
> to us if this behavior is intended or not, and we worry that this
> will
> come back to bite us in the future.
> [...]
> [... things about Java-style finalisation ...]

Keep in mind that Jonas Hahnfeld (from LilyPond) was looking into _not_
enabling Java-style finalisation (until guardians are used), see
.

Greetings,
Maxime




Re: Java finalization & smobs?

2021-12-10 Thread Maxime Devos
Han-Wen Nienhuys schreef op vr 10-12-2021 om 15:59 [+0100]:
> On the one hand, the docs for smobs state "must assume .. all SCM
> values that it references have already been freed and are thus
> invalid", which suggests that smob freeing happens in random order,
> which is consistent with what we see. On the other hand, Guile sets
> up
> BDWGC with GC_java_finalization=1, which should keep GC dependencies
> of an object alive until the object itself is finalized, and I think
> we have observed the mark calls that make this happen.
> 
> which of the two is it?

I assume that the fact that Java-style finalization is used, is
considered an internal implementation detail.

That doesn't explain why things are going wrong, of course.

Greetings,
Maxime




Re: [patch] Add instructions for sending patches

2021-12-11 Thread Maxime Devos
Hi,

Dr. Arne Babenhauserheide schreef op za 11-12-2021 om 16:12 [+0100]:
> + (p "To contribute small improvements, please send patches to
> "
> +    (a (@ (href "mailto:guile-devel@gnu.org";))
> "guile-devel@gnu.org")
> +   ".")

What about contributing _large_ improvements?
Where should patches for large improvements go?

> + (p "For larger changes, please discuss them first in the "
> +(a (@ (href "https://mail.gnu.org/mailman/listinfo/guile->
devel/")) "development mailing list")

What if I tried to discuss them, but nobody answered?
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=46258)
(Not 100% accurate though, because I discussed the interface on IRC a
bit IIRC? I can't find it in the logs anymore though.)

What if, I then proceed with writing the patches, and nobody responds
with some points to work on or applies it?
(https://lists.gnu.org/archive/html/guile-devel/2021-03/msg00026.html)
(The only response is a +1-style response.)

What if, eight months later, I send a simplified patch series, with
things made more consistent, and with much more tests, and this time,
there is exactly one response, with a minor point that is quickly
addressed
(https://lists.gnu.org/archive/html/guile-devel/2021-11/msg00019.html),
but the patches aren't applied?

There have been many commits and two releases since the first patch
series
(https://git.savannah.gnu.org/cgit/guile.git/log/?id=653cc0bf953a11432f77ade9c007848e947cc430&qt=range&q=653cc0bf953a11432f77ade9c007848e947cc430..HEAD&ofs=100)
, without any signs that it will actually ever be applied.

So I guess what I'm trying to say, is that while your patch documenting
how to contribute seems reasonable to me, it has been very inaccurate
for me in practice (not your fault!).

Greetings,
Maxime




Re: Maintenance and future of Guile

2021-12-19 Thread Maxime Devos
Hi,

Blake Shaw schreef op ma 20-12-2021 om 03:05 [+0700]:
> personally I've been programming for about 15 years now but my career
> has been entirely in new media (video, graphics, audio), so while
> I've
> worked with plenty of lower-level libraries over the years, I didn't
> start to get an itch for compilers until covid happened. I was also
> doing a PhD in philosophy of mathematics at the time (which I've
> postponed indefinitely to prevent being separated from my partner
> during 
> covid travel craziness) so I definitely think I have the *potential*
> to
> contribute to a project like Guile, its just a matter of finding the
> time to read some compiler books (which usually are neither short nor
> easy!).

I want to note that, while definitely the compiler part is an important
part of Guile, there's plenty of non-compiler and non-language things
in Guile as well, so reading compiler books should be unnecessary to
contribute to Guile.

E.g., things like getopt
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32154),
the HTTP API (https://debbugs.gnu.org/cgi/bugreport.cgi?bug=43711),
a bug fix in the test suite
(https://debbugs.gnu.org/cgi/bugreport.cgi?bug=43521) (verified to
work, for almost a year!).

Anyway, I would like to help when I get back to hacking, although I'd
have a (non-Guile) backlog to work through first, and there would be
some other projects I'd be working on as well.

Greetings,
Maxime.




Re: Scheme+

2021-12-20 Thread Maxime Devos
Linus Björnstam schreef op ma 20-12-2021 om 09:15 [+0100]:
> I played around with it and it seems to rely heavily on mutation,
> which makes guile (and chez and racket for that matter) box the
> values. That adds a layer of indirection to memory access, meaning
> slower code (apart from the more obvious problems of continuation
> safety and threading safety).

Concerning thread-safety and continuation safety: as long as
continuations aren't resumed multiple times (*), and as long as no
closures are passed, then the mutation doesn't make any observable
difference (except fastness).

(*) E.g., the continuations that guile-fibers construct are resumed
only once.


Greetings,
Maxime.




Re: (web server) serving on both ipv6 and ipv4?

2022-01-19 Thread Maxime Devos
Dr. Arne Babenhauserheide schreef op wo 19-01-2022 om 08:57 [+0100]:
> Hi,
> 
> 
> with both fibers server and (web server) there is a split between IPv4
> and IPv6:
> 
> 
> IPv4:
> 
> (fibers:run-server handler-with-path #:family AF_INET #:port port #:addr 
> INADDR_ANY)
> 
> (run-server handler-with-path 'http `(#:host "localhost" #:family 
> ,AF_INET #:addr ,INADDR_ANY #:port ,port))
> 
> 
> IPv6:
> 
> (define s
> (let ((s (socket AF_INET6 SOCK_STREAM 0)))
> (setsockopt s SOL_SOCKET SO_REUSEADDR 1)
> (bind s AF_INET6 (inet-pton AF_INET6 ip) port)
> s))
> (fibers:run-server handler-with-path #:family AF_INET6 #:port port #:addr 
> (inet-pton AF_INET6 ip) #:socket s)
> 
> (define s
> (let ((s (socket AF_INET6 SOCK_STREAM 0)))
> (setsockopt s SOL_SOCKET SO_REUSEADDR 1)
> (bind s AF_INET6 (inet-pton AF_INET6 ip) port)
> s))
> (run-server handler-with-path 'http `(#:family ,AF_INET6 #:addr 
> (inet-pton AF_INET6 ip) #:port ,port #:socket ,s))
> 
> 
> Is there a way to bind to both IPv6 and IPv4, so my server will react to
> requests regardless of whether a client reaches my computer over IPv4 or
> IPv6?

Maybe the IPV6_V6ONLY (see the ipv6(7) man page) is relevant here.
Alternatively, you could run two servers in parallel: one bound to an
IPv4 address and another bound to an IPv6 address.

Unfortunately, the fibers HTTP server calls 'run-fibers' (even if
there's already some scheduler), so each server will be run in its own
fresh scheduler, this might cause problems..

There's some code in 'cuirass' and 'gnunet-scheme' (see
)
that doesn't spawn its own scheduler.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Added srfi-214: flexvectors

2022-01-19 Thread Maxime Devos
Vijay Marupudi schreef op di 18-01-2022 om 21:34 [-0500]:
> Hello,
> 
> I have attached to this email a patch to add support for srfi-214,
> flexvectors.
> 
> I have made as few changes to the code from the sample implementation.
> 
> If this is accepted, I can work on adding to the documentation.
> 
> I have been using this for a while, and it has worked wonderfully.

How about including the tests
(https://github.com/scheme-requests-for-implementation/srfi-214/blob/master/implementation/tests.scm)
as well?

Guile doesn't use SRFI-64 in its own tests though, so some changes may
be necessary.

I noticed you started the patch with:

+;;; Copyright (C) 2022 Free Software Foundation, Inc.
+;;; [LGPL blurb]

however, the README says ‘by Adam Nelson’.  Did you reach some kind of
agreement with Adam Nelson about copyright assignment?  And since SRFIs
are licensed under Expat (not 100% sure), wouldn't this need to be the
Expat license text?

Even if the Expat license allows this (I don't know), then I would
still recommend to keep the license the same, such that fixes can
easily be interchanged between Scheme implementations (e.g. there have
been some fixes to SRFI-64 a while ago).

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Added srfi-214: flexvectors

2022-01-19 Thread Maxime Devos
Vijay Marupudi schreef op wo 19-01-2022 om 08:51 [-0500]:
> > however, the README says ‘by Adam Nelson’.  Did you reach some kind
> > of
> > agreement with Adam Nelson about copyright assignment?  And since
> > SRFIs
> > are licensed under Expat (not 100% sure), wouldn't this need to be
> > the
> > Expat license text?
> > 
> > Even if the Expat license allows this (I don't know), then I would
> > still recommend to keep the license the same, such that fixes can
> > easily be interchanged between Scheme implementations (e.g. there
> > have
> > been some fixes to SRFI-64 a while ago).
> 
> There was no copyright assignment.

If no copyright assignment has happend, then the copyright still
belongs to the author
-- from the Git repository's LICENSE:  Copyright © Adam Nelson (2020)).
While possibly you might have made some small changes to flexvectors,
it seems that most code is preserved, so at most a ‘© FSF’ line could
be added (*), however, the copyright line ‘© Adam Nelson’ would need to
remain, otherwise the copyright lines are misleading.

(*) This assumes you did copyright assignment to the FSF, otherwise
‘© Vijay Marupudi’.

Furthermore, the license requires preserving existing copyright
notices:

> The above copyright notice and [...] (including [...]) shall be
> included in all copies or substantial portions of the Software.

>  The expat license is GPL compatible,
> so I assumed GPL would be the preferred license for a contribution to
> Guile. [...] I can definitely change the license for my edits to
> whatever is

The expat license is GPL compatible, but the expat license requires
preserving the license text:

> Permission is hereby granted [...]:
> 
> The above [...] and this permission notice (including the next
> paragraph) shall be included in all copies or substantial portions of
> the Software.
> 
> [warranty disclaimer]

Here, ‘this permission notice’ seems to be the text of the expat
license.  But I'm not seeing this text in the srfi-214.scm of your
patch.

> best for Guile.

That would be up to the maintainers I suppose.


Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Added srfi-214: flexvectors

2022-01-19 Thread Maxime Devos
Vijay Marupudi schreef op wo 19-01-2022 om 10:44 [-0500]:
> > If no copyright assignment has happend, then the copyright still
> > belongs to the author
> > -- from the Git repository's LICENSE:  Copyright © Adam Nelson
> > (2020)).
> > While possibly you might have made some small changes to
> > flexvectors,
> > it seems that most code is preserved, so at most a ‘© FSF’ line
> > could
> > be added (*), however, the copyright line ‘© Adam Nelson’ would
> > need to
> > remain, otherwise the copyright lines are misleading.
> > 
> > (*) This assumes you did copyright assignment to the FSF, otherwise
> > ‘© Vijay Marupudi’.
> 
> That's fair, thanks for looking into it! I was unaware of where to
> include that information. I have added Adam Nelson and my name (can
> remove this if necessary, just did it to be complete) to the license
> comments and switched the `srfi-214.scm' file to the expat license
> for
> now.
> 
> Note that I kept the GPL license in the srfi-214.test file, given
> that the README in test-suite/README says:
> 
> > Please write more Guile tests, and send them to bug-gu...@gnu.org.
> > We'll merge them into the distribution.  All test suites must be
> > licensed for our use under the GPL, but I don't think I'm going to
> > collect assignment papers for them.

Guile's README cannot override the law, so the expat license text
would need to remain.  I think test-suite/README is primarily
concerned license compatibility and consistency, so I guess
for code from external sources, the ‘let GPL be the license’
requirement can be relaxed somewhat.

For example, see tests/srfi-27.test and tests/srfi-41.test -- they
appear to be Expat.

Something I forgot to mention: documentation!  Would you be up
to documenting flexvectors in Guile (in ‘6.6 Datatypes’ I presume,
after ‘vlists’ maybe, with a cross-reference from
‘7.5 SRFI Support Modules’)?

> I have not assigned my copyright to the FSF, but can do so if
> necessary.

As I understand it, a maintainer will inform you on what you
need to sign, etc -- it's a process initiated by the maintainer,
not the contributor.




signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Added srfi-214: flexvectors

2022-01-20 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 10:34 [-0500]:
> My latest patch now has documentation, mostly derived from the SRFI-
> 214
> documentation. Who would have figured that conversion to texinfo
> would be the
> most time consuming part of this patch?
> 
> I would like advice on how to attribute the documentation to Adam
> Nelson.

Here are two examples in the wild (slib):

> 6.18.11 provide and require
> ---
> 
> Aubrey Jaffer, mostly to support his portable Scheme library SLIB,
> implemented a provide/require mechanism for many Scheme
> implementations.
> Library files in SLIB _provide_ a feature, and when user programs
> _require_ that feature, the library file is loaded in.
> 

(GOOPS):

> 8 GOOPS
> ***
>
> GOOPS is the object oriented extension to Guile.  Its implementation
> is
> derived from STk-3.99.3 by Erick Gallesio and version 1.3 of Gregor
> Kiczales’ ‘Tiny-Clos’.  It is very close in spirit to CLOS, the
> Common
> Lisp Object System, but is adapted for the Scheme language.
> 
> [...]
> 8.1 Copyright Notice
> 
> 
> The material in this chapter is partly derived from the STk Reference
> Manual written by Erick Gallesio, whose copyright notice is as
> follows.
> 
>Copyright © 1993-1999 Erick Gallesio - I3S-CNRS/ESSI 
> Permission to use, copy, modify, distribute,and license this software
> and its documentation for any purpose is hereby granted, provided
> that
> existing copyright notices are retained in all copies and that this
> notice is included verbatim in any distributions.  No written
> agreement,
> license, or royalty fee is required for any of the authorized uses.
> This software is provided “AS IS” without express or implied
> warranty.
> 
>The material has been adapted for use in Guile, with the author’s
> permission.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Added srfi-214: flexvectors

2022-01-20 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 12:57 [-0500]:
> > Here are two examples in the wild (slib):
> 
> Thanks, the patch, which is attached, now attributes credit
> appropriately.
> 
> Thank you very much for your help Maxime. I believe there is nothing
> else pending and that the patch is ready?

I haven't really looked closely at the documentation or code,
but the structure of the patch seems fine now, except perhaps:

> "Software"), to deal in the Software without restriction, including

Unicode has been a thing now since quite a while, so writing “Software”
with curly quotes instead of "straight quotes" is possible now.  Or
perhaps Texinfo takes care of that by itself.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-01-21 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 22:23 [-0500]:
> --- a/libguile/bytevectors.c
> +++ b/libguile/bytevectors.c
> [...]

Boundary conditions can be tricky, I would recommend writing some
tests.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-01-21 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 22:23 [-0500]:
> +  c_start = scm_to_size_t (start);
> +  if (SCM_UNLIKELY (c_start >= c_len))
> +    {
> +  scm_out_of_range (FUNC_NAME, start);
> +    }
> +
> +  if (!scm_is_eq (end, SCM_UNDEFINED))
> + {
> +   c_end = scm_to_size_t (end);
> +   if (SCM_UNLIKELY (c_end > c_len))
> +     scm_out_of_range (FUNC_NAME, end);

IIUC, this will cause an out-of-range error for the following:

(utf8->string "" 0 0)

However, the following works:

(substring "" 0 0) ; -> empty string

There seems to be an inconsistency here.  Can (c_start >= c_len) be
relaxed to c_start > c_len?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-01-21 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 22:23 [-0500]:
> +@deffn {Scheme Procedure} utf8->string utf [start [end]]
>  @deffnx {Scheme Procedure} utf16->string utf [endianness]
>  @deffnx {Scheme Procedure} utf32->string utf [endianness]
>  @deffnx {C Function} scm_utf8_to_string (utf)
> +@deffnx {C Function} scm_utf8_to_string_range (utf, start, end)

It would be nice to document if it's an open, closed or half-
open/closed range.  E.g. see the documentation of 'substring':

 -- Scheme Procedure: substring str start [end]
 -- C Function: scm_substring (str, start, end)
 Return a new string formed from the characters of STR beginning
 with index START (inclusive) and ending with index END
(exclusive).
 STR must be a string, START and END must be exact integers
 satisfying:

 0 <= START <= END <= ‘(string-length STR)’.

 The returned string shares storage with STR initially, but it is
 copied as soon as one of the two strings is modified.

It seems a bit weird to support [start] and [end] for utf8->string but
not for utf16->string and utf32->string.

Greetings,
Maxime. 


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-01-21 Thread Maxime Devos
Vijay Marupudi schreef op do 20-01-2022 om 22:23 [-0500]:
> +  c_start = scm_to_size_t (start);

This seems suboptimal because if start > SIZE_MAX,
then this will throw an 'out-of-range' exception without attributing
it to 'utf8->string' (untested).

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-01-21 Thread Maxime Devos
Vijay Marupudi schreef op vr 21-01-2022 om 15:20 [-0500]:
+  (pass-if-exception "utf8->string range: end < start"
+  exception:out-of-range
+  (let* ((utf8 (string->utf8 "gnu guile")))
+    (utf8->string utf8 1 0)))
+  [other tests]

It would be nice to check multibyte characters as well,
to verify that byte indices and not character indices are used.

E.g., (utf8->string #vu8(195 169) 0 2) should return "é".

Another nice test: (utf8->string #vu8(195 169) 0 1) should raise
a 'decoding-error', even though #vu8(195 169) is valid UTF-8.

And (utf8->string #vu8(0 32 196) 0 2) should return "\x00 " even
though #vu8(0 32 195) is invalid UTF-8 -- and as a bonus, it checks
that the nul character is supported -- which can be easily forgotten
because Guile is implemented in C which usually terminates strings
by zero instead of using a length field.

Overall, the patch you sent seems a reasonable approach to me, though
I didn't verify the details.  I find myself at times copying a part
of a bytevector to a new bytevector because some procedure doesn't
allow specifying byte ranges ...

Greetings,
Maxime


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-04 Thread Maxime Devos
Stefan Israelsson Tampe schreef op vr 04-02-2022 om 21:11 [+0100]:
> using an implicit let in conditionals are bad in that you cannot
> escape from the let form which means that you loos
> conditional defines for example in the toplevel. e.g. [...]

While old versions of Guile (Guile 1.8?) did support conditional
defines on the top-level, new versions of Guile (Guile 2.0 and later)
don't:

(if #true
(define x 'foo)
(define x 'bar))

While compiling expression:
Syntax error:
unknown file:2:4: definition in expression context, where definitions
are not allowed, in form (define x (quote foo))

The following still works though of course:

(define x (if #true 'foo 'bar))

So for the current version of Guile (3.0.X), there don't appear to be
backwards-compatibility problems in this area.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-04 Thread Maxime Devos
Stefan Israelsson Tampe schreef op vr 04-02-2022 om 22:40 [+0100]:
> Anyhow conditional defining vars is a common theme in other languages
> so I think it was kind of natural to implement if as it was done.

AFAIK no Lisp or Scheme except for Guile < 2.0 implements conditionally
defining local variables (but then I usually only consider Guile Scheme
and the RnRS, so this doesn't mean much).  In my experience, I have
never seen a need for conditionally defining a local variable in Scheme
code (if you have a real-world example, please share).

It also seems impossible to implement this w.r.t. the macro system ---
what should, say, bound-identifier=? do when one of its identifiers is
only conditionally bound?  Or for another example:

If I do

(define foo 'bar)
(define-syntax foobar
  (syntax-rules (foo)
((_ foo)
 (begin (pk "it's a foo!") foo))
((_ goo)
 (begin (pk "it's not a foo ...") goo
   
(define (zebra stripes)
  (if stripes
  (define foo 'quux))
  (foobar foo)) ;; <--- ***

then sometimes the 'foo' in '***' refers to the global variable 'foo'
and hence 'foobar' expands to the "it's a foo'.'  Sometimes the 'foo'
in '***' refers to the local variable 'foo' (!= the global foo) hence
'foobar' expands to the "it's not a foo ...".

However, it's impossible for a macro to expand to multiple things at
once!

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-05 Thread Maxime Devos
Hi,

> > (define foo 'bar) ;; <--- ^^^
> > (define-syntax foobar
> >   (syntax-rules (foo)
> > ((_ foo)
> >  (begin (pk "it's a foo!") foo))
> > ((_ goo)
> >  (begin (pk "it's not a foo ...") goo
> > 
> > (define (zebra stripes)
> >   (if stripes
> >   (define foo 'quux)) ;;  <--- ###
> >   (foobar foo)) ;; <--- ***

Stefan Israelsson Tampe schreef op za 05-02-2022 om 02:14 [+0100]:
> For conditional variables you gave a default value.

I don't understand the question, I didn't give a default value?

The variable 'foo' (^^^) is a different variable from 'foo' (###)
since 'foo' (^^^) is a module variable, and 'foo' (###) is a local
variable in 'zebra'.  Merely having the same name does not imply
being the same variable, c.f. shadowing, so '^^^' does _not_ give
a default value to the 'foo' in '###'.

(If '###' was 'set!' instead of 'define', then the two variables would
have been the same.)

> So then why on earth do you not have an implicit let ?
> There must be a good reason.

I don't understand the question, there's an implicit 'let' here:
the definition of 'zebra'.  Also, I don't see what the question ‘why do
you not have an implicit let?’ has to do with ‘For conditional
variables you gave a default value.’.

Also, AFAICT these questions don't seem to have anything to do
with the macro system problems I noted?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-05 Thread Maxime Devos
Stefan Israelsson Tampe schreef op za 05-02-2022 om 18:31 [+0100]:
> Hmm this was wrong, I mean
> 
> For conditional variables we have a default begin. So then why on
> earth do you not have an implicit let?, Just laziness?

Do you mean Guile in general, or the particular example I gave?
Also, I don't know what you mean with ‘for conditional variables we
have a default begin’ -- what's a ‘default begin’ here, and also Guile
doesn't (currently) have conditional variables.

> There should  be a good reason or? this is a pretty fundamental
> change that I support but then we should not be lazy not trying to
> understand the design choices of the old beards.

I think the thread of the following message

is relevant, though I've only just started reading it.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-06 Thread Maxime Devos
to...@tuxteam.de schreef op zo 06-02-2022 om 10:27 [+0100]:
> ...but doesn't "see" whether bindings are actually used (quite
> possibly
> those go away in a later optimisation phase, though):
> 
> | scheme@(guile-user)> ,expand (let ((x 3)) (message #t "Yikes"))
> | $3 = (let ((x 3)) (message #t "Yikes"))

They do go away during optimisation:

scheme@(guile-user)> ,optimize (let ((x 3)) (message #t "Yikes"))
$1 = (message #t "Yikes")



signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-06 Thread Maxime Devos
Stefan Israelsson Tampe schreef op zo 06-02-2022 om 21:13 [+0100]:
> Hmm just why conditionals use begin and not let,

I'd assume the reason is that this is how it has been done in the past
and because of performance reasons (which don't seem to apply
anymore?), so I guess that we could now switch to the more general
'let'?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-06 Thread Maxime Devos
Stefan Israelsson Tampe schreef op zo 06-02-2022 om 22:10 [+0100]:
> I think you are right on this, I looked at the scheme spec and I find
> no trace for using a let or not or not in the spec.
> So it is an implementation detail. Now, this is important, if I want
> to write portable code if cond case allows definitions
> without an explicit let, it is not portable anymore!! So this is the
> only cost I see with your idea. This issue can probably 
> be mitigated but it means that we must maintain two versions of the
> conditional constructs.

Any old portable code (in particular, not assuming the proposed Guile
behaviour) still has the same semantics; old portable code remains
portable code.

As such, we don't have to have two versions of the conditional
constructs in Guile, there is no backwards incompatibility.

However, there would admittedly be a slightly higher risk of writing
unportable code _by accident_.

FWIW, Guile already exports unportable syntax in (rnrs base):
R6RS doesn't mention named let anywhere, yet Guile exports it as 'let'
in (rnrs base) anyway.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Fwd: [Patch] definitions in when, unless, do as well as in cond- and case-clauses

2022-02-06 Thread Maxime Devos
Maxime Devos schreef op zo 06-02-2022 om 22:26 [+0100]:
> FWIW, Guile already exports unportable syntax in (rnrs base):
> R6RS doesn't mention named let anywhere, yet Guile exports it as
> 'let'
> in (rnrs base) anyway.

Nevermind, R6RS has named let:
<http://www.r6rs.org/final/html/r6rs/r6rs-Z-H-2.html#node_toc_node_sec_11.16>




Re: GNU Guile 3.0.8 released

2022-02-11 Thread Maxime Devos
Andy Wingo schreef op vr 11-02-2022 om 08:47 [+0100]:
> We are delighted to announce GNU Guile release 3.0.8, the latest in the [...]
> The Guile 3.0.8 release mixes maintenance and optimizations [...]

Is there any reason the fix
 was not
applied?

In the future, could it be announced in advance that a new version will
be released? Then people could test the new proposed version and remind
maintainers of forgotten fixes before the version has been finalised.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: hastbables in scheme, are they slow? using goops is this madness

2022-02-21 Thread Maxime Devos
Stefan Israelsson Tampe schreef op di 22-02-2022 om 00:05 [+0100]:
> 2. For very large hash tables C based solutions are about 1.5-2.0
> faster. 
> (for-each (lambda (i) (hashq-set! h i i)) (iota 2000))

For what sizes is Scheme faster, and for what sizes is Scheme faster?
Where is the cut-off point?

Also, seems quite nice.  While I haven't had noticed performance
problems yet with C hashtables, the Scheme implementation would
eliminate the problem of 'hash-for-each' forming a continuation
barrier.

> LICENSE
> LGPL v2 or v3

Guile is LGPL2+, so to be eventually integrated into Guile, shouldn't
it to LGPL2+ (there might eventually be a LGPLv4)?

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Guile optimizations slowing down the program?

2022-03-08 Thread Maxime Devos
Jean Abou Samra schreef op wo 09-03-2022 om 00:31 [+0100]:
> In summary, the less Guile optimizes, the faster LilyPond runs. Is that
> something expected?

I don't think so, but I don't have a clue how this happens ...

Greetings,
Maxime


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-03-09 Thread Maxime Devos
Vijay Marupudi schreef op vr 21-01-2022 om 20:21 [-0500]:
> +SCM_DEFINE (scm_utf16_range_to_string, "utf16->string",
> +    1, 3, 0,
> +    (SCM utf, SCM endianness, SCM start, SCM end),
> +    "Return a newly allocate string that contains from the
> UTF-8-"
> +    "encoded contents of bytevector @var{utf}.")

Did you mean UTF-16?


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-03-09 Thread Maxime Devos
Vijay Marupudi schreef op vr 21-01-2022 om 20:21 [-0500]:
> +SCM_DEFINE (scm_utf8_range_to_string, "utf8->string",
> +    1, 2, 0,
> +    (SCM utf, SCM start, SCM end),
> +    "Return a newly allocate string that contains from the
> UTF-8-"
> +    "encoded contents of bytevector @var{utf}.")





Re: [PATCH] Enable utf8->string to take a range

2022-03-09 Thread Maxime Devos
Vijay Marupudi schreef op vr 21-01-2022 om 20:21 [-0500]:
> +SCM_DEFINE (scm_utf8_range_to_string, "utf8->string",
> +    1, 2, 0,
> +    (SCM utf, SCM start, SCM end),
> +    "Return a newly allocate string that contains from the
> UTF-8-"
> +    "encoded contents of bytevector @var{utf}.")

This is incorrect, since the nul character is encoded even though UTF-
proper does not allow encoding the nul character -- UTF-8 with an
encoding of the nul character is sometimes called ‘modified UTF-8’.

The distinction is sometimes relevant, e.g. the GNS specifications asks
for labels to be encoded in UTF-8, and according to the spec writers,
that implied that nul characters are forbidden.

As such, I cannot rely on 'utf8->string' to verify that there aren't
any nul characters.

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-03-09 Thread Maxime Devos
Maxime Devos schreef op wo 09-03-2022 om 14:24 [+0100]:
> This is incorrect, since the nul character is encoded even though
> UTF-
> proper does not allow encoding the nul character -- UTF-8 with an
> encoding of the nul character is sometimes called ‘modified UTF-8’.

That's not quite correct, seems like Guile uses another encoding, but
still.


signature.asc
Description: This is a digitally signed message part


Re: [PATCH] Enable utf8->string to take a range

2022-03-09 Thread Maxime Devos
Maxime Devos schreef op wo 09-03-2022 om 14:27 [+0100]:
> That's not quite correct, seems like Guile uses another encoding, but
> still.

Nevermind, seems like a misinterpreded a comment and #vu8(97 0 98) is
valid UTF-8 after all, it's just not possible to encode it as a zero-
terminated string.


signature.asc
Description: This is a digitally signed message part


Re: Are source locations broken?

2022-03-25 Thread Maxime Devos
Jean Abou Samra schreef op vr 25-03-2022 om 21:11 [+0100]:
> Please have a look at:
> 
> $ ./libguile/guile test.scm
> ;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
> ;;;   or pass the --no-auto-compile argument to disable.
> ;;; compiling /home/jean/Bureau/ENS-1A/dm_anac/test.scm
> ;;; : warning: possibly unbound variable 
> `unbound-variable'
> ;;; compiled 
> /home/jean/.cache/guile/ccache/3.0-LE-8-4.6/home/jean/Bureau/ENS-1A/dm_anac/test.scm.go
>  
> 
> Backtrace:
> [snipped]
> 
> 
> Note the . In LilyPond, I suddenly lost
> all locations for compilation warnings when upgrading from
> Guile 3.0.5 to 3.0.8. The above is with the main branch.

Here's a minimal reproducer:

$ cat trtr.scm:
> foo

$ guild compile trtr.scm
> : warning: possibly unbound variable `foo'
> wrote `$HOME/.cache/guile/ccache/3.0-LE-8-4.6/$HOME/trtr.scm.go'

Greetings,
Maxime.


signature.asc
Description: This is a digitally signed message part


Re: Are source locations broken?

2022-03-25 Thread Maxime Devos
Maxime Devos schreef op vr 25-03-2022 om 21:22 [+0100]:
Here's a minimal reproducer:

$ cat trtr.scm:
> foo

$ guild compile trtr.scm
> : warning: possibly unbound variable `foo'
> wrote `$HOME/.cache/guile/ccache/3.0-LE-8-4.6/$HOME/trtr.scm.go'

Curiously, it seems that source locations were actually recorded:

(define-syntax pk-the-source-location
  (lambda (s)
(pk 'invocation (syntax-source s))
(syntax-case s ()
  ((_ stuff)
   (pk 'use (syntax-source #'stuff))
   #'stuff

(lambda () (pk-the-source-location foo))

;;; [...]
;;; (invocation ((filename . "$HOME/trtr.scm") (line . 8) (column . 11)))

;;; (use ((filename . "$HOME/trtr.scm") (line . 8) (column . 35)))
;;; : warning: possibly unbound variable `foo'
;;; compiled [...]



signature.asc
Description: This is a digitally signed message part


  1   2   3   4   >