[Guile-commits] 01/02: Ignore meta/build-env

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 8e48a58fcb59b9f7938c95a12c28881c5bf31bdd
Author: Andy Wingo 
Date:   Mon Jul 11 23:05:54 2016 +0200

Ignore meta/build-env

* .gitignore: Ignore meta/build-env.
---
 .gitignore |1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index 1bfd328..4d0718c 100644
--- a/.gitignore
+++ b/.gitignore
@@ -164,3 +164,4 @@ INSTALL
 /test-suite/standalone/test-foreign-object-c
 /test-suite/standalone/test-srfi-4
 lib/stddef.h
+/meta/build-env

[Guile-commits] branch stable-2.0 updated (f6dd212 -> 61b8794)

[Andy Wingo]

wingo pushed a change to branch stable-2.0
in repository guile.

  from  f6dd212   Factor start_child out of open_process
   new  8e48a58   Ignore meta/build-env
   new  61b8794   Rename win32-uname.[ch] to posix-w32.[ch]

The 2 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 .gitignore  |1 +
 libguile/Makefile.am|4 ++--
 libguile/{win32-uname.c => posix-w32.c} |2 +-
 libguile/{win32-uname.h => posix-w32.h} |6 +++---
 libguile/posix.c|8 
 5 files changed, 11 insertions(+), 10 deletions(-)
 rename libguile/{win32-uname.c => posix-w32.c} (99%)
 rename libguile/{win32-uname.h => posix-w32.h} (95%)

[Guile-commits] 02/02: Rename win32-uname.[ch] to posix-w32.[ch]

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 61b8794e040f033166901c2fc4c370651f495c2f
Author: Andy Wingo 
Date:   Mon Jul 11 23:15:03 2016 +0200

Rename win32-uname.[ch] to posix-w32.[ch]

* libguile/posix-w32.c:
* libguile/posix-w32.h: Rename from win32-uname.c and win32-uname.h.
* libguile/posix.c:
* libguile/Makefile.am
  (EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES)
  (noinst_HEADERS): Adapt.
---
 libguile/Makefile.am|4 ++--
 libguile/{win32-uname.c => posix-w32.c} |2 +-
 libguile/{win32-uname.h => posix-w32.h} |6 +++---
 libguile/posix.c|8 
 4 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/libguile/Makefile.am b/libguile/Makefile.am
index 4605037..cd85604 100644
--- a/libguile/Makefile.am
+++ b/libguile/Makefile.am
@@ -443,7 +443,7 @@ EXTRA_libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = 
_scm.h\
 dynl.c regex-posix.c   \
 posix.c net_db.c socket.c  \
 debug-malloc.c \
-win32-uname.c  \
+posix-w32.c\
 locale-categories.h
 
 ## delete guile-snarf.awk from the installation bindir, in case it's
@@ -490,7 +490,7 @@ uninstall-hook:
 noinst_HEADERS = conv-integer.i.c conv-uinteger.i.c\
  srfi-14.i.c   \
  quicksort.i.c  \
- win32-uname.h \
+ posix-w32.h   \
 private-gc.h private-options.h ports-internal.h
 
 # vm instructions
diff --git a/libguile/win32-uname.c b/libguile/posix-w32.c
similarity index 99%
rename from libguile/win32-uname.c
rename to libguile/posix-w32.c
index 5349f14..f1251b2 100644
--- a/libguile/win32-uname.c
+++ b/libguile/posix-w32.c
@@ -26,7 +26,7 @@
 #include 
 #include 
 
-#include "win32-uname.h"
+#include "posix-w32.h"
 
 /*
  * Get name and information about current kernel.
diff --git a/libguile/win32-uname.h b/libguile/posix-w32.h
similarity index 95%
rename from libguile/win32-uname.h
rename to libguile/posix-w32.h
index 4b74981..b4c6510 100644
--- a/libguile/win32-uname.h
+++ b/libguile/posix-w32.h
@@ -1,7 +1,7 @@
 /* classes: h_files */
 
-#ifndef SCM_WIN32_UNAME_H
-#define SCM_WIN32_UNAME_H
+#ifndef SCM_POSIX_W32_H
+#define SCM_POSIX_W32_H
 
 /* Copyright (C) 2001, 2006 Free Software Foundation, Inc.
  *
@@ -49,4 +49,4 @@ struct utsname
 
 int uname (struct utsname * uts);
 
-#endif /* SCM_WIN32_UNAME_H */
+#endif /* SCM_POSIX_W32_H */
diff --git a/libguile/posix.c b/libguile/posix.c
index 94489dc..6b4e72e 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -81,6 +81,10 @@
 #include "libguile/threads.h"
 
 
+#ifdef __MINGW32__
+# include "posix-w32.h"
+#endif
+
 #if HAVE_SYS_WAIT_H
 # include 
 #endif
@@ -1426,10 +1430,6 @@ scm_open_process (SCM mode, SCM prog, SCM args)
 #undef FUNC_NAME
 #endif /* HAVE_START_CHILD */
 
-#ifdef __MINGW32__
-# include "win32-uname.h"
-#endif
-
 #if defined (HAVE_UNAME) || defined (__MINGW32__)
 SCM_DEFINE (scm_uname, "uname", 0, 0, 0,
 (),

[Guile-commits] 04/05: More specific status:exit-val et al compilation guards

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 0fb3e82ceef7bef6164ed4703f1a5cd2a9645fae
Author: Andy Wingo 
Date:   Mon Jul 11 22:52:35 2016 +0200

More specific status:exit-val et al compilation guards

* libguile/posix.c (scm_status_exit_val, scm_status_term_sig)
  (scm_status_stop_sig): Guard on WIFEXITED et al macros instead of on
  MinGW.
---
 libguile/posix.c |8 ++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index e3a435e..2f5fd7e 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -718,7 +718,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,
 #undef FUNC_NAME
 #endif /* HAVE_WAITPID */
 
-#ifndef __MINGW32__
+#ifdef WIFEXITED
 SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, 
 (SCM status),
"Return the exit status value, as would be set if a process\n"
@@ -737,7 +737,9 @@ SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0,
 return SCM_BOOL_F;
 }
 #undef FUNC_NAME
+#endif /* WIFEXITED */
 
+#ifdef WIFSIGNALED
 SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0, 
 (SCM status),
"Return the signal number which terminated the process, if any,\n"
@@ -753,7 +755,9 @@ SCM_DEFINE (scm_status_term_sig, "status:term-sig", 1, 0, 0,
 return SCM_BOOL_F;
 }
 #undef FUNC_NAME
+#endif /* WIFSIGNALED */
 
+#ifdef WIFSTOPPED
 SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0, 
 (SCM status),
"Return the signal number which stopped the process, if any,\n"
@@ -769,7 +773,7 @@ SCM_DEFINE (scm_status_stop_sig, "status:stop-sig", 1, 0, 0,
 return SCM_BOOL_F;
 }
 #undef FUNC_NAME
-#endif /* __MINGW32__ */
+#endif /* WIFSTOPPED */
 
 #ifdef HAVE_GETPPID
 SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,

[Guile-commits] 01/05: More robust setuid, setgid, etc detection

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 509c4205baeabb499dba55b9b3df8303f56609fe
Author: Andy Wingo 
Date:   Mon Jul 11 22:14:38 2016 +0200

More robust setuid, setgid, etc detection

* configure.ac: Check for getuid, getgid, setuid, and setgid.
* libguile/posix.c (scm_getuid, scm_getgid, scm_setuid, scm_setgid):
  Only provide Scheme functions if the OS provides these facilities.
  (scm_geteuid, scm_getegid, scm_seteuid, scm_setegid): Provide if the
  host has getuid, getgid, etc, instead of being in a MinGW guard.
---
 configure.ac |4 ++--
 libguile/posix.c |   30 --
 2 files changed, 18 insertions(+), 16 deletions(-)

diff --git a/configure.ac b/configure.ac
index 565fff5..cb61b09 100644
--- a/configure.ac
+++ b/configure.ac
@@ -759,9 +759,9 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
 #
 AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid
\
   fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid   \
-  gettimeofday gmtime_r ioctl lstat mkdir mknod nice   \
+  gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mknod nice \
   readdir_r readdir64_r readlink rename rmdir setegid seteuid  \
-  setlocale setpgid setsid sigaction siginterrupt stat64   \
+  setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \
   strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid  \
   strdup system usleep atexit on_exit chown link fcntl ttyname getpwent
\
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \
diff --git a/libguile/posix.c b/libguile/posix.c
index 2654716..f37de83 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -800,8 +800,7 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETPPID */
 
-
-#ifndef __MINGW32__
+#ifdef HAVE_GETUID
 SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
 (),
"Return an integer representing the current real user ID.")
@@ -810,9 +809,9 @@ SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
   return scm_from_int (getuid ());
 }
 #undef FUNC_NAME
+#endif /* HAVE_GETUID */
 
-
-
+#ifdef HAVE_GETGID
 SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0,
 (),
"Return an integer representing the current real group ID.")
@@ -821,9 +820,9 @@ SCM_DEFINE (scm_getgid, "getgid", 0, 0, 0,
   return scm_from_int (getgid ());
 }
 #undef FUNC_NAME
+#endif /* HAVE_GETGID */
 
-
-
+#ifdef HAVE_GETUID
 SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0,
 (),
"Return an integer representing the current effective user ID.\n"
@@ -839,8 +838,9 @@ SCM_DEFINE (scm_geteuid, "geteuid", 0, 0, 0,
 #endif
 }
 #undef FUNC_NAME
+#endif /* HAVE_GETUID */
 
-
+#ifdef HAVE_GETGID
 SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0,
 (),
"Return an integer representing the current effective group ID.\n"
@@ -856,8 +856,9 @@ SCM_DEFINE (scm_getegid, "getegid", 0, 0, 0,
 #endif
 }
 #undef FUNC_NAME
+#endif /* HAVE_GETGID */
 
-
+#ifdef HAVE_SETUID
 SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0, 
 (SCM id),
