bug#71980: close 71980

[Matt Wette]

close 71980

bug#71980: close

[Matt Wette]

close

bug#71980: tmpnam

[Matt Wette]

See also bug #71796, which has smaller delta.

bug#71980: [3.0.10] posix.test uses depcrecated tmpnam

[Matt Wette]

With `--disable-tmpnam'  argument to configure, posix.test fails: 
missing `tmpnam`.


patch attached

--- test-suite/tests/posix.test-orig    2024-07-03 15:45:16.352132881 -0700
+++ test-suite/tests/posix.test    2024-07-07 09:21:53.342855356 -0700
@@ -361,20 +361,21 @@
   (status:exit-val (system* "something-that-does-not-exist"

   (pass-if-equal "https://bugs.gnu.org/52835;
-  "bong\n"
-    (let ((file (tmpnam)))
+    "bong\n"
+    (let ((port (mkstemp "T-XX")))
   ;; Redirect stdout and stderr to FILE.
   (define status
-    (call-with-output-file file
-  (lambda (port)
-    (with-output-to-port port
+    (with-output-to-port port
+  (lambda ()
+    (with-error-to-port port
   (lambda ()
-    (with-error-to-port port
-  (lambda ()
-    (system* "sh" "-c" "echo bong >&2"
+    (system* "sh" "-c" "echo bong >&2"))

   (and (zero? (status:exit-val status))
-   (call-with-input-file file get-string-all
+   (zero? (seek port 0 SEEK_SET))
+   (let ((contents (get-string-all port)))
+ (close-port port)
+ contents

   (pass-if-equal "https://bugs.gnu.org/63024;
   0
--- test-suite/tests/posix.test-orig2024-07-03 15:45:16.352132881 -0700
+++ test-suite/tests/posix.test 2024-07-07 09:21:53.342855356 -0700
@@ -361,20 +361,21 @@
   (status:exit-val (system* "something-that-does-not-exist"
 
   (pass-if-equal "https://bugs.gnu.org/52835;
-  "bong\n"
-(let ((file (tmpnam)))
+"bong\n"
+(let ((port (mkstemp "T-XX")))
   ;; Redirect stdout and stderr to FILE.
   (define status
-(call-with-output-file file
-  (lambda (port)
-(with-output-to-port port
+(with-output-to-port port
+  (lambda ()
+(with-error-to-port port
   (lambda ()
-(with-error-to-port port
-  (lambda ()
-(system* "sh" "-c" "echo bong >&2"
+(system* "sh" "-c" "echo bong >&2"))
 
   (and (zero? (status:exit-val status))
-   (call-with-input-file file get-string-all
+   (zero? (seek port 0 SEEK_SET))
+   (let ((contents (get-string-all port)))
+ (close-port port)
+ contents
 
   (pass-if-equal "https://bugs.gnu.org/63024;
   0

bug#71765: 3.0.10: make check fails when configure --disable-tmpnam

[Matt Wette]

In 3.0.10, if I use the --disable-tmpnam argument to configure, then 
`make check' fails


Running ports.test
Running posix.test
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
ERROR: posix.test: system*: https://bugs.gnu.org/52835 - arguments: 
((unbound-variable #f "Unbound variable: ~S" (tmpnam) #f))

make[5]: *** [Makefile:2622: tests/posix.log] Error 1

ubuntu 23.10, x86_64

bug#71742: [3.0.10] make check fails when configure --disable-tmpnam

[Matt Wette]

In 3.0.10, if I use the --disable-tmpnam argument to configure, then 
`make check' fails


Running ports.test
Running posix.test
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
ERROR: posix.test: system*: https://bugs.gnu.org/52835 - arguments: 
((unbound-variable #f "Unbound variable: ~S" (tmpnam) #f))

make[5]: *** [Makefile:2622: tests/posix.log] Error 1

ubuntu 23.10, x86_64

bug#69857: ports.c, "scm-set-current-output-port" vs "set-current-output-port"

[Matt Wette]

In guile-3.0.9, in ports.c I believe scheme name for setting the error 
output is
inappropriately named "scm-set-current-output-port".   It does not show 
in guile
because set-current-output-port is defined using the parameter 
current-output-port.


SCM
scm_set_current_input_port (SCM port)
#define FUNC_NAME "set-current-input-port"
{
  ...
}
#undef FUNC_NAME

SCM
scm_set_current_output_port (SCM port)
#define FUNC_NAME "scm-set-current-output-port"
{
  ...
}
#undef FUNC_NAME

bug#68703: update to lightning.texi to work w/ texi2any --pdf (with patch)

[Matt Wette]

The following changes to libguile/lightening/lightning.texi will allow 
it to be used with texi2any --pdf:


--- lightning.texi    2022-06-20 07:44:21.159880656 -0700
+++ lightning.texi-fixed    2024-01-24 12:07:27.621547717 -0800
@@ -83,22 +83,12 @@
 @ifnottex
 @node Top
 @top @lightning{}
-
-@iftex
-@macro comma
-@verbatim{|,|}
-@end macro
-@end iftex
-
-@ifnottex
-@macro comma
-@verb{|,|}
-@end macro
 @end ifnottex

 This document describes @value{TOPIC} the @lightning{} library for
 dynamic code generation.

+@ifnottex
 @menu
 * Overview::    What GNU lightning is
 * Installation::    Configuring and installing GNU lightning
--- lightning.texi	2022-06-20 07:44:21.159880656 -0700
+++ lightning.texi-fixed	2024-01-24 12:07:27.621547717 -0800
@@ -83,22 +83,12 @@
 @ifnottex
 @node Top
 @top @lightning{}
-
-@iftex
-@macro comma
-@verbatim{|,|}
-@end macro
-@end iftex
-
-@ifnottex
-@macro comma
-@verb{|,|}
-@end macro
 @end ifnottex
 
 This document describes @value{TOPIC} the @lightning{} library for
 dynamic code generation.
 
+@ifnottex
 @menu
 * Overview::What GNU lightning is
 * Installation::Configuring and installing GNU lightning

bug#62125: ref manual errors in assembler insn descriptions

[Matt Wette]

Hi All,

I'm pretty sure the instruction desciprtions shown below in the manual
are in error.   Please let me know if my corrections are correct.

Matt

--- vm.texi-orig    2023-03-11 08:40:59.000388237 -0800
+++ vm.texi    2023-03-11 08:48:57.940061512 -0800
@@ -1468,8 +1468,8 @@
 @var{obj}, and store it to @var{dst}.
 @end deftypefn

-@deftypefn Instruction {} scm-set! s8:@var{dst} s8:@var{idx} s8:@var{obj}
-@deftypefnx Instruction {} scm-set!/immediate s8:@var{dst} c8:@var{idx} 
s8:@var{obj}

+@deftypefn Instruction {} scm-set! s8:@var{obj} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} scm-set!/immediate s8:@var{obj} c8:@var{idx} 
s8:@var{val}

 Store the @code{scm} local @var{val} into object @var{obj} at word
 offset @var{idx}.
 @end deftypefn
@@ -1490,8 +1490,8 @@
 the @code{u64} local @var{dst}.
 @end deftypefn

-@deftypefn Instruction {} word-set! s8:@var{dst} s8:@var{idx} s8:@var{obj}
-@deftypefnx Instruction {} word-set!/immediate s8:@var{dst} 
c8:@var{idx} s8:@var{obj}

+@deftypefn Instruction {} word-set! s8:@var{obj} s8:@var{idx} s8:@var{val}
+@deftypefnx Instruction {} word-set!/immediate s8:@var{obj} 
c8:@var{idx} s8:@var{val}

 Store the @code{u64} local @var{val} into object @var{obj} at word
 offset @var{idx}.
 @end deftypefn
@@ -1501,7 +1501,7 @@
 to the unboxed pointer local @var{dst}.
 @end deftypefn

-@deftypefn Instruction {} pointer-set!/immediate s8:@var{dst} 
c8:@var{idx} s8:@var{obj}
+@deftypefn Instruction {} pointer-set!/immediate s8:@var{obj} 
c8:@var{idx} s8:@var{val}

 Store the unboxed pointer local @var{val} into object @var{obj} at word
 offset @var{idx}.
 @end deftypefn

bug#27782: mman patch for v3.0.9

[Matt Wette]

I think this is still not there.
I have found additional issues with some suggested updates.

Maybe we should have a branch in the guile repo for this.

bug#61788: [3.0.9] --disable-tmpnam build fails "make check"

[Matt Wette]

I built gule-3.0.9 with "configure --disable-tmpnam" and get the
following failure from posix.test while running "make check":

Running ports.test
warning: call to primitive-fork while multiple threads are running;
 further behavior unspecified.  See "Processes" in the
 manual, for more information.
Running posix.test
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
In execvp of something-that-does-not-exist: No such file or directory
ERROR: posix.test: system*: https://bugs.gnu.org/52835 - arguments:
 ((unbound-variable #f "Unbound variable: ~S" (tmpnam) #f))
Running print.test

I'm guessing this should use mkstemp instead, but I could not get
it to work.

bug#27782: mman patch for v3.0.9

[Matt Wette]

Note.  I have made more changes based on feedback from the mailing list.

1) removed use of scm_c_take_typed_bytevector
2) changed code to generate PAGE_SIZE

I think the mmap finalizer still needs review from the Guile experts.

I'm attaching a patch to the v3.0.9 release (commit 9b20ca).
Sorry about not using format-patch, but diff.

Matt
diff --git a/configure.ac b/configure.ac
index d5ce1c4ac..c3c33e8b3 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1018,6 +1018,8 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+AC_CHECK_FUNCS([msync])
+
 
 #
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..16f3bbc49 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..1f4c5c793 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,13 +67,21 @@
 # include 
 #endif
 
+#ifdef HAVE_SYS_MMAN_H
+# include 
+#endif
+
 #include "async.h"
+#include "atomics-internal.h"   /* mmap */
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h" /* mmap */
+#include "foreign.h"/* mmap */
 #include "fports.h"
 #include "gsubr.h"
+#include "ioext.h"  /* mmap */
 #include "iselect.h"
 #include "list.h"
 #include "load.h"	/* for scm_i_mirror_backslashes */
@@ -2263,6 +2271,311 @@ scm_dir_free (SCM p)
 
 
 
+#ifdef HAVE_SYS_MMAN_H
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+scm_misc_error ("mmap", "expecting bytevector", SCM_EOL);
+
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+  SCM_SYSCALL (rv = munmap(c_addr, c_len));
+  if (rv != 0)
+scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+/* Code for scm_dynwind_acquire_port and release_port sourced from ports.c. */
+
+static void
+release_port (SCM port)
+{
+  scm_t_port *pt = SCM_PORT (port);
+  uint32_t cur = 1, next = 0;
+  while (!scm_atomic_compare_and_swap_uint32 (>refcount, , next))
+{
+  if (cur == 0)
+return;
+  next = cur - 1;
+}
+ if (cur > 1)
+return;
+
+  if (SCM_PORT_TYPE (port)->close)
+SCM_PORT_TYPE (port)->close (port);
+
+  /* Skip encoding code from ports.c! */
+}
+
+static void
+scm_dynwind_acquire_port (SCM port)
+{
+  scm_t_port *pt = SCM_PORT (port);
+  uint32_t cur = 1, next = 2;
+  while (!scm_atomic_compare_and_swap_uint32 (>refcount, , next))
+{
+  if (cur == 0)
+scm_wrong_type_arg_msg (NULL, 0, port, "open port");
+  next = cur + 1;
+}
+  scm_dynwind_unwind_handler_with_scm (release_port, port,
+   SCM_F_WIND_EXPLICITLY);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
+(SCM addr, SCM len, SCM 

bug#27782: patch for mmap and friends

[Matt Wette]

On 1/14/23 2:42 PM, Maxime Devos wrote:

    {
  /* Use the fd of the port under clobber protection from
 concurrency. As scm_dynwind_acquire_port assumes that
 FILE is a port, check that first. */
  SCM_VALIDATE_PORT (SCM_ARG5, file);
  scm_dynwind_acquire_port (file);
  c_fd = scm_fileno (file);
    }


Thanks.  I'll try this, modulo update to  scm_to_int (scm_fileno (file)).

Matt

bug#27782: patch for mmap and friends

[Matt Wette]

On 1/13/23 4:49 PM, Matt Wette wrote:

Please consider this patch for adding mmap(), munmap() and msync()
 to libguile/filesys.c.  Included is update for posix.texi and test 
file mman.test.

Once included, feature 'mman should be #t.

Matt

Please add the attached file: test-suite/tests/mman.test.

I thought it was included in the patch.  It's the thought that counts, 
right?


Matt


 mman.test --- Tests for mmap API.-*- scheme -*-

 Copyright 2022 Free Software Foundation, Inc.

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Lesser General Public
 License as published by the Free Software Foundation; either
 version 3 of the License, or (at your option) any later version.

 This library is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 Lesser General Public License for more details.

 You should have received a copy of the GNU Lesser General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 
USA

(define-module (test-mman)
  #:use-module (test-suite lib)
  #:use-module (test-suite guile-test)
  #:use-module (rnrs bytevectors)
  #:declarative? #f
  )

(define (mmap-test-file)
  (data-file-name "foo.txt"))

(define mmap-test-string "hello, world")

(define (gen-mmap-test-file)
  (with-output-to-file (mmap-test-file)
(lambda () (display mmap-test-string

(when (provided? 'mman)

  (gen-mmap-test-file)

  (with-test-prefix "mman"

(pass-if "mman 1"
  (let ((bv (mmap 0 #x100)))
(bytevector-u8-set! bv 0 34)
(= (bytevector-u8-ref bv 0) 34)))

))

;; --- last line ---

bug#27782: patch for mmap and friends

[Matt Wette]

Please consider this patch for adding mmap(), munmap() and msync()
 to libguile/filesys.c.  Included is update for posix.texi and test 
file mman.test.

Once included, feature 'mman should be #t.

Matt
From 6c944174d35d43f87340c8199d47f3f088fa6ca7 Mon Sep 17 00:00:00 2001
From: Matt Wette 
Date: Fri, 13 Jan 2023 16:42:06 -0800
Subject: [PATCH] Add mmap and friends (munmap, msync).

* libguile/filesys.[ch]: added scm_mmap_search, scm_mmap, scm_msync, and
  init_mman, built on availability of HAVE_MMAN_H; also provides feature
  'mman
* doc/ref/posix.texi: added documentation for mmap and friends
* test-suite/Makefile.am: updated for mman.test
* test-suite/tests/mman.test: mmap tests
---
 configure.ac   |   2 +
 doc/ref/posix.texi |  45 +++
 libguile/filesys.c | 264 +
 libguile/filesys.h |   4 +
 test-suite/Makefile.am |   1 +
 5 files changed, 316 insertions(+)

diff --git a/configure.ac b/configure.ac
index f8c12f0d7..c348d14a2 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1018,6 +1018,8 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+AC_CHECK_FUNCS([msync])
+
 
 #
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index 5653d3758..16f3bbc49 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..0ddb4cfee 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,11 +67,17 @@
 # include 
 #endif
 
+#ifdef HAVE_SYS_MMAN_H
+# include 
+#endif
+
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"
+#include "foreign.h"
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -2263,6 +2269,261 @@ scm_dir_free (SCM p)
 
 
 
+#ifdef HAVE_SYS_MMAN_H
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+scm_misc_error ("mmap", "expecting bytevector", SCM_EOL);
+
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+  SCM_SYSCALL (rv = munmap(c_addr, c_len));
+  if (rv != 0)
+scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
+(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	"Create a memory mapping, returning a bytevector..  @var{addr},\n"
+	"if non-zero, is the staring address; or, if zero, is assigned by\n"
+	"the system.  @var{prot}, if provided, assigns protection.\n"
+	"@var{fd}, if provided associates the memory region with a file\n"
+	"starting at @var{offset}, if prov

bug#27782: patch to add support for mmap and friends

[Matt Wette]

Please disregard previous patch.  I have more to do.
I'll try to catch the next release cycle.

bug#27782: patch to add support for mmap and friends

[Matt Wette]

Guile Maintainers:

Please consider the atttached patch for mmap and friends.
Includes mmap, mmap/shared, munmap, msync.

Matt
From 306570beb3d1895abd03700593cc342282e4ccd1 Mon Sep 17 00:00:00 2001
From: Matt Wette 
Date: Tue, 20 Dec 2022 17:15:27 -0800
Subject: [PATCH] Add support for mmap, munmap and msync

* libguile/filesys.c(mmap,munmap,msync): added implementation for mmap
  and friends
* doc/ref/posix.texi: add documentation for mmap and friends
---
 configure.ac   |  12 ++
 doc/ref/posix.texi |  45 ++
 libguile/filesys.c | 268 +
 libguile/filesys.h |   4 +
 test-suite/Makefile.am |   1 +
 test-suite/tests/mmap-api.test |  47 ++
 6 files changed, 377 insertions(+)
 create mode 100644 test-suite/tests/mmap-api.test

diff --git a/configure.ac b/configure.ac
index b3879df1f..da49d477a 100644
--- a/configure.ac
+++ b/configure.ac
@@ -199,6 +199,10 @@ AC_ARG_ENABLE(regex,
   [  --disable-regex omit regular expression interfaces],,
   enable_regex=yes)
 
+AC_ARG_ENABLE(mmap_api,
+  AS_HELP_STRING([--disable-mmap_api],[omit mmap API]),,
+  enable_mmap_api=yes)
+
 AC_ARG_ENABLE(tmpnam,
   AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
   enable_tmpnam=yes)
@@ -950,6 +954,10 @@ if test "$enable_regex" = yes; then
AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
 fi
 
+if test "$enable_mmap_api" = yes; then
+   AC_DEFINE([ENABLE_MMAP_API], 1, [Define when mmap API support is enabled.])
+fi
+
 if test "$enable_tmpnam" = yes; then
AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
 fi
@@ -1018,6 +1026,10 @@ AC_CHECK_MEMBERS([struct tm.tm_gmtoff],,,
 ])
 GUILE_STRUCT_UTIMBUF
 
+if test "$enable_mmap_api" = "yes"; then
+  AC_CHECK_FUNCS([msync])
+fi
+
 
 #
 #
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index bde0f150c..8114135fe 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -1216,6 +1216,51 @@ valid separators.  Thus, programs should not assume that
 separator---e.g., when extracting the components of a file name.
 @end defvr
 
+@deffn {Scheme Procedure} mmap addr len [prot [flags [fd [offset
+@deffnx {Scheme Procedure} mmap/search addr len [prot [flags [fd [offset
+Create a memory mapping, returning a bytevector.  @var{addr}, if
+non-zero, is the staring address; or, if zero, is assigned by the
+system.  @var{prot}, if provided, assigns protection.  @var{fd},
+if provided associates the memory region with a file, starting 
+at @var{offset}, if provided.
+The region returned by mmap will NOT be searched by the garbage
+ collector for pointers, while that returned by mmap/search will.
+Note that the finalizer for the returned bytevector will call munmap.
+Defaults for optional arguments are
+@table @asis
+@item prot
+(logior PROT_READ PROT_WRITE)
+@item flags
+(logior MAP_ANONYMOUS MAP_PRIVATE)
+@item fd
+-1
+@item offset
+0
+@end table
+@end deffn
+
+@deffn {Scheme Procedure} munmap bvec
+Given bytevector generated by mmap or mmap/search, unmap the
+the associated memory.  The argument will be modified to 
+reflect a zero length bv.  The return value is unspecified.
+Note that munmap is called by finalizer associated with
+bytevectors returned from mmap and mmap/search.
+@end deffn
+
+@deffn {Scheme Procedure} msync addr length flag
+Flush changes made to the in-core copy of a file mapped using
+mmap or mmap/search.  This should be executed on modified memory
+before calling munmap.  The @var{flags} argument must be exactly one
+of the following:
+@table @code
+@item MS_ASYNC
+Initiate update, return immediately.
+@item MS_SYNC
+Initiate update, block until complete.
+@item MS_INVALIDATE
+Invalidate other mappings of the same file.
+@end table
+@end deffn
 
 @node User Information
 @subsection User Information
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1f0bba556..ad3dab471 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -67,11 +67,17 @@
 # include 
 #endif
 
+#if defined(ENABLE_MMAP_API) && defined(HAVE_SYS_MMAN_H)
+# include 
+#endif
+
 #include "async.h"
 #include "boolean.h"
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h"
+#include "foreign.h"
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -2263,6 +2269,264 @@ scm_dir_free (SCM p)
 
 
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+/* see https://pubs.opengroup.org/onlinepubs/9699919799/functions/mmap.html */
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int rv;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+   

bug#32040: bug in repl/server.scm

[Matt Wette]

I can confirm this still exists in guile 3.0.8:
The symptom that I see is when client (telnet localhost 37146)
quits server responds with the following:

   In thread:
  Wrong type to apply: ()

 Nice find Isaac!

bug#54478: unwanted source references

[Matt Wette]

I think the error is in use of "src" arg to make-seq in the following loop,
in ice-9/psyntax.scm, starting at line 1633:

(let lp ((var-ids var-ids) (vars vars) (vals vals)
 (tail (expand-tail-expr)))
  (cond
   ((null? var-ids) tail)
   ((not (car var-ids))
(lp (cdr var-ids) (cdr vars) (cdr vals)
(make-seq src ((car vals)) tail)))
   (else
(let ((var-ids (map (lambda (id)
  (if id (syntax->datum id) '_))
(reverse var-ids)))
  (vars (map (lambda (var) (or var (gen-label)))
 (reverse vars)))
  (vals (map (lambda (expand-expr id)
   (if id
   (expand-expr)
   (make-seq src
 (expand-expr)
 (build-void src
 (reverse vals) (reverse var-ids
  (build-letrec src #t var-ids vars vals tail)

bug#54478: unwanted source references showing up w/ -O0 (with patch)

[Matt Wette]

In guile-3.0.8, when I compile w/ optimiation-level 0, I am seeing references
to the beginning let-form.   The following illustrates the issue.  Consider

foo.scm:
(define *a* (make-parameter 0))
(define (foo . args)
(let* ((b (+ (*a*) 1))
   (c (+ (*a*) b 2)))
  (simple-format #t "foo a= ~S\n" (*a*))
  (simple-format #t "foo b= ~S\n" b)
  (simple-format #t "foo c= ~S\n" c)))

and p2.scm:
(use-modules (system base compile))
(use-modules (system vm program))
(use-modules (ice-9 pretty-print))

(compile-and-load "foo.scm" #:optimization-level 0)
(define sources (program-sources-pre-retire foo))
(pretty-print sources)

With guile-3.0.8, I see the followiing output.
Note the references back to line 2.((0 "foo.scm" 1 . 0)
 (20 "foo.scm" 2 . 4)
 (20 "foo.scm" 2 . 15)
 (76 "foo.scm" 2 . 18)
 (132 "foo.scm" 2 . 17)
 (152 "foo.scm" 2 . 23)
 (156 "foo.scm" 2 . 14)
 (176 "foo.scm" 2 . 4)
 (176 "foo.scm" 3 . 15)
 (232 "foo.scm" 3 . 18)
 (288 "foo.scm" 3 . 17)
 (308 "foo.scm" 3 . 23)
 (312 "foo.scm" 3 . 25)
 (316 "foo.scm" 3 . 14)
 (336 "foo.scm" 2 . 4)
 (336 "foo.scm" 4 . 7)
 (392 "foo.scm" 4 . 21)
 (396 "foo.scm" 4 . 24)
 (404 "foo.scm" 4 . 39)
 (460 "foo.scm" 4 . 38)
 (480 "foo.scm" 4 . 6)
 (496 "foo.scm" 2 . 4)
 (496 "foo.scm" 5 . 7)
 (552 "foo.scm" 5 . 21)
 (556 "foo.scm" 5 . 24)
 (564 "foo.scm" 5 . 38)
 (568 "foo.scm" 5 . 6)
 (584 "foo.scm" 6 . 7)
 (640 "foo.scm" 6 . 21)
 (644 "foo.scm" 6 . 24)
 (652 "foo.scm" 6 . 38)
 (656 "foo.scm" 6 . 6))

With the patch shown below, this is what I get:
((0 "foo.scm" 1 . 0)
 (20 "foo.scm" 2 . 4)
 (20 "foo.scm" 2 . 15)
 (76 "foo.scm" 2 . 18)
 (132 "foo.scm" 2 . 17)
 (152 "foo.scm" 2 . 23)
 (156 "foo.scm" 2 . 14)
 (176 "foo.scm" 2 . 4)
 (176 "foo.scm" 3 . 15)
 (232 "foo.scm" 3 . 18)
 (288 "foo.scm" 3 . 17)
 (308 "foo.scm" 3 . 23)
 (312 "foo.scm" 3 . 25)
 (316 "foo.scm" 3 . 14)
 (336 "foo.scm" 4 . 7)
 (392 "foo.scm" 4 . 21)
 (396 "foo.scm" 4 . 24)
 (404 "foo.scm" 4 . 39)
 (460 "foo.scm" 4 . 38)
 (480 "foo.scm" 4 . 6)
 (496 "foo.scm" 5 . 7)
 (552 "foo.scm" 5 . 21)
 (556 "foo.scm" 5 . 24)
 (564 "foo.scm" 5 . 38)
 (568 "foo.scm" 5 . 6)
 (584 "foo.scm" 6 . 7)
 (640 "foo.scm" 6 . 21)
 (644 "foo.scm" 6 . 24)
 (652 "foo.scm" 6 . 38)
 (656 "foo.scm" 6 . 6))


Patch follows.  In a sequence, the source of the forms should be emitted,
not the parent sequence source (start).
--- guile-3.0.8-dist/module/language/tree-il/compile-bytecode.scm   
2021-09-30 05:30:38.0 -0700
+++ guile-3.0.8-srcfix/module/language/tree-il/compile-bytecode.scm 
2022-03-19 09:37:28.126740690 -0700
@@ -910,7 +910,7 @@
 (define (visit-seq exp env ctx)
   (match exp
 (($  src head tail)
- (maybe-emit-source src)
+ ;;(maybe-emit-source src)
  (for-effect head env)
  (for-context tail env ctx
 

bug#42345: 3.0.4 says "wrong num' of arg's to 1" vs 2.2.4: "wrong num' of arg's to baz"

[Matt Wette]

In Guile 3.0.4, the program below results in the error:

/home/mwette/zz.scm:5:2: In procedure bar:
Wrong number of arguments to 1


In Guile 2.2.4, the same program results in the error:

;;; /home/mwette/zz.scm:11:14: warning: wrong number of arguments to `bar'
;;; compiled 
/home/mwette/.cache/guile/ccache/2.2-LE-8-3.A/home/mwette/zz.scm.go



However, once compiled, Guile 3.0.4, will repeat the same error message,
while Guile 2.2.4, will not report any error.

I consider reporting "1" as the name of a procedure a bug.

Here is the program:
(define (foo)

  (define (bar a b)
    (+ a b))

  (define (baz)
    (let* ((a 1)
       (b 2)
       (r (bar a b a)))
  r))

  (baz))

(foo)

bug#27782: new patch for mma

[Matt Wette]

Attached is a patch against guile master (at 3.0.4),
commit 5e1748f75128107e3a0707b66df5adb95d98437e

It is a incomplete, but functional, implementation of a mmap-api, including
1) mmap : low-level mmap, returns a bytevector, not searched for roots
2) mmap/search : like mmap, but not marked w/ GC_exclude_static_roots
3) mmap-file: high-level, easy-to-use mmap (e.g., (mmap-file "foo.dat"))

