[Guile-commits] branch main updated: Remove array contp flag

[Daniel Llorens]

This is an automated email from the git hooks/post-receive script.

lloda pushed a commit to branch main
in repository guile.

The following commit(s) were added to refs/heads/main by this push:
     new 3df3ba1  Remove array contp flag
3df3ba1 is described below

commit 3df3ba1a2c956bba122328e1fc4be614171a4f42
Author: Daniel Llorens <lloda@sarc.name>
AuthorDate: Mon Aug 16 19:02:43 2021 +0200

    Remove array contp flag
    
    This flag was set, but never used in Guile, and there was no documented
    API to access it.
    
    To check if an array is contiguous, use (array-contents <> #t).
    
    * libguile/arrays.h (scm_i_raw_array): New function.
      SCM_I_ARRAY_CONTIGUOUS, SCM_SET_ARRAY_CONTIGUOUS_FLAG,
      SCM_CLR_ARRAY_CONTIGUOUS_FLAG, SCM_I_ARRAY_CONTP: Remove.
      scm_t_array_dim: Declare here, not in array-handle.h.
      SCM_I_ARRAY_NDIM: Shift by one bit since the contp flag isn't there
      anymore.
    * module/syste/vm/assembler.scm: Match removal of contp flag.
    * libguile/arrays.c (scm_i_make_array): Reuse scm_i_raw_array.
      (scm_i_ra_set_contp): Remove.
      (scm_transpose_array): Don't set or clear the contp flag.
      (scm_make_shared_array): Don't set or clear the contp flag.
      (scm_make_typed_array): Don't set the contp flag.
    * libguile/array-map.c (scm_i_array_rebase): Reuse scm_i_raw_array.
---
 libguile/array-handle.h        | 10 ++--------
 libguile/array-map.c           |  2 +-
 libguile/arrays.c              | 33 +--------------------------------
 libguile/arrays.h              | 28 ++++++++++++++++------------
 libguile/deprecated.c          |  1 -
 module/system/vm/assembler.scm |  5 +++--
 6 files changed, 23 insertions(+), 56 deletions(-)

diff --git a/libguile/array-handle.h b/libguile/array-handle.h
index 137371e..6ad80eb 100644
--- a/libguile/array-handle.h
+++ b/libguile/array-handle.h
@@ -1,7 +1,7 @@
 #ifndef SCM_ARRAY_HANDLE_H
 #define SCM_ARRAY_HANDLE_H
 
-/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2011,2013-2014,2018
+/* Copyright 1995-1997,1999-2001,2004,2006,2008-2009,2011,2013-2014,2018,2021
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -25,19 +25,13 @@
 #include "libguile/error.h"
 #include "libguile/inline.h"
 #include "libguile/numbers.h"
+#include "libguile/arrays.h"
 
 
 
 typedef SCM (*scm_t_vector_ref) (SCM, size_t);
 typedef void (*scm_t_vector_set) (SCM, size_t, SCM);
 
-typedef struct scm_t_array_dim
-{
-  ssize_t lbnd;
-  ssize_t ubnd;
-  ssize_t inc;
-} scm_t_array_dim;
-
 typedef enum
   {
     SCM_ARRAY_ELEMENT_TYPE_SCM = 0,   /* SCM values */
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 92a249b..ce0f7ba 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -667,7 +667,7 @@ 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 b = scm_i_raw_array (ndim);
     SCM_I_ARRAY_SET_V (b, SCM_I_ARRAY_V (a));
 /* FIXME do check base */
     SCM_I_ARRAY_SET_BASE (b, base);
diff --git a/libguile/arrays.c b/libguile/arrays.c
index f4eddd9..924ee00 100644
--- a/libguile/arrays.c
+++ b/libguile/arrays.c
@@ -52,7 +52,6 @@
 #include "strings.h"
 #include "uniform.h"
 #include "vectors.h"
-#include "verify.h"
 
 #include "arrays.h"
 
@@ -493,16 +492,11 @@ SCM_DEFINE (scm_shared_array_increments, 
"shared-array-increments", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-/* FIXME: to avoid this assumption, fix the accessors in arrays.h,
-   scm_i_make_array, and the array cases in system/vm/assembler.scm. */
 
-verify (sizeof (scm_t_array_dim) == 3*sizeof (scm_t_bits));
-
-/* Matching SCM_I_ARRAY accessors in arrays.h */
 SCM
 scm_i_make_array (int ndim)
 {
-  SCM ra = scm_words (((scm_t_bits) ndim << 17) + scm_tc7_array, 3 + ndim*3);
+  SCM ra = scm_i_raw_array (ndim);
   SCM_I_ARRAY_SET_V (ra, SCM_BOOL_F);
   SCM_I_ARRAY_SET_BASE (ra, 0);
   /* dimensions are unset */
@@ -566,7 +560,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);
 
@@ -600,28 +593,6 @@ SCM_DEFINE (scm_make_array, "make-array", 1, 0, 1,
 }
 #undef FUNC_NAME
 
-/* see scm_from_contiguous_array */
-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),
@@ -735,7 +706,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
@@ -1006,7 +976,6 @@ 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;
     }
 }