"Sets both the real and effective user IDs to the integer @var{id}, 
provided\n"
@@ -870,7 +871,9 @@ SCM_DEFINE (scm_setuid, "setuid", 1, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
+#endif /* HAVE_SETUID */
 
+#ifdef HAVE_SETGID
 SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0, 
 (SCM id),
"Sets both the real and effective group IDs to the integer 
@var{id}, provided\n"
@@ -883,7 +886,9 @@ SCM_DEFINE (scm_setgid, "setgid", 1, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
+#endif /* HAVE_SETGID */
 
+#ifdef HAVE_SETUID
 SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0, 
 (SCM id),
"Sets the effective user ID to the integer @var{id}, provided the 
process\n"
@@ -905,10 +910,9 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* __MINGW32__ */
+#endif /* HAVE_SETUID */
 
-
-#ifdef HAVE_SETEGID
+#ifdef HAVE_SETGID
 SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
 (SCM id),
"Sets the effective group ID to the integer @var{id}, provided the 
process\n"
@@ -931,8 +935,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0,
 
 }
 #undef FUNC_NAME
-#endif
-
+#endif /* HAVE_SETGID */
 
 #ifdef HAVE_GETPGRP
 SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
@@ -948,7 +951,6 @@ SCM_DEFINE (scm_getpgrp, "getpgrp", 0, 0, 0,
 #undef FUNC_NAME
 #endif /* HAVE_GETPGRP */
 
-
 #ifdef HAVE_SETPGID
 SCM_DEFINE (scm_setpgid, "setpgid", 2, 0, 0, 
 (SCM pid, SCM pgid),

[Guile-commits] 03/05: getaffinity, setaffinity docstring cleanup

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 2ef67d08ef7c5ce6f8b62214b698b91c424cef22
Author: Andy Wingo 
Date:   Mon Jul 11 22:17:59 2016 +0200

getaffinity, setaffinity docstring cleanup

* libguile/posix.c (scm_getaffinity, scm_setaffinity): Clean up
  docstrings.  Obviously if you have the function, you don't need to be
  told that you have it in the docstring.
---
 libguile/posix.c |   14 ++
 1 file changed, 2 insertions(+), 12 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index 68ad827..e3a435e 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1957,7 +1957,6 @@ SCM_DEFINE (scm_setpriority, "setpriority", 3, 0, 0,
 #endif /* HAVE_SETPRIORITY */
 
 #ifdef HAVE_SCHED_GETAFFINITY
-
 static SCM
 cpu_set_to_bitvector (const cpu_set_t *cs)
 {
@@ -1982,10 +1981,7 @@ SCM_DEFINE (scm_getaffinity, "getaffinity", 1, 0, 0,
"process @var{pid}.  Each CPU the process has affinity with\n"
"has its corresponding bit set in the returned bitvector.\n"
"The number of bits set is a good estimate of how many CPUs\n"
-   "Guile can use without stepping on other processes' toes.\n\n"
-   "Currently this procedure is only defined on GNU variants\n"
-   "(@pxref{CPU Affinity, @code{sched_getaffinity},, libc, The\n"
-   "GNU C Library Reference Manual}).\n")
+   "Guile can use without stepping on other processes' toes.")
 #define FUNC_NAME s_scm_getaffinity
 {
   int err;
@@ -1999,19 +1995,14 @@ SCM_DEFINE (scm_getaffinity, "getaffinity", 1, 0, 0,
   return cpu_set_to_bitvector (&cs);
 }
 #undef FUNC_NAME
-
 #endif /* HAVE_SCHED_GETAFFINITY */
 
 #ifdef HAVE_SCHED_SETAFFINITY
-
 SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
(SCM pid, SCM mask),
"Install the CPU affinity mask @var{mask}, a bitvector, for\n"
"the process or thread with ID @var{pid}.  The return value\n"
-   "is unspecified.\n\n"
-   "Currently this procedure is only defined on GNU variants\n"
-   "(@pxref{CPU Affinity, @code{sched_setaffinity},, libc, The\n"
-   "GNU C Library Reference Manual}).\n")
+   "is unspecified.")
 #define FUNC_NAME s_scm_setaffinity
 {
   cpu_set_t cs;
@@ -2040,7 +2031,6 @@ SCM_DEFINE (scm_setaffinity, "setaffinity", 2, 0, 0,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-
 #endif /* HAVE_SCHED_SETAFFINITY */
 
 

[Guile-commits] 02/05: Provide `kill' only if supported by the host

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit 2247a56d5dab1a9fde1c66f73116e7fa8257607f
Author: Andy Wingo 
Date:   Mon Jul 11 22:17:09 2016 +0200

Provide `kill' only if supported by the host

* libguile/posix.c (scm_kill): Only provide if the host has `kill'.  An
  incompatible change on MinGW, where this function would work only if
  the PID was the current PID, but that will be fixed by the next
  process.
---
 libguile/posix.c |   21 ++---
 1 file changed, 2 insertions(+), 19 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index f37de83..68ad827 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -626,6 +626,7 @@ SCM_DEFINE (scm_setrlimit, "setrlimit", 3, 0, 0,
 #endif /* HAVE_GETRLIMIT */
 
 
+#ifdef HAVE_KILL
 SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
 (SCM pid, SCM sig),
"Sends a signal to the specified process or group of processes.\n\n"
@@ -653,30 +654,12 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
 #define FUNC_NAME s_scm_kill
 {
   /* Signal values are interned in scm_init_posix().  */
-#ifdef HAVE_KILL
   if (kill (scm_to_int (pid), scm_to_int  (sig)) != 0)
 SCM_SYSERROR;
-#else
-  /* Mingw has raise(), but not kill().  (Other raw DOS environments might
- be similar.)  Use raise() when the requested pid is our own process,
- otherwise bomb.  */
-  if (scm_to_int (pid) == getpid ())
-{
-  if (raise (scm_to_int (sig)) != 0)
-{
-err:
-  SCM_SYSERROR;
-}
-  else
-{
-  errno = ENOSYS;
-  goto err;
-}
-}
-#endif
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
+#endif
 
 #ifdef HAVE_WAITPID
 SCM_DEFINE (scm_waitpid, "waitpid", 1, 1, 0,

[Guile-commits] 05/05: Factor start_child out of open_process

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit f6dd2120458de320d9f9b728d2207c89ae46737d
Author: Andy Wingo 
Date:   Mon Jul 11 22:46:55 2016 +0200

Factor start_child out of open_process

* libguile/posix.c (start_child): Factor out from open_process.  Based
  on initial work by Eli Zaretskii.
---
 libguile/posix.c |  188 ++
 1 file changed, 104 insertions(+), 84 deletions(-)

diff --git a/libguile/posix.c b/libguile/posix.c
index 2f5fd7e..94489dc 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1235,10 +1235,96 @@ SCM_DEFINE (scm_fork, "primitive-fork", 0, 0, 0,
   return scm_from_int (pid);
 }
 #undef FUNC_NAME
+#endif /* HAVE_FORK */
 
+#ifdef HAVE_FORK
+#define HAVE_START_CHILD 1
 /* Since Guile uses threads, we have to be very careful to avoid calling
functions that are not async-signal-safe in the child.  That's why
this function is implemented in C.  */
+static pid_t
+start_child (const char *exec_file, char **exec_argv,
+int reading, int c2p[2], int writing, int p2c[2],
+ int in, int out, int err)
+{
+  int pid;
+  int max_fd = 1024;
+
+#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_NOFILE)
+  {
+struct rlimit lim = { 0, 0 };
+if (getrlimit (RLIMIT_NOFILE, &lim) == 0)
+  max_fd = lim.rlim_cur;
+  }
+#endif
+
+  pid = fork ();
+
+  if (pid != 0)
+/* The parent, with either and error (pid == -1), or the PID of the
+   child.  Return directly in either case.  */
+return pid;
+
+  /* The child.  */
+  if (reading)
+close (c2p[0]);
+  if (writing)
+close (p2c[1]);
+
+  /* Close all file descriptors in ports inherited from the parent
+ except for in, out, and err.  Heavy-handed, but robust.  */
+  while (max_fd--)
+if (max_fd != in && max_fd != out && max_fd != err)
+  close (max_fd);
+
+  /* Ignore errors on these open() calls.  */
+  if (in == -1)
+in = open ("/dev/null", O_RDONLY);
+  if (out == -1)
+out = open ("/dev/null", O_WRONLY);
+  if (err == -1)
+err = open ("/dev/null", O_WRONLY);
+
+  if (in > 0)
+{
+  if (out == 0)
+do out = dup (out); while (errno == EINTR);
+  if (err == 0)
+do err = dup (err); while (errno == EINTR);
+  do dup2 (in, 0); while (errno == EINTR);
+  close (in);
+}
+  if (out > 1)
+{
+  if (err == 1)
+do err = dup (err); while (errno == EINTR);
+  do dup2 (out, 1); while (errno == EINTR);
+  close (out);
+}
+  if (err > 2)
+{
+  do dup2 (err, 2); while (errno == EINTR);
+  close (err);
+}
+
+  execvp (exec_file, exec_argv);
+
+  /* The exec failed!  There is nothing sensible to do.  */
+  if (err > 0)
+{
+  char *msg = strerror (errno);
+  fprintf (fdopen (err, "a"), "In execvp of %s: %s\n",
+   exec_file, msg);
+}
+
+  _exit (EXIT_FAILURE);
+
+  /* Not reached.  */
+  return -1;
+}
+#endif
+
+#ifdef HAVE_START_CHILD
 static SCM
 scm_open_process (SCM mode, SCM prog, SCM args)
 #define FUNC_NAME "open-process"
@@ -1251,7 +1337,7 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   int pid;
   char *exec_file;
   char **exec_argv;
-  int max_fd = 1024;
+  SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
 
   exec_file = scm_to_locale_string (prog);
   exec_argv = scm_i_allocate_string_pointers (scm_cons (prog, args));
@@ -1300,15 +1386,8 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   in = SCM_FPORT_FDES (port);
   }
 
-#if defined (HAVE_GETRLIMIT) && defined (RLIMIT_NOFILE)
-  {
-struct rlimit lim = { 0, 0 };
-if (getrlimit (RLIMIT_NOFILE, &lim) == 0)
-  max_fd = lim.rlim_cur;
-  }
-#endif
-
-  pid = fork ();
+  pid = start_child (exec_file, exec_argv, reading, c2p, writing, p2c,
+ in, out, err);
 
   if (pid == -1)
 {
@@ -1328,85 +1407,24 @@ scm_open_process (SCM mode, SCM prog, SCM args)
   SCM_SYSERROR;
 }
 
-  if (pid)
-/* Parent. */
-{
-  SCM read_port = SCM_BOOL_F, write_port = SCM_BOOL_F;
-
-  /* There is no sense in catching errors on close().  */
-  if (reading)
-{
-  close (c2p[1]);
-  read_port = scm_fdes_to_port (c2p[0], "r0", sym_read_pipe);
-}
-  if (writing)
-{
-  close (p2c[0]);
-  write_port = scm_fdes_to_port (p2c[1], "w0", sym_write_pipe);
-}
-
-  return scm_values
-(scm_list_3 (read_port, write_port, scm_from_int (pid)));
-}
-
-  /* The child.  */
+  /* There is no sense in catching errors on close().  */
   if (reading)
-close (c2p[0]);
-  if (writing)
-close (p2c[1]);
-
-  /* Close all file descriptors in ports inherited from the parent
- except for in, out, and err.  Heavy-handed, but robust.  */
-  while (max_fd--)
-if (max_fd != in && max_fd != out && max_fd != err)
-  close (max_fd);
-
-  /* Ignore errors on these open() calls.  */
-  if (in == -1)
-in = open ("/dev/nul

[Guile-commits] branch stable-2.0 updated (e2c1659 -> f6dd212)

[Andy Wingo]

wingo pushed a change to branch stable-2.0
in repository guile.

  from  e2c1659   Locale is default port encoding
   new  509c420   More robust setuid, setgid, etc detection
   new  2247a56   Provide `kill' only if supported by the host
   new  2ef67d0   getaffinity, setaffinity docstring cleanup
   new  0fb3e82   More specific status:exit-val et al compilation guards
   new  f6dd212   Factor start_child out of open_process

The 5 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 configure.ac |4 +-
 libguile/posix.c |  261 +++---
 2 files changed, 132 insertions(+), 133 deletions(-)

[Guile-commits] Success: Hydra job gnu:guile-master:build_without_threads.i686-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_without_threads.i686-linux’ has 
changed from "Failed with output" to "Success".  For details, see

  https://hydra.nixos.org/build/37520539

This may be due to a commit by Andy Wingo .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] 01/01: Locale is default port encoding

[Andy Wingo]

wingo pushed a commit to branch stable-2.0
in repository guile.

commit e2c1659d953bb4973e612a041380ca2439b70a3e
Author: Andy Wingo 
Date:   Fri Jun 24 07:43:58 2016 +0200

Locale is default port encoding

* libguile/ports.c (scm_init_ports): Use the locale as the default
  charset.  This allows GUILE_INSTALL_LOCALE=1 to work properly,
  harmonizing the default port encoding with the installed locale.
---
 NEWS |1 +
 libguile/ports.c |3 +++
 2 files changed, 4 insertions(+)

diff --git a/NEWS b/NEWS
index 36ab4c0..17b98c2 100644
--- a/NEWS
+++ b/NEWS
@@ -148,6 +148,7 @@ More ARM cross-compilation targets are supported: "arm.*eb",
 ()
 
 ** Ports
+*** Setting GUILE_INSTALL_LOCALE=1 sets port default charset from locale
 *** Fix port position handling on binary input ports
 ()
 *** Bytevector and custom binary ports to use ISO-8859-1
diff --git a/libguile/ports.c b/libguile/ports.c
index d7459b3..5a756b7 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2911,6 +2911,9 @@ scm_init_ports ()
 scm_make_fluid_with_default (SCM_BOOL_F));
   scm_port_encoding_init = 1;
 
+  /* Use the locale as the default port encoding.  */
+  scm_i_set_default_port_encoding (locale_charset ());
+
   SCM_VARIABLE_SET (default_conversion_strategy_var,
 scm_make_fluid_with_default (sym_substitute));
   scm_conversion_strategy_init = 1;

[Guile-commits] branch stable-2.0 updated (a14e873 -> e2c1659)

[Andy Wingo]

wingo pushed a change to branch stable-2.0
in repository guile.

  from  a14e873   Fix invalid use of 'PTR2SCM'.
   new  e2c1659   Locale is default port encoding

The 1 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 NEWS |1 +
 libguile/ports.c |3 +++
 2 files changed, 4 insertions(+)

[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_clang.i686-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_clang.i686-linux’ has changed 
from "Success" to "Failed with output".  For details, see

  https://hydra.nixos.org/build/37520537

This may be due to a commit by Andy Wingo .

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Failed with output: Hydra job gnu:guile-master:build.x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build.x86_64-linux’ has changed from 
"Success" to "Failed with output".  For details, see

  https://hydra.nixos.org/build/37520540

This may be due to a commit by Andy Wingo .

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-2-0:build_CPPFLAGS=_DSCM_DEBUG_TYPING_STRICTNESS=2 on x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job 
‘gnu:guile-2-0:build_CPPFLAGS=_DSCM_DEBUG_TYPING_STRICTNESS=2’ (on 
x86_64-linux) has changed from "Failed with output" to "Success".  For details, 
see

  https://hydra.nixos.org/build/37520773

This may be due to 4 commits by Ludovic Courtès .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build_enable_guile_debug on x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_enable_guile_debug’ (on 
x86_64-linux) has changed from "Failed with output" to "Success".  For details, 
see

  https://hydra.nixos.org/build/37519322

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] 04/04: Fix invalid use of 'PTR2SCM'.

[Ludovic Court�s]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit a14e873cce0700cb0a84dd03632e542bd0223637
Author: Ludovic Courtès 
Date:   Mon Jul 11 11:04:34 2016 +0200

Fix invalid use of 'PTR2SCM'.

Fixes a typo introduced in 04359b42b952ce1a09444e64d83dae9fb0a39da6.

* libguile/load.c (try_load_thunk_from_file): Use 'SCM2PTR', not
'PTR2SCM'.
---
 libguile/load.c |6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/libguile/load.c b/libguile/load.c
index f018181..c2ee509 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014, 2016 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
@@ -618,9 +618,9 @@ try_load_thunk_from_file (SCM filename)
 {
   return scm_c_catch (SCM_BOOL_T,
   do_load_thunk_from_file,
-  PTR2SCM (filename),
+  SCM2PTR (filename),
   load_thunk_from_file_catch_handler,
-  PTR2SCM (filename),
+  SCM2PTR (filename),
   NULL, NULL);
 }
 

[Guile-commits] 02/04: Unconditionally include from Gnulib.

[Ludovic Court�s]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 2bdd40a6966b18d4f62eaf1ce2d803b9b34c9d93
Author: Ludovic Courtès 
Date:   Mon Jul 11 11:00:38 2016 +0200

Unconditionally include  from Gnulib.

* libguile/stime.c: Unconditionally include .
---
 libguile/stime.c |6 +-
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/libguile/stime.c b/libguile/stime.c
index f430ca4..aa0784d 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -61,11 +61,7 @@
 #include "libguile/stime.h"
 
 #include 
-
-
-#ifdef HAVE_CLOCK_GETTIME
-# include 
-#endif
+#include /* Gnulib-provided */
 
 #include 
 #include 

[Guile-commits] 03/04: Add missing 'const' qualifier.

[Ludovic Court�s]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 2c5ab455c26a6386c781f62b6d732c9b29919111
Author: Ludovic Courtès 
Date:   Mon Jul 11 11:01:16 2016 +0200

Add missing 'const' qualifier.

* libguile/stime.c (tzvar): Add 'const'.
---
 libguile/stime.c |2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/libguile/stime.c b/libguile/stime.c
index aa0784d..7e6f303 100644
--- a/libguile/stime.c
+++ b/libguile/stime.c
@@ -327,7 +327,7 @@ filltime (struct tm *bd_time, int zoff, const char *zname)
   return result;
 }
 
-static char tzvar[3] = "TZ";
+static const char tzvar[3] = "TZ";
 
 /* if zone is set, create a temporary environment with only a TZ
string.  other threads or interrupt handlers shouldn't be allowed

[Guile-commits] branch stable-2.0 updated (5b7b574 -> a14e873)

[Ludovic Court�s]

civodul pushed a change to branch stable-2.0
in repository guile.

  from  5b7b574   Add meta/build-env
   new  92b8087   build: Remove unneeded check for 'unsetenv'.
   new  2bdd40a   Unconditionally include  from Gnulib.
   new  2c5ab45   Add missing 'const' qualifier.
   new  a14e873   Fix invalid use of 'PTR2SCM'.

The 4 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 configure.ac |4 ++--
 libguile/load.c  |6 +++---
 libguile/stime.c |8 ++--
 3 files changed, 7 insertions(+), 11 deletions(-)

[Guile-commits] 01/04: build: Remove unneeded check for 'unsetenv'.

[Ludovic Court�s]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 92b8087d7d87ec8a66e1dd7d14f73dc6be87c3cd
Author: Ludovic Courtès 
Date:   Mon Jul 11 10:59:04 2016 +0200

build: Remove unneeded check for 'unsetenv'.

* configure.ac: Remove check for 'unsetenv', which is unneeded since we
use Gnulib's 'unsetenv'.
---
 configure.ac |4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index d5c6a85..565fff5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -5,7 +5,7 @@ dnl
 define(GUILE_CONFIGURE_COPYRIGHT,[[
 
 Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-  2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Free Software 
Foundation, Inc.
+  2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016 Free Software 
Foundation, Inc.
 
 This file is part of GUILE
 
@@ -765,7 +765,7 @@ AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 
ctermid \
   strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid  \
   strdup system usleep atexit on_exit chown link fcntl ttyname getpwent
\
   getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \
-  index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron\
+  index bcopy memcpy rindex truncate isblank _NSGetEnviron \
   strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat\
   sched_getaffinity sched_setaffinity sendfile])
 

[Guile-commits] Failed with output: Hydra job gnu:guile-master:build_without_threads.i686-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_without_threads.i686-linux’ has 
changed from "Success" to "Failed with output".  For details, see

  https://hydra.nixos.org/build/37519329

Go forth and fix it.

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build.x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build.x86_64-linux’ has changed from 
"Failed with output" to "Success".  For details, see

  https://hydra.nixos.org/build/37518345

This may be due to 2 commits by Andy Wingo .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build_without_threads.x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_without_threads.x86_64-linux’ 
has changed from "Failed with output" to "Success".  For details, see

  https://hydra.nixos.org/build/37518342

This may be due to 2 commits by Andy Wingo .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] 25/25: Support typed arrays in some sort functions

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit f227a56991162b54cd01688964623e5915ffba3f
Author: Daniel Llorens 
Date:   Tue Jul 5 17:20:47 2016 +0200

Support typed arrays in some sort functions

* libguile/sort.c (sort!, sort, restricted-vector-sort!, sorted?):
  Support arrays of rank 1, whatever the type.

* libguile/quicksort.i.c: Fix accessors to handle typed arrays.

* test-suite/tests/sort.test: Test also with typed arrays.
---
 libguile/quicksort.i.c |   47 +++---
 libguile/sort.c|  150 
 test-suite/tests/sort.test |   38 +--
 3 files changed, 152 insertions(+), 83 deletions(-)

diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c
index 4e39f82..d3a0f93 100644
--- a/libguile/quicksort.i.c
+++ b/libguile/quicksort.i.c
@@ -11,7 +11,7 @@
version but doesn't consume extra memory.
  */
 
-#define SWAP(a, b) do { const SCM _tmp = a; a = b; b = _tmp; } while (0)
+#define SWAP(a, b) do { const SCM _tmp = GET(a); SET(a, GET(b)); SET(b, _tmp); 
} while (0)
 
 
 /* Order using quicksort.  This implementation incorporates four
@@ -54,8 +54,7 @@
 #defineSTACK_NOT_EMPTY  (stack < top)
 
 static void
-NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
-  SCM less)
+NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less)
 {
   /* Stack node declarations used to store unfulfilled partition obligations. 
*/
   typedef struct {
@@ -65,8 +64,6 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 
   static const char s_buggy_less[] = "buggy less predicate used when sorting";
 
-#define ELT(i) base_ptr[(i)*INC]
-
   if (nr_elems == 0)
 /* Avoid lossage with unsigned arithmetic below.  */
 return;
@@ -92,18 +89,18 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 skips a comparison for both the left and right. */
 
  SCM_TICK;
-   
- if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo
-   SWAP (ELT(mid), ELT(lo));
- if (scm_is_true (scm_call_2 (less, ELT(hi), ELT(mid
-   SWAP (ELT(mid), ELT(hi));
+
+ if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo
+   SWAP (mid, lo);
+ if (scm_is_true (scm_call_2 (less, GET(hi), GET(mid
+   SWAP (mid, hi);
  else
goto jump_over;
- if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo
-   SWAP (ELT(mid), ELT(lo));
+ if (scm_is_true (scm_call_2 (less, GET(mid), GET(lo
+   SWAP (mid, lo);
jump_over:;
 
- pivot = ELT(mid);
+ pivot = GET(mid);
  left = lo + 1;
  right = hi - 1;
 
@@ -112,7 +109,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 that this algorithm runs much faster than others. */
  do
{
- while (scm_is_true (scm_call_2 (less, ELT(left), pivot)))
+ while (scm_is_true (scm_call_2 (less, GET(left), pivot)))
{
  left += 1;
  /* The comparison predicate may be buggy */
@@ -120,7 +117,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
scm_misc_error (NULL, s_buggy_less, SCM_EOL);
}
 
- while (scm_is_true (scm_call_2 (less, pivot, ELT(right
+ while (scm_is_true (scm_call_2 (less, pivot, GET(right
{
  right -= 1;
  /* The comparison predicate may be buggy */
@@ -130,7 +127,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
 
  if (left < right)
{
- SWAP (ELT(left), ELT(right));
+ SWAP (left, right);
  left += 1;
  right -= 1;
}
@@ -192,11 +189,11 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
and the operation speeds up insertion sort's inner loop. */
 
 for (run = tmp + 1; run <= thresh; run += 1)
-  if (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp
+  if (scm_is_true (scm_call_2 (less, GET(run), GET(tmp
tmp = run;
 
 if (tmp != 0)
-  SWAP (ELT(tmp), ELT(0));
+  SWAP (tmp, 0);
 
 /* Insertion sort, running from left-hand-side up to right-hand-side.  */
 
@@ -206,7 +203,7 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
SCM_TICK;
 
tmp = run - 1;
-   while (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp
+   while (scm_is_true (scm_call_2 (less, GET(run), GET(tmp
  {
/* The comparison predicate may be buggy */
if (tmp == 0)
@@ -218,12 +215,12 @@ NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM
tmp += 1;
if (tmp != run)
  {
-SCM to_insert = ELT(run);
+SCM to_insert = GET(run);
 size_t hi, lo;
 
 for (hi = lo = run; --lo >= tmp; hi = lo)
-   

[Guile-commits] 19/25: Avoid variable stack use in scm_array_for_each_cell()

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 2ce48a3f4610228b8b4d8f65a1c501ebfff2b3f9
Author: Daniel Llorens 
Date:   Thu Mar 31 16:02:19 2016 +0200

Avoid variable stack use in scm_array_for_each_cell()

* libguile/arrays.c (scm_array_for_each_cell): Allocate all variable
  sized data at the top of the function using
  scm_gc_malloc_pointerless().
---
 libguile/arrays.c |   53 -
 1 file changed, 40 insertions(+), 13 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 0e8c6c2..292d80e 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -592,13 +592,46 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
 "@end lisp")
 #define FUNC_NAME s_scm_array_for_each_cell
 {
-  // FIXME replace stack by scm_gc_malloc_pointerless()
-  int const N = scm_ilength(a_);
-  int const frank = scm_to_int(frank_);
-  scm_t_array_handle ah[N];
-  SCM a[N];
-  scm_t_array_dim * as[N];
-  int rank[N];
+  int const N = scm_ilength (a_);
+  int const frank = scm_to_int (frank_);
+
+  // wish C had better stack support
+
+  size_t stack_size = 0;
+  stack_size += N*sizeof (scm_t_array_handle);
+  stack_size += N*sizeof (SCM);
+  stack_size += N*sizeof (scm_t_array_dim *);
+  stack_size += N*sizeof (int);
+  stack_size += frank*sizeof (ssize_t);
+
+  stack_size += N*sizeof (SCM);
+  stack_size += N*sizeof (SCM *);
+  stack_size += frank*sizeof (ssize_t);
+  stack_size += frank*sizeof (int);
+
+  stack_size += N*sizeof(size_t);
+  char * stack = scm_gc_malloc_pointerless (stack_size, "stack");
+
+#define AFIC_ALLOC_ADVANCE(stack, count, type, name)\
+  type * name = (void *)stack;  \
+  stack += count*sizeof(type);
+
+  char * stack0 = stack;
+  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_handle, ah);
+  AFIC_ALLOC_ADVANCE (stack, N, SCM, a);
+  AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_dim *, as);
+  AFIC_ALLOC_ADVANCE (stack, N, int, rank);
+  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, s);
+
+  AFIC_ALLOC_ADVANCE (stack, N, SCM, ai);
+  AFIC_ALLOC_ADVANCE (stack, N, SCM *, dargs);
+  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, i);
+  AFIC_ALLOC_ADVANCE (stack, frank, int, order);
+
+  AFIC_ALLOC_ADVANCE(stack, N, size_t, base);
+  assert((stack0+stack_size==stack) && "internal error");
+#undef AFIC_ALLOC_ADVANCE
+
   for (int n=0; scm_is_pair(a_); a_=scm_cdr(a_), ++n)
 {
   a[n] = scm_car(a_);
@@ -607,7 +640,6 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
   rank[n] = scm_array_handle_rank(ah+n);
 }
   // checks.
-  ssize_t s[frank];
   char const * msg = NULL;
   if (frank<0)
 {
@@ -641,7 +673,6 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
   scm_misc_error("array-for-each-cell", msg, scm_cons_star(frank_, a_));
 }
   // prepare moving cells.
-  SCM ai[N];
   scm_t_array_dim * ais[N];
   for (int n=0; n!=N; ++n)
 {
@@ -656,7 +687,6 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
 }
   // prepare rest list for callee.
   SCM dargs_ = SCM_EOL;
-  SCM * dargs[N];
   {
 SCM *p = &dargs_;
 for (int n=0; n

[Guile-commits] 14/25: Do not use array handles in scm_vector

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit da81901c9aea6fb95775634742d34b2d3a73ca8d
Author: Daniel Llorens 
Date:   Wed Feb 25 09:47:40 2015 +0100

Do not use array handles in scm_vector

* libguile/vectors.c (scm_vector): Use SCM_I_VECTOR_WELTS on new vector
  instead of generic scm_vector_elements; cf. scm_vector_copy().

  (scm_vector_elements): Forward to scm_vector_writable_elements().

  (scm_vector_writable_elements): Remove special error message for weak
  vector arg.

* libguile/generalized-vectors.c (SCM_VALIDATE_VECTOR_WITH_HANDLE):
  Remove unused macro.

* libguile/array-handle.c (scm_array_handle_elements): Forward to
  scm_array_handle_writable_elements().
---
 libguile/array-handle.c|4 +---
 libguile/generalized-vectors.c |4 
 libguile/vectors.c |   52 ++--
 3 files changed, 19 insertions(+), 41 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 17be456..5da4871 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -320,9 +320,7 @@ scm_array_handle_release (scm_t_array_handle *h)
 const SCM *
 scm_array_handle_elements (scm_t_array_handle *h)
 {
-  if (h->element_type != SCM_ARRAY_ELEMENT_TYPE_SCM)
-scm_wrong_type_arg_msg (NULL, 0, h->array, "non-uniform array");
-  return ((const SCM*)h->elements) + h->base;
+  return scm_array_handle_writable_elements (h);
 }
 
 SCM *
diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index 308cf6e..5a89332 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -70,10 +70,6 @@ SCM_DEFINE (scm_make_generalized_vector, 
"make-generalized-vector", 2, 1, 0,
 #undef FUNC_NAME
 
 
-#define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
-  scm_generalized_vector_get_handle (val, handle)
-
-
 void
 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
 {
diff --git a/libguile/vectors.c b/libguile/vectors.c
index 5dab545..0149dca 100644
--- a/libguile/vectors.c
+++ b/libguile/vectors.c
@@ -59,26 +59,13 @@ const SCM *
 scm_vector_elements (SCM vec, scm_t_array_handle *h,
 size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
-  scm_generalized_vector_get_handle (vec, h);
-  if (lenp)
-{
-  scm_t_array_dim *dim = scm_array_handle_dims (h);
-  *lenp = dim->ubnd - dim->lbnd + 1;
-  *incp = dim->inc;
-}
-  return scm_array_handle_elements (h);
+  return scm_vector_writable_elements (vec, h, lenp, incp);
 }
 
 SCM *
 scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
  size_t *lenp, ssize_t *incp)
 {
-  if (SCM_I_WVECTP (vec))
-scm_wrong_type_arg_msg (NULL, 0, vec, "non-weak vector");
-
   scm_generalized_vector_get_handle (vec, h);
   if (lenp)
 {
@@ -89,7 +76,7 @@ scm_vector_writable_elements (SCM vec, scm_t_array_handle *h,
   return scm_array_handle_writable_elements (h);
 }
 
-SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0, 
+SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a vector, otherwise return\n"
"@code{#f}.")
@@ -99,7 +86,7 @@ SCM_DEFINE (scm_vector_p, "vector?", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0, 
+SCM_DEFINE (scm_vector_length, "vector-length", 1, 0, 0,
(SCM v),
 "Returns the number of elements in @var{vector} as an exact 
integer.")
 #define FUNC_NAME s_scm_vector_length
@@ -127,7 +114,7 @@ SCM_REGISTER_PROC (s_list_to_vector, "list->vector", 1, 0, 
0, scm_vector);
"(list->vector '(dididit dah)) @result{}   #(dididit dah)\n"
"@end lisp")
 */
-SCM_DEFINE (scm_vector, "vector", 0, 0, 1, 
+SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
(SCM l),
"@deffnx {Scheme Procedure} list->vector l\n"
"Return a newly allocated vector composed of the\n"
@@ -141,27 +128,24 @@ SCM_DEFINE (scm_vector, "vector", 0, 0, 1,
   SCM res;
   SCM *data;
   long i, len;
-  scm_t_array_handle handle;
 
   SCM_VALIDATE_LIST_COPYLEN (1, l, len);
 
   res = scm_c_make_vector (len, SCM_UNSPECIFIED);
-  data = scm_vector_writable_elements (res, &handle, NULL, NULL);
+  data = SCM_I_VECTOR_WELTS (res);
   i = 0;
-  while (scm_is_pair (l) && i < len) 
+  while (scm_is_pair (l) && i < len)
 {
   data[i] = SCM_CAR (l);
   l = SCM_CDR (l);
   i += 1;
 }
 
-  scm_array_handle_release (&handle);
-
   return res;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0, 
+SCM_DEFINE (scm_vector_ref, "vector-ref", 2, 0, 0,
(SCM vector, SCM k),
 "@var{k} must be a valid index of @var{vector}.\n"
 "@samp{Vector-ref} returns the contents of element @var{k} of\n"
@@ -193,7 +177,7 

[Guile-commits] 16/25: Draft documentation for (array-for-each-cell)

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit a8dd99d0de8d08bcfb63fa152c81b5cc110640c2
Author: Daniel Llorens 
Date:   Wed Sep 16 11:44:23 2015 +0200

Draft documentation for (array-for-each-cell)

* doc/ref/api-compound.texi: New section 'Arrays as arrays of
  arrays'. Move the documentation for (array-from), (array-from*) and
  (array-amend!) in here. Add documentation for (array-for-each-cell).
---
 doc/ref/api-compound.texi |  161 -
 1 file changed, 116 insertions(+), 45 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 7f70374..34a832f 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1203,6 +1203,7 @@ dimensional arrays.
 * Array Syntax::
 * Array Procedures::
 * Shared Arrays::
+* Arrays as arrays of arrays::
 * Accessing Arrays from C::
 @end menu
 
@@ -1715,13 +1716,82 @@ sample points are enough because @var{mapfunc} is 
linear.
 Return the element at @code{(idx @dots{})} in @var{array}.
 @end deffn
 
+
+@deffn {Scheme Procedure} shared-array-increments array
+@deffnx {C Function} scm_shared_array_increments (array)
+For each dimension, return the distance between elements in the root vector.
+@end deffn
+
+@deffn {Scheme Procedure} shared-array-offset array
+@deffnx {C Function} scm_shared_array_offset (array)
+Return the root vector index of the first element in the array.
+@end deffn
+
+@deffn {Scheme Procedure} shared-array-root array
+@deffnx {C Function} scm_shared_array_root (array)
+Return the root vector of a shared array.
+@end deffn
+
+@deffn {Scheme Procedure} array-contents array [strict]
+@deffnx {C Function} scm_array_contents (array, strict)
+If @var{array} may be @dfn{unrolled} into a one dimensional shared array
+without changing their order (last subscript changing fastest), then
+@code{array-contents} returns that shared array, otherwise it returns
+@code{#f}.  All arrays made by @code{make-array} and
+@code{make-typed-array} may be unrolled, some arrays made by
+@code{make-shared-array} may not be.
+
+If the optional argument @var{strict} is provided, a shared array will
+be returned only if its elements are stored internally contiguous in
+memory.
+@end deffn
+
+@deffn {Scheme Procedure} transpose-array array dim1 dim2 @dots{}
+@deffnx {C Function} scm_transpose_array (array, dimlist)
+Return an array sharing contents with @var{array}, but with
+dimensions arranged in a different order.  There must be one
+@var{dim} argument for each dimension of @var{array}.
+@var{dim1}, @var{dim2}, @dots{} should be integers between 0
+and the rank of the array to be returned.  Each integer in that
+range must appear at least once in the argument list.
+
+The values of @var{dim1}, @var{dim2}, @dots{} correspond to
+dimensions in the array to be returned, and their positions in the
+argument list to dimensions of @var{array}.  Several @var{dim}s
+may have the same value, in which case the returned array will
+have smaller rank than @var{array}.
+
+@lisp
+(transpose-array '#2((a b) (c d)) 1 0) @result{} #2((a c) (b d))
+(transpose-array '#2((a b) (c d)) 0 0) @result{} #1(a d)
+(transpose-array '#3(((a b c) (d e f)) ((1 2 3) (4 5 6))) 1 1 0) @result{}
+#2((a 4) (b 5) (c 6))
+@end lisp
+@end deffn
+
+@node Arrays as arrays of arrays
+@subsubsection Arrays as arrays of arrays
+
+The functions in this section allow you to treat an array of rank
+@math{n} as an array of lower rank @math{n-k} where the elements are
+themselves arrays (`cells') of rank @math{k}. This replicates some of
+the functionality of `enclosed arrays', a feature of old Guile that was
+removed before @w{version 2.0}. However, these functions do not require
+a special type and operate on any array.
+
+When we operate on an array in this way, we speak of the first @math{k}
+dimensions of the array as the @math{k}-`frame' of the array, while the
+last @math{n-k} dimensions are the dimensions of the
+@math{n-k}-`cell'. For example, a 2D-array (a matrix) can be seen as a
+1D array of rows. In this case, the rows are the 1-cells of the array.
+
 @deffn {Scheme Procedure} array-from array idx @dots{}
 @deffnx {C Function} scm_array_from (array, idxlist)
 If the length of @var{idxlist} equals the rank @math{n} of
 @var{array}, return the element at @code{(idx @dots{})}, just like
 @code{(array-ref array idx @dots{})}. If, however, the length @math{k}
 of @var{idxlist} is shorter than @math{n}, then return the shared
-@math{(n-k)}-rank prefix cell of @var{array} given by @var{idxlist}.
+@math{(n-k)}-rank cell of @var{array} given by @var{idxlist}.
 
 For example:
 
@@ -1752,8 +1822,8 @@ The name `from' comes from the J language.
 @deffnx {C Function} scm_array_from_s (array, idxlist)
 Like @code{(array-from array idx @dots{})}, but return a 0-rank shared
 array if the length of @var{idxlist} matches the rank of
-@var{array}. This can be useful when using @var{A

[Guile-commits] 07/25: Tests & doc for array-from, array-from*, array-set-from!

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit ecb38d4268fdbb764473f2c723c7b0a9aef3eb25
Author: Daniel Llorens 
Date:   Wed Feb 11 19:12:28 2015 +0100

Tests & doc for array-from, array-from*, array-set-from!

* test-suite/tests/arrays.test: tests for array-from, array-from*,
  array-set-from!

* doc/ref/api-compound.texi: document array-from, array-from*,
  array-set-from!.
---
 doc/ref/api-compound.texi|  125 ++
 test-suite/tests/arrays.test |  109 
 2 files changed, 223 insertions(+), 11 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index b4ae79c..23f2de0 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -30,7 +30,7 @@ values can be looked up within them.
 * Structures::  Low-level record representation.
 * Dictionary Types::About dictionary types in general.
 * Association Lists::   List-based dictionaries.
-* VHashes:: VList-based dictionaries.   
+* VHashes:: VList-based dictionaries.
 * Hash Tables:: Table-based dictionaries.
 @end menu
 
@@ -241,7 +241,7 @@ or a pair which has a list in its cdr.
 @c FIXME::martin: What is a proper, what an improper list?
 @c What is a circular list?
 
-@c FIXME::martin: Maybe steal some graphics from the Elisp reference 
+@c FIXME::martin: Maybe steal some graphics from the Elisp reference
 @c manual?
 
 @menu
@@ -1117,7 +1117,7 @@ bv
 @end example
 
 If @var{uvec} is a uniform vector of unsigned long integers, then
-they're indexes into @var{bitvector} which are set to @var{bool}.  
+they're indexes into @var{bitvector} which are set to @var{bool}.
 
 @example
 (define bv #*0110)
@@ -1200,10 +1200,10 @@ numeric vectors, bytevectors, bit vectors and ordinary 
vectors as one
 dimensional arrays.
 
 @menu
-* Array Syntax::
-* Array Procedures::
-* Shared Arrays::   
-* Accessing Arrays from C:: 
+* Array Syntax::
+* Array Procedures::
+* Shared Arrays::
+* Accessing Arrays from C::
 @end menu
 
 @node Array Syntax
@@ -1247,7 +1247,7 @@ As a special case, an array of rank 0 is printed as
 @code{#0()}, where @code{} is the result of
 printing the single element of the array.
 
-Thus, 
+Thus,
 
 @table @code
 @item #(1 2 3)
@@ -1709,6 +1709,109 @@ base and stride for new array indices in @var{oldarray} 
data.  A few
 sample points are enough because @var{mapfunc} is linear.
 @end deffn
 
+
+@deffn {Scheme Procedure} array-ref array idx @dots{}
+@deffnx {C Function} scm_array_ref (array, idxlist)
+Return the element at @code{(idx @dots{})} in @var{array}.
+@end deffn
+
+@deffn {Scheme Procedure} array-from array idx @dots{}
+@deffnx {C Function} scm_array_from (array, idxlist)
+If the length of @var{idxlist} equals the rank @math{n} of
+@var{array}, return the element at @code{(idx @dots{})}, just like
+@code{(array-ref array idx @dots{})}. If, however, the length @math{k}
+of @var{idxlist} is shorter than @math{n}, then return the shared
+@math{(n-k)}-rank prefix cell of @var{array} given by @var{idxlist}.
+
+For example:
+
+@example
+@lisp
+(array-from #2((a b) (c d)) 0) @result{} #(a b)
+(array-from #2((a b) (c d)) 1) @result{} #(c d)
+(array-from #2((a b) (c d)) 1 1) @result{} d
+(array-from #2((a b) (c d))) @result{} #2((a b) (c d))
+@end lisp
+@end example
+
+@code{(apply array-from array indices)} is equivalent to
+
+@lisp
+(let ((len (length indices)))
+  (if (= (array-rank a) len)
+(apply array-ref a indices)
+(apply make-shared-array a
+   (lambda t (append indices t))
+   (drop (array-dimensions a) len
+@end lisp
+
+The name `from' comes from the J language.
+@end deffn
+
+@deffn {Scheme Procedure} array-from* array idx @dots{}
+@deffnx {C Function} scm_array_from_s (array, idxlist)
+Like @code{(array-from array idx @dots{})}, but return a 0-rank shared
+array if the length of @var{idxlist} matches the rank of
+@var{array}. This can be useful when using @var{ARRAY} as destination
+of copies.
+
+Compare:
+
+@example
+@lisp
+(array-from #2((a b) (c d)) 1 1) @result{} d
+(array-from* #2((a b) (c d)) 1) @result{} #0(d)
+(define a (make-array 'a 2 2))
+(array-fill! (array-from* a 1 1) 'b)
+a @result{} #2((a a) (a b)).
+(array-fill! (array-from a 1 1) 'b) @result{} error: not an array
+@end lisp
+@end example
+
+@code{(apply array-from* array indices)} is equivalent to
+
+@lisp
+(apply make-shared-array a
+  (lambda t (append indices t))
+  (drop (array-dimensions a) (length indices)))
+@end lisp
+@end deffn
+
+
+@deffn {Scheme Procedure} array-set-from! array x idx @dots{}
+@deffnx {C Function} scm_array_set_from_x (array, x, idxlist)
+If the length of @var{idxlist} equals the rank @math{n} of
+@var{array}, set the element at @code{(idx @dots{})} of @var{array} to
+@var{x}, just like @code{(array-set! a

[Guile-commits] 08/25: Rename array-set-from!, scm_array_set_from_x to array-amend!, scm_array_amend_x

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 3aafc2c857541fc4d015b5d6ba2ac075f50240d0
Author: Daniel Llorens 
Date:   Wed Feb 11 19:32:02 2015 +0100

Rename array-set-from!, scm_array_set_from_x to array-amend!, 
scm_array_amend_x
---
 doc/ref/api-compound.texi|   12 +++-
 libguile/arrays.c|   18 +-
 libguile/arrays.h|2 +-
 test-suite/tests/arrays.test |   16 
 4 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 23f2de0..7f70374 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1778,8 +1778,8 @@ a @result{} #2((a a) (a b)).
 @end deffn
 
 
-@deffn {Scheme Procedure} array-set-from! array x idx @dots{}
-@deffnx {C Function} scm_array_set_from_x (array, x, idxlist)
+@deffn {Scheme Procedure} array-amend! array x idx @dots{}
+@deffnx {C Function} scm_array_amend_x (array, x, idxlist)
 If the length of @var{idxlist} equals the rank @math{n} of
 @var{array}, set the element at @code{(idx @dots{})} of @var{array} to
 @var{x}, just like @code{(array-set! array x idx @dots{})}. If,
@@ -1795,12 +1795,12 @@ For example:
 
 @example
 @lisp
-(array-set-from! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b))
-(array-set-from! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y))
+(array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b))
+(array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y))
 @end lisp
 @end example
 
-@code{(apply array-set-from! array x indices)} is equivalent to
+@code{(apply array-amend! array x indices)} is equivalent to
 
 @lisp
 (let ((len (length indices)))
@@ -1809,6 +1809,8 @@ For example:
 (array-copy! x (apply array-from array indices)))
   array)
 @end lisp
+
+The name `amend' comes from the J language.
 @end deffn
 
 
diff --git a/libguile/arrays.c b/libguile/arrays.c
index 31474ed..6d1927c 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -431,7 +431,7 @@ SCM_DEFINE (scm_array_from_s, "array-from*", 1, 0, 1,
(SCM ra, SCM indices),
 "Return the array slice @var{ra}[@var{indices} ..., ...]\n"
 "The rank of @var{ra} must equal to the number of indices or 
larger.\n\n"
-"See also @code{array-ref}, @code{array-from}, 
@code{array-set-from!}.\n\n"
+"See also @code{array-ref}, @code{array-from}, 
@code{array-amend!}.\n\n"
 "@code{array-from*} may return a rank-0 array. For example:\n"
 "@lisp\n"
 "(array-from* #2((1 2 3) (4 5 6)) 1 1) @result{} #0(5)\n"
@@ -463,7 +463,7 @@ SCM_DEFINE (scm_array_from, "array-from", 1, 0, 1,
 "Return the element at the @code{(@var{indices} ...)} position\n"
 "in array @var{ra}, or the array slice @var{ra}[@var{indices} ..., 
...]\n"
 "if the rank of @var{ra} is larger than the number of indices.\n\n"
-"See also @code{array-ref}, @code{array-from*}, 
@code{array-set-from!}.\n\n"
+"See also @code{array-ref}, @code{array-from*}, 
@code{array-amend!}.\n\n"
 "@code{array-from} never returns a rank 0 array. For example:\n"
 "@lisp\n"
 "(array-from #2((1 2 3) (4 5 6)) 1 1) @result{} 5\n"
@@ -495,7 +495,7 @@ SCM_DEFINE (scm_array_from, "array-from", 1, 0, 1,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_array_set_from_x, "array-set-from!", 2, 0, 1,
+SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1,
 (SCM ra, SCM b, SCM indices),
 "Set the array slice @var{ra}[@var{indices} ..., ...] to 
@var{b}\n."
 "Equivalent to @code{(array-copy! @var{b} (apply array-from 
@var{ra} @var{indices}))}\n"
@@ -506,14 +506,14 @@ SCM_DEFINE (scm_array_set_from_x, "array-set-from!", 2, 
0, 1,
 "For example:\n"
 "@lisp\n"
 "(define A (list->array 2 '((1 2 3) (4 5 6\n"
-"(array-set-from! A #0(99) 1 1) @result{} #2((1 2 3) (4 #0(99) 
6))\n"
-"(array-set-from! A 99 1 1) @result{} #2((1 2 3) (4 99 6))\n"
-"(array-set-from! A #(a b c) 0) @result{} #2((a b c) (4 99 6))\n"
-"(array-set-from! A #2((x y z) (9 8 7))) @result{} #2((x y z) (9 8 
7))\n\n"
+"(array-amend! A #0(99) 1 1) @result{} #2((1 2 3) (4 #0(99) 6))\n"
+"(array-amend! A 99 1 1) @result{} #2((1 2 3) (4 99 6))\n"
+"(array-amend! A #(a b c) 0) @result{} #2((a b c) (4 99 6))\n"
+"(array-amend! A #2((x y z) (9 8 7))) @result{} #2((x y z) (9 8 
7))\n\n"
 "(define B (make-array 0))\n"
-"(array-set-from! B 15) @result{} #0(15)\n"
+"(array-amend! B 15) @result{} #0(15)\n"
 "@end lisp")
-#define FUNC_NAME s_scm_array_set_from_x
+#define FUNC_NAME s_scm_array_amend_x
 {
   ARRAY_FROM_POS(scm_list_3 (ra, b, indices))
   SCM o;
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 6399333..bd216ae

[Guile-commits] 13/25: Remove deprecated and unused generalized-vector functions

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit cea5139e6528dc9018a3bb447c2d242a6f778d52
Author: Daniel Llorens 
Date:   Fri Feb 20 19:49:34 2015 +0100

Remove deprecated and unused generalized-vector functions

* libguile/generalized-vectors.h, libguile/generalized-vectors.c
  (scm_is_generalized_vector, scm_c_generalized_vector_length,
  scm_c_generalized_vector_ref, scm_c_generalized_vector_set_x): These
  functions were deprecated in 2.0.9. Remove.
---
 libguile/generalized-vectors.c |   35 ++-
 libguile/generalized-vectors.h |4 
 2 files changed, 2 insertions(+), 37 deletions(-)

diff --git a/libguile/generalized-vectors.c b/libguile/generalized-vectors.c
index fc493bc..308cf6e 100644
--- a/libguile/generalized-vectors.c
+++ b/libguile/generalized-vectors.c
@@ -49,7 +49,7 @@ scm_i_register_vector_constructor (SCM type, SCM (*ctor)(SCM, 
SCM))
 /* need to increase VECTOR_CTORS_N_STATIC_ALLOC, buster */
 abort ();
   else
-{ 
+{
   vector_ctors[num_vector_ctors_registered].tag = type;
   vector_ctors[num_vector_ctors_registered].ctor = ctor;
   num_vector_ctors_registered++;
@@ -69,23 +69,10 @@ SCM_DEFINE (scm_make_generalized_vector, 
"make-generalized-vector", 2, 1, 0,
 }
 #undef FUNC_NAME
 
-int
-scm_is_generalized_vector (SCM obj)
-{
-  int ret = 0;
-  if (scm_is_array (obj))
-{
-  scm_t_array_handle h;
-  scm_array_get_handle (obj, &h);
-  ret = scm_array_handle_rank (&h) == 1;
-  scm_array_handle_release (&h);
-}
-  return ret;
-}
 
 #define SCM_VALIDATE_VECTOR_WITH_HANDLE(pos, val, handle)   \
   scm_generalized_vector_get_handle (val, handle)
-   
+
 
 void
 scm_generalized_vector_get_handle (SCM vec, scm_t_array_handle *h)
@@ -98,24 +85,6 @@ scm_generalized_vector_get_handle (SCM vec, 
scm_t_array_handle *h)
 }
 }
 
-size_t
-scm_c_generalized_vector_length (SCM v)
-{
-  return scm_c_array_length (v);
-}
-
-SCM
-scm_c_generalized_vector_ref (SCM v, ssize_t idx)
-{
-  return scm_c_array_ref_1 (v, idx);
-}
-
-void
-scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val)
-{
-  scm_c_array_set_1_x (v, val, idx);
-}
-
 void
 scm_init_generalized_vectors ()
 {
diff --git a/libguile/generalized-vectors.h b/libguile/generalized-vectors.h
index 876537a..77d6272 100644
--- a/libguile/generalized-vectors.h
+++ b/libguile/generalized-vectors.h
@@ -30,10 +30,6 @@
 
 /* Generalized vectors */
 
-SCM_API int scm_is_generalized_vector (SCM obj);
-SCM_API size_t scm_c_generalized_vector_length (SCM v);
-SCM_API SCM scm_c_generalized_vector_ref (SCM v, ssize_t idx);
-SCM_API void scm_c_generalized_vector_set_x (SCM v, ssize_t idx, SCM val);
 SCM_API void scm_generalized_vector_get_handle (SCM vec,
scm_t_array_handle *h);
 

[Guile-commits] 02/25: Remove scm_from_contiguous_array

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit c557ff68ec84bc29caff45ca71dfe7fc07979059
Author: Daniel Llorens 
Date:   Mon Feb 9 17:27:33 2015 +0100

Remove scm_from_contiguous_array

This function is undocumented, unused within Guile, and can be trivially
replaced by make-array + array-copy without requiring contiguity.

* libguile/arrays.h (scm_from_contiguous_array): remove declaration.

* libguile/arrays.c (scm_from_contiguous_array): remove.
---
 libguile/arrays.c |   35 ---
 libguile/arrays.h |2 --
 2 files changed, 37 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 05f8597..6613542 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -270,41 +270,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
 }
 #undef FUNC_NAME
 
-SCM
-scm_from_contiguous_array (SCM bounds, const SCM *elts, size_t len)
-#define FUNC_NAME "scm_from_contiguous_array"
-{
-  size_t k, rlen = 1;
-  scm_t_array_dim *s;
-  SCM ra;
-  scm_t_array_handle h;
-
-  ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-  s = SCM_I_ARRAY_DIMS (ra);
-  k = SCM_I_ARRAY_NDIM (ra);
-
-  while (k--)
-{
-  s[k].inc = rlen;
-  SCM_ASSERT_RANGE (1, bounds, s[k].lbnd <= s[k].ubnd + 1);
-  rlen = (s[k].ubnd - s[k].lbnd + 1) * s[k].inc;
-}
-  if (rlen != len)
-SCM_MISC_ERROR ("element length and dimensions do not match", SCM_EOL);
-
-  SCM_I_ARRAY_SET_V (ra, scm_c_make_vector (rlen, SCM_UNDEFINED));
-  scm_array_get_handle (ra, &h);
-  memcpy (h.writable_elements, elts, rlen * sizeof(SCM));
-  scm_array_handle_release (&h);
-
-  if (1 == SCM_I_ARRAY_NDIM (ra) && 0 == SCM_I_ARRAY_BASE (ra))
-if (0 == s->lbnd)
-  return SCM_I_ARRAY_V (ra);
-  return ra;
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
(SCM fill, SCM bounds),
"Create and return an array.")
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 5f40597..c486f20 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -37,8 +37,6 @@
 /** Arrays */
 
 SCM_API SCM scm_make_array (SCM fill, SCM bounds);
-SCM_API SCM scm_from_contiguous_array (SCM bounds, const SCM *elts,
-   size_t len);
 SCM_API SCM scm_make_typed_array (SCM type, SCM fill, SCM bounds);
 SCM_API SCM scm_from_contiguous_typed_array (SCM type, SCM bounds,
  const void *bytes,

[Guile-commits] branch lloda-array-support updated (70320be -> f227a56)

[Daniel Llorens]

lloda pushed a change to branch lloda-array-support
in repository guile.

  discards  70320be   Support typed arrays in some sort functions
  discards  1445204   Remove uniform-array-read!, uniform-array-write from the 
manual
  discards  34280dd   Remove commented stack version of 
scm_array_for_each_cell()
  discards  2825388   Fix pool version of scm_array_for_each_cell by aligning 
pointers
  discards  91a1965   Fix a corner case with empty arrays in 
(array-for-each-cell)
  discards  9e6c15a   Clean up (array-for-each-cell)
  discards  1849425   Avoid variable stack use in scm_array_for_each_cell()
  discards  1057644   Special case for array-map! with three arguments
  discards  7d38516   New export (array-for-each-cell-in-order)
  discards  ad39ff6   Draft documentation for (array-for-each-cell)
  discards  8c5be6a   Draft of (array-for-each-cell)
  discards  ffa7f12   Do not use array handles in scm_vector
  discards  84b3a87   Remove deprecated and unused generalized-vector functions
  discards  cac6aa2   Speed up for multi-arg cases of scm_ramap functions
  discards  de4b776   Remove deprecated array functions
  discards  0ade9b3   Fix compilation of rank 0 typed array literals
  discards  99be399   Don't use array handles in scm_c_array_rank
  discards  1d91ffa   Rename array-set-from!, scm_array_set_from_x to 
array-amend!, scm_array_amend_x
  discards  d33dd7e   Tests & doc for array-from, array-from*, array-set-from!
  discards  ee960e4   New functions array-from, array-from*, array-set-from!
  discards  7e44709   Compile in C99 mode
  discards  dc56398   Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
  discards  c4fdcc6   Unuse array 'contiguous' flag
  discards  dff3e91   Remove scm_from_contiguous_array
  discards  7f17738   Avoid unneeded internal use of array handles
  adds  85faf8e   Update NEWS
  adds  0d191d1   Update git-version-gen.diff for current gnulib
  adds  d484bfb   Update Gnulib to 68b6ade.
  adds  b05b67b   Avoid Gnulib unistr/* modules
  adds  38f23e7   Add meta/build-env
   new  655494c   Avoid unneeded internal use of array handles
   new  c557ff6   Remove scm_from_contiguous_array
   new  212c5b0   Unuse array 'contiguous' flag
   new  b9cbf3b   Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle
   new  839dec6   Compile in C99 mode
   new  7d7ada3   New functions array-from, array-from*, array-set-from!
   new  ecb38d4   Tests & doc for array-from, array-from*, array-set-from!
   new  3aafc2c   Rename array-set-from!, scm_array_set_from_x to 
array-amend!, scm_array_amend_x
   new  ed6c655   Don't use array handles in scm_c_array_rank
   new  fc0e75c   Fix compilation of rank 0 typed array literals
   new  348d8b4   Remove deprecated array functions
   new  c17799d   Speed up for multi-arg cases of scm_ramap functions
   new  cea5139   Remove deprecated and unused generalized-vector functions
   new  da81901   Do not use array handles in scm_vector
   new  fb4d4d9   Draft of (array-for-each-cell)
   new  a8dd99d   Draft documentation for (array-for-each-cell)
   new  ffd949e   New export (array-for-each-cell-in-order)
   new  b854d0f   Special case for array-map! with three arguments
   new  2ce48a3   Avoid variable stack use in scm_array_for_each_cell()
   new  f6003e8   Clean up (array-for-each-cell)
   new  79bf245   Fix a corner case with empty arrays in 
(array-for-each-cell)
   new  4a361f2   Fix pool version of scm_array_for_each_cell by aligning 
pointers
   new  cbaa6ca   Remove commented stack version of 
scm_array_for_each_cell()
   new  3320eaa   Remove uniform-array-read!, uniform-array-write from the 
manual
   new  f227a56   Support typed arrays in some sort functions

This update added new revisions after undoing existing revisions.
That is to say, some revisions that were in the old version of the
branch are not in the new version.  This situation occurs
when a user --force pushes a change and generates a repository
containing something like this:

 * -- * -- B -- O -- O -- O   (70320be)
\
 N -- N -- N   refs/heads/lloda-array-support (f227a56)

You should already have received notification emails for all of the O
revisions, and so the following emails describe only the N revisions
from the common base, B.

Any revisions marked "omits" are not gone; other references still
refer to them.  Any revisions marked "discards" are gone forever.

The 25 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 GNUmakefile|2 +-
 NEWS   |  480 +++
 am/bootstrap.am|2 +-
 am/guilec 

[Guile-commits] 21/25: Fix a corner case with empty arrays in (array-for-each-cell)

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 79bf245c7e13b1cd1f47df533f78c6f676d66c56
Author: Daniel Llorens 
Date:   Thu Apr 21 17:38:49 2016 +0200

Fix a corner case with empty arrays in (array-for-each-cell)

* libguile/array-map.c (scm_array_for_each_cell): Bail out early if any
  of the sizes is zero. Pack ais at the end of the fake stack.

* test-suite/tests/array-map.test: Add regression test.
---
 libguile/array-map.c|  333 +--
 test-suite/tests/array-map.test |   14 +-
 2 files changed, 296 insertions(+), 51 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 0bbc095..028f79b 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -651,6 +651,7 @@ scm_i_array_rebase (SCM a, size_t base)
 return b;
 }
 
+/*
 SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
 (SCM frame_rank, SCM op, SCM args),
 "Apply @var{op} to each of the cells of rank 
rank(@var{arg})-@var{frame_rank}\n"
@@ -675,23 +676,22 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
 {
   int const N = scm_ilength (args);
   int const frank = scm_to_int (frame_rank);
-
-  // wish C had better stack support
+  SCM dargs_ = SCM_EOL;
 
   size_t stack_size = 0;
   stack_size += N*sizeof (scm_t_array_handle);
   stack_size += N*sizeof (SCM);
   stack_size += N*sizeof (scm_t_array_dim *);
   stack_size += N*sizeof (int);
-  stack_size += frank*sizeof (ssize_t);
 
+  stack_size += frank*sizeof (ssize_t);
   stack_size += N*sizeof (SCM);
   stack_size += N*sizeof (SCM *);
   stack_size += frank*sizeof (ssize_t);
-  stack_size += frank*sizeof (int);
 
+  stack_size += frank*sizeof (int);
   stack_size += N*sizeof (size_t);
-  char * stack = scm_gc_malloc_pointerless (stack_size, "stack");
+  char * stack = scm_gc_malloc (stack_size, "stack");
 
 #define AFIC_ALLOC_ADVANCE(stack, count, type, name)\
   type * name = (void *)stack;  \
@@ -702,14 +702,14 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
   AFIC_ALLOC_ADVANCE (stack, N, SCM, args_);
   AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_dim *, as);
   AFIC_ALLOC_ADVANCE (stack, N, int, rank);
-  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, s);
 
+  AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, s);
   AFIC_ALLOC_ADVANCE (stack, N, SCM, ai);
   AFIC_ALLOC_ADVANCE (stack, N, SCM *, dargs);
   AFIC_ALLOC_ADVANCE (stack, frank, ssize_t, i);
-  AFIC_ALLOC_ADVANCE (stack, frank, int, order);
 
-  AFIC_ALLOC_ADVANCE(stack, N, size_t, base);
+  AFIC_ALLOC_ADVANCE (stack, frank, int, order);
+  AFIC_ALLOC_ADVANCE (stack, N, size_t, base);
   assert((stack0+stack_size==stack) && "internal error");
 #undef AFIC_ALLOC_ADVANCE
 
@@ -725,56 +725,284 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
   if (frank<0)
 {
   msg = "bad frame rank";
-} else
+}
+  else
+{
+  for (int n=0; n!=N; ++n)
+{
+  if (rank[n]typed-array 'f64 2 '((9 1) (7 8
  (y (f64vector 99 99)))
 (array-for-each-cell 1 (lambda (y x) (array-set! y (- (array-ref x 0) 
(array-ref x 1 y x)
-y)))
+y))
+
+  (pass-if-equal "regression: zero-sized frame loop without unrolling"
+  99
+(let* ((x 99)
+   (o (make-array 0. 0 3 2)))
+  (array-for-each-cell 2
+(lambda (o a0 a1)
+  (set! x 0))
+o
+(make-shared-array (make-array 1. 0 1) (const '(0 0)) 0 3)
+(make-array 2. 0 3))
+  x)))

[Guile-commits] 06/25: New functions array-from, array-from*, array-set-from!

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 7d7ada39d09e718cda8002a7b46584c62e99adc1
Author: Daniel Llorens 
Date:   Wed Feb 11 16:44:21 2015 +0100

New functions array-from, array-from*, array-set-from!

* libguile/arrays.h (scm_array_from, scm_array_from_s,
  scm_array_set_from_x): new declarations.

* libguile/arrays.c (scm_array_from, scm_array_from_s,
  scm_array_set_from_x): new functions, export as array-from,
  array-from*, array-set-from!.
---
 libguile/arrays.c |  153 +
 libguile/arrays.h |6 +++
 2 files changed, 159 insertions(+)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index c852e64..31474ed 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -395,6 +395,159 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 
2, 0, 1,
 #undef FUNC_NAME
 
 
+#define ARRAY_FROM_POS(error_args)  \
+  scm_t_array_handle handle;\
+  scm_array_get_handle (ra, &handle);   \
+  scm_t_array_dim * s = scm_array_handle_dims (&handle);\
+  size_t ndim = scm_array_handle_rank (&handle);\
+  size_t k = ndim;  \
+  ssize_t pos = 0;  \
+  SCM i = indices;  \
+  for (; k>0 && scm_is_pair (i); --k, ++s, i=scm_cdr (i))   \
+{   \
+  ssize_t ik = scm_to_ssize_t (scm_car (i));\
+  if (iklbnd || ik>s->ubnd) \
+{   \
+  scm_array_handle_release (&handle);   \
+  scm_misc_error (FUNC_NAME, "indices out of range", error_args); \
+}   \
+  pos += (ik-s->lbnd) * s->inc; \
+}
+
+#define ARRAY_FROM_GET_O\
+  o = scm_i_make_array (k); \
+  SCM_I_ARRAY_SET_V (o, handle.vector); \
+  SCM_I_ARRAY_SET_BASE (o, pos + handle.base);  \
+  scm_t_array_dim * os = SCM_I_ARRAY_DIMS (o);  \
+  for (; k>0; --k, ++s, ++os)   \
+{   \
+  os->ubnd = s->ubnd;   \
+  os->lbnd = s->lbnd;   \
+  os->inc = s->inc; \
+}
+
+
+SCM_DEFINE (scm_array_from_s, "array-from*", 1, 0, 1,
+   (SCM ra, SCM indices),
+"Return the array slice @var{ra}[@var{indices} ..., ...]\n"
+"The rank of @var{ra} must equal to the number of indices or 
larger.\n\n"
+"See also @code{array-ref}, @code{array-from}, 
@code{array-set-from!}.\n\n"
+"@code{array-from*} may return a rank-0 array. For example:\n"
+"@lisp\n"
+"(array-from* #2((1 2 3) (4 5 6)) 1 1) @result{} #0(5)\n"
+"(array-from* #2((1 2 3) (4 5 6)) 1) @result{} #(4 5 6)\n"
+"(array-from* #2((1 2 3) (4 5 6))) @result{} #2((1 2 3) (4 5 6))\n"
+"(array-from* #0(5) @result{} #0(5).\n"
+"@end lisp")
+#define FUNC_NAME s_scm_array_from_s
+{
+  ARRAY_FROM_POS(scm_list_2 (ra, indices))
+  SCM o;
+  if (k==ndim)
+o = ra;
+  else if (scm_is_null (i))
+{ ARRAY_FROM_GET_O }
+  else
+{
+  scm_array_handle_release (&handle);
+  scm_misc_error(FUNC_NAME, "too many indices", scm_list_2 (ra, indices));
+}
+  scm_array_handle_release (&handle);
+  return o;
+}
+#undef FUNC_NAME
+
+
+SCM_DEFINE (scm_array_from, "array-from", 1, 0, 1,
+   (SCM ra, SCM indices),
+"Return the element at the @code{(@var{indices} ...)} position\n"
+"in array @var{ra}, or the array slice @var{ra}[@var{indices} ..., 
...]\n"
+"if the rank of @var{ra} is larger than the number of indices.\n\n"
+"See also @code{array-ref}, @code{array-from*}, 
@code{array-set-from!}.\n\n"
+"@code{array-from} never returns a rank 0 array. For example:\n"
+"@lisp\n"
+"(array-from #2((1 2 3) (4 5 6)) 1 1) @result{} 5\n"
+"(array-from #2((1 2 3) (4 5 6)) 1) @result{} #(4 5 6)\n"
+"(array-from #2((1 2 3) (4 5 6))) @result{} #2((1 2 3) (4 5 6))\n"
+"(array-from #0(5) @result{} 5.\n"
+"@end lisp")
+#define FUNC_NAME s_scm_array_from
+{
+  ARRAY_FROM_POS(scm_list_2 (ra, indices))
+  SCM o;
+  if (k>0)
+{
+  if (k==ndim)
+o = ra;
+  else
+{ ARRAY_FROM_GET_O }
+}
+  else if (scm_is_null(i))
+o = scm_array_handle_ref (&handle, pos);
+  else
+{
+  scm_array_handle_release (&

[Guile-commits] 15/25: Draft of (array-for-each-cell)

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit fb4d4d966c75723ddb5ee339db87b24078f8c900
Author: Daniel Llorens 
Date:   Tue Sep 8 16:57:30 2015 +0200

Draft of (array-for-each-cell)

* libguile/arrays.c (scm_i_array_rebase, scm_array_for_each_cell): new
  functions. Export scm_array_for_each_cell() as (array-for-each-cell).

* libguile/arrays.h (scm_i_array_rebase, scm_array_for_each_cell):
  prototypes.
---
 libguile/arrays.c |  192 -
 libguile/arrays.h |2 +
 2 files changed, 192 insertions(+), 2 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 26c4543..de86023 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -546,7 +546,7 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1,
 { ARRAY_FROM_GET_O }
   scm_array_handle_release(&handle);
   /* an error is still possible here if o and b don't match. */
-  /* TODO copying like this wastes the handle, and the bounds matching
+  /* FIXME copying like this wastes the handle, and the bounds matching
  behavior of array-copy! is not strict. */
   scm_array_copy_x(b, o);
 }
@@ -564,11 +564,199 @@ SCM_DEFINE (scm_array_amend_x, "array-amend!", 2, 0, 1,
 }
 #undef FUNC_NAME
 
-
 #undef ARRAY_FROM_POS
 #undef ARRAY_FROM_GET_O
 
 
+// Copy array descriptor with different base.
+SCM
+scm_i_array_rebase (SCM a, size_t base)
+{
+size_t ndim = SCM_I_ARRAY_NDIM(a);
+SCM b = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
+SCM_I_ARRAY_SET_V (b, SCM_I_ARRAY_V (a));
+// FIXME do check base
+SCM_I_ARRAY_SET_BASE (b, base);
+memcpy(SCM_I_ARRAY_DIMS(b), SCM_I_ARRAY_DIMS(a), 
sizeof(scm_t_array_dim)*ndim);
+return b;
+}
+
+SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
+(SCM frank_, SCM op, SCM a_),
+"Apply op to each of the rank (-frank) cells of the arguments,\n"
+"in unspecified order. The first frank dimensions of the\n"
+"arguments must match. Rank-0 cells are passed as such.\n\n"
+"The value returned is unspecified.\n\n"
+"For example:\n"
+"@lisp\n"
+"@end lisp")
+#define FUNC_NAME s_scm_array_for_each_cell
+{
+  // FIXME replace stack by scm_gc_malloc_pointerless()
+  int const N = scm_ilength(a_);
+  scm_t_array_handle ah[N];
+  SCM a[N];
+  scm_t_array_dim * as[N];
+  int rank[N];
+  for (int n=0; scm_is_pair(a_); a_=scm_cdr(a_), ++n)
+{
+  a[n] = scm_car(a_);
+  scm_array_get_handle(a[n], ah+n);
+  as[n] = scm_array_handle_dims(ah+n);
+  rank[n] = scm_array_handle_rank(ah+n);
+}
+  // checks.
+  int const frank = scm_to_int(frank_);
+  ssize_t s[frank];
+  char const * msg = NULL;
+  if (frank<0)
+{
+  msg = "bad frame rank";
+} else
+{
+  for (int n=0; n!=N; ++n) {
+if (rank[n]

[Guile-commits] 12/25: Speed up for multi-arg cases of scm_ramap functions

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit c17799dda915dab93142c76bda9152d25919cb49
Author: Daniel Llorens 
Date:   Fri Feb 13 18:42:27 2015 +0100

Speed up for multi-arg cases of scm_ramap functions

This patch results in a 20%-40% speedup in the > 1 argument cases of
the following microbenchmarks:

(define A (make-shared-array #0(1) (const '()) #e1e7))
; 1, 2, 3 arguments.
(define a 0) ,time (array-for-each (lambda (b) (set! a (+ a b))) A)
(define a 0) ,time (array-for-each (lambda (b c) (set! a (+ a b c))) A A)
(define a 0) ,time (array-for-each (lambda (b c d) (set! a (+ a b c d))) A 
A A)

(define A (make-shared-array (make-array 1) (const '()) #e1e7))
(define B (make-shared-array #0(1) (const '()) #e1e7))
; 1, 2, 3 arguments.
,time (array-map! A + B)
,time (array-map! A + B B)
,time (array-map! A + B B B)

* libguile/array-map.c (scm_ramap): note on cproc arguments.

  (rafill): assume that dst's lbnd is 0.

  (racp): assume that src's lbnd is 0.

  (ramap): assume that ra0's lbnd is 0. When there're more than two
  arguments, compute the array handles before the loop. Allocate the arg
  list once and reuse it in the loop.

  (rafe): like rafe, when there's more than one argument.

  (AREF, ASET): remove.
---
 libguile/array-map.c|  151 +++
 libguile/array-map.h|2 +-
 test-suite/tests/ramap.test |   10 +--
 3 files changed, 86 insertions(+), 77 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 587df02..058b6fe 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1996, 1998, 2000, 2001, 2004, 2005, 2006, 2008, 2009,
- *   2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2010, 2011, 2012, 2013, 2014, 2015 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
@@ -48,18 +48,6 @@
 static const char vi_gc_hint[] = "array-indices";
 
 static SCM
-AREF (SCM v, size_t pos)
-{
-  return scm_c_array_ref_1 (v, pos);
-}
-
-static void
-ASET (SCM v, size_t pos, SCM val)
-{
-  scm_c_array_set_1_x (v, val, pos);
-}
-
-static SCM
 make1array (SCM v, ssize_t inc)
 {
   SCM a = scm_i_make_array (1);
@@ -99,6 +87,10 @@ cindk (SCM ra, ssize_t *ve, int kend)
 #define LBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].lbnd
 #define UBND(ra, k) SCM_I_ARRAY_DIMS (ra)[k].ubnd
 
+
+/* scm_ramapc() always calls cproc with rank-1 arrays created by
+   make1array. cproc (rafe, ramap, rafill, racp) can assume that the
+   dims[0].lbnd of these arrays is always 0. */
 int
 scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, const char *what)
 {
@@ -167,7 +159,7 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
 scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
   va1 = make1array (ra1, 1);
 
-  if (LBND (ra0, 0) < LBND (va1, 0) || UBND (ra0, 0) > UBND (va1, 0))
+  if (LBND (ra0, 0) < 0 /* LBND (va1, 0) */ || UBND (ra0, 0) > UBND 
(va1, 0))
 scm_misc_error (what, "array shape mismatch: ~S", scm_list_1 
(ra0));
 }
   *plva = scm_cons (va1, SCM_EOL);
@@ -224,14 +216,12 @@ scm_ramapc (void *cproc_ptr, SCM data, SCM ra0, SCM lra, 
const char *what)
 static int
 rafill (SCM dst, SCM fill)
 {
-  scm_t_array_handle h;
-  size_t n, i;
-  ssize_t inc;
-  scm_array_get_handle (SCM_I_ARRAY_V (dst), &h);
-  i = SCM_I_ARRAY_BASE (dst);
-  inc = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (dst)->ubnd - SCM_I_ARRAY_DIMS (dst)->lbnd + 1);
+  size_t n = SCM_I_ARRAY_DIMS (dst)->ubnd + 1;
+  size_t i = SCM_I_ARRAY_BASE (dst);
+  ssize_t inc = SCM_I_ARRAY_DIMS (dst)->inc;
   dst = SCM_I_ARRAY_V (dst);
+  scm_t_array_handle h;
+  scm_array_get_handle (dst, &h);
 
   for (; n-- > 0; i += inc)
 h.vset (h.vector, i, fill);
@@ -255,19 +245,15 @@ SCM_DEFINE (scm_array_fill_x, "array-fill!", 2, 0, 0,
 static int
 racp (SCM src, SCM dst)
 {
-  scm_t_array_handle h_s, h_d;
-  size_t n, i_s, i_d;
-  ssize_t inc_s, inc_d;
-
   dst = SCM_CAR (dst);
-  i_s = SCM_I_ARRAY_BASE (src);
-  i_d = SCM_I_ARRAY_BASE (dst);
-  inc_s = SCM_I_ARRAY_DIMS (src)->inc;
-  inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
-  n = (SCM_I_ARRAY_DIMS (src)->ubnd - SCM_I_ARRAY_DIMS (src)->lbnd + 1);
+  size_t i_s = SCM_I_ARRAY_BASE (src);
+  size_t i_d = SCM_I_ARRAY_BASE (dst);
+  size_t n = (SCM_I_ARRAY_DIMS (src)->ubnd + 1);
+  ssize_t inc_s = SCM_I_ARRAY_DIMS (src)->inc;
+  ssize_t inc_d = SCM_I_ARRAY_DIMS (dst)->inc;
   src = SCM_I_ARRAY_V (src);
   dst = SCM_I_ARRAY_V (dst);
-
+  scm_t_array_handle h_s, h_d;
   scm_array_get_handle (src, &h_s);
   scm_array_get_handle (dst, &h_d);
 
@@ -310,44 +296,56 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 static

[Guile-commits] 18/25: Special case for array-map! with three arguments

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit b854d0f34aeb573ec724484225d5067bb52863d6
Author: Daniel Llorens 
Date:   Wed Dec 9 13:10:48 2015 +0100

Special case for array-map! with three arguments

Benchmark:

(define type #t)
(define A (make-typed-array 's32 0 1 1000))
(define B (make-typed-array 's32 0 1 1000))
(define C (make-typed-array 's32 0 1 1000))

before:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.792653s real time, 0.790970s run time.  0.00s spent in GC.

after:

scheme@(guile-user)> ,time (array-map! C + A B)
;; 0.598513s real time, 0.597146s run time.  0.00s spent in GC.

* libguile/array-map.c (ramap): Add special case with 3 arguments.
---
 libguile/array-map.c |   56 +++---
 1 file changed, 35 insertions(+), 21 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 058b6fe..f07fd00 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -320,32 +320,46 @@ ramap (SCM ra0, SCM proc, SCM ras)
   h0.vset (h0.vector, i0, scm_call_1 (proc, h1.vref (h1.vector, i1)));
   else
 {
-  size_t restn = scm_ilength (ras);
-
-  SCM args = SCM_EOL;
-  SCM *p = &args;
-  SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint);
-  for (size_t k = 0; k < restn; ++k)
+  SCM ra2 = SCM_CAR (ras);
+  ras = SCM_CDR (ras);
+  size_t i2 = SCM_I_ARRAY_BASE (ra2);
+  ssize_t inc2 = SCM_I_ARRAY_DIMS (ra2)->inc;
+  ra2 = SCM_I_ARRAY_V (ra2);
+  scm_t_array_handle h2;
+  scm_array_get_handle (ra2, &h2);
+  if (scm_is_null (ras))
+for (; n--; i0 += inc0, i1 += inc1, i2 += inc2)
+  h0.vset (h0.vector, i0, scm_call_2 (proc, h1.vref (h1.vector, 
i1), h2.vref (h2.vector, i2)));
+  else
 {
-  *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
-  sa[k] = SCM_CARLOC (*p);
-  p = SCM_CDRLOC (*p);
-}
+  size_t restn = scm_ilength (ras);
 
-  scm_t_array_handle *hs = scm_gc_malloc
-(sizeof(scm_t_array_handle) * restn, vi_gc_hint);
-  for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras))
-scm_array_get_handle (scm_car (ras), hs+k);
+  SCM args = SCM_EOL;
+  SCM *p = &args;
+  SCM **sa = scm_gc_malloc (sizeof(SCM *) * restn, vi_gc_hint);
+  for (size_t k = 0; k < restn; ++k)
+{
+  *p = scm_cons (SCM_UNSPECIFIED, SCM_EOL);
+  sa[k] = SCM_CARLOC (*p);
+  p = SCM_CDRLOC (*p);
+}
+
+  scm_t_array_handle *hs = scm_gc_malloc
+(sizeof(scm_t_array_handle) * restn, vi_gc_hint);
+  for (size_t k = 0; k < restn; ++k, ras = scm_cdr (ras))
+scm_array_get_handle (scm_car (ras), hs+k);
+
+  for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, i2 += inc2, ++i)
+{
+  for (size_t k = 0; k < restn; ++k)
+*(sa[k]) = scm_array_handle_ref (hs+k, 
i*hs[k].dims[0].inc);
+  h0.vset (h0.vector, i0, scm_apply_2 (proc, h1.vref 
(h1.vector, i1), h2.vref (h2.vector, i2), args));
+}
 
-  for (ssize_t i = 0; n--; i0 += inc0, i1 += inc1, ++i)
-{
   for (size_t k = 0; k < restn; ++k)
-*(sa[k]) = scm_array_handle_ref (hs+k, i*hs[k].dims[0].inc);
-  h0.vset (h0.vector, i0, scm_apply_1 (proc, h1.vref (h1.vector, 
i1), args));
+scm_array_handle_release (hs+k);
 }
-
-  for (size_t k = 0; k < restn; ++k)
-scm_array_handle_release (hs+k);
+  scm_array_handle_release (&h2);
 }
   scm_array_handle_release (&h1);
 }

[Guile-commits] 01/25: Avoid unneeded internal use of array handles

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 655494c65bb623d734493e457ccdb927f339a668
Author: Daniel Llorens 
Date:   Mon Feb 9 12:11:52 2015 +0100

Avoid unneeded internal use of array handles

* libguile/arrays.c (scm_shared_array_root): adopt uniform check order.

  (scm_shared_array_offset, scm_shared_array_increments): use the array
  fields directly just as scm_shared_array_root does.

* test-suite/tests/arrays.test: tests for shared-array-offset,
  shared-array-increments.
---
 libguile/arrays.c|   44 
 test-suite/tests/arrays.test |   76 ++
 2 files changed, 85 insertions(+), 35 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 52fe90a..05f8597 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -71,10 +71,10 @@ SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 
0, 0,
 {
   if (SCM_I_ARRAYP (ra))
 return SCM_I_ARRAY_V (ra);
-  else if (!scm_is_array (ra))
-scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
-  else
+  else if (scm_is_array (ra))
 return ra;
+  else
+scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
 }
 #undef FUNC_NAME
 
@@ -84,13 +84,12 @@ SCM_DEFINE (scm_shared_array_offset, "shared-array-offset", 
1, 0, 0,
"Return the root vector index of the first element in the array.")
 #define FUNC_NAME s_scm_shared_array_offset
 {
-  scm_t_array_handle handle;
-  SCM res;
-
-  scm_array_get_handle (ra, &handle);
-  res = scm_from_size_t (handle.base);
-  scm_array_handle_release (&handle);
-  return res;
+  if (SCM_I_ARRAYP (ra))
+return scm_from_size_t (SCM_I_ARRAY_BASE (ra));
+  else if (scm_is_array (ra))
+return scm_from_size_t (0);
+  else
+scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
 }
 #undef FUNC_NAME
 
@@ -100,18 +99,19 @@ SCM_DEFINE (scm_shared_array_increments, 
"shared-array-increments", 1, 0, 0,
"For each dimension, return the distance between elements in the 
root vector.")
 #define FUNC_NAME s_scm_shared_array_increments
 {
-  scm_t_array_handle handle;
-  SCM res = SCM_EOL;
-  size_t k;
-  scm_t_array_dim *s;
-
-  scm_array_get_handle (ra, &handle);
-  k = scm_array_handle_rank (&handle);
-  s = scm_array_handle_dims (&handle);
-  while (k--)
-res = scm_cons (scm_from_ssize_t (s[k].inc), res);
-  scm_array_handle_release (&handle);
-  return res;
+  if (SCM_I_ARRAYP (ra))
+{
+  size_t k = SCM_I_ARRAY_NDIM (ra);
+  SCM res = SCM_EOL;
+  scm_t_array_dim *dims = SCM_I_ARRAY_DIMS (ra);
+  while (k--)
+res = scm_cons (scm_from_ssize_t (dims[k].inc), res);
+  return res;
+}
+  else if (scm_is_array (ra))
+return scm_list_1 (scm_from_ssize_t (1));
+  else
+scm_wrong_type_arg_msg (FUNC_NAME, SCM_ARG1, ra, "array");
 }
 #undef FUNC_NAME
 
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index e76c699..7c7b467 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -23,9 +23,13 @@
   #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-4 gnu))
 
-;;;
-;;; array?
-;;;
+(define (array-row a i)
+  (make-shared-array a (lambda (j) (list i j))
+ (cadr (array-dimensions a
+
+(define (array-col a j)
+  (make-shared-array a (lambda (i) (list i j))
+ (car (array-dimensions a
 
 (define exception:wrong-num-indices
   (cons 'misc-error "^wrong number of indices.*"))
@@ -33,6 +37,15 @@
 (define exception:length-non-negative
   (cons 'read-error ".*array length must be non-negative.*"))
 
+(define exception:wrong-type-arg
+  (cons #t "Wrong type"))
+
+(define exception:mapping-out-of-range
+  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
+
+;;;
+;;; array?
+;;;
 
 (with-test-prefix "array?"
 
@@ -210,9 +223,6 @@
 ;;; make-shared-array
 ;;;
 
-(define exception:mapping-out-of-range
-  (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
-
 (with-test-prefix/c&e "make-shared-array"
 
   ;; this failed in guile 1.8.0
@@ -392,13 +402,57 @@
   (eq? (shared-array-root a) (shared-array-root b) (array-contents a)
 
 ;;;
+;;; shared-array-offset
+;;;
+
+(with-test-prefix/c&e "shared-array-offset"
+
+  (pass-if "plain vector"
+(zero? (shared-array-offset (make-vector 4 0
+
+  (pass-if "plain array rank 2"
+(zero? (shared-array-offset (make-array 0 4 4
+
+  (pass-if "row of rank-2 array, I"
+(= 0 (shared-array-offset (array-row (make-array 0 5 3) 0
+
+  (pass-if "row of rank-2 array, II"
+(= 4 (shared-array-offset (array-row (make-array 0 6 4) 1
+
+  (pass-if "col of rank-2 array, I"
+(= 0 (shared-array-offset (array-col (make-array 0 5 3) 0
+
+  (pass-if "col of rank-2 array, II"
+(= 1 (shared-array-offset (array-col (make-array 0 6 4) 1)
+
+
+;;;
+;;; shared-array-increments
+;;;
+
+(with-test-prefi

[Guile-commits] 03/25: Unuse array 'contiguous' flag

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 212c5b0f299660bddd1c0b2c9645b453be72b4ee
Author: Daniel Llorens 
Date:   Tue Feb 10 17:21:29 2015 +0100

Unuse array 'contiguous' flag

SCM_I_ARRAY_FLAG_CONTIGUOUS (arrays.h) was set by all array-creating
functions (make-typed-array, transpose-array, make-shared-array) but it
was only used by array-contents, which needed to traverse the dimensions
anyway.

* libguile/arrays.c (scm_make_typed_array,
  scm_from_contiguous_typed_array): don't set the contiguous flag.

  (scm_transpose_array, scm_make_shared_array): don't call
  scm_i_ra_set_contp.

  (scm_array_contents): inline scm_i_ra_set_contp() here. Adopt uniform
  type check order. Remove redundant comments.

  (scm_i_ra_set_contp): remove.

* libguile/arrays.h: note.

* test-suite/tests/arrays.test: test array-contents with rank 0 array.
---
 libguile/arrays.c|   77 --
 libguile/arrays.h|2 +-
 test-suite/tests/arrays.test |6 
 3 files changed, 36 insertions(+), 49 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 6613542..c852e64 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -188,7 +188,6 @@ SCM_DEFINE (scm_make_typed_array, "make-typed-array", 2, 0, 
1,
   SCM ra;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -225,7 +224,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
   size_t sz;
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
@@ -279,27 +277,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-static void
-scm_i_ra_set_contp (SCM ra)
-{
-  size_t k = SCM_I_ARRAY_NDIM (ra);
-  if (k)
-{
-  ssize_t inc = SCM_I_ARRAY_DIMS (ra)[k - 1].inc;
-  while (k--)
-   {
- if (inc != SCM_I_ARRAY_DIMS (ra)[k].inc)
-   {
- SCM_CLR_ARRAY_CONTIGUOUS_FLAG (ra);
- return;
-   }
- inc *= (SCM_I_ARRAY_DIMS (ra)[k].ubnd
- - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 1);
-   }
-}
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
-}
-
 
 SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 0, 1,
(SCM oldra, SCM mapfunc, SCM dims),
@@ -413,7 +390,6 @@ SCM_DEFINE (scm_make_shared_array, "make-shared-array", 2, 
0, 1,
return scm_make_generalized_vector (scm_array_type (ra), SCM_INUM0,
 SCM_UNDEFINED);
 }
-  scm_i_ra_set_contp (ra);
   return ra;
 }
 #undef FUNC_NAME
@@ -512,16 +488,12 @@ SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 
1,
}
   if (ndim > 0)
SCM_MISC_ERROR ("bad argument list", SCM_EOL);
-  scm_i_ra_set_contp (res);
   return res;
 }
 }
 #undef FUNC_NAME
 
-/* attempts to unroll an array into a one-dimensional array.
-   returns the unrolled array or #f if it can't be done.  */
-/* if strict is true, return #f if returned array
-   wouldn't have contiguous elements.  */
+
 SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
(SCM ra, SCM strict),
"If @var{ra} may be @dfn{unrolled} into a one dimensional shared\n"
@@ -531,31 +503,38 @@ SCM_DEFINE (scm_array_contents, "array-contents", 1, 1, 0,
"@code{make-array} and @code{make-uniform-array} may be unrolled,\n"
"some arrays made by @code{make-shared-array} may not be.  If\n"
"the optional argument @var{strict} is provided, a shared array\n"
-   "will be returned only if its elements are stored internally\n"
-   "contiguous in memory.")
+   "will be returned only if its elements are stored contiguously\n"
+   "in memory.")
 #define FUNC_NAME s_scm_array_contents
 {
-  if (!scm_is_array (ra))
-scm_wrong_type_arg_msg (NULL, 0, ra, "array");
-  else if (SCM_I_ARRAYP (ra))
+  if (SCM_I_ARRAYP (ra))
 {
   SCM v;
-  size_t k, ndim = SCM_I_ARRAY_NDIM (ra), len = 1;
-  if (!SCM_I_ARRAY_CONTP (ra))
-   return SCM_BOOL_F;
-  for (k = 0; k < ndim; k++)
-   len *= SCM_I_ARRAY_DIMS (ra)[k].ubnd - SCM_I_ARRAY_DIMS (ra)[k].lbnd + 
1;
+  size_t ndim = SCM_I_ARRAY_NDIM (ra);
+  scm_t_array_dim *s = SCM_I_ARRAY_DIMS (ra);
+  size_t k = ndim;
+  size_t len = 1;
+
+  if (k)
+{
+  ssize_t last_inc = s[k - 1].inc;
+  while (k--)
+{
+  if (len*last_inc != s[k].inc)
+return SCM_BOOL_F;
+  len *= (s[k].ubnd - s[k].lbnd + 1);
+}
+}
+
   if (!SCM_UNBNDP (strict) && scm_is_true (strict))
{
- if (ndim && (1 != SCM_I_ARRAY_DIMS (ra)[ndim - 1].inc))
+ if (ndim && (1 != s[ndim - 1].inc)

[Guile-commits] 10/25: Fix compilation of rank 0 typed array literals

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit fc0e75c50d6bced2cf86e8e6b175ec62dd40acfc
Author: Daniel Llorens 
Date:   Thu Feb 12 13:02:24 2015 +0100

Fix compilation of rank 0 typed array literals

* module/system/vm/assembler.scm (simple-uniform-vector?): array-length
  fails for rank 0 arrays; fix the shape condition.

* test-suite/tests/arrays.test: test reading of #0f64(x) in compilation
  context.
---
 module/system/vm/assembler.scm |4 +++-
 test-suite/tests/arrays.test   |8 +++-
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 20a652c..f6b3caa 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -995,7 +995,9 @@ immediate, and @code{#f} otherwise."
 (define (simple-uniform-vector? obj)
   (and (array? obj)
(symbol? (array-type obj))
-   (equal? (array-shape obj) (list (list 0 (1- (array-length obj)))
+   (match (array-shape obj)
+ (((0 n)) #t)
+ (else #f
 
 (define (statically-allocatable? x)
   "Return @code{#t} if a non-immediate constant can be allocated
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index c6027c2..9bd0676 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -217,7 +217,13 @@
 (with-test-prefix/c&e "array-equal?"
 
   (pass-if "#s16(...)"
-(array-equal? #s16(1 2 3) #s16(1 2 3
+(array-equal? #s16(1 2 3) #s16(1 2 3)))
+
+  (pass-if "#0f64(...)"
+(array-equal? #0f64(99) (make-typed-array 'f64 99)))
+
+  (pass-if "#0(...)"
+(array-equal? #0(99) (make-array 99
 
 ;;;
 ;;; make-shared-array

[Guile-commits] 17/25: New export (array-for-each-cell-in-order)

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit ffd949e59740745c2b9a9f73dffa70878be0b344
Author: Daniel Llorens 
Date:   Wed Dec 9 12:57:19 2015 +0100

New export (array-for-each-cell-in-order)

* libguile/arrays.h (array-for-each-cell-in-order): Declare.

* libguile/arrays.c (array-for-each-cell-in-order): Define.
---
 libguile/arrays.c |   14 +-
 libguile/arrays.h |1 +
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index de86023..0e8c6c2 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -594,6 +594,7 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
 {
   // FIXME replace stack by scm_gc_malloc_pointerless()
   int const N = scm_ilength(a_);
+  int const frank = scm_to_int(frank_);
   scm_t_array_handle ah[N];
   SCM a[N];
   scm_t_array_dim * as[N];
@@ -606,7 +607,6 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
   rank[n] = scm_array_handle_rank(ah+n);
 }
   // checks.
-  int const frank = scm_to_int(frank_);
   ssize_t s[frank];
   char const * msg = NULL;
   if (frank<0)
@@ -757,6 +757,17 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
 #undef FUNC_NAME
 
 
+SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order", 
2, 0, 1,
+(SCM frank_, SCM op, SCM a_),
+"Same as array-for-each-cell, but visit the cells sequentially\n"
+"and in row-major order.\n")
+#define FUNC_NAME s_scm_array_for_each_cell_in_order
+{
+  return scm_array_for_each_cell (frank_, op, a_);
+}
+#undef FUNC_NAME
+
+
 /* args are RA . DIMS */
 SCM_DEFINE (scm_transpose_array, "transpose-array", 1, 0, 1,
(SCM ra, SCM args),
@@ -1131,6 +1142,7 @@ scm_i_print_array (SCM array, SCM port, scm_print_state 
*pstate)
 return scm_i_print_array_dimension (&h, 0, 0, port, pstate);
 }
 
+
 void
 scm_init_arrays ()
 {
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 5a88b72..b43e93c 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -53,6 +53,7 @@ SCM_API SCM scm_array_from_s (SCM ra, SCM indices);
 SCM_API SCM scm_array_from (SCM ra, SCM indices);
 SCM_API SCM scm_array_amend_x (SCM ra, SCM b, SCM indices);
 SCM_API SCM scm_array_for_each_cell (SCM frank, SCM op, SCM args);
+SCM_API SCM scm_array_for_each_cell_in_order (SCM frank, SCM op, SCM args);
 
 SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
 SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);

[Guile-commits] 11/25: Remove deprecated array functions

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 348d8b46b0fa24d65eb6e4008b32fb725d7ec3f1
Author: Daniel Llorens 
Date:   Fri Feb 13 16:45:21 2015 +0100

Remove deprecated array functions

* libguile/array-map.c (scm_array_fill_int, scm_array_fill_int,
scm_ra_eqp, scm_ra_lessp scm_ra_leqp, scm_ra_grp, scm_ra_greqp,
scm_ra_sum, scm_ra_difference, scm_ra_product, scm_ra_divide,
scm_array_identity): remove deprecated functions.

* libguile/array-map.h: remove declaration of deprecated functions.
---
 libguile/array-map.c |  261 --
 libguile/array-map.h |   16 
 2 files changed, 277 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 938f0a7..587df02 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -307,267 +307,6 @@ SCM_DEFINE (scm_array_copy_x, "array-copy!", 2, 0, 0,
 #undef FUNC_NAME
 
 
-#if SCM_ENABLE_DEPRECATED == 1
-
-/* to be used as cproc in scm_ramapc to fill an array dimension with
-   "fill". */
-int
-scm_array_fill_int (SCM ra, SCM fill, SCM ignore SCM_UNUSED)
-{
-  unsigned long i;
-  unsigned long n = SCM_I_ARRAY_DIMS (ra)->ubnd - SCM_I_ARRAY_DIMS (ra)->lbnd 
+ 1;
-  long inc = SCM_I_ARRAY_DIMS (ra)->inc;
-  unsigned long base = SCM_I_ARRAY_BASE (ra);
-
-  ra = SCM_I_ARRAY_V (ra);
-
-  for (i = base; n--; i += inc)
-ASET (ra, i, fill);
-
-  return 1;
-}
-
-/* Functions callable by ARRAY-MAP! */
-
-int
-scm_ra_eqp (SCM ra0, SCM ras)
-{
-  SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras));
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  ra2 = SCM_I_ARRAY_V (ra2);
-
-  scm_array_get_handle (ra0, &ra0_handle);
-  ra0_dims = scm_array_handle_dims (&ra0_handle);
-  n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1;
-  inc0 = ra0_dims[0].inc;
-
-  {
-for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
-  if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
-   if (!scm_is_eq (AREF (ra1, i1), AREF (ra2, i2)))
- scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
-  }
-
-  scm_array_handle_release (&ra0_handle);
-  return 1;
-}
-
-/* opt 0 means <, nonzero means >= */
-
-static int
-ra_compare (SCM ra0, SCM ra1, SCM ra2, int opt)
-{
-  scm_t_array_handle ra0_handle;
-  scm_t_array_dim *ra0_dims;
-  size_t n;
-  ssize_t inc0;
-  size_t i0 = 0;
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1), i2 = SCM_I_ARRAY_BASE (ra2);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  long inc2 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  ra2 = SCM_I_ARRAY_V (ra2);
-
-  scm_array_get_handle (ra0, &ra0_handle);
-  ra0_dims = scm_array_handle_dims (&ra0_handle);
-  n = ra0_dims[0].ubnd - ra0_dims[0].lbnd + 1;
-  inc0 = ra0_dims[0].inc;
-
-  {
-for (; n-- > 0; i0 += inc0, i1 += inc1, i2 += inc2)
-  if (scm_is_true (scm_array_handle_ref (&ra0_handle, i0)))
-   if (opt ?
-   scm_is_true (scm_less_p (AREF (ra1, i1), AREF (ra2, i2))) :
-   scm_is_false (scm_less_p (AREF (ra1, i1), AREF (ra2, i2
- scm_array_handle_set (&ra0_handle, i0, SCM_BOOL_F);
-  }
-
-  scm_array_handle_release (&ra0_handle);
-  return 1;
-}
-
-
-
-int
-scm_ra_lessp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 0);
-}
-
-
-int
-scm_ra_leqp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 1);
-}
-
-
-int
-scm_ra_grp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (SCM_CDR (ras)), SCM_CAR (ras), 0);
-}
-
-
-int
-scm_ra_greqp (SCM ra0, SCM ras)
-{
-  return ra_compare (ra0, SCM_CAR (ras), SCM_CAR (SCM_CDR (ras)), 1);
-}
-
-
-int
-scm_ra_sum (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (!scm_is_null(ras))
-{
-  SCM ra1 = SCM_CAR (ras);
-  unsigned long i1 = SCM_I_ARRAY_BASE (ra1);
-  long inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
-  ra1 = SCM_I_ARRAY_V (ra1);
-  switch (SCM_TYP7 (ra0) == SCM_TYP7 (ra1) ? SCM_TYP7 (ra0) : 0)
-   {
-   default:
- {
-   for (; n-- > 0; i0 += inc0, i1 += inc1)
- ASET (ra0, i0, scm_sum (AREF(ra0, i0), AREF(ra1, i1)));
-   break;
- }
-   }
-}
-  return 1;
-}
-
-
-
-int
-scm_ra_difference (SCM ra0, SCM ras)
-{
-  long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra0)->lbnd + 1;
-  unsigned long i0 = SCM_I_ARRAY_BASE (ra0);
-  long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc;
-  ra0 = SCM_I_ARRAY_V (ra0);
-  if (scm_is_null (ras))
-{
-  switch (SCM_TYP7 (ra0))
-   {
-   default

[Guile-commits] 04/25: Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit b9cbf3b6deee2516f5341d2df4aac8201dd3113b
Author: Daniel Llorens 
Date:   Wed Feb 11 12:58:01 2015 +0100

Reuse SCM_BYTEVECTOR_TYPED_LENGTH in scm_array_get_handle

* libguile/bytevectors.h (SCM_BYTEVECTOR_TYPE_SIZE,
  SCM_BYTEVECTOR_TYPED_LENGTH): moved from libguile/bytevectors.c.

* libguile/array-handle.c (scm_array_get_handle): reuse
  SCM_BYTEVECTOR_TYPED_LENGTH.
---
 libguile/array-handle.c |   12 +---
 libguile/bytevectors.c  |   13 -
 libguile/bytevectors.h  |5 +
 3 files changed, 14 insertions(+), 16 deletions(-)

diff --git a/libguile/array-handle.c b/libguile/array-handle.c
index 2252ecc..17be456 100644
--- a/libguile/array-handle.c
+++ b/libguile/array-handle.c
@@ -1,6 +1,6 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005,
  * 2006, 2009, 2011, 2013, 2014 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
@@ -185,15 +185,13 @@ scm_array_get_handle (SCM array, scm_t_array_handle *h)
   break;
 case scm_tc7_bytevector:
   {
-size_t byte_length, length, element_byte_size;
+size_t length;
 scm_t_array_element_type element_type;
 scm_t_vector_ref vref;
 scm_t_vector_set vset;
 
-byte_length = scm_c_bytevector_length (array);
 element_type = SCM_BYTEVECTOR_ELEMENT_TYPE (array);
-element_byte_size = scm_i_array_element_type_sizes[element_type] / 8;
-length = byte_length / element_byte_size;
+length = SCM_BYTEVECTOR_TYPED_LENGTH (array);
 
 switch (element_type)
   {
@@ -248,7 +246,7 @@ scm_array_handle_pos (scm_t_array_handle *h, SCM indices)
   scm_t_array_dim *s = scm_array_handle_dims (h);
   ssize_t pos = 0, i;
   size_t k = scm_array_handle_rank (h);
-  
+
   while (k > 0 && scm_is_pair (indices))
 {
   i = scm_to_signed_integer (SCM_CAR (indices), s->lbnd, s->ubnd);
@@ -340,7 +338,7 @@ scm_init_array_handle (void)
 {
 #define DEFINE_ARRAY_TYPE(tag, TAG) \
   scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_##TAG] = 
scm_from_utf8_symbol (#tag)
-  
+
   scm_i_array_element_types[SCM_ARRAY_ELEMENT_TYPE_SCM] = SCM_BOOL_T;
   DEFINE_ARRAY_TYPE (a, CHAR);
   DEFINE_ARRAY_TYPE (b, BIT);
diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c
index e426ae3..8e9b5e6 100644
--- a/libguile/bytevectors.c
+++ b/libguile/bytevectors.c
@@ -192,11 +192,6 @@
 #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent)\
   SCM_SET_CELL_OBJECT_3 ((_bv), (_parent))
 
-#define SCM_BYTEVECTOR_TYPE_SIZE(var)   \
-  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
-#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\
-  (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYTEVECTOR_TYPE_SIZE (var))
-
 /* The empty bytevector.  */
 SCM scm_null_bytevector = SCM_UNSPECIFIED;
 
@@ -414,7 +409,7 @@ scm_i_print_bytevector (SCM bv, SCM port, scm_print_state 
*pstate SCM_UNUSED)
 {
   ssize_t ubnd, inc, i;
   scm_t_array_handle h;
-  
+
   scm_array_get_handle (bv, &h);
 
   scm_putc ('#', port);
@@ -643,7 +638,7 @@ SCM_DEFINE (scm_uniform_array_to_bytevector, 
"uniform-array->bytevector",
   size_t len, sz, byte_len;
   scm_t_array_handle h;
   const void *elts;
-  
+
   contents = scm_array_contents (array, SCM_BOOL_T);
   if (scm_is_false (contents))
 scm_wrong_type_arg_msg (FUNC_NAME, 0, array, "uniform contiguous array");
@@ -1940,7 +1935,7 @@ utf_encoding_name (char *name, size_t utf_width, SCM 
endianness)
   memcpy (SCM_BYTEVECTOR_CONTENTS (utf), c_utf, c_utf_len); \
   scm_dynwind_end ();   \
 \
-  return (utf); 
+  return (utf);
 
 
 
@@ -2001,7 +1996,7 @@ SCM_DEFINE (scm_string_to_utf32, "string->utf32",
   if (!scm_is_eq (SCM_UNBNDP (endianness) ? scm_endianness_big : endianness,
   scm_i_native_endianness))
 swap_u32 (wchars, wchar_len);
-  
+
   bv = make_bytevector (bytes_len, SCM_ARRAY_ELEMENT_TYPE_VU8);
   memcpy (SCM_BYTEVECTOR_CONTENTS (bv), wchars, bytes_len);
   free (wchars);
diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h
index a5eeaea..af4ac1c 100644
--- a/libguile/bytevectors.h
+++ b/libguile/bytevectors.h
@@ -129,6 +129,11 @@ SCM_API SCM scm_utf32_to_string (SCM, SCM);
 #define SCM_BYTEVECTOR_CONTIGUOUS_P(_bv)   \
   (SCM_BYTEVECTOR_FLAGS (_bv) >> 8UL)
 
+#define SCM_BYTEVECTOR_TYPE_SIZE(var)   \
+  (scm_i_array_element_type_sizes[SCM_BYTEVECTOR_ELEMENT_TYPE (var)]/8)
+#define SCM_BYTEVECTOR_TYPED_LENGTH(var)\
+  (SCM_BYTEVECTOR_LENGTH (var) / SCM_BYT

[Guile-commits] 05/25: Compile in C99 mode

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 839dec6325f1ec9acb72ead9e4aef87c9395264e
Author: Daniel Llorens 
Date:   Wed Feb 11 14:05:08 2015 +0100

Compile in C99 mode

* configure.ac: Require C99 flags. Remove -Wdeclaration-after-statement.
---
 configure.ac |   33 -
 1 file changed, 16 insertions(+), 17 deletions(-)

diff --git a/configure.ac b/configure.ac
index 1735c56..5d76407 100644
--- a/configure.ac
+++ b/configure.ac
@@ -65,7 +65,7 @@ AC_CANONICAL_HOST
 AC_LIBTOOL_WIN32_DLL
 
 AC_PROG_INSTALL
-AC_PROG_CC
+AC_PROG_CC_C99
 gl_EARLY
 AC_PROG_CPP
 AC_PROG_SED
@@ -175,19 +175,19 @@ dnl  investigation of problems with "64" system and 
library calls on
 dnl  Darwin (MacOS X).  The libguile code (_scm.h) assumes that if a
 dnl  system has stat64, it will have all the other 64 APIs too; but on
 dnl  Darwin, stat64 is there but other APIs are missing.
-dnl 
+dnl
 dnl  It also appears, from the Darwin docs, that most system call APIs
 dnl  there (i.e. the traditional ones _without_ "64" in their names) have
 dnl  been 64-bit-capable for a long time now, so it isn't necessary to
 dnl  use "64" versions anyway.  For example, Darwin's off_t is 64-bit.
-dnl 
+dnl
 dnl  A similar problem has been reported for HP-UX:
 dnl  http://www.nabble.com/Building-guile-1.8.2-on-hpux-td13106681.html
-dnl 
+dnl
 dnl  Therefore, and also because a Guile without LARGEFILE64 support is
 dnl  better than no Guile at all, we provide this option to suppress
 dnl  trying to use "64" calls.
-dnl 
+dnl
 dnl  It may be that for some 64-bit function on Darwin/HP-UX we do need
 dnl  to use a "64" call, and hence that by using --without-64-calls we're
 dnl  missing out on that.  If so, someone can work on that in the future.
@@ -850,7 +850,7 @@ volatile complex double z = - _Complex_I;
 int
 main (void)
 {
-  z = csqrt (z);   
+  z = csqrt (z);
   if (creal (z) > 0.0)
 return 0;  /* good */
   else
@@ -914,9 +914,9 @@ AC_CHECK_SIZEOF(size_t)
 AC_CHECK_SIZEOF(ssize_t)
 ffi_size_type=uint$(($ac_cv_sizeof_size_t*8))
 ffi_ssize_type=sint$(($ac_cv_sizeof_ssize_t*8))
-AC_DEFINE_UNQUOTED([ffi_type_size_t], ffi_type_${ffi_size_type}, 
+AC_DEFINE_UNQUOTED([ffi_type_size_t], ffi_type_${ffi_size_type},
   [ffi type for size_t])
-AC_DEFINE_UNQUOTED([ffi_type_ssize_t], ffi_type_${ffi_ssize_type}, 
+AC_DEFINE_UNQUOTED([ffi_type_ssize_t], ffi_type_${ffi_ssize_type},
   [ffi type for ssize_t])
 
 dnl i18n tests
@@ -1271,7 +1271,7 @@ LIBS="$save_LIBS"
 
 AC_CHECK_SIZEOF(float)
 if test "$ac_cv_sizeof_float" -le "$ac_cv_sizeof_long"; then
-AC_DEFINE([SCM_SINGLES], 1, 
+AC_DEFINE([SCM_SINGLES], 1,
   [Define this if floats are the same size as longs.])
 fi
 
@@ -1402,7 +1402,7 @@ case "$with_threads" in
 
 # On Solaris, sched_yield lives in -lrt.
 AC_SEARCH_LIBS(sched_yield, rt)
-
+
   ;;
 esac
 
@@ -1478,7 +1478,7 @@ GUILE_THREAD_LOCAL_STORAGE
 fi # with_threads=pthreads
 
 
-## Cross building  
+## Cross building
 if test "$cross_compiling" = "yes"; then
   AC_MSG_CHECKING(cc for build)
   ## /usr/bin/cc still uses wrong assembler
@@ -1486,8 +1486,8 @@ if test "$cross_compiling" = "yes"; then
   CC_FOR_BUILD="${CC_FOR_BUILD-PATH=/usr/bin:$PATH cc}"
 else
   CC_FOR_BUILD="${CC_FOR_BUILD-$CC}"
-fi   
- 
+fi
+
 ## AC_MSG_CHECKING("if we are cross compiling")
 ## AC_MSG_RESULT($cross_compiling)
 if test "$cross_compiling" = "yes"; then
@@ -1500,14 +1500,14 @@ CCLD_FOR_BUILD="$CC_FOR_BUILD"
 AC_SUBST(cross_compiling)
 AC_ARG_VAR(CC_FOR_BUILD,[build system C compiler])
 AC_SUBST(CCLD_FOR_BUILD)
-   
+
 ## libtool erroneously calls CC_FOR_BUILD HOST_CC;
 ## --HOST is the platform that PACKAGE is compiled for.
 HOST_CC="$CC_FOR_BUILD"
 AC_SUBST(HOST_CC)
 
 GUILE_CHECK_GUILE_FOR_BUILD
-   
+
 ## If we're using GCC, add flags to reduce strictness of undefined
 ## behavior, and ask for aggressive warnings.
 GCC_CFLAGS=""
@@ -1524,8 +1524,7 @@ case "$GCC" in
 ## .
 
 POTENTIAL_GCC_CFLAGS="-Wall -Wmissing-prototypes \
-  -Wdeclaration-after-statement -Wpointer-arith \
-  -Wswitch-enum -fno-strict-aliasing -fwrapv"
+  -Wpointer-arith -Wswitch-enum -fno-strict-aliasing -fwrapv"
 # Do this here so we don't screw up any of the tests above that might
 # not be "warning free"
 if test "${GUILE_ERROR_ON_WARNING}" = yes

[Guile-commits] 22/25: Fix pool version of scm_array_for_each_cell by aligning pointers

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 4a361f2902171a094d7f9b5bf2a98da9445fbd23
Author: Daniel Llorens 
Date:   Wed Jun 22 14:54:01 2016 +0200

Fix pool version of scm_array_for_each_cell by aligning pointers

* libguile/array-map.c (scm_array_for_each_cell): Align all pointers to
  pointer size.
---
 libguile/array-map.c |   36 +++-
 1 file changed, 19 insertions(+), 17 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 028f79b..3d1b3e3 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -651,7 +651,8 @@ scm_i_array_rebase (SCM a, size_t base)
 return b;
 }
 
-/*
+static inline size_t padtoptr(size_t d) { return (d + (sizeof (void *) - 1)) & 
~(sizeof (void *) - 1); }
+
 SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
 (SCM frame_rank, SCM op, SCM args),
 "Apply @var{op} to each of the cells of rank 
rank(@var{arg})-@var{frame_rank}\n"
@@ -679,23 +680,23 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
   SCM dargs_ = SCM_EOL;
 
   size_t stack_size = 0;
-  stack_size += N*sizeof (scm_t_array_handle);
-  stack_size += N*sizeof (SCM);
-  stack_size += N*sizeof (scm_t_array_dim *);
-  stack_size += N*sizeof (int);
-
-  stack_size += frank*sizeof (ssize_t);
-  stack_size += N*sizeof (SCM);
-  stack_size += N*sizeof (SCM *);
-  stack_size += frank*sizeof (ssize_t);
-
-  stack_size += frank*sizeof (int);
-  stack_size += N*sizeof (size_t);
+  stack_size += padtoptr(N*sizeof (scm_t_array_handle));
+  stack_size += padtoptr(N*sizeof (SCM));
+  stack_size += padtoptr(N*sizeof (scm_t_array_dim *));
+  stack_size += padtoptr(N*sizeof (int));
+
+  stack_size += padtoptr(frank*sizeof (ssize_t));
+  stack_size += padtoptr(N*sizeof (SCM));
+  stack_size += padtoptr(N*sizeof (SCM *));
+  stack_size += padtoptr(frank*sizeof (ssize_t));
+
+  stack_size += padtoptr(frank*sizeof (int));
+  stack_size += padtoptr(N*sizeof (size_t));
   char * stack = scm_gc_malloc (stack_size, "stack");
 
 #define AFIC_ALLOC_ADVANCE(stack, count, type, name)\
   type * name = (void *)stack;  \
-  stack += count*sizeof (type);
+  stack += padtoptr(count*sizeof (type));
 
   char * stack0 = stack;
   AFIC_ALLOC_ADVANCE (stack, N, scm_t_array_handle, ah);
@@ -884,8 +885,8 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-*/
 
+/*
 SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
 (SCM frame_rank, SCM op, SCM args),
 "Apply @var{op} to each of the cells of rank 
rank(@var{arg})-@var{frame_rank}\n"
@@ -909,8 +910,8 @@ SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 
2, 0, 1,
 #define FUNC_NAME s_scm_array_for_each_cell
 {
   // FIXME replace stack by scm_gc_malloc_pointerless()
-  int const N = scm_ilength(args);
-  int const frank = scm_to_int(frame_rank);
+  int const N = scm_ilength (args);
+  int const frank = scm_to_int (frame_rank);
   SCM dargs_ = SCM_EOL;
 
   scm_t_array_handle ah[N];
@@ -1097,6 +1098,7 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
+*/
 
 SCM_DEFINE (scm_array_for_each_cell_in_order, "array-for-each-cell-in-order", 
2, 0, 1,
 (SCM frank, SCM op, SCM a),

[Guile-commits] 24/25: Remove uniform-array-read!, uniform-array-write from the manual

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit 3320eaa7887a5079936681123e34de1d6588e85d
Author: Daniel Llorens 
Date:   Thu Jun 23 12:15:31 2016 +0200

Remove uniform-array-read!, uniform-array-write from the manual

These procedures where removed in
fc7bd367ab4b5027a7f80686b1e229c62e43c90b (2011-05-12).

* doc/ref/api-compound.texi: Ditto.
---
 doc/ref/api-compound.texi |   33 -
 1 file changed, 33 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index ef4869c..dde814c 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1569,39 +1569,6 @@ $\left(\matrix{%
 @end example
 @end deffn
 
-@deffn {Scheme Procedure} uniform-array-read! ra [port_or_fd [start [end]]]
-@deffnx {C Function} scm_uniform_array_read_x (ra, port_or_fd, start, end)
-Attempt to read all elements of array @var{ra}, in lexicographic order, as
-binary objects from @var{port_or_fd}.
-If an end of file is encountered,
-the objects up to that point are put into @var{ra}
-(starting at the beginning) and the remainder of the array is
-unchanged.
-
-The optional arguments @var{start} and @var{end} allow
-a specified region of a vector (or linearized array) to be read,
-leaving the remainder of the vector unchanged.
-
-@code{uniform-array-read!} returns the number of objects read.
-@var{port_or_fd} may be omitted, in which case it defaults to the value
-returned by @code{(current-input-port)}.
-@end deffn
-
-@deffn {Scheme Procedure} uniform-array-write ra [port_or_fd [start [end]]]
-@deffnx {C Function} scm_uniform_array_write (ra, port_or_fd, start, end)
-Writes all elements of @var{ra} as binary objects to
-@var{port_or_fd}.
-
-The optional arguments @var{start}
-and @var{end} allow
-a specified region of a vector (or linearized array) to be written.
-
-The number of objects actually written is returned.
-@var{port_or_fd} may be
-omitted, in which case it defaults to the value returned by
-@code{(current-output-port)}.
-@end deffn
-
 @node Shared Arrays
 @subsubsection Shared Arrays
 

[Guile-commits] 23/25: Remove commented stack version of scm_array_for_each_cell()

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit cbaa6cadcce4aa46be24f4ebf4bdaaf94d4f6abd
Author: Daniel Llorens 
Date:   Wed Jun 22 14:55:27 2016 +0200

Remove commented stack version of scm_array_for_each_cell()

* libguile/array-map.c: Ditto.
---
 libguile/array-map.c |  214 --
 1 file changed, 214 deletions(-)

diff --git a/libguile/array-map.c b/libguile/array-map.c
index 3d1b3e3..6c3772e 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -886,220 +886,6 @@ SCM_DEFINE (scm_array_for_each_cell, 
"array-for-each-cell", 2, 0, 1,
 }
 #undef FUNC_NAME
 
-/*
-SCM_DEFINE (scm_array_for_each_cell, "array-for-each-cell", 2, 0, 1,
-(SCM frame_rank, SCM op, SCM args),
-"Apply @var{op} to each of the cells of rank 
rank(@var{arg})-@var{frame_rank}\n"
-"of the arrays @var{args}, in unspecified order. The first\n"
-"@var{frame_rank} dimensions of each @var{arg} must match.\n"
-"Rank-0 cells are passed as rank-0 arrays.\n\n"
-"The value returned is unspecified.\n\n"
-"For example:\n"
-"@lisp\n"
-";; Sort the rows of rank-2 array A.\n\n"
-"(array-for-each-cell 1 (lambda (x) (sort! x <)) a)\n"
-"\n"
-";; Compute the arguments of the (x y) vectors in the rows of 
rank-2\n"
-";; array XYS and store them in rank-1 array ANGLES. Inside OP,\n"
-";; XY is a rank-1 (2-1) array, and ANGLE is a rank-0 (1-1) 
array.\n\n"
-"(array-for-each-cell 1 \n"
-"  (lambda (xy angle)\n"
-"(array-set! angle (atan (array-ref xy 1) (array-ref xy 
0\n"
-"  xys angles)\n"
-"@end lisp")
-#define FUNC_NAME s_scm_array_for_each_cell
-{
-  // FIXME replace stack by scm_gc_malloc_pointerless()
-  int const N = scm_ilength (args);
-  int const frank = scm_to_int (frame_rank);
-  SCM dargs_ = SCM_EOL;
-
-  scm_t_array_handle ah[N];
-  SCM args_[N];
-  scm_t_array_dim * as[N];
-  int rank[N];
-
-  ssize_t s[frank];
-  SCM ai[N];
-  SCM * dargs[N];
-  ssize_t i[frank];
-
-  int order[frank];
-  size_t base[N];
-
-  for (int n=0; scm_is_pair(args); args=scm_cdr(args), ++n)
-{
-  args_[n] = scm_car(args);
-  scm_array_get_handle(args_[n], ah+n);
-  as[n] = scm_array_handle_dims(ah+n);
-  rank[n] = scm_array_handle_rank(ah+n);
-}
-  // checks.
-  char const * msg = NULL;
-  if (frank<0)
-{
-  msg = "bad frame rank";
-}
-  else
-{
-  for (int n=0; n!=N; ++n)
-{
-  if (rank[n]

[Guile-commits] 20/25: Clean up (array-for-each-cell)

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit f6003e88812c33e24e7038937e76e1292774ee98
Author: Daniel Llorens 
Date:   Fri Apr 1 12:46:37 2016 +0200

Clean up (array-for-each-cell)

* libguile/array-map.c (array-for-each-cell,
  array-for-each-cell-in-order): Moved from libguile/arrays.c. Fix
  argument names. Complete docstring.

* libguile/array-map.h (array-for-each-cell,
  array-for-each-cell-in-order): Declarations moved from
  libguile/arrays.h.

* test-suite/tests/array-map.test: Renamed from
  test-suite/tests/ramap.test, fix module name.

  Add tests for (array-for-each-cell).

* test-suite/Makefile.am: Apply rename array-map.test -> ramap.test.

* doc/ref/api-compound.texi: Minor documentation fixes.
---
 doc/ref/api-compound.texi   |   34 ++--
 libguile/array-map.c|  244 ++-
 libguile/array-map.h|3 +
 libguile/arrays.c   |  228 -
 libguile/arrays.h   |2 -
 test-suite/Makefile.am  |2 +-
 test-suite/tests/{ramap.test => array-map.test} |   23 ++-
 7 files changed, 283 insertions(+), 253 deletions(-)

diff --git a/doc/ref/api-compound.texi b/doc/ref/api-compound.texi
index 34a832f..ef4869c 100644
--- a/doc/ref/api-compound.texi
+++ b/doc/ref/api-compound.texi
@@ -1795,14 +1795,12 @@ of @var{idxlist} is shorter than @math{n}, then return 
the shared
 
 For example:
 
-@example
 @lisp
 (array-from #2((a b) (c d)) 0) @result{} #(a b)
 (array-from #2((a b) (c d)) 1) @result{} #(c d)
 (array-from #2((a b) (c d)) 1 1) @result{} d
 (array-from #2((a b) (c d))) @result{} #2((a b) (c d))
 @end lisp
-@end example
 
 @code{(apply array-from array indices)} is equivalent to
 
@@ -1827,7 +1825,6 @@ write into.
 
 Compare:
 
-@example
 @lisp
 (array-from #2((a b) (c d)) 1 1) @result{} d
 (array-from* #2((a b) (c d)) 1) @result{} #0(d)
@@ -1836,7 +1833,6 @@ Compare:
 a @result{} #2((a a) (a b)).
 (array-fill! (array-from a 1 1) 'b) @result{} error: not an array
 @end lisp
-@end example
 
 @code{(apply array-from* array indices)} is equivalent to
 
@@ -1863,12 +1859,19 @@ This function returns the modified @var{array}.
 
 For example:
 
-@example
 @lisp
 (array-amend! (make-array 'a 2 2) b 1 1) @result{} #2((a a) (a b))
 (array-amend! (make-array 'a 2 2) #(x y) 1) @result{} #2((a a) (x y))
 @end lisp
-@end example
+
+Note that @code{array-amend!} will expect elements, not arrays, when the
+destination has rank 0. One can work around this using
+@code{array-from*} instead.
+
+@lisp
+(array-amend! (make-array 'a 2 2) #0(b) 1 1) @result{} #2((a a) (a #0(b)))
+(let ((a (make-array 'a 2 2))) (array-copy! #0(b) (array-from* a 1 1)) a) 
@result{} #2((a a) (a b))
+@end lisp
 
 @code{(apply array-amend! array x indices)} is equivalent to
 
@@ -1886,10 +1889,10 @@ The name `amend' comes from the J language.
 
 @deffn {Scheme Procedure} array-for-each-cell frame-rank op x @dots{}
 @deffnx {C Function} scm_array_for_each_cell (array, frame_rank, op, xlist)
-Each @var{x} must be an array of rank @math{n_x} ≥ @var{frame-rank}, and
+Each @var{x} must be an array of rank ≥ @var{frame-rank}, and
 the first @var{frame-rank} dimensions of each @var{x} must all be the
 same. @var{array-for-each-cell} calls @var{op} with each set of
-(@math{n_x} - @var{frame-rank})-cells from @var{x}, in unspecified order.
+(rank(@var{x}) - @var{frame-rank})-cells from @var{x}, in unspecified order.
 
 @var{array-for-each-cell} allows you to loop over cells of any rank
 without having to carry an index list or construct slices manually. The
@@ -1898,26 +1901,20 @@ to write to them.
 
 This function returns an unspecified value.
 
-For example:
+For example, to sort the rows of rank-2 array @code{a}:
 
-@example
-Sort the rows of rank-2 array @code{a}:
 @lisp
 (array-for-each-cell 1 (lambda (x) (sort! x <)) a)
 @end lisp
-@end example
 
-@example
-Let @code{a} be a rank-2 array where each row is a 2-vector @math{x,
-y}. Compute the norms of these vectors and store them in rank-1 array
-@code{b}:
+As another example, let @code{a} be a rank-2 array where each row is a 
2-vector @math{(x,y)}.
+Let's compute the arguments of these vectors and store them in rank-1 array 
@code{b}.
 @lisp
 (array-for-each-cell 1
   (lambda (a b)
-(array-set! b (hypot (array-ref a 0) (array-ref a 1
+(array-set! b (atan (array-ref a 1) (array-ref a 0
   a b)
 @end lisp
-@end example
 
 @code{(apply array-for-each-cell frame-rank op x)} is functionally
 equivalent to
@@ -1933,7 +1930,6 @@ equivalent to
 (lambda i (apply op (map (lambda (x) (apply array-from* x i)) x)
 @end lisp
 
-The name `amend' comes from the J language.
 @end deffn
 
 
diff --git a/libguile/array-map.c b/libguile/array-map.c
index f07fd00..0bbc095 100644
--- a/libguile/array

[Guile-commits] 09/25: Don't use array handles in scm_c_array_rank

[Daniel Llorens]

lloda pushed a commit to branch lloda-array-support
in repository guile.

commit ed6c65507ae3b93e02dbe22a2c1e31c1b8c329fb
Author: Daniel Llorens 
Date:   Thu Feb 12 10:15:42 2015 +0100

Don't use array handles in scm_c_array_rank

* libguile/arrays.c (scm_c_array_rank): moved from
  libguile/generalized-arrays.c. Don't use array handles, but follow the
  same type check sequence as the other array functions
  (shared-array-root, etc).

  (scm_array_rank): moved from libguile/generalized-arrays.h.

* libguile/arrays.h: move prototypes here.
---
 libguile/arrays.c |   21 
 libguile/arrays.h |3 +++
 libguile/generalized-arrays.c |   43 +++--
 libguile/generalized-arrays.h |3 ---
 4 files changed, 35 insertions(+), 35 deletions(-)

diff --git a/libguile/arrays.c b/libguile/arrays.c
index 6d1927c..26c4543 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -64,6 +64,27 @@
   (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
 
 
+size_t
+scm_c_array_rank (SCM array)
+{
+  if (SCM_I_ARRAYP (array))
+return SCM_I_ARRAY_NDIM (array);
+  else if (scm_is_array (array))
+return 1;
+  else
+scm_wrong_type_arg_msg ("array-rank", SCM_ARG1, array, "array");
+}
+
+SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0,
+   (SCM array),
+   "Return the number of dimensions of the array @var{array.}\n")
+#define FUNC_NAME s_scm_array_rank
+{
+  return scm_from_size_t (scm_c_array_rank (array));
+}
+#undef FUNC_NAME
+
+
 SCM_DEFINE (scm_shared_array_root, "shared-array-root", 1, 0, 0,
(SCM ra),
"Return the root vector of a shared array.")
diff --git a/libguile/arrays.h b/libguile/arrays.h
index bd216ae..9b7fd6c 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -56,6 +56,9 @@ SCM_API SCM scm_array_amend_x (SCM ra, SCM b, SCM indices);
 SCM_API SCM scm_list_to_array (SCM ndim, SCM lst);
 SCM_API SCM scm_list_to_typed_array (SCM type, SCM ndim, SCM lst);
 
+SCM_API size_t scm_c_array_rank (SCM ra);
+SCM_API SCM scm_array_rank (SCM ra);
+
 /* internal. */
 
 #define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)  /* currently unused */
diff --git a/libguile/generalized-arrays.c b/libguile/generalized-arrays.c
index 9a001eb..99125f2 100644
--- a/libguile/generalized-arrays.c
+++ b/libguile/generalized-arrays.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995,1996,1997,1998,2000,2001,2002,2003,2004, 2005, 2006, 
2009, 2010, 2013, 2014 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
@@ -104,27 +104,6 @@ SCM_DEFINE (scm_typed_array_p, "typed-array?", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-size_t
-scm_c_array_rank (SCM array)
-{
-  scm_t_array_handle handle;
-  size_t res;
-
-  scm_array_get_handle (array, &handle);
-  res = scm_array_handle_rank (&handle);
-  scm_array_handle_release (&handle);
-  return res;
-}
-
-SCM_DEFINE (scm_array_rank, "array-rank", 1, 0, 0, 
-   (SCM array),
-   "Return the number of dimensions of the array @var{array.}\n")
-#define FUNC_NAME s_scm_array_rank
-{
-  return scm_from_size_t (scm_c_array_rank (array));
-}
-#undef FUNC_NAME
-
 
 size_t
 scm_c_array_length (SCM array)
@@ -144,7 +123,7 @@ scm_c_array_length (SCM array)
   return res;
 }
 
-SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0, 
+SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
(SCM array),
"Return the length of an array: its first dimension.\n"
 "It is an error to ask for the length of an array of rank 0.")
@@ -155,7 +134,7 @@ SCM_DEFINE (scm_array_length, "array-length", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0, 
+SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 0,
(SCM ra),
"@code{array-dimensions} is similar to @code{array-shape} but 
replaces\n"
"elements with a @code{0} minimum with one greater than the 
maximum. So:\n"
@@ -168,7 +147,7 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 
0,
   scm_t_array_dim *s;
   SCM res = SCM_EOL;
   size_t k;
-  
+
   scm_array_get_handle (ra, &handle);
   s = scm_array_handle_dims (&handle);
   k = scm_array_handle_rank (&handle);
@@ -186,7 +165,7 @@ SCM_DEFINE (scm_array_dimensions, "array-dimensions", 1, 0, 
0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0, 
+SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
(SCM ra),
"")
 #define FUNC_NAME s_scm_array_type
@@ -197,7 +176,7 @@ SCM_DEFINE (scm_array_type, "array-type", 1, 0, 0,
   scm_array_get_handle (ra, &h);
   type = scm_array_handle_element_type (&h);
   scm_array_handle_release (&h);
-  
+
   return type;
 }
 #undef

[Guile-commits] Success: Hydra job gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1 on x86_64-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build_CPPFLAGS=_DSCM_DEBUG=1’ (on 
x86_64-linux) has changed from "Failed with output" to "Success".  For details, 
see

  https://hydra.nixos.org/build/37518349

This may be due to 2 commits by Andy Wingo .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] Success: Hydra job gnu:guile-master:build.i686-linux

[Hydra Build Daemon]

Hi,

The status of Hydra job ‘gnu:guile-master:build.i686-linux’ has changed from 
"Failed with output" to "Success".  For details, see

  https://hydra.nixos.org/build/37518340

This may be due to 2 commits by Andy Wingo .

Yay!

Regards,

The Hydra build daemon.

[Guile-commits] branch master updated (38f23e7 -> 867316f)

[Andy Wingo]

wingo pushed a change to branch master
in repository guile.

  from  38f23e7   Add meta/build-env
   new  867316f   build-env: prebuilt .go files are in srcdir

The 1 revisions listed above as "new" are entirely new to this
repository and will be described in separate emails.  The revisions
listed as "adds" were already present in the repository and have only
been added to this reference.


Summary of changes:
 meta/build-env.in |2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

[Guile-commits] 01/01: build-env: prebuilt .go files are in srcdir

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 867316ffcd65bd1e5e23813c22ba2515586ae845
Author: Andy Wingo 
Date:   Mon Jul 11 09:26:25 2016 +0200

build-env: prebuilt .go files are in srcdir

* meta/build-env.in (GUILE_LOAD_COMPILED_PATH): Look for prebuilt files
  in the srcdir, not the builddir.
---
 meta/build-env.in |2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/meta/build-env.in b/meta/build-env.in
index 7a5bf33..b271d0b 100644
--- a/meta/build-env.in
+++ b/meta/build-env.in
@@ -54,7 +54,7 @@ then
 
GUILE_LOAD_PATH="$GUILE_LOAD_PATH:${top_builddir}/module:${top_builddir}/guile-readline"
 fi
 export GUILE_LOAD_PATH
-
GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/bootstrap:${top_builddir}/prebuilt/@host@:${top_builddir}/guile-readline"
+
GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/bootstrap:${top_srcdir}/prebuilt/@host@:${top_builddir}/guile-readline"
 export GUILE_LOAD_COMPILED_PATH
 
 # Don't look in installed dirs for guile modules