The above are coded in libguile/filesys.[ch].

Also included is test-suite/tests/mmap-api.test.

Build:
$ ./configure --enable-mmap-api
$ make
$ make check
...
Running mmap-api.test
...

Since implementation of mmap may be not simple, I propose a
git branch (e.g., wip-mmap-api) be created to invite group review,
update, test the update.

Matt


diff --git a/configure.ac b/configure.ac
index 3e96094f6..382d7d528 100644
--- a/configure.ac
+++ b/configure.ac
@@ -170,6 +170,10 @@ AC_ARG_ENABLE(tmpnam,
   AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
   enable_tmpnam=yes)
 
+AC_ARG_ENABLE(mmap-api,
+  AS_HELP_STRING([--enable-mmap-api],[enable MMAP interface]),,
+  enable_mmap_api=no)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
 
@@ -917,6 +921,10 @@ if test "$enable_tmpnam" = yes; then
AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
 fi
 
+if test "$enable_mmap_api" = yes; then
+   AC_DEFINE([ENABLE_MMAP_API], 1, [Define when MMAP API is enabled.])
+fi
+
 AC_REPLACE_FUNCS([strerror memmove])
 
 # Reasons for testing:
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 39bfd38cc..04e5dfd4d 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -79,11 +79,22 @@
 # include 
 #endif
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+#  include 
+#  include 
+#  include 
+#endif
+#endif
+
 #include "async.h"
 #include "boolean.h"
+#include "bytevectors.h"/* mmap */
 #include "dynwind.h"
 #include "fdes-finalizers.h"
 #include "feature.h"
+#include "finalizers.h" /* mmap */
+#include "foreign.h"/* mmap */
 #include "fports.h"
 #include "gsubr.h"
 #include "iselect.h"
@@ -1880,6 +1891,314 @@ scm_dir_free (SCM p)
 
 
 