diff --git a/libguile/arrays.h b/libguile/arrays.h
index 494645d..e427eab 100644
--- a/libguile/arrays.h
+++ b/libguile/arrays.h
@@ -23,7 +23,6 @@
 
 
 #include "libguile/print.h"
-#include "libguile/array-handle.h"
 
 
 
@@ -85,26 +84,31 @@ SCM_API SCM scm_array_ref (SCM v, SCM args);
 SCM_API SCM scm_array_set_x (SCM v, SCM obj, SCM args);
 SCM_API SCM scm_array_to_list (SCM v);
 
-/* internal. */
+typedef struct scm_t_array_dim
+{
+  ssize_t lbnd;
+  ssize_t ubnd;
+  ssize_t inc;
+} scm_t_array_dim;
 
-/* see scm_from_contiguous_array  for these three */
-#define SCM_I_ARRAY_FLAG_CONTIGUOUS (1 << 0)  
-#define SCM_SET_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) | 
(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
-#define SCM_CLR_ARRAY_CONTIGUOUS_FLAG(x) \
-  (SCM_SET_CELL_WORD_0 ((x), SCM_CELL_WORD_0 (x) & 
~(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16)))
+/* internal. */
 
 #define SCM_I_ARRAYP(a)            SCM_TYP16_PREDICATE (scm_tc7_array, a)
-#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x)>>17))
-#define SCM_I_ARRAY_CONTP(x) (SCM_CELL_WORD_0 (x) & 
(SCM_I_ARRAY_FLAG_CONTIGUOUS << 16))
-
+#define SCM_I_ARRAY_NDIM(x)  ((size_t) (SCM_CELL_WORD_0 (x)>>16))
 #define SCM_I_ARRAY_V(a)    SCM_CELL_OBJECT_1 (a)
 #define SCM_I_ARRAY_BASE(a) ((size_t) SCM_CELL_WORD_2 (a))
 #define SCM_I_ARRAY_DIMS(a) ((scm_t_array_dim *) SCM_CELL_OBJECT_LOC (a, 3))
-
 #define SCM_I_ARRAY_SET_V(a, v)       SCM_SET_CELL_OBJECT_1(a, v)
 #define SCM_I_ARRAY_SET_BASE(a, base) SCM_SET_CELL_WORD_2(a, base)
 
+/* See the array cases in system/vm/assembler.scm. */
+
+static inline SCM
+scm_i_raw_array (int ndim)
+{
+  return scm_words (((scm_t_bits) ndim << 16) + scm_tc7_array, 3 + ndim*3);
+}
+
 SCM_INTERNAL SCM scm_i_make_array (int ndim);
 SCM_INTERNAL int scm_i_print_array (SCM array, SCM port, scm_print_state 
*pstate);
 SCM_INTERNAL SCM scm_i_shap2ra (SCM args);
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 7ec08ec..277a4d9 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -608,7 +608,6 @@ scm_from_contiguous_typed_array (SCM type, SCM bounds, 
const void *bytes,
      "to copy data to the new array.");
 
   ra = scm_i_shap2ra (bounds);
-  SCM_SET_ARRAY_CONTIGUOUS_FLAG (ra);
   s = SCM_I_ARRAY_DIMS (ra);
   k = SCM_I_ARRAY_NDIM (ra);
 
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index d4c9de8..ea50b5b 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -2061,8 +2061,9 @@ should be .data or .rodata), and return the resulting 
linker object.
 
        ((array? obj)
         (let-values
-            ;; array tag + rank + contp flag: see libguile/arrays.h .
-            (((tag) (logior tc7-array (ash (array-rank obj) 17) (ash 1 16)))
+            ;; array tag + rank
+            ;; see libguile/arrays.h: SCM_I_ARRAY_NDIM, SCM_I_ARRAYP, 
scm_i_raw_array
+            (((tag) (logior tc7-array (ash (array-rank obj) 16)))
              ((bv-set! bvs-set!)
               (case word-size
                 ((4) (values bytevector-u32-set! bytevector-s32-set!))