+#ifdef ENABLE_MMAP_API
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+/* FiXME
+ * rlb says add msync()
+ * Windows : look for MapViewOfFile
+ */
+
+/* undefined, string or int acceptable */
+static int
+mm_flags (SCM prot, int def)
+{
+  if (SCM_UNBNDP (prot))
+return def;
+  else
+scm_misc_error("mmap", "bad prot option", SCM_EOL);
+  return -1;
+}
+
+static int
+mm_prot (SCM prot, int def)
+{
+  if (SCM_UNBNDP (prot))
+return def;
+  else
+scm_misc_error("mmap", "bad prot option", SCM_EOL);
+  return -1;
+}
+
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  SCM bvec;
+  void *c_addr;
+  size_t c_len;
+  int res;
+
+  bvec = SCM_PACK_POINTER (ptr);
+  if (!SCM_BYTEVECTOR_P (bvec))
+abort();
+  
+  c_addr = SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = (size_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0)
+scm_misc_error ("mmap", "failed to munmap memory", SCM_EOL);
+}
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0, 
+(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+	"mmap addr len [prot [flags [fd [offset"
+	"See the unix man page for mmap.  Returns a bytevector."
+	"Note that the region allocated will be searched by the garbage"
+	"collector for pointers. \n"
+	"Defaults:\n"
+	"  prot   (logior PROT_READ PROT_WRITE)\n"
+	"  flags  (logior MAP_ANON MAP_PRIVATE)\n"
+	"  fd -1\n"
+	"  offset 0\n"
+	"E.g., @code{(define reg (mmap/search %null-pointer #x1000)}\n")
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+c_prot = PROT_READ | PROT_WRITE;
+  else 
+c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+c_fd = -1;
+  else
+c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+c_offset = 0;
+  else
+c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+SCM_SYSERROR;			/* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+ SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  assert(sizeof(void*) <= sizeof(size_t));
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}

bug#21897: verified in 3.0.2

[Matt Wette]

This still exists in 3.0.2

scheme@(guile-user)> ,use (ice-9 control)

scheme@(guile-user)> (call/ec (lambda (c) (with-continuation-barrier (lambda () (c "through 
continuation"))) "c-w-b returned"))
$1 = "through continuation"

scheme@(guile-user)> (version)
$2 = "3.0.2"

bug#27209: patch

[Matt Wette]

attached is patch : added ", or @code{#f} if there are no keyword arguments"
>From 2c3f7ea9ddd9d245a000ad8b19176f132607405b Mon Sep 17 00:00:00 2001
From: Matt Wette 
Date: Fri, 27 Mar 2020 10:19:53 -0700
Subject: [PATCH] 	* doc/ref/compiler.texi: for description of
 lambda-case argument 	'kw' added "or @code{#f} if there are no keyword
 arguments"

---
 doc/ref/compiler.texi | 11 ++-
 1 file changed, 6 insertions(+), 5 deletions(-)

diff --git a/doc/ref/compiler.texi b/doc/ref/compiler.texi
index 8b99d43f1..b1664300a 100644
--- a/doc/ref/compiler.texi
+++ b/doc/ref/compiler.texi
@@ -419,11 +419,12 @@ argument, or @code{#f}.
 @var{kw} is a list of the form, @code{(@var{allow-other-keys?}
 (@var{keyword} @var{name} @var{var}) ...)}, where @var{keyword} is the
 keyword corresponding to the argument named @var{name}, and whose
-corresponding gensym is @var{var}.  @var{inits} are tree-il expressions
-corresponding to all of the optional and keyword arguments, evaluated to
-bind variables whose value is not supplied by the procedure caller.
-Each @var{init} expression is evaluated in the lexical context of
-previously bound variables, from left to right.
+corresponding gensym is @var{var}, or @code{#f} if there are no keyword
+arguments.  @var{inits} are tree-il expressions corresponding to all of
+the optional and keyword arguments, evaluated to bind variables whose
+value is not supplied by the procedure caller.  Each @var{init}
+expression is evaluated in the lexical context of previously bound
+variables, from left to right.
 
 @var{gensyms} is a list of gensyms corresponding to all arguments:
 first all of the required arguments, then the optional arguments if
-- 
2.17.1

bug#38486: done

[Matt Wette]

fixed by wingo:

$ git log -1
commit ef6f7ce70bfb9310cfec2a87a0a26ad7b9ab355b (HEAD -> master, origin/master, 
origin/HEAD)
Author: Andy Wingo 
Date:   Mon Mar 23 14:45:29 2020 +0100

Fix fixpoint computation in compute-significant-bits

* module/language/cps/specialize-numbers.scm (preserve-eq?): New

  helper.
  (sigbits-union): Use the new helper.  Fixes bugs.gnu.org/38486.
  Thanks to Zack Marvel for the bug report and Matt Wette for tracking
  it down.

bug#29001: git patch

[Matt Wette]

Attached is the git patch against the following guile commit:

bef5e0b3938cc88e3a1a1ac590b009875cc38162



>From 71ff7e79369a4514a961fc5cf76593b254c32d4c Mon Sep 17 00:00:00 2001
From: Matt Wette 
Date: Sun, 22 Mar 2020 09:12:37 -0700
Subject: [PATCH] 2020-03-22 Matt Wette 

* configure.ac:
Provide new option: --disable-tmpnam
This is made available for installations that don't want to allow
the insecure POSIX tmpname function.  Use mkstemp! instead.

* libguile/posix.c
tmpnam is deprecated; and enabled by ENABLE_TMPNAM
---
 configure.ac |  8 
 libguile/posix.c | 11 +++
 2 files changed, 19 insertions(+)

diff --git a/configure.ac b/configure.ac
index 6198c7e..3e96094 100644
--- a/configure.ac
+++ b/configure.ac
@@ -166,6 +166,10 @@ AC_ARG_ENABLE(regex,
   [  --disable-regex omit regular expression interfaces],,
   enable_regex=yes)
 
+AC_ARG_ENABLE(tmpnam,
+  AS_HELP_STRING([--disable-tmpnam],[omit POSIX tmpnam]),,
+  enable_tmpnam=yes)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
 
@@ -909,6 +913,10 @@ if test "$enable_regex" = yes; then
AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
 fi
 
+if test "$enable_tmpnam" = yes; then
+   AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
+fi
+
 AC_REPLACE_FUNCS([strerror memmove])
 
 # Reasons for testing:
diff --git a/libguile/posix.c b/libguile/posix.c
index a1520ab..9b9b476 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -87,6 +87,10 @@
 #include "vectors.h"
 #include "version.h"
 
+#if (SCM_ENABLE_DEPRECATED == 1)
+#include "deprecation.h"
+#endif
+
 #include "posix.h"
 
 #if HAVE_SYS_WAIT_H
@@ -1588,6 +1592,8 @@ SCM_DEFINE (scm_environ, "environ", 0, 1, 0,
 }
 #undef FUNC_NAME
 
+#if (SCM_ENABLE_DEPRECATED == 1)
+#ifdef ENABLE_TMPNAM
 #ifdef L_tmpnam
 
 SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
@@ -1602,6 +1608,9 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
   char name[L_tmpnam];
   char *rv;
 
+  scm_c_issue_deprecation_warning
+  ("Use of tmpnam is deprecated.  Use mkstemp! instead.");
+
   SCM_SYSCALL (rv = tmpnam (name));
   if (rv == NULL)
 /* not SCM_SYSERROR since errno probably not set.  */
@@ -1610,6 +1619,8 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
 }
 #undef FUNC_NAME
 
+#endif
+#endif
 #endif
 
 SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
-- 
2.17.1

bug#38486: specialize-numbers.scm: compute-significant-bits

[Matt Wette]

I've narrowed it down to the named let loop "lp" in this routine in
module/language/cps/specialize-numbers.scm


(define (compute-significant-bits cps types kfun)
  "Given the locally inferred types @var{types}, compute a map of VAR ->
BITS indicating the significant bits needed for a variable.  BITS may be
#f to indicate all bits, or a non-negative integer indicating a bitmask."
  (let ((preds (invert-graph (compute-successors cps kfun
    (let lp ((worklist (intmap-keys preds)) (visited empty-intset)
 (out empty-intmap))
  (match (intset-prev worklist)
    (#f out)
    (label
 (let ((worklist (intset-remove worklist label))
   (visited* (intset-add visited label)))
   (define (continue out*)
 (if (and (eq? out out*) (eq? visited visited*))
 (lp worklist visited out)
 (lp (intset-union worklist (intmap-ref preds label))
 visited* out*)))
   (define (add-def out var)
 (intmap-add out var 0 sigbits-union))
   (define (add-defs out vars)
 (match vars
   (() out)
   ((var . vars) (add-defs (add-def out var) vars
   (define (add-unknown-use out var)
 (intmap-add out var (inferred-sigbits types label var)
 sigbits-union))
   (define (add-unknown-uses out vars)
 (match vars
   (() out)
   ((var . vars)
    (add-unknown-uses (add-unknown-use out var) vars
   (continue
    (match (intmap-ref cps label)
  (($ $kfun src meta self)
   (add-def out self))
  (($ $kargs names vars ($ $continue k src exp))
   (let ((out (add-defs out vars)))
 (match exp
   ((or ($ $const) ($ $prim) ($ $fun) ($ $closure) ($ 
$rec))

    ;; No uses, so no info added to sigbits.
    out)
   (($ $values args)
    (match (intmap-ref cps k)
  (($ $kargs _ vars)
   (if (intset-ref visited k)
   (fold (lambda (arg var out)
   (intmap-add out arg (intmap-ref out var)
   sigbits-union))
 out args vars)
   out))
  (($ $ktail)
   (add-unknown-uses out args
   (($ $call proc args)
    (add-unknown-use (add-unknown-uses out args) proc))
   (($ $callk label proc args)
    (add-unknown-use (add-unknown-uses out args) proc))
   (($ $branch kt ($ $values (arg)))
    (add-unknown-use out arg))
   (($ $branch kt ($ $primcall name args))
    (add-unknown-uses out args))
   (($ $primcall name args)
    (let ((h (significant-bits-handler name)))
  (if h
  (match (intmap-ref cps k)
    (($ $kargs _ defs)
 (h label types out args defs)))
  (add-unknown-uses out args
   (($ $prompt escape? tag handler)
    (add-unknown-use out tag)
  (_ out)

bug#38486: hang

[Matt Wette]

So I hacked modules/cps/optimize.scm to display the optimization phases.

Here is what I got up to the point where guile hangs.
It looks like it's hanging in specialize-numbers.

running eliminate-dead-code
running prune-top-level-scopes
running simplify
running contify
running inline-constructors
running elide-values
running prune-bailouts
running peel-loops
running eliminate-common-subexpressions
running type-fold
running resolve-self-references
running eliminate-dead-code
running simplify
running specialize-numbers

The patch:
--- module/language/cps/optimize.scm-orig    2020-03-21 
14:16:17.313452995 -0700

+++ module/language/cps/optimize.scm    2020-03-21 14:18:32.264770889 -0700
@@ -73,7 +73,10 @@
 (maybe-verify program)
 (set! program
   (if (kw-arg-ref opts kw default)
-  (maybe-verify (pass program))
+  (begin
+    (display "running ") (display (quote pass)) (newline)
+    (force-output (current-output-port))
+    (maybe-verify (pass program)))
   program))
 ...
 (maybe-verify program)))

bug#38486: try all options

[Matt Wette]

The behavior is that guild compile 38486-1.scm hangs

These optimization flags eliminate that behavior: the code compiles quickly:
 -O0
 -O1
 -Ono-simplify
 -Ono-contify
 -Ono-cse
 -Ono-specialize-numbers

These optimization flags are ineffective: the behavior remains:
 -Ono-partial-eval
 -Ono-eliminate-dead-code
 -Ono-prune-top-level-scopes
 -Ono-inline-constructors
 -Ono-specialize-primcalls
 -Ono-elide-values
 -Ono-prune-bailouts
 -Ono-peel-loops
 -Ono-type-fold
 -Ono-resolve-self-references
 -Ono-licm
 -Ono-rotate-loops
 -Ono-precolor-calls

bug#38486: compile livelock

[Matt Wette]

I reproduced the behavior on 2.2.7.   I also found that -O0 and -O1 do 
not have a problem:


$ meta/guild compile -O0 38486-1.scm -o 38486-1.go
wrote `38486-1.go'

$ meta/guild compile -O1 38486-1.scm -o 38486-1.go
wrote `38486-1.go'

$ meta/guild compile -O2 38486-1.scm -o 38486-1.go
^Cerror: interrupted by the user

bug#29001: patch

[Matt Wette]

Note: The above patch makes tmpnam report that it is deprecated.

bug#29001: --disable-tmpnam

[Matt Wette]

"make" and "make check" succeeds on 3.0.1 / Ubuntu 18.04 / x86_64 with
1) --disable-tmpnam
2) --enable-tmpnam
3) neither

This updates libguile/posix.c and configure.ac to allow extra
configuration option --disable-tmpnam.   This is made available
for installations that don't want to allow the insecure tmpnam
function.  (Use mkstemp! instead.)

--- libguile/posix.c-orig    2020-03-18 16:55:09.349588085 -0700
+++ libguile/posix.c    2020-03-18 17:07:20.860142083 -0700
@@ -65,6 +65,7 @@

 #include "async.h"
 #include "bitvectors.h"
+#include "deprecation.h"
 #include "dynwind.h"
 #include "extensions.h"
 #include "feature.h"
@@ -1588,6 +1589,7 @@
 }
 #undef FUNC_NAME

+#ifdef ENABLE_TMPNAM
 #ifdef L_tmpnam

 SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
@@ -1602,6 +1604,9 @@
   char name[L_tmpnam];
   char *rv;

+  scm_c_issue_deprecation_warning
+  ("Use of tmpnam is deprecated.  Use mkstemp! instead.");
+
   SCM_SYSCALL (rv = tmpnam (name));
   if (rv == NULL)
 /* not SCM_SYSERROR since errno probably not set.  */
@@ -1611,6 +1616,7 @@
 #undef FUNC_NAME

 #endif
+#endif

 SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
 (void),
--- configure.ac-orig    2020-03-18 17:11:17.977427035 -0700
+++ configure.ac    2020-03-18 17:09:57.850334685 -0700
@@ -166,6 +166,10 @@
   [  --disable-regex omit regular expression interfaces],,
   enable_regex=yes)

+AC_ARG_ENABLE(tmpnam,
+  [  --disable-tmpnam    omit POSIX tmpnam],,
+  enable_tmpnam=yes)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))

@@ -909,6 +913,10 @@
    AC_DEFINE([ENABLE_REGEX], 1, [Define when regex support is enabled.])
 fi

+if test "$enable_tmpnam" = yes; then
+   AC_DEFINE([ENABLE_TMPNAM], 1, [Define when tmpnam support is enabled.])
+fi
+
 AC_REPLACE_FUNCS([strerror memmove])

 # Reasons for testing:

bug#40075: patch

[Matt Wette]

Below is a patch against guile-3.0.1.

"make" works, "make check" works.

null-threads.c was not seeing "SCM_USE_NULL_THREADS" so include 
libguile/scmconfig.h

null-threads.c was not seeing def of SCM_API so include "libguile/scm.h"
web-server.test used (if (provided? 'threads) ) so #undefined if 
no threads.



--- libguile/null-threads.h-orig    2020-03-21 08:12:37.852229565 -0700
+++ libguile/null-threads.h    2020-03-21 08:33:26.239759647 -0700
@@ -36,6 +36,8 @@
 #include 
 #include 

+#include "libguile/scm.h"
+
 /* Threads
 */
 typedef int scm_i_pthread_t;
--- libguile/null-threads.c-orig    2020-03-21 08:07:50.113439437 -0700
+++ libguile/null-threads.c    2020-03-21 08:08:32.681573253 -0700
@@ -23,6 +23,7 @@

 #include 

+#include "libguile/scmconfig.h"

 #if SCM_USE_NULL_THREADS
 #include "null-threads.h"
--- test-suite/tests/web-server.test-orig    2020-03-21 
09:29:57.688813542 -0700

+++ test-suite/tests/web-server.test    2020-03-21 09:35:08.850651216 -0700
@@ -93,25 +93,25 @@
 "not found"
   (expect http-get "/does-not-exist" 404))

-(pass-if-equal "GET with keep-alive"
-    '("Hello, λ world!"
-  "Écrit comme ça en Latin-1."
-  "GNU Guile")
-  (if (provided? 'threads)
+(if (provided? 'threads)
+    (pass-if-equal "GET with keep-alive"
+  '("Hello, λ world!"
+    "Écrit comme ça en Latin-1."
+    "GNU Guile")
   (let ((port (open-socket-for-uri %server-base-uri)))
-    (define result
-  (map (lambda (path)
- (let-values (((response body)
-   (http-get (string-append 
%server-base-uri path)

- #:port port
- #:keep-alive? #t
- #:headers
- '((user-agent . "GNU Guile")
-   (and (= (response-code response) 200)
-    body)))
-   '("/" "/latin1" "/user-agent")))
-    (close-port port)
-    result)))
+    (define result
+      (map (lambda (path)
+         (let-values (((response body)
+               (http-get (string-append %server-base-uri path)
+                     #:port port
+                     #:keep-alive? #t
+                     #:headers
+                     '((user-agent . "GNU Guile")
+           (and (= (response-code response) 200)
+            body)))
+       '("/" "/latin1" "/user-agent")))
+    (close-port port)
+    result)))

 (pass-if-equal "POST /"
 "forbidden"

bug#40075: pthreads

[Matt Wette]

I have duplicated this w/ 3.0.1 on ubuntu 18.04, x86_64.

I will look into this today.

Matt

bug#40075: oops

[Matt Wette]

scratch that - 29001 is about the tmpnam issue

bug#21076: dynamic-link

[Matt Wette]

I have encountered this issue with dynamic-link.
I propose a small patch to Guile (works on v3.0.1) to address it.
At least this allows me to load the file if I know the exact name.

This patch fixes issue with libtool and OSes which use
non-standard extensions for shared libraries.  The libltdl
function lt_dlopenext expects the argument to have a standard
extension or no extention.  Arguments reflecting shared object
files with non-standard extensions will fail to load.  For
example, my system has /usr/lib64/libyaml-0.so.2.  w/o this
patch (dynamic-link "libyaml-0.so.2") does not work; with it,
it does.  Go figure.

--- libguile/dynl.c-orig    2020-03-20 05:56:42.101214929 -0700
+++ libguile/dynl.c    2020-03-20 05:57:40.432893330 -0700
@@ -69,7 +69,10 @@
 handle = lt_dlopen (NULL);
   else
 {
-  handle = lt_dlopenext (fname);
+  handle = lt_dlopen (fname);
+
+  if (handle == NULL)
+ handle = lt_dlopenext (fname);

   if (handle == NULL
 #ifdef LT_DIRSEP_CHAR

bug#29001: tmpnam

[Matt Wette]

On 3/18/20 4:48 PM, Matt Wette wrote:

This is related to 4075 at debbugs.gnu.org \


er  40075 at debbugs.gnu.org

working on patch against 3.0.1

going better this time

bug#29001: tmpnam

[Matt Wette]

This is related to 4075 at debbugs.gnu.org

bug#40075: tmpnam

[Matt Wette]

This is related to 29001 at debbugs.gnu.org

bug#17940: (begin)

[Matt Wette]

I have run into this also, in writing macros.
My workaround is to always add (if #f #f)
in my forms that allow no expressions in the body.
See second-to-last line below.

(define-syntax sx-match-1
  (syntax-rules ()
    ((_ v (pat exp ...) c1 ...)
 (let ((kf (lambda () (sx-match-1 v c1 ...
   (sxm-sexp v pat (begin (if #f #f) exp ...) (kf
    ((_ v) (error "sx-match: nothing matches"

bug#39196: patch

[Matt Wette]

Here is a patch to make it work.

--- module/system/repl/command.scm-orig    2020-01-19 13:46:55.041867060 
-0800

+++ module/system/repl/command.scm    2020-01-19 13:48:02.982264244 -0800
@@ -30,7 +30,7 @@
   #:use-module (system vm program)
   #:use-module (system vm trap-state)
   #:use-module (system vm vm)
-  #:autoload (system base language) (lookup-language language-reader)
+  #:autoload (system base language) (lookup-language language-reader 
language-title language-name)

   #:autoload (system vm trace) (call-with-trace)
   #:use-module (ice-9 format)
   #:use-module (ice-9 session)

bug#39196: ,L brainfuck : not working in 3.0.0

[Matt Wette]

scheme@(guile-user)> (version)
$4 = "3.0.0"
scheme@(guile-user)> ,L brainfuck
While executing meta-command:
Unbound variable: language-title


noting change to system/base/syntax.scm:
< ;; Copyright (C) 2001, 2009, 2016 Free Software Foundation, Inc
---
> ;; Copyright (C) 2001, 2009, 2016, 2019 Free Software Foundation, Inc
68c68
<    (define ,name (make-record-type ,(symbol->string name) ',slot-names
---
>    (define ,name (make-record-type ',name ',slot-names
101c101
<    (define ,name (make-record-type ,(symbol->string name) ',slot-names
---
>    (define ,name (make-record-type ',name ',slot-names

bug#32367: sigaction hangs

[Matt Wette]

On 12/15/18 8:46 AM, Matt Wette wrote:

-s seems to end up using load-in-vicinity: I can re-create this way:

mwette$ guile -L `pwd` -c '(load-in-vicinity (getcwd) "foo.scm")'
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /home/mwette/proj/guile/bugs-guile/32367/foo.scm
setting SIGCHILD to SIG_DFL...
^C



And using `-l' to load scsh.scm fixes the problem:

mwette$ guile -L `pwd` -l scsh.scm -c '(load-in-vicinity (getcwd) 
"foo.scm")'setting SIGCHILD to SIG_DFL...

setting SIGCHILD to SIG_DFL...done
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /home/mwette/proj/guile/bugs-guile/32367/foo.scm
;;; compiled 
/home/mwette/.cache/guile/ccache/2.2-LE-8-3.A/home/mwette/proj/guile/bugs-guile/32367/foo.scm.go

mwette $

An update from 2.2.3 to 2.2.4 adds call-with-module-autoload-lock which 
places a
mutex around autoload.  This looks like one place to start digging. See 
ice-9/threads.scm:


(set! (@ (guile) call-with-module-autoload-lock)
  (let ((mutex (make-mutex 'recursive)))
    (lambda (thunk)
  (with-mutex mutex
    (thunk)

bug#32367: sigaction hangs

[Matt Wette]

-s seems to end up using load-in-vicinity: I can re-create this way:

mwette$ guile -L `pwd` -c '(load-in-vicinity (getcwd) "foo.scm")'
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /home/mwette/proj/guile/bugs-guile/32367/foo.scm
setting SIGCHILD to SIG_DFL...
^C

bug#32429: scm_to_off_t

[Matt Wette]

can you post your config.log file?

That error is bizarre because scm_to_off_t should be #defined from 
libguile/syscalls.h

bug#29845: close

[Matt Wette]

Not needed.

bug#30094: load-lang patch

[Matt Wette]

I am now posting patch for this to github.com mwette guile-contrib 
patch-2.2.4 load.patch .

bug#30094: test script

[Matt Wette]

The following test script works with the 2.2.4 patch provided.
elisp tests don't work well but I think that is elisp issue.
This stuff works with my own developed.

;;; load-lang.test --*- scheme -*-

(define-module (test-suite test-load-lang)
  #:use-module (test-suite lib))

(define tmp-dir (getcwd))

(define (data-file-name filename)
  (in-vicinity tmp-dir filename))

(with-test-prefix "load/lang"

  (pass-if "using #lang"
(let ((src-file (data-file-name "load1js")))
  (with-output-to-file src-file
(lambda ()
  (display "#lang ecmascript\n")
  (display "function js_1pl(b) { return 1 + b; }\n")))
  (load src-file)
  (delete-file src-file)
  (= (js_1pl 2) 3)))

  (pass-if "using dot-js"
(let ((src-file (data-file-name "load2.js")))
  (with-output-to-file src-file
(lambda ()
  (display "function js_2pl(b) { return 2 + b; }\n")))
  (load src-file)
  (delete-file src-file)
  (= (js_2pl 2) 4)))

  )

;; --- last line ---

bug#30094: patch for adding external lang support

[Matt Wette]

There is a left-over simple-format statement which should be removed.

bug#30094: patch for adding external lang support

[Matt Wette]

Here is a patch against 2.2.4.  It compiled and passed "make check".
Still to go: some test-suite scripts.


--- module/system/base/compile.scm-orig 2016-08-01 04:32:31.0 -0700
+++ module/system/base/compile.scm  2018-09-04 06:27:53.056330281 -0700
@@ -28,6 +28,7 @@
   #:use-module (ice-9 receive)
   #:export (compiled-file-name
 compile-file
+   add-extension
 compile-and-load
 read-and-compile
 compile
@@ -132,11 +133,65 @@
  (and (false-if-exception (ensure-directory (dirname f)))
   f
 
+;; --- new ---

+
+(define (lang-from-port port)
+
+  (define (release chl)
+(let loop ((chl chl))
+  (unless (null? chl)
+   (unread-char (car chl) port)
+   (loop (cdr chl
+#f)
+
+  (define (return chl)
+(string->symbol (reverse-list->string chl)))
+   
+  (let loop ((cl '()) (st 0) (kl '(#\# #\l #\a #\n #\g)) (ch (read-char port)))
+(case st
+  ((0) (cond   ; read `#lang'
+   ((eof-object? ch) (release cl))
+   ((null? kl) (loop cl 1 kl ch))
+   ((char=? ch (car kl))
+(loop (cons ch cl) st (cdr kl) (read-char port)))
+   (else (release (cons ch cl)
+  ((1) (cond   ; skip spaces
+   ((eof-object? ch) (release cl))
+   ((char=? ch #\space) (loop (cons ch cl) st kl (read-char port)))
+   (else (loop cl 2 '() ch
+  ((2) (cond   ; collect lang name
+   ((eof-object? ch) (return kl))
+   ((char=? ch #\newline) (return kl))
+   ((char-whitespace? ch) (loop cl 3 kl ch))
+   (else (loop cl st (cons ch kl) (read-char port)
+  ((3) (cond
+   ((eof-object? ch) (return kl))
+   ((char=? ch #\newline) (return kl))
+   (else (loop cl st kl (read-char port
+
+(define %file-extension-map
+  '(("scm" . scheme)
+("el" . elisp)
+("js" . ecmascript)))
+
+(define (add-extension tag lang)
+  (unless (and (string? tag) (symbol? lang))
+(error "expecting string symbol"))
+  (set! %file-extension-map (acons tag lang %file-extension-map)))
+
+(define* (lang-from-file file)
+  (let* ((ix (string-rindex file #\.))
+   (ext (and ix (substring file (1+ ix)
+(and ext (assoc-ref %file-extension-map ext
+
+
+;; ---
+
 (define* (compile-file file #:key
(output-file #f)
-   (from (current-language))
+   (from #f)
(to 'bytecode)
-   (env (default-environment from))
+   (env #f)
(opts '())
(canonicalization 'relative))
   (with-fluids ((%file-port-name-canonicalization canonicalization))
@@ -151,11 +206,17 @@
   (ensure-directory (dirname comp))
   (call-with-output-file/atomic comp
 (lambda (port)
-  ((language-printer (ensure-language to))
-   (read-and-compile in #:env env #:from from #:to to #:opts
- (cons* #:to-file? #t opts))
-   port))
-file)
+ (let* ((from (or from
+  (lang-from-port in)
+  (lang-from-file file)
+  (current-language)))
+(env (or env (default-environment from
+   (simple-format (current-error-port) "compiling from lang ~A\n" from)
+   ((language-printer (ensure-language to))
+(read-and-compile in #:env env #:from from #:to to #:opts
+  (cons* #:to-file? #t opts))
+port)))
+   file)
   comp)))
 
 (define* (compile-and-load file #:key (from (current-language)) (to 'value)

bug#30094: proposed code for alt languages

[Matt Wette]

Hey all,

The attached code implements alternative languages. It is roughly a patch to
(system base compile).  It provides
1) extra procedures lang-from-port and lang-from-file
2) the global %file-extension-map
3) an altered version of compile-file

Behavior:
1) if the first line of the file is `#lang ' then that is used as from
2) if the file-ending matches an entry in the a-list %file-extension-map the 
ref is used

Matt

In the following, compile.scm and ncompile.scm are trimmed to only contain
the procedure compile-file
mwette$ diff -c compile.scm ncompile.scm
*** compile.scm Sun Aug 19 14:19:44 2018
--- ncompile.scmSun Aug 19 14:20:07 2018
***
*** 1,10 
! (define* (compile-file file #:key
!(output-file #f)
!(from (current-language))
!(to 'bytecode)
!(env (default-environment from))
!(opts '())
!(canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
  (let* ((comp (or output-file (compiled-file-name file)
   (error "failed to create path for auto-compiled file"
--- 1,10 
! (define* (ncompile-file file #:key
!   (output-file #f)
!   (from #f)
!   (to 'bytecode)
!   (env #f)
!   (opts '())
!   (canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
  (let* ((comp (or output-file (compiled-file-name file)
   (error "failed to create path for auto-compiled file"
***
*** 16,25 
  
(ensure-directory (dirname comp))

(call-with-output-file/atomic comp
! (lambda (port)
!   ((language-printer (ensure-language to))
!(read-and-compile in #:env env #:from from #:to to #:opts
!  (cons* #:to-file? #t opts))
!port))
! file)
!   comp)))
--- 16,31 
  
(ensure-directory (dirname comp))

(call-with-output-file/atomic comp
!   (lambda (port)
! (let* ((from (or from
!  (lang-from-port in)
!  (lang-from-file file)
!  (current-language)))
!(env (or env (default-environment from
!   (simple-format (current-error-port) "compiling from lang ~A\n" from)
!   ((language-printer (ensure-language to))
!(read-and-compile in #:env env #:from from #:to to #:opts
!  (cons* #:to-file? #t opts))
!port)))
! file)
!   comp)))


Here is ncompile:;; ncompile v180819b
;; usage:
;;   (ncompile-file "foo.m")
;; first checks for first line of the form
;;   #lang 
;; then uses file ending ".m" => nx-matlab


(define-module (ncompile)
  #:export (ncompile-file)
  )

(define (lang-from-port port)

  (define (release chl)
(let loop ((chl chl))
  (unless (null? chl)
(unread-char (car chl) port)
(loop (cdr chl
#f)

  (define (return chl)
(string->symbol (reverse-list->string chl)))

  (let loop ((cl '()) (st 0) (kl '(#\# #\l #\a #\n #\g)) (ch (read-char port)))
(case st
  ((0) (cond; read `#lang'
((eof-object? ch) (release cl))
((null? kl) (loop cl 1 kl ch))
((char=? ch (car kl))
 (loop (cons ch cl) st (cdr kl) (read-char port)))
(else (release (cons ch cl)
  ((1) (cond; skip spaces
((eof-object? ch) (release cl))
((char=? ch #\space) (loop (cons ch cl) st kl (read-char port)))
(else (loop cl 2 '() ch
  ((2) (cond; collect lang name
((eof-object? ch) (return kl))
((char=? ch #\newline) (return kl))
((char-whitespace? ch) (loop cl 3 kl ch))
(else (loop cl st (cons ch kl) (read-char port)
  ((3) (cond
((eof-object? ch) (return kl))
((char=? ch #\newline) (return kl))
(else (loop cl st kl (read-char port

(define %file-extension-map
  '(("scm" . scheme)
("el" . elisp)
("m" . nx-matlab)
("js" . ecmascript)))

(define* (lang-from-file file)
  (let* ((ix (string-rindex file #\.))
(ext (and ix (substring file (1+ ix)
(and ext (assoc-ref %file-extension-map ext

(define call-with-output-file/atomic
  (@@ (system base compile) call-with-output-file/atomic))
(define language-printer
  (@ (system base language) language-printer))
(define ensure-language
  (@@ (system base compile) ensure-language))
(define ensure-directory
  (@@ (system base compile) ensure-directory))
(define read-and-compile
  (@@ (system base compile) read-and-compile))
(define compiled-file-name
  

bug#32164: guile --language=xxx

[Matt Wette]

This bug applies to version 2.2.3.

bug#32164: guile --language=xxx fails with outdated go file

[Matt Wette]

If using ``--language='' option with `guile' and one of the language source
files is newer than the .go file, guile will fail with "no such language".
See below.  Apparently the file is compiled.  I'm guessing this could be an
issue a circular dependency.

mwette$ guile --language=javascript ,zz.js
mwette$ touch separser.scm
mwette$ guile --language=javascript ,zz.js
;;; note: source file 
/home/mwette/repo/sv/nyacc-modev/examples/nyacc/lang/javascript/separser.scm
;;;   newer than compiled 
/home/mwette/.cache/guile/ccache/2.2-LE-8-3.A/home/mwette/repo/sv/nyacc-modev/examples/nyacc/lang/javascript/separser.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling 
/home/mwette/repo/sv/nyacc-modev/examples/nyacc/lang/javascript/separser.scm
;;; WARNING: compilation of 
/home/mwette/repo/sv/nyacc-modev/examples/nyacc/lang/javascript/separser.scm 
failed:
;;; no such language javascript
mwette$ guild compile separser.scm
wrote 
`/home/mwette/.cache/guile/ccache/2.2-LE-8-3.A/home/mwette/repo/sv/nyacc-modev/examples/nyacc/lang/javascript/separser.scm.go'
mwette$ guile --language=javascript ,zz.js
mwette$

bug#31154: Acknowledgement (predicate function for foreign-object not obvious)

[Matt Wette]

Perhaps it belongs with the demo in Section 5.5 Defining New Foreign Object 
Types,
with the image demo.

bug#31154: predicate function for foreign-object not obvious

[Matt Wette]

The reference manual (guile-2.2.3) does not provide instruction on how to 
generate
a predicate for a foreign object, and it is not obvious.  Maybe it doesn't need 
to
be in the manual but should then be in an example somewhere, IMO.

The following patch to the reference manual is one option:


--- doc/ref/api-foreign-objects.texi-orig   2018-04-14 11:26:35.779502997 
-0700
+++ doc/ref/api-foreign-objects.texi2018-04-14 11:28:42.823072217 -0700
@@ -96,6 +96,33 @@
 needed.
 @end deftypefn
 
+To generate a predicate for a foreign object use the @code{SCM_IS_A_P}

+macro as follows.
+
+@example
+static SCM foo_type;
+
+static SCM
+scm_foo_p(SCM obj) {
+  return SCM_IS_A_P(obj, foo_type)? SCM_BOOL_T: SCM_BOOL_F;
+}
+
+void
+init_foo()
+{
+  SCM name, slots;
+
+  name = scm_from_utf8_symbol("foo");
+  slots = scm_list_2 (scm_from_utf8_symbol ("data"),
+ scm_from_utf8_symbol ("deps"));
+  finalizer = NULL;
+  foo_type = scm_make_foreign_object_type(name, slots, finalizer);
+
+  scm_c_define_gsubr("foo?", 1, 0, 0, scm_foo_p);
+  ...
+}
+@end example
+
 One can also access foreign objects from Scheme.  @xref{Foreign Objects
 and Scheme}, for some examples.
 

bug#30276: typos in the manual (api-macros, vm)

[Matt Wette]

A couple typos in the maual

--- api-macros.texi-fix 2018-01-28 13:22:52.305712852 -0800
+++ api-macros.texi 2017-11-19 11:22:01.0 -0800
@@ -1280,7 +1280,7 @@
 
 In this way @code{(macroexpand @var{foo})} is equivalent to

 @code{(macroexpand @var{foo} 'e '(eval))}.  The second argument is the
-mode (@code{'e} for ``eval'') and the third is the
+mode (@code{'e} for ``eval'') and the second is the
 eval-syntax-expanders-when parameter (only @code{eval} in this default
 setting).
 
--- vm.texi	2017-05-13 09:41:37.0 -0700

+++ vm.texi-fix 2018-01-28 13:21:31.621618026 -0800
@@ -719,7 +719,7 @@
 
 For calls, both in tail position and in non-tail position, we require

 that the procedure and the arguments already be shuffled into place
-befor the call instruction.  ``Into place'' for a tail call means that
+before the call instruction.  ``Into place'' for a tail call means that
 the procedure should be in slot 0, relative to the @code{fp}, and the
 arguments should follow.  For a non-tail call, if the procedure is in
 @code{fp}-relative slot @var{n}, the arguments should follow from slot

bug#27782: mmap for guile

[Matt Wette]

here is a start on test-suite/tests/mmap.test

+ mmap.test --- test suite for Guile's mmap functions  -*- scheme -*-
+
+
+(define-module (test-mmap)
+  #:use-module (test-suite lib))
+
+(use-modules (rnrs bytevectors))
+
+(with-test-prefix "mmap"
+
+  (pass-if "basics"
+(let* ((siz #x1)
+  (reg (mmap 0 siz)))
+  (and (eqv? (bytevector-length reg) siz)
+  (begin (bytevector-u8-set! reg 0 99)
+ (eqv? (bytevector-u8-ref reg 0) 99))
+  (begin (bytevector-u8-set! reg (1- siz) 98)
+ (eqv? (bytevector-u8-ref reg (1- siz)) 98))
+  #t)))
+
+  )
+
+ --- last line ---

bug#27782: mmap for guile

[Matt Wette]

got it.

> On Nov 24, 2017, at 8:22 AM, Nala Ginrut <nalagin...@gmail.com> wrote:
> 
> Thanks for the work! Could you please add MAP_POPULATE too?
> 
> 2017年11月24日 下午11:55，"Matt Wette" <matt.we...@gmail.com 
> <mailto:matt.we...@gmail.com>>写道：
> 
> 
> 
> 
> 
> I did a little more on this.  Here is the latest.
> It provides mmap (not searched) and mmap/search (searched for pointers to GC).
> 
> 
> --- libguile/filesys.c.orig 2017-03-01 10:54:31.0 -0800
> +++ libguile/filesys.c  2017-10-28 10:05:10.0 -0700
> @@ -1828,9 +1828,14 @@
> 
> 
> 
> +#include "mman.c"
> +
>  void
>  scm_init_filesys ()
>  {
> +#ifdef HAVE_SYS_MMAN_H
> +  init_mman();
> +#endif
>  #ifdef HAVE_POSIX
>scm_tc16_dir = scm_make_smob_type ("directory", 0);
>scm_set_smob_free (scm_tc16_dir, scm_dir_free);
> --- libguile/mman.c.orig2017-10-28 10:05:10.0 -0700
> +++ libguile/mman.c 2017-11-04 09:23:35.0 -0700
> @@ -0,0 +1,199 @@
> +// mman.c - v171104a
> +#ifdef HAVE_CONFIG_H
> +#  include 
> +#endif
> +
> +#ifdef HAVE_SYS_MMAN_H
> +#  include 
> +#  include 
> +#endif
> +
> +#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
> +
> +#include "libguile/_scm.h"
> +#include "libguile/smob.h"
> +#include "libguile/fdes-finalizers.h"
> +#include "libguile/feature.h"
> +
> +SCM_API SCM scm_mmap_search (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
> +SCM offset);
> +SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
> + SCM offset);
> +SCM_API SCM scm_munmap (SCM bvec);
> +void init_mman(void);
> +static void mmap_finalizer (void *ptr, void *data);
> +
> +SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0,
> +(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +   "mmap addr len [prot [flags [fd [offset"
> +   "See the unix man page for mmap.  Returns a bytevector."
> +   "Note that the region allocated will be searched by the garbage"
> +   "collector for pointers.  \n"
> +   " Defaults:\n"
> +   "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +   "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
> +   "  FD -1\n"
> +   "  OFFSET 0\n"
> +   "@example\n(define reg (mmap/search %null-pointer #x1000)\n"
> +   "@end example"
> +   )
> +#define FUNC_NAME s_scm_mmap_search
> +{
> +  void *c_mem, *c_addr;
> +  size_t c_len;
> +  int c_prot, c_flags, c_fd;
> +  scm_t_off c_offset;
> +  SCM pointer, bvec;
> +
> +  if (SCM_POINTER_P (addr))
> +c_addr = SCM_POINTER_VALUE (addr);
> +  else if (scm_is_integer (addr))
> +c_addr = (void*) scm_to_uintptr_t (addr);
> +  else
> +SCM_MISC_ERROR("bad addr", addr);
> +
> +  c_len = scm_to_size_t (len);
> +
> +  if (SCM_UNBNDP (prot))
> +c_prot = PROT_READ | PROT_WRITE;
> +  else
> +c_prot = scm_to_int (prot);
> +
> +  if (SCM_UNBNDP (flags))
> +c_flags = MAP_ANON | MAP_PRIVATE;
> +  else
> +c_flags = scm_to_int (flags);
> +
> +  if (SCM_UNBNDP (fd))
> +c_fd = -1;
> +  else
> +c_fd = scm_to_int (fd);
> +
> +  if (SCM_UNBNDP (fd))
> +c_offset = 0;
> +  else
> +c_offset = scm_to_off_t (offset);
> +
> +  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
> +  if (c_mem == MAP_FAILED)
> +SCM_SYSERROR;  /* errno set */
> +
> +  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
> +  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
> +SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
> +  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
> +  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
> +  return bvec;
> +}
> +#undef FUNC_NAME
> +
> +SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0,
> +(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
> +   "mmap addr len [prot [flags [fd [offset"
> +   "See the man page.  Returns a bytevector."
> +   "Note that the region returned by mmap will NOT be searched "
> +   "by the garbage collector for pointers.\n"
> +   "Defaults:\n"
> +   "  PROT   (logior PROT_READ PROT_WRITE)\n"
> +   "  FLAGS  (logior

bug#27782: mmap for guile

[Matt Wette]

I did a little more on this.  Here is the latest.
It provides mmap (not searched) and mmap/search (searched for pointers to GC).


--- libguile/filesys.c.orig 2017-03-01 10:54:31.0 -0800
+++ libguile/filesys.c  2017-10-28 10:05:10.0 -0700
@@ -1828,9 +1828,14 @@
 
 
 
+#include "mman.c"
+
 void
 scm_init_filesys ()
 {
+#ifdef HAVE_SYS_MMAN_H
+  init_mman();
+#endif
 #ifdef HAVE_POSIX
   scm_tc16_dir = scm_make_smob_type ("directory", 0);
   scm_set_smob_free (scm_tc16_dir, scm_dir_free);
--- libguile/mman.c.orig2017-10-28 10:05:10.0 -0700
+++ libguile/mman.c 2017-11-04 09:23:35.0 -0700
@@ -0,0 +1,199 @@
+// mman.c - v171104a
+#ifdef HAVE_CONFIG_H
+#  include 
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+#  include 
+#  include 
+#endif
+
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+#include "libguile/_scm.h"
+#include "libguile/smob.h"
+#include "libguile/fdes-finalizers.h"
+#include "libguile/feature.h"
+
+SCM_API SCM scm_mmap_search (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+SCM offset);
+SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+ SCM offset);
+SCM_API SCM scm_munmap (SCM bvec);
+void init_mman(void);
+static void mmap_finalizer (void *ptr, void *data);
+
+SCM_DEFINE (scm_mmap_search, "mmap/search", 2, 4, 0, 
+(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+   "mmap addr len [prot [flags [fd [offset"
+   "See the unix man page for mmap.  Returns a bytevector."
+   "Note that the region allocated will be searched by the garbage"
+   "collector for pointers.  \n"
+   " Defaults:\n"
+   "  PROT   (logior PROT_READ PROT_WRITE)\n"
+   "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+   "  FD -1\n"
+   "  OFFSET 0\n"
+   "@example\n(define reg (mmap/search %null-pointer #x1000)\n"
+   "@end example"
+   )
+#define FUNC_NAME s_scm_mmap_search
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+c_prot = PROT_READ | PROT_WRITE;
+  else 
+c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+c_fd = -1;
+  else
+c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+c_offset = 0;
+  else
+c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+SCM_SYSERROR;  /* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+   "mmap addr len [prot [flags [fd [offset"
+   "See the man page.  Returns a bytevector."
+   "Note that the region returned by mmap will NOT be searched "
+   "by the garbage collector for pointers.\n"
+   "Defaults:\n"
+   "  PROT   (logior PROT_READ PROT_WRITE)\n"
+   "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+   "  FD -1\n"
+   "  OFFSET 0\n"
+   "@example\n"
+   "(define bvec-1MB (mmap 0 #x10)\n"
+   "@end example"
+   )
+#define FUNC_NAME s_scm_mmap
+{
+  SCM bvec;
+  void *c_mem;
+  size_t c_len;
+
+  bvec = scm_mmap_search(addr, len, prot, flags, fd, offset);
+  c_mem = SCM_BYTEVECTOR_CONTENTS(bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH(bvec);
+
+  /* tell GC not to scan for pointers */
+  GC_exclude_static_roots(c_mem, (char*) c_mem + c_len);
+
+  return bvec;
+}
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  void *c_addr;
+  intptr_t c_len;
+  int res;
+
+  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
+  c_len = (intptr_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0) SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+(SCM bvec),
+   "See the man page. Given bytevector unmap."
+   )
+#define FUNC_NAME s_scm_munmap
+{
+  void *c_addr;
+  size_t c_len;
+  int c_res;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_res 

bug#27579: wchar_t needed also

[Matt Wette]

We will also need wchar_t.   And what about char16_t and char32_t ?

bug#27782: mmap for guile 2.2.2

[Matt Wette]

I located GC_exclude_static_roots() call for the collector.

Now mmap/search will run allocate a bytevector as in the previously provided 
patch.
And mmap will call mmap/search and then apply GC_exclude_static_roots() to the 
mmap'd region.

bug#27782: mmap for guile 2.2.2

[Matt Wette]

I worked on the code a bit more.  It is currently implemented as a #include 
"mman.c" in filesys.c 
and another file "mman.c".

I believe this needs to be reviewed by someone who understands the constraints 
on foriegn pointers 
and finalization better than I do.  Also, there is a comment to add a procedure 
mmap/no-search to 
guarantee that the allocated region is not searched by the GC for pointers.

The following patch is against guile-2.2.2:

--- libguile/filesys.c.orig 2017-07-21 06:14:18.0 -0700
+++ libguile/filesys.c  2017-10-27 15:40:04.0 -0700
@@ -1828,9 +1828,14 @@
 
 
 
+#include "mman.c"
+
 void
 scm_init_filesys ()
 {
+#ifdef HAVE_SYS_MMAN_H
+  init_mman();
+#endif
 #ifdef HAVE_POSIX
   scm_tc16_dir = scm_make_smob_type ("directory", 0);
   scm_set_smob_free (scm_tc16_dir, scm_dir_free);
--- libguile/mman.c.orig2017-07-20 17:06:55.0 -0700
+++ libguile/mman.c 2017-10-28 08:12:46.0 -0700
@@ -0,0 +1,165 @@
+#ifdef HAVE_CONFIG_H
+#  include 
+#endif
+
+#ifdef HAVE_SYS_MMAN_H
+#  include 
+#  include 
+#endif
+
+#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
+
+#include "libguile/_scm.h"
+#include "libguile/smob.h"
+#include "libguile/fdes-finalizers.h"
+#include "libguile/feature.h"
+
+SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
+ SCM offset);
+SCM_API SCM scm_munmap (SCM bvec);
+void init_mman(void);
+static void mmap_finalizer (void *ptr, void *data);
+
+
+SCM_DEFINE (scm_mmap, "mmap", 2, 4, 0, 
+(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
+   "mmap addr len [prot [flags [fd [offset"
+   "See the man page.  Returns a bytevector."
+   "ordinarily convert to bytevector using pointer->bytevector.  "
+   "Note that the region returned by mmap is not (?) searched "
+   "by the garbage collector.  Defaults:\n"
+   "  PROT   (logior PROT_READ PROT_WRITE)\n"
+   "  FLAGS  (logior MAP_ANON MAP_PRIVATE)\n"
+   "  FD -1\n"
+   "  OFFSET 0\n"
+   "@example\n(define reg (mmap %null-pointer #x1000)\n"
+   "@end example"
+   )
+#define FUNC_NAME s_scm_mmap
+{
+  void *c_mem, *c_addr;
+  size_t c_len;
+  int c_prot, c_flags, c_fd;
+  scm_t_off c_offset;
+  SCM pointer, bvec;
+
+  if (SCM_POINTER_P (addr))
+c_addr = SCM_POINTER_VALUE (addr);
+  else if (scm_is_integer (addr))
+c_addr = (void*) scm_to_uintptr_t (addr);
+  else
+SCM_MISC_ERROR("bad addr", addr);
+
+  c_len = scm_to_size_t (len);
+  
+  if (SCM_UNBNDP (prot))
+c_prot = PROT_READ | PROT_WRITE;
+  else 
+c_prot = scm_to_int (prot);
+
+  if (SCM_UNBNDP (flags))
+c_flags = MAP_ANON | MAP_PRIVATE;
+  else
+c_flags = scm_to_int (flags);
+
+  if (SCM_UNBNDP (fd))
+c_fd = -1;
+  else
+c_fd = scm_to_int (fd);
+
+  if (SCM_UNBNDP (fd))
+c_offset = 0;
+  else
+c_offset = scm_to_off_t (offset);
+
+  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
+  if (c_mem == MAP_FAILED)
+SCM_SYSERROR;  /* errno set */
+
+  pointer = scm_cell (scm_tc7_pointer, (scm_t_bits) c_mem);
+  bvec = scm_c_take_typed_bytevector((signed char *) c_mem + c_offset, c_len,
+SCM_ARRAY_ELEMENT_TYPE_VU8, pointer);
+  /* if sizeof(void*) < sizeof(size_t) we are in trouble: */
+  scm_i_set_finalizer (SCM2PTR (bvec), mmap_finalizer, (void*) c_len);
+  return bvec;
+}
+static void
+mmap_finalizer (void *ptr, void *data)
+{
+  void *c_addr;
+  intptr_t c_len;
+  int res;
+
+  c_addr = (void *) SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr));
+  c_len = (intptr_t) data;
+  res = munmap(c_addr, c_len);
+  if (res != 0) SCM_SYSERROR;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_munmap, "munmap", 1, 0, 0, 
+(SCM bvec),
+   "See the man page. Given bytevector unmap."
+   )
+#define FUNC_NAME s_scm_munmap
+{
+  void *c_addr;
+  size_t c_len;
+  int c_res;
+
+  SCM_VALIDATE_BYTEVECTOR (1, bvec);
+  
+  c_addr = (void *) SCM_BYTEVECTOR_CONTENTS (bvec);
+  c_len = SCM_BYTEVECTOR_LENGTH (bvec);
+
+  c_res = munmap(c_addr, c_len);
+  if (c_res == -1)
+SCM_SYSERROR;  /* errno set */
+
+  // TODO: clean up bytevector
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+void init_mman(void) {
+#ifdef PROT_NONE
+  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_READ", scm_from_int (PROT_READ));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE));
+#endif
+#ifdef PROT_
+  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC));
+#endif
+
+#ifdef MAP_ANONYMOUS
+  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS));
+#endif
+#ifdef MAP_ANON
+  scm_c_define ("MAP_ANO

bug#29001: tmpnam option

[Matt Wette]

OK I have it working.  Complete patch here, assuming config.h.in is generated 
by your autotools.

--- libguile/posix.c-orig   2017-10-24 05:28:30.0 -0700
+++ libguile/posix.c2017-10-24 05:28:51.0 -0700
@@ -1557,6 +1557,7 @@
 }
 #undef FUNC_NAME
 
+#ifdef ENABLE_TMPNAM
 #ifdef L_tmpnam
 
 SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
@@ -1580,6 +1581,7 @@
 #undef FUNC_NAME
 
 #endif
+#endif
 
 SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
 (void),
--- configure.ac-orig   2017-10-24 05:21:56.0 -0700
+++ configure.ac2017-10-27 09:03:20.0 -0700
@@ -164,6 +164,10 @@
   [  --disable-regex omit regular expression interfaces],,
   enable_regex=yes)
 
+AC_ARG_ENABLE(tmpnam,
+  [  --enable-tmpnam enable POSIX tmpnam],
+  AC_DEFINE(ENABLE_TMPNAM,1,[enable POSIX tmpnam()]),)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))
 

bug#29001: [wishlist] configure option to disable tmpnam

[Matt Wette]

It would be nice to have a configure option to disable/enable including the 
POSIX function tmpnam.
It may give Guile a more "code secure" option to have the default be disabled.

I tried to generate a patch, but I could not get it to work both ways (disable 
and enable).  My autoconf
knowledge and skills are lacking. 

Here is what I tried (THIS DOES NOT WORK)

--- libguile/posix.c-orig   2017-10-24 05:28:30.0 -0700
+++ libguile/posix.c2017-10-24 05:28:51.0 -0700
@@ -1557,6 +1557,7 @@
 }
 #undef FUNC_NAME
 
+#ifdef ENABLE_TMPNAM
 #ifdef L_tmpnam
 
 SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
@@ -1580,6 +1581,7 @@
 #undef FUNC_NAME
 
 #endif
+#endif
 
 SCM_DEFINE (scm_tmpfile, "tmpfile", 0, 0, 0,
 (void),

--- configure.ac-orig   2017-10-24 05:21:56.0 -0700
+++ configure.ac2017-10-25 16:07:34.0 -0700
@@ -164,6 +164,10 @@
   [  --disable-regex omit regular expression interfaces],,
   enable_regex=yes)
 
+AC_ARG_ENABLE(tmpnam,
+  [  --enable-tmpnam enable POSIX tmpnam],
+  enable_tmpnam=yes, enable_tmpnam=no)
+
 AC_ARG_ENABLE([deprecated],
   AS_HELP_STRING([--disable-deprecated],[omit deprecated features]))

^--- DOES NOT WORK
 

bug#27579: System foreign

[Matt Wette]

While we are at it, I need long-long-int and unsigned-long-long-int.  This is 
for my FFI helper, to auto-code FFI code.
(Then my chore is to deal with varargs.)

bug#27782: Acknowledgement ([wishlist] scheme level mmap)

[Matt Wette]

Works on guile-2.2.2:
> (use-modules (system foreign))
> (define raw (mmap %null-pointer #x1000 (logior PROT_READ PROT_WRITE)
 (logior MAP_ANON MAP_PRIVATE) -1 0))
> (munmap raw #x1000)

  
$ diff filesys.c.orig filesys.c
+ #include "mmap.c"
+ 
  void
  scm_init_filesys ()
  {
+   MMAP_DEFS;
  #ifdef HAVE_POSIX
scm_tc16_dir = scm_make_smob_type ("directory", 0);
scm_set_smob_free (scm_tc16_dir, scm_dir_free);


mmap.c-post2: 

#ifdef HAVE_CONFIG_H
#  include 
#endif

#ifdef HAVE_SYS_MMAN_H
#  include 
#  include 
#endif

#include "libguile/_scm.h"
#include "libguile/smob.h"
#include "libguile/fdes-finalizers.h"
#include "libguile/feature.h"

SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
  SCM offset);
SCM_API SCM scm_munmap (SCM addr, SCM len);

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
// python mmap makes the last four args optional
// should use fd=-1 default on mac
// The following works:
// > (use-modules (system foreign))
// > (define raw (mmap %null-pointer #x1000 (logior PROT_READ PROT_WRITE)
//  (logior MAP_ANON MAP_PRIVATE) -1 0))
// > (munmap raw #x1000)
SCM_DEFINE (scm_mmap, "mmap", 6, 0, 0, 
(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
"See the man page. returns a foreign pointer which one would"
"ordinarily convert to bytevector using pointer->bytevector.  "
"Note that the region returned by mmap is not (?) searched "
"by the garbage collector."
"@example\n(define reg\n (pointer->bytevector\n  "
"(mmap %null-pointer #x1 (logior PROT_READ PROT_WRITE) "
"(logior MAP_ANON MAP_PRIVATE) -1 0) #x1000))"
"@end example"
)
#define FUNC_NAME s_scm_mmap
{
  void *c_mem, *c_addr;
  size_t c_len;
  int c_prot, c_flags, c_fd;
  scm_t_off c_offset;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);
  c_prot = scm_to_int (prot);
  c_flags = scm_to_int (flags);
  c_fd = scm_to_int (fd);
  c_offset = SCM_UNBNDP (offset) ? 0: scm_to_off_t (offset);

  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);
  if (c_mem == MAP_FAILED)
SCM_SYSERROR; /* errno set */
  else 
return scm_from_pointer (c_mem, NULL);
}

#undef FUNC_NAME
SCM_DEFINE (scm_munmap, "munmap", 2, 0, 0, 
(SCM addr, SCM len),
"See the man page. Given foreign pointer unmap."
)
#define FUNC_NAME s_scm_munmap
{
  void *c_addr;
  size_t c_len;
  int c_res;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);

  c_res = munmap(c_addr, c_len);
  if (c_res == -1)
SCM_SYSERROR; /* errno set */
  else
return scm_from_int (c_res);
}
#endif /* HAVE_SYS_MMAN_H */

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)

#define MMAP_DEFS   \
  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE)); \
  scm_c_define ("PROT_READ", scm_from_int (PROT_READ)); \
  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE)); \
  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC)); \
  \
  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS)); \
  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON)); \
  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE)); \
  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED)); \
  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE)); \
  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE)); \
  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED)); \
  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE))

#else
#define MMAP_DEFS /* */
#endif /* HAVE_SYS_MMAN_H */

bug#27782: [wishlist] scheme level mmap

[Matt Wette]

There was an implicit request on the user-guile mailing list (20 Jul 2017) to 
provide a scheme language call to mmap.

I am working on a prototype and will post when I get a simple case working.  
Here is non-working code so far:


Currently I have this in a file “mmap.c” and #including into filesys.c.


#ifdef HAVE_CONFIG_H
#  include 
#endif

#ifdef HAVE_SYS_MMAN_H
#  include 
#endif

#include "libguile/_scm.h"
#include "libguile/smob.h"
#include "libguile/fdes-finalizers.h"
#include "libguile/feature.h"

SCM_API SCM scm_mmap (SCM addr, SCM len, SCM prot, SCM flags, SCM fd,
  SCM offset);
SCM_API SCM scm_munmap (SCM addr, SCM len);

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)
// python mmap makes the last four args optional
// should use fd=-1 default on mac
SCM_DEFINE (scm_mmap, "mmap", 6, 0, 0, 
(SCM addr, SCM len, SCM prot, SCM flags, SCM fd, SCM offset),
"See the man page. returns a foreign pointer which one would"
"ordinarily convert to bytevector using pointer->bytevector.  "
"Note that the region returned by mmap is not (?) searched "
"by the garbage collector."
"@example\n(define reg\n (pointer->bytevector\n  "
"(mmap %void-pointer #x1 (logior PROT_READ PROT_WRITE) "
"MAP_ANON -1 0) #x1000))"
"@end example"
)
#define FUNC_NAME s_scm_mmap
{
  void *c_mem, *c_addr;
  size_t c_len;
  int c_prot, c_flags, c_fd;
  scm_t_off c_offset;
  SCM ret;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);
  c_prot = scm_to_int (prot);
  c_flags = scm_to_int (flags);
  c_fd = scm_to_int (fd);
  c_offset = SCM_UNBNDP (offset) ? 0: scm_to_off_t (offset);
  
  c_mem = mmap(c_addr, c_len, c_prot, c_flags, c_fd, c_offset);

  ret = scm_from_pointer (c_mem, NULL);
  return ret;
}

#undef FUNC_NAME
SCM_DEFINE (scm_munmap, "munmap", 2, 0, 0, 
(SCM addr, SCM len),
"See the man page. Given foreign pointer unmap."
)
#define FUNC_NAME s_scm_munmap
{
  void *c_addr;
  size_t c_len;
  int c_res;
  SCM res;

  SCM_VALIDATE_POINTER (1, addr);
  
  c_addr = (void *) SCM_POINTER_VALUE (addr);
  c_len = scm_to_size_t (len);

  c_res = munmap(c_addr, c_len);
  res = scm_from_int (c_res);
  return res;
}
#endif /* HAVE_SYS_MMAN_H */

#if defined(HAVE_SYS_MMAN_H) && defined(HAVE_MAP_ANONYMOUS)

#define MMAP_DEFS   \
  scm_c_define ("PROT_NONE", scm_from_int (PROT_NONE)); \
  scm_c_define ("PROT_READ", scm_from_int (PROT_READ)); \
  scm_c_define ("PROT_WRITE", scm_from_int (PROT_WRITE)); \
  scm_c_define ("PROT_EXEC", scm_from_int (PROT_EXEC)); \
  \
  scm_c_define ("MAP_ANONYMOUS", scm_from_int (MAP_ANONYMOUS)); \
  scm_c_define ("MAP_ANON", scm_from_int (MAP_ANON)); \
  scm_c_define ("MAP_FILE", scm_from_int (MAP_FILE)); \
  scm_c_define ("MAP_FIXED", scm_from_int (MAP_FIXED)); \
  scm_c_define ("MAP_HASSEMAPHORE", scm_from_int (MAP_HASSEMAPHORE)); \
  scm_c_define ("MAP_PRIVATE", scm_from_int (MAP_PRIVATE)); \
  scm_c_define ("MAP_SHARED", scm_from_int (MAP_SHARED)); \
  scm_c_define ("MAP_NOCACHE", scm_from_int (MAP_NOCACHE))

#else
#define MMAP_DEFS /* */
#endif /* HAVE_SYS_MMAN_H */

bug#27579: intptr_t and uintptr_t

[Matt Wette]

I found the issue.   I called the symbol intptr_t in foreign.c and intptr in 
foreign.scm

Now both use intptr_t and uintptr_t, with patch below.

Matt

--- libguile/foreign.c-orig 2017-07-04 15:57:55.0 -0700
+++ libguile/foreign.c  2017-07-04 16:02:45.0 -0700
@@ -56,6 +56,8 @@
 SCM_SYMBOL (sym_size_t, "size_t");
 SCM_SYMBOL (sym_ssize_t, "ssize_t");
 SCM_SYMBOL (sym_ptrdiff_t, "ptrdiff_t");
+SCM_SYMBOL (sym_intptr_t, "intptr_t");
+SCM_SYMBOL (sym_uintptr_t, "uintptr_t");
 
 /* that's for pointers, you know. */
 SCM_SYMBOL (sym_asterisk, "*");
@@ -1248,6 +1250,26 @@
 #endif
  );
 
+  scm_define (sym_intptr_t,
+#if SCM_SIZEOF_INTPTR_T == 8
+ scm_from_uint8 (SCM_FOREIGN_TYPE_INT64)
+#elif SCM_SIZEOF_INTPTR_T == 4
+ scm_from_uint8 (SCM_FOREIGN_TYPE_INT32)
+#else
+# error unsupported sizeof (scm_t_intptr)
+#endif
+ );
+
+  scm_define (sym_uintptr_t,
+#if SCM_SIZEOF_UINTPTR_T == 8
+ scm_from_uint8 (SCM_FOREIGN_TYPE_UINT64)
+#elif SCM_SIZEOF_UINTPTR_T == 4
+ scm_from_uint8 (SCM_FOREIGN_TYPE_UINT32)
+#else
+# error unsupported sizeof (scm_t_uintptr)
+#endif
+ );
+
   null_pointer = scm_cell (scm_tc7_pointer, 0);
   scm_define (sym_null, null_pointer);
 }
--- module/system/foreign.scm-orig  2017-07-04 16:06:15.0 -0700
+++ module/system/foreign.scm   2017-07-04 16:44:27.0 -0700
@@ -30,6 +30,7 @@
 uint16 int16
 uint32 int32
 uint64 int64
+intptr_t uintptr_t
 
 sizeof alignof
 

bug#27579: Intptr and uintptr

[Matt Wette]

I sent this patch prematurely.  The symbol intptr is not visible at the 
interpreter prompt via (use-modules (system foreign)). — Matt

bug#27579: [patch] add intptr uintptr to (system foreign)

[Matt Wette]

I submit this patch for adding intptr and uintptr to (system foreign).
This is with reference to guile-2.2.2 and changes libguile/foreign.c and 
module/system/foreign.scm.
After application, I was albe to get guile-2.2.2 to complete “make” and “make 
check”. 
No specific tests for this patch have been performed.

Rationale: I am working on a FFI helper which uses scheme-bytestructure (see 
GitHub.com) and that package includes these types.

Matt

--- libguile/foreign.c-orig 2017-07-04 15:57:55.0 -0700
+++ libguile/foreign.c  2017-07-04 16:02:45.0 -0700
@@ -56,6 +56,8 @@
 SCM_SYMBOL (sym_size_t, "size_t");
 SCM_SYMBOL (sym_ssize_t, "ssize_t");
 SCM_SYMBOL (sym_ptrdiff_t, "ptrdiff_t");
+SCM_SYMBOL (sym_intptr_t, "intptr_t");
+SCM_SYMBOL (sym_uintptr_t, "uintptr_t");
 
 /* that's for pointers, you know. */
 SCM_SYMBOL (sym_asterisk, "*");
@@ -1248,6 +1250,26 @@
 #endif
  );
 
+  scm_define (sym_intptr_t,
+#if SCM_SIZEOF_INTPTR_T == 8
+ scm_from_uint8 (SCM_FOREIGN_TYPE_INT64)
+#elif SCM_SIZEOF_INTPTR_T == 4
+ scm_from_uint8 (SCM_FOREIGN_TYPE_INT32)
+#else
+# error unsupported sizeof (scm_t_intptr)
+#endif
+ );
+
+  scm_define (sym_uintptr_t,
+#if SCM_SIZEOF_UINTPTR_T == 8
+ scm_from_uint8 (SCM_FOREIGN_TYPE_UINT64)
+#elif SCM_SIZEOF_UINTPTR_T == 4
+ scm_from_uint8 (SCM_FOREIGN_TYPE_UINT32)
+#else
+# error unsupported sizeof (scm_t_uintptr)
+#endif
+ );
+
   null_pointer = scm_cell (scm_tc7_pointer, 0);
   scm_define (sym_null, null_pointer);
 }
--- module/system/foreign.scm-orig  2017-07-04 16:06:15.0 -0700
+++ module/system/foreign.scm   2017-07-04 16:06:51.0 -0700
@@ -30,6 +30,7 @@
 uint16 int16
 uint32 int32
 uint64 int64
+intptr uintptr
 
 sizeof alignof
 

bug#27209: [minor] documentation of tree-il/lambda-case

[Matt Wette]

In the documentation on lambda-case under Tree-IL there is a paragraph starting 
with “kw is a list of the form …”.  

The paragraph does not specify what to use if there are no keywords.  I believe 
in this case the argument should be #f.

bug#25324: Make check fails on FreeBSD 11.0

[Matt Wette]

“make check” works for guile 2.2.2 on FreeBSD 11.0.

bug#26183: patch for guile-2.2.0 on FreeBSD 11.0

[Matt Wette]

> On Apr 19, 2017, at 7:20 AM, Andy Wingo <wi...@igalia.com> wrote:
> 
> On Mon 20 Mar 2017 02:39, Matt Wette <matt.we...@gmail.com> writes:
> 
>> Attached is a patch to apply to guile-2.2.0 to compile on FreeBSD 11.0
>> Changes
>> 1) updated README to indicate which extra FreeBSD packages need to be 
>> installed
>> 2) minor change to configure.ac (implies autoconf needs to run) to use 
>> bdw-gc-threaded instead of bdw-gc
>> With this, I had successful configure, gmake, and gmake check.
> 
> Applied with some adaptations.  Please see git master and test.  Thanks!
> 
> Andy

Attached is patch file with suggested changes: the README was not quite 
correct, and “pkg install texinfo” also required.

Matt



README.diff
Description: Binary data

bug#26183: patch for guile-2.2.0 on FreeBSD 11.0

[Matt Wette]

Attached is a patch to apply to guile-2.2.0 to compile on FreeBSD 11.0
Changes
1) updated README to indicate which extra FreeBSD packages need to be installed
2) minor change to configure.ac (implies autoconf needs to run) to use 
bdw-gc-threaded instead of bdw-gc
With this, I had successful configure, gmake, and gmake check.


freebsd.patch
Description: Binary data

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

This should be closed. — Matt

bug#22601: guile.texi section on ice-9 match

[Matt Wette]

Patch for guile-2.2.0, wrt doc/ref/match.texi, is attached.



match.texi.patch
Description: Binary data

bug#25509: FreeBSD 11.0

[Matt Wette]

HI saffron,

I have been able to get guile-2.1.8 to build on FreeBSD 11.0.

I had to “pkg install” : pkgconf, gmake, boehm-gc-threaded

Then to work around following config issue, I “pkg install autotools”
Edit autoconf.ac and find “bdw-gc”, change to “bdw-gc-threaded”
PKG_CHECK_MODULES([BDW_GC], [bdw-gc-threaded >= 7.2])

Then run autoconf, then ./configure —prefix=/usr/local, then gmake (make did 
not work for me), but takes hours.

Then “make check”.  

Matt

bug#22901: drain-input doesn't decode

[Matt Wette]

> On Feb 26, 2017, at 9:46 AM, Matt Wette <matt.we...@gmail.com> wrote:
> 
> I put together a test and tried on 2.1.7 - my test fails.  See attached.
> 
>  (pass-if "encoded input"
>(let ((fn (test-file))
> (nc "utf-8")
> (st "\u03b2\u03b1\u03b4 \u03b1\u03c3\u03c3 am I.")
> ;;(st "hello, world\n")
> )
>  (let ((p1 (open-output-file fn #:encoding nc)))
>   ;;(display st p1)
>   (string-for-each (lambda (ch) (write-char ch p1)) st)
>   (close p1))
>  (let* ((p0 (open-input-file fn #:encoding nc))
>(s0 (begin (unread-char (read-char p0) p0) (drain-input p0
>   (simple-format #t "~S\n" s0)
>   (equal? s0 st
> 

My bad.  The failure was on guile-2.0.13.  It seems to work on guile-2.1.7:

mwette$ guile-2.1.7-dev3/meta/guile port-di.test
"βαδ ασσ am I."
PASS: drain-input: encoded input

bug#22901: drain-input doesn't decode

[Matt Wette]

I put together a test and tried on 2.1.7 - my test fails.  See attached.

  (pass-if "encoded input"
(let ((fn (test-file))
  (nc "utf-8")
  (st "\u03b2\u03b1\u03b4 \u03b1\u03c3\u03c3 am I.")
  ;;(st "hello, world\n")
  )
  (let ((p1 (open-output-file fn #:encoding nc)))
;;(display st p1)
(string-for-each (lambda (ch) (write-char ch p1)) st)
(close p1))
  (let* ((p0 (open-input-file fn #:encoding nc))
 (s0 (begin (unread-char (read-char p0) p0) (drain-input p0
(simple-format #t "~S\n" s0)
(equal? s0 st



port-di.test
Description: Binary data

bug#25872: [minor] SXML Transform section in ref-man does not mention `(sxml transform)'

[Matt Wette]

This is a minor nit.  The reference manual does not direct user to do 
`(use-modules (sxml transform))'

The following patch is wrt guile-2.1.7/doc/ref/sxml.texi

--- sxml.texi.orig  2017-02-25 06:33:38.0 -0800
+++ sxml.texi   2017-02-25 06:36:00.0 -0800
@@ -457,6 +457,8 @@
 @node Transforming SXML
 @subsection Transforming SXML
 @subsubsection Overview
+@code{(sxml transform)} defines a number of procedures for transforming
+SXML, analogous to using XSL for XML.
 @heading SXML expression tree transformers
 @subheading Pre-Post-order traversal of a tree and creation of a new tree
 @smallexample 

bug#25822: ref manual typo in "Shifts, Resets and All That"

[Matt Wette]

So I was reading on prompts and came across this sentence in the section 
entitled “Shifts, Reset and All That”:

The default handler accepts a procedure of one argument, which will called on 
the captured continuation, within a prompt. 

Something appears to be missing text or something; I have no clue what.  This 
remains in 2.1.7.

bug#25791: atomics on macOS

[Matt Wette]

I saw this too and gave up trying to fix it.  I think this needs to be worked 
bottom up: I believe the C99 standard is specific about the type qualifier 
_Atomic being present for the first argument.  The workaround for now IMO, is 
to change atomics-internal.h from this:

#ifdef HAVE_STDATOMIC_H

to this:

#if (defined HAVE_STDATOMIC_H) && (!defined __clang__)

By the way, gcc is forgiving here.

Matt

bug#25790: guile-2.1.7 SOCK_CLOEXEC etc

[Matt Wette]

I see the same problem on Mac OS.

If the following appeared in a header somewhere CLOEXEC would work:
#define SOCK_CLOEXEC FD_CLOEXEC
It would work.  Note the implementation in lib/accept4.c:
#ifndef SOCK_CLOEXEC
#define SOCK_CLOEXEC 0
#endif
Then later the flags to accept4 have SOCK_CLOEXEC set, then the call to fcntl 
includes FD_CLOEXEC. 
So any system that defines FD_CLOEXEC should be able to use SOCK_CLOEXEC.  But 
it needs to be defined.

I assume if a system supports O_NONBLOCK then something could be done with 
SOCK_NONBLOCK also.

I was going to submit a patch that is the same, except that I removed the text 
“No ifdef as accept4 has a gnulib implementation.”

Matt

bug#25785: scm_c_make_polar broken

[Matt Wette]

So, I may have missed the update for config.h.in.   I am not sure this gets 
autogenerated or not.

--- config.h.in.orig2017-02-18 13:27:19.0 -0800
+++ config.h.in 2017-02-18 13:27:45.0 -0800
@@ -2183,6 +2183,9 @@
 /* Define to 1 if you have the `sincos' function. */
 #undef HAVE_SINCOS
 
+/* Define to 1 if you have the `__sincos' function. */
+#undef HAVE___SINCOS
+
 /* Define to 1 if you have the `snprintf' function. */
 #undef HAVE_SNPRINTF
 

bug#25786: [PATCH] use of abs() in numbers.c: should be labs()

[Matt Wette]

In libguile/numbers.c abs() is used for long argument where labs() should be 
used.  
A patch is included below for guile-2.1.7.

/* Returns log(n/d), for exact non-zero integers n and d */
static SCM
log_of_fraction (SCM n, SCM d)
{
  long n_size = scm_to_long (scm_integer_length (n));
  long d_size = scm_to_long (scm_integer_length (d));

  if (abs (n_size - d_size) > 1)
return (scm_difference (log_of_exact_integer (n),
log_of_exact_integer (d)));


--- libguile/numbers.c.orig 2017-02-18 08:29:52.0 -0800
+++ libguile/numbers.c  2017-02-18 08:30:23.0 -0800
@@ -9951,7 +9951,7 @@
   long n_size = scm_to_long (scm_integer_length (n));
   long d_size = scm_to_long (scm_integer_length (d));
 
-  if (abs (n_size - d_size) > 1)
+  if (labs (n_size - d_size) > 1)
 return (scm_difference (log_of_exact_integer (n),
log_of_exact_integer (d)));
   else if (scm_is_false (scm_negative_p (n)))

bug#25785: scm_c_make_polar broken on APPLE

[Matt Wette]

numbers.c:scm_c_make_polar in guile-2.1.7 breaks on APPLE (macOS 10.12).Reason: APPLE does not have sincos(), and gcc will optimize sin/cos to use cexp(), and cexp() does not preserve sign of zero.Patch includes (and attached) for guile-2.1.7.  This uses macOS __sincos().Example:In scm_c_make_polar, “gcc -O2”  turns sin(), cos() into cexp(), since cexp(i*x) = cos(x) + i*sin(x):gcc -O0 =>LM4339:	movq	-32(%rbp), %rax	movd	%rax, %xmm0	call	_sin	movd	%xmm0, %rax	movq	%rax, -8(%rbp)LM4340:	movq	-32(%rbp), %rax	movd	%rax, %xmm0	call	_cos	movd	%xmm0, %rax	movq	%rax, -16(%rbp)gcc -O2 =>	pxor	%xmm0, %xmm0LVL2703:	call	_cexpI wrote a little C program to show that cexp() does not preserve the zero-signed-ness: cos,sin: +1.00 -0.00__sincos: +1.00 -0.00    cexp: +1.00 +0.00The scm_c_make_polar will use sincos() if available, but macOS does not have sincos(), it has __sincos().#include #include #include #include extern double z, p, n;int main() {  double complex c;  double d, sine, cosine;  d = z*n;  printf(" cos,sin: %+f %+f\n", cos(d), sin(d));  __sincos(d, , );  printf("__sincos: %+f %+f\n", cosine, sine);  c = cexp(CMPLX(0.0, d));  printf("    cexp: %+f %+f\n", creal(c), cimag(c));}double z = 0.0, p = +1.0, n = -1.0;--- configure.ac.orig	2017-02-18 08:35:06.0 -0800+++ configure.ac	2017-02-18 08:35:26.0 -0800@@ -1152,8 +1152,9 @@ #   asinh, acosh, atanh, trunc - C99 standard, generally not available on #                                older systems #   sincos - GLIBC extension+#   __sincos - APPLE extension #-AC_CHECK_FUNCS(asinh acosh atanh copysign finite sincos trunc)+AC_CHECK_FUNCS(asinh acosh atanh copysign finite sincos __sincos trunc)  # C99 specifies isinf and isnan as macros. # HP-UX provides only macros, no functions.--- libguile/numbers.c.patch.labs	2017-02-18 08:31:21.0 -0800+++ libguile/numbers.c	2017-02-18 08:34:18.0 -0800@@ -9109,6 +9109,8 @@      details.  */ #if (defined HAVE_SINCOS) && (defined __GLIBC__) && (defined _GNU_SOURCE)   sincos (ang, , );+#elif (defined HAVE___SINCOS)+  __sincos (ang, , ); #else   s = sin (ang);   c = cos (ang);

sincos.patch
Description: Binary data

bug#24677: Failure in automatic tests for guile 2.0.13

[Matt Wette]

This may be related to the following, in which I have posted some fixes:

https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24862 

bug#24677: Failure in automatic tests for guile 2.0.13

[Matt Wette]

I did a make check, Mac OS Sierra, and saw it crash too.  

$ cd test-suite/lalr
$ ../../meta/guile 
...
scheme@(guile-user)> (load "test-lr-basics-01.scm")
ERROR: In procedure #:
ERROR: Wrong type to apply: #

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> 


modules/system/base/lalr.upstream.scm contains the following:

(define-record-type lexical-token
  (make-lexical-token category source value)
  lexical-token?
  (category lexical-token-category)
  (source   lexical-token-source)
  (valuelexical-token-value))

bug#24884: Segfault on (mkstemp! "XX" 0)

[Matt Wette]

Please check 24862, which includes a patch: 
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=24862 


The issue is that (at least on Mac OS 10.12) mkstemp will only accept specific 
flags.

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

Here is a patch that gets mine working.  Not sure it solves all the Sierra 
issues.

*** libguile/filesys.c-orig 2016-11-05 07:49:09.0 -0700
--- libguile/filesys.c  2016-11-10 05:38:53.0 -0800
***
*** 1486,1491 
--- 1486,1494 
mode_bits = scm_i_mode_bits (mode);
  }
  
+ #ifdef __APPLE__
+   open_flags &= O_APPEND|O_SHLOCK|O_EXLOCK|O_CLOEXEC;
+ #endif
SCM_SYSCALL (rv = mkostemp (c_tmpl, open_flags));
if (rv == -1)
  SCM_SYSERROR;

The man page for mkstemp says the following:

 The mkostemp() function is like mkstemp() but allows specifying addi-
 tional open(2) flags (defined in ).  The permitted flags are
 O_APPEND, O_SHLOCK, O_EXLOCK and O_CLOEXEC.


Note that macports includes another patch for Sierra:

--- libguile/stime.c
+++ libguile/stime.c
@@ -834,6 +834,10 @@ scm_init_stime()
 
 #ifdef HAVE_POSIX_CPUTIME
   {
+#ifdef __APPLE__
+if (clock_gettime (CLOCK_PROCESS_CPUTIME_ID, _run_time_base) == 0)
+  get_internal_run_time = get_internal_run_time_posix_timer;
+#else
 clockid_t dummy;
 
 /* Only use the _POSIX_CPUTIME clock if it's going to work across
@@ -843,6 +847,7 @@ scm_init_stime()
   get_internal_run_time = get_internal_run_time_posix_timer;
 else
   errno = 0;
+#endif
   }
 #endif /* HAVE_POSIX_CPUTIME */
 #endif /* HAVE_CLOCKTIME */

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

(lldb) n
Process 85754 stopped
* thread #1: tid = 0xe66f2, 0x00010002c03f 
guile`scm_i_mkstemp(tmpl=0x000104cd09a0, mode=0x000100ea34c0) + 238 at 
filesys.c:1490, queue = 'com.apple.main-thread', stop reason = step over
frame #0: 0x00010002c03f guile`scm_i_mkstemp(tmpl=0x000104cd09a0, 
mode=0x000100ea34c0) + 238 at filesys.c:1490
   1487 }
   1488 
   1489   SCM_SYSCALL (rv = mkostemp (c_tmpl, open_flags));
-> 1490   if (rv == -1)
   1491 SCM_SYSERROR;
   1492 
   1493   scm_substring_move_x (scm_from_locale_string (c_tmpl),
(lldb) p rv
(int) $8 = -1
(lldb) 

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

Fixed:

mwette$ time build-env guild compile --target="x86_64-apple-darwin16.1.0" 
-Wunbound-variable -Warity-mismatch -Wformat  -L "$DIR/module" -L 
"$DIR/guile-readline"  -o "ice-9/eval.go" "ice-9/eval.scm" 
wrote `ice-9/eval.go'

real0m0.484s
user0m0.358s
sys 0m0.049s

mwette$ echo $DIR
/Users/mwette/proj/scheme/guile/guile-2.0.12

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

Now I see this is broken.  I don’ t know why 2.0.13 is showing up :( UGH.

> On Nov 7, 2016, at 6:21 PM, Matt Wette <mwe...@alumni.caltech.edu> wrote:
> 
> Using the same process as above I get the following on guile-2.0.12:
> 
> mwette$ time build-env guild compile --target="x86_64-apple-darwin16.1.0" 
> -Wunbound-variable -Warity-mismatch -Wformat  -L 
> "/Users/mwette/proj/scheme/guile/guile-2.0.13/module" -L 
> /Users/mwette/proj/scheme/guile/guile-2.0.13/module/  -L 
> /Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readline/  -o 
> "ice-9/eval.go" "ice-9/eval.scm" 
> wrote `ice-9/eval.go'
> 
> real  0m0.484s
> user  0m0.357s
> sys   0m0.051s
> 
> 
> 
> Also, the “env DYLD… echo $DYLD…” demo above is clearly broken.  But I have 
> verified that DYLD_LIBRARY_PATH is filters out of env copy in the shell.
> 
> 

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

Using the same process as above I get the following on guile-2.0.12:

mwette$ time build-env guild compile --target="x86_64-apple-darwin16.1.0" 
-Wunbound-variable -Warity-mismatch -Wformat  -L 
"/Users/mwette/proj/scheme/guile/guile-2.0.13/module" -L 
/Users/mwette/proj/scheme/guile/guile-2.0.13/module/  -L 
/Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readline/  -o 
"ice-9/eval.go" "ice-9/eval.scm" 
wrote `ice-9/eval.go'

real0m0.484s
user0m0.357s
sys 0m0.051s



Also, the “env DYLD… echo $DYLD…” demo above is clearly broken.  But I have 
verified that DYLD_LIBRARY_PATH is filters out of env copy in the shell.

bug#24862: guile 2.0.13 build error under macOS 10.12 Sierra

[Matt Wette]

I am trying to work this.   I have a MacBook Pro running Sierra (Mac OS 10.12.1).  I have macports installed, and was able to get guile 2.0.12 installed in the macports tree (/opt/local) using a custom macports file.Note: Sierra seems to have issues running gdb.  Apparently the SIP needs to be turned off.  Instead I have been using the Xcode lldb debugger.Note: Sierra has an issue with DYLD_LIBRARY_PATH.  Namely, it will not copy that env variable to sub-shells:mwette$ export DYLD_LIBRARY_PATH=abcmwette$ DYLD_LIBRARY_PATH=def echo $DYLD_LIBRARY_PATHabcI downloaded guile-2.0.13 and applied the macports sierra.patch (attached).  I usedCC=gcc-mp-6 CFLAGS=-g LDFLAGS=-g ./configure --prefix=/opt/local --enable-guile-debug --disable-sharedBuild when trying to compile eval.scm => eval.go.  I set up the associated environment in my shell and found that executing in build-env or not makes a difference.  mwette$ env | grep GUILEGUILE=/Users/mwette/proj/scheme/guile/guile-2.0.13/libguile/guileGUILE_LOAD_PATH=/Users/mwette/proj/scheme/guile/guile-2.0.13/module:/Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readline:/Users/mwette/proj/scheme/guile/guile-2.0.13GUILE_LOAD_COMPILED_PATH=/Users/mwette/proj/scheme/guile/guile-2.0.13/module:/Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readlineGUILE_WARN_DEPRECATED=detailedGUILE_INSTALL_LOCALE=1GUILE_SYSTEM_PATH=GUILE_AUTO_COMPILE=0GUILE_SYSTEM_EXTENSIONS_PATH=Within build-env it takes 12 seconds to crash.  Without build-env it returns immediately.  I don’t know if that means it is working or not: it does create a eval.go file.mwette$ time build-env guild compile --target="x86_64-apple-darwin16.1.0" -Wunbound-variable -Warity-mismatch -Wformat  -L "/Users/mwette/proj/scheme/guile/guile-2.0.13/module" -L /Users/mwette/proj/scheme/guile/guile-2.0.13/module/  -L /Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readline/  -o "ice-9/eval.go" "ice-9/eval.scm" Backtrace:In unknown file:   ?: 3 [apply-smob/1 # #t ...]   ?: 2 [apply-smob/1 #]   ?: 1 [primitive-eval ((@ # %) (begin # # #))]   ?: 0 [mkstemp! "ice-9/eval.go.XX" "wb"]ERROR: real	0m12.227suser	0m12.598ssys	0m0.098smwette$ time guild compile --target="x86_64-apple-darwin16.1.0" -Wunbound-variable -Warity-mismatch -Wformat  -L "/Users/mwette/proj/scheme/guile/guile-2.0.13/module" -L /Users/mwette/proj/scheme/guile/guile-2.0.13/module/  -L /Users/mwette/proj/scheme/guile/guile-2.0.13/guile-readline/  -o "ice-9/eval.go" "ice-9/eval.scm" ;;; note: source file /Users/mwette/proj/scheme/guile/guile-2.0.13/module/system/base/target.scm;;;       newer than compiled /opt/local/lib/guile/2.0/ccache/system/base/target.gowrote `ice-9/eval.go'real	0m0.420suser	0m0.353ssys	0m0.036s

sierra.patch
Description: Binary data

bug#23349: Compile output shall be error output

[Matt Wette]

And I believe this works as asked.  Below I execute the same “load” three times 
under guile, under bash: first two w/o “2>/dev/null”, and the third time with 
“2>/dev/null” .  For the fourth time, I use “2>/dev/null -s ,update” to process 
as script (and skip the banner).

mwette$ guile
GNU Guile 2.0.11
Copyright (C) 1995-2014 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (load ",update") 
;;; note: source file 
/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm
;;;   newer than compiled 
/Users/mwette/.cache/guile/ccache/2.0-LE-8-2.0/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm
;;; compiled 
/Users/mwette/.cache/guile/ccache/2.0-LE-8-2.0/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm.go
$1 = 0
scheme@(guile-user)> ^D

mwette$ guile 
GNU Guile 2.0.11
Copyright (C) 1995-2014 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (load ",update")
;;; note: source file 
/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm
;;;   newer than compiled 
/Users/mwette/.cache/guile/ccache/2.0-LE-8-2.0/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm.go
;;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0
;;;   or pass the --no-auto-compile argument to disable.
;;; compiling /Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm
;;; compiled 
/Users/mwette/.cache/guile/ccache/2.0-LE-8-2.0/Users/mwette/repo/sv/nyacc.git/module/nyacc/lang/c99/cpp.scm.go
$1 = 0
scheme@(guile-user)> ^D

mwette$ guile 2>/dev/null
GNU Guile 2.0.11
Copyright (C) 1995-2014 Free Software Foundation, Inc.

Guile comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
This program is free software, and you are welcome to redistribute it
under certain conditions; type `,show c' for details.

Enter `,help' for help.
scheme@(guile-user)> (load ",update")
$1 = 0
scheme@(guile-user)> ^D

mwette$ guile 2>/dev/null -s ,update

mwette$ 

bug#23349: Compile output shall be error output

[Matt Wette]

This issue is very similar to that in #16364.

bug#17953: guile 2.0.11 on mavericks

[Matt Wette]

I can verify that macports now provides a working port of guile-2.0.11.

bug#21698: accessing multiple flagged values with (ice-9 getopt-long)

[Matt Wette]

Thanks for the pointer.  I can work with SRFI-37.  I am OK w/ rejection of the 
patch.  — Matt

> On Jun 24, 2016, at 7:53 AM, Andy Wingo <wi...@pobox.com> wrote:
> 
> Hi Matt,
> 
> Thanks for the patch.  My instinct however is to point you towards
> SRFI-37, which in addition to supporting multiple argument values can
> also be used to fold over the precise argument order.  I just don't know
> that we should be expanding (ice-9 getopt-long); it has its use case and
> if your needs go beyond it, then probably your needs go way beyond it.
> 
>  https://www.gnu.org/software/guile/manual/html_node/SRFI_002d37.html
> 
> Ludovic, second opinions?
> 
> Andy
> 
> On Sat 17 Oct 2015 19:05, Matt Wette <matthew.we...@verizon.net> writes:
> 
>> This is in reference to guile-2.0.11.
>> 
>> The (ice-9 getopt-long) module does not provide a process for
>> accessing multiple command line arguments.
>> 
>> A patch for ice-9/getopt-long.scm is attached which adds the procedure
>> getopt-ref/many to access multiple argument values.
>> 
>> The following program and results illustrate the use of the current
>> getopt-ref and the proposed getopt-ref/many:
>> 
>> mwette$ ./gotest.scm -f foo1 -b bar1 -f foo2 baz1 baz2
>> 
>> program arguments:
>> 
>> ("./gotest.scm" "-f" "foo1" "-b" "bar1" "-f" "foo2" "baz1" "baz2")
>> 
>> getopt using option-ref:
>> 
>> foo: "foo2"
>> 
>> bar: "bar1"
>> 
>> getopt using option-ref/many:
>> 
>> foo: ("foo1" "foo2")
>> 
>> bar: "bar1"
>> 
>> where
>> 
>> mwette$ cat gotest.scm 
>> 
>> #!/opt/local/bin/guile
>> 
>> !#
>> 
>> (use-modules (ice-9 getopt-long))
>> 
>> (define spec
>> 
>> '((foo (single-char #\f) (value #t))
>> 
>> (bar (single-char #\b) (value #t
>> 
>> (let* ((args (program-arguments))
>> 
>> (opts (getopt-long args spec)))
>> 
>> (simple-format #t "program arguments:\n")
>> 
>> (simple-format #t "~S\n" args)
>> 
>> (simple-format #t "\ngetopt using option-ref:\n")
>> 
>> (simple-format #t "foo: ~S\n" (option-ref opts 'foo #f))
>> 
>> (simple-format #t "bar: ~S\n" (option-ref opts 'bar #f))
>> 
>> (simple-format #t "\ngetopt using option-ref/many:\n")
>> 
>> (simple-format #t "foo: ~S\n" (option-ref/many opts 'foo #f))
>> 
>> (simple-format #t "bar: ~S\n" (option-ref/many opts 'bar #f))
>> 
>> )
>> 
>> 
>> 
>> *** getopt-long.scm-orig 2015-10-15 06:40:29.0 -0700
>> --- getopt-long.scm  2015-10-17 09:42:41.0 -0700
>> ***
>> *** 154,159 
>> --- 154,173 
>>  ;;; (option-ref (getopt-long ...) 'x-includes 42) => "/usr/include"
>>  ;;; (option-ref (getopt-long ...) 'not-a-key! 31) => 31
>> 
>> + ;;; (option-ref/many OPTIONS KEY DEFAULT)
>> + ;;; Return value in alist OPTIONS using KEY, a symbol; or DEFAULT if not
>> + ;;; found.  If multiple arg-options provided a list is returned.  The value
>> + ;;; is either a string, a list or `#t'.
>> + ;;;
>> + ;;; For example, if the above was executed with multiple x-includes flags,
>> + ;;; then all will be returned in a list:
>> + ;;;
>> + ;;; (getopt-long '("my-prog" "-vk" "/tmp" "foo1" 
>> "--x-includes=/usr/include"
>> + ;;;"--x-includes=/opt/includd" "--" "-fred" "foo2" "foo3")
>> + ;;;grammar)
>> + ;;; (option-ref/many (getopt-long ...) 'x-includes 42)
>> + ;;; => ("/usr/include" "/opt/include")
>> + 
>>  ;;; Code:
>> 
>>  (define-module (ice-9 getopt-long)
>> ***
>> *** 162,168 
>>#:use-module (ice-9 match)
>>#:use-module (ice-9 regex)
>>#:use-module (ice-9 optargs)
>> !   #:export (getopt-long option-ref))
>> 
>>  (define %program-name (make-fluid "guile"))
>>  (define (program-name)
>> --- 176,182 
>>#:use-module (ice-9 match)
>>#:use-module (ice-9 regex)
>>#:use-module (ice-9 optargs)
>> !   #:export (getopt-long option-ref option-ref/many))
>> 
>>  (define %program-name (make-fluid "guile"))
>>  (define (program-name)
>> ***
>> *** 368,371 
>> --- 382,397 
>>  The value is either a string or `#t'."
>>(or (assq-ref options key) default))
>> 
>> + (define (option-ref/many options key default)
>> +   "Return value, or values, in alist OPTIONS using KEY, a symbol; or 
>> DEFAULT if not found.
>> + The value is either a string, a list or `#t'."
>> +   (let loop ((rez #f) (opts options))
>> + (if (null? opts) (or rez default)
>> +(if (eq? key (caar opts))
>> +(cond
>> + ((pair? rez) (loop (cons (cdar opts) res) (cdr opts)))
>> + (rez (loop (list (cdar opts) rez) (cdr opts)))
>> + (else (loop (cdar opts) (cdr opts
>> +(loop rez (cdr opts))
>> + 
>>  ;;; getopt-long.scm ends here

bug#18477: byte-compiled files have wrong permissions

[Matt Wette]

Comment:

Does a fix of this bug imply that permissions on each directory in the trail to 
compiled files should reflect the permissions on the trail to the source file?