emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] trunk r115095: Simplify, port and tune bool vector impleme


From: Paul Eggert
Subject: [Emacs-diffs] trunk r115095: Simplify, port and tune bool vector implementation.
Date: Thu, 14 Nov 2013 02:39:33 +0000
User-agent: Bazaar (2.6b2)

------------------------------------------------------------
revno: 115095
revision-id: address@hidden
parent: address@hidden
committer: Paul Eggert <address@hidden>
branch nick: trunk
timestamp: Wed 2013-11-13 18:39:28 -0800
message:
  Simplify, port and tune bool vector implementation.
  
  * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): Remove.
  * src/alloc.c (bool_vector_exact_payload_bytes)
  (bool_vector_payload_bytes): Remove.
  (bool_vector_fill): Return its argument.
  * src/alloc.c (bool_vector_fill):
  * src/lread.c (read1):
  * src/print.c (print_object):
  Simplify by using bool_vector_bytes.
  * src/alloc.c (make_uninit_bool_vector):
  New function, broken out from Fmake_bool_vector.
  (Fmake_bool_vector): Use it.  Use tail call.
  (make_uninit_bool_vector, vector_nbytes): Simplify size calculations.
  * src/data.c (BITS_PER_ULL): New constant.
  (ULLONG_MAX, count_one_bits_ll): Fall back on long counterparts
  if long long versions don't exist.
  (shift_right_ull): New function.
  (count_one_bits_word): New function, replacing popcount_bits_word
  macro.  Don't assume that bits_word is no wider than long long.
  (count_one_bits_word, count_trailing_zero_bits):
  Don't assume that bits_word is no wider than long long.
  * src/data.c (bool_vector_binop_driver, bool_vector_not):
  * src/fns.c (Fcopy_sequence):
  * src/lread.c (read1):
  Create an uninitialized destination, to avoid needless work.
  (internal_equal): Simplify.
  (Ffillarray): Prefer tail call.
  * src/data.c (bool_vector_binop_driver): Don't assume bit vectors always
  contain at least one word.
  (bits_word_to_host_endian): Prefer if to #if.  Don't assume
  chars are narrower than ints.
  * src/data.c (Fbool_vector_count_matches, Fbool_vector_count_matches_at):
  * src/fns.c (Fcopy_sequence):
  Simplify and tune.
  * src/lisp.h (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD):
  Don't try to port to hosts where bits_word values have holes; the
  code wouldn't work there anyway.  Verify this assumption, though.
  (bool_vector_bytes): New function.
  (make_uninit_bool_vector): New decl.
  (bool_vector_fill): Now returns Lisp_Object.
modified:
  ChangeLog                      changelog-20091113204419-o5vbwnq5f7feedwu-1538
  configure.ac                   
configure.in-20091113204419-o5vbwnq5f7feedwu-783
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/alloc.c                    alloc.c-20091113204419-o5vbwnq5f7feedwu-252
  src/data.c                     data.c-20091113204419-o5vbwnq5f7feedwu-251
  src/fns.c                      fns.c-20091113204419-o5vbwnq5f7feedwu-203
  src/lisp.h                     lisp.h-20091113204419-o5vbwnq5f7feedwu-253
  src/lread.c                    lread.c-20091113204419-o5vbwnq5f7feedwu-266
  src/print.c                    print.c-20091113204419-o5vbwnq5f7feedwu-262
=== modified file 'ChangeLog'
--- a/ChangeLog 2013-11-13 08:04:57 +0000
+++ b/ChangeLog 2013-11-14 02:39:28 +0000
@@ -1,3 +1,8 @@
+2013-11-14  Paul Eggert  <address@hidden>
+
+       Simplify, port and tune bool vector implementation.
+       * configure.ac (BITSIZEOF_SIZE_T, SIZEOF_SIZE_T): Remove.
+
 2013-11-13  Paul Eggert  <address@hidden>
 
        * Makefile.in (ACLOCAL_INPUTS): Add configure.ac.

=== modified file 'configure.ac'
--- a/configure.ac      2013-11-12 03:01:07 +0000
+++ b/configure.ac      2013-11-14 02:39:28 +0000
@@ -4720,8 +4720,6 @@
 gl_ASSERT_NO_GNULIB_POSIXCHECK
 gl_ASSERT_NO_GNULIB_TESTS
 gl_INIT
-gl_STDINT_BITSIZEOF([size_t], [[#include <stddef.h>]])
-AC_CHECK_SIZEOF([size_t])
 CFLAGS=$SAVE_CFLAGS
 LIBS=$SAVE_LIBS
 

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-11-14 01:52:18 +0000
+++ b/src/ChangeLog     2013-11-14 02:39:28 +0000
@@ -1,5 +1,45 @@
 2013-11-14  Paul Eggert  <address@hidden>
 
+       Simplify, port and tune bool vector implementation.
+       * alloc.c (bool_vector_exact_payload_bytes)
+       (bool_vector_payload_bytes): Remove.
+       (bool_vector_fill): Return its argument.
+       * alloc.c (bool_vector_fill):
+       * lread.c (read1):
+       * print.c (print_object):
+       Simplify by using bool_vector_bytes.
+       * alloc.c (make_uninit_bool_vector):
+       New function, broken out from Fmake_bool_vector.
+       (Fmake_bool_vector): Use it.  Use tail call.
+       (make_uninit_bool_vector, vector_nbytes): Simplify size calculations.
+       * data.c (BITS_PER_ULL): New constant.
+       (ULLONG_MAX, count_one_bits_ll): Fall back on long counterparts
+       if long long versions don't exist.
+       (shift_right_ull): New function.
+       (count_one_bits_word): New function, replacing popcount_bits_word
+       macro.  Don't assume that bits_word is no wider than long long.
+       (count_one_bits_word, count_trailing_zero_bits):
+       Don't assume that bits_word is no wider than long long.
+       * data.c (bool_vector_binop_driver, bool_vector_not):
+       * fns.c (Fcopy_sequence):
+       * lread.c (read1):
+       Create an uninitialized destination, to avoid needless work.
+       (internal_equal): Simplify.
+       (Ffillarray): Prefer tail call.
+       * data.c (bool_vector_binop_driver): Don't assume bit vectors always
+       contain at least one word.
+       (bits_word_to_host_endian): Prefer if to #if.  Don't assume
+       chars are narrower than ints.
+       * data.c (Fbool_vector_count_matches, Fbool_vector_count_matches_at):
+       * fns.c (Fcopy_sequence):
+       Simplify and tune.
+       * lisp.h (bits_word, BITS_WORD_MAX, BITS_PER_BITS_WORD):
+       Don't try to port to hosts where bits_word values have holes; the
+       code wouldn't work there anyway.  Verify this assumption, though.
+       (bool_vector_bytes): New function.
+       (make_uninit_bool_vector): New decl.
+       (bool_vector_fill): Now returns Lisp_Object.
+
        * xfns.c (xic_create_fontsetname):
        * xrdb.c (gethomedir): Prefer tail calls.
 

=== modified file 'src/alloc.c'
--- a/src/alloc.c       2013-11-07 05:31:04 +0000
+++ b/src/alloc.c       2013-11-14 02:39:28 +0000
@@ -2041,26 +2041,10 @@
   return val;
 }
 
-static EMACS_INT
-bool_vector_exact_payload_bytes (EMACS_INT nbits)
-{
-  eassume (0 <= nbits);
-  return (nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
-}
-
-static EMACS_INT
-bool_vector_payload_bytes (EMACS_INT nbits)
-{
-  EMACS_INT exact_needed_bytes = bool_vector_exact_payload_bytes (nbits);
-
-  /* Always allocate at least one machine word of payload so that
-     bool-vector operations in data.c don't need a special case
-     for empty vectors.  */
-  return ROUNDUP (exact_needed_bytes + !exact_needed_bytes,
-                 sizeof (bits_word));
-}
-
-void
+/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
+   Return A.  */
+
+Lisp_Object
 bool_vector_fill (Lisp_Object a, Lisp_Object init)
 {
   EMACS_INT nbits = bool_vector_size (a);
@@ -2068,48 +2052,50 @@
     {
       unsigned char *data = bool_vector_uchar_data (a);
       int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1;
-      ptrdiff_t nbytes = ((nbits + BOOL_VECTOR_BITS_PER_CHAR - 1)
-                         / BOOL_VECTOR_BITS_PER_CHAR);
+      ptrdiff_t nbytes = bool_vector_bytes (nbits);
       int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1));
       memset (data, pattern, nbytes - 1);
       data[nbytes - 1] = pattern & last_mask;
     }
+  return a;
 }
 
-DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
-       doc: /* Return a new bool-vector of length LENGTH, using INIT for each 
element.
-LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
-  (Lisp_Object length, Lisp_Object init)
+/* Return a newly allocated, uninitialized bool vector of size NBITS.  */
+
+Lisp_Object
+make_uninit_bool_vector (EMACS_INT nbits)
 {
   Lisp_Object val;
   struct Lisp_Bool_Vector *p;
-  EMACS_INT exact_payload_bytes, total_payload_bytes, needed_elements;
-
-  CHECK_NATNUM (length);
-
-  exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length));
-  total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length));
-
-  needed_elements = ((bool_header_size - header_size + total_payload_bytes
+  EMACS_INT word_bytes, needed_elements;
+  word_bytes = bool_vector_words (nbits) * sizeof (bits_word);
+  needed_elements = ((bool_header_size - header_size + word_bytes
                      + word_size - 1)
                     / word_size);
-
   p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
   XSETVECTOR (val, p);
   XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
-
-  p->size = XFASTINT (length);
-  bool_vector_fill (val, init);
+  p->size = nbits;
 
   /* Clear padding at the end.  */
-  eassume (exact_payload_bytes <= total_payload_bytes);
-  memset (bool_vector_uchar_data (val) + exact_payload_bytes,
-          0,
-          total_payload_bytes - exact_payload_bytes);
+  if (nbits)
+    p->data[bool_vector_words (nbits) - 1] = 0;
 
   return val;
 }
 
+DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
+       doc: /* Return a new bool-vector of length LENGTH, using INIT for each 
element.
+LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
+  (Lisp_Object length, Lisp_Object init)
+{
+  Lisp_Object val;
+
+  CHECK_NATNUM (length);
+  val = make_uninit_bool_vector (XFASTINT (length));
+  return bool_vector_fill (val, init);
+}
+
 
 /* Make a string from NBYTES bytes at CONTENTS, and compute the number
    of characters from the contents.  This string may be unibyte or
@@ -2858,24 +2844,27 @@
 vector_nbytes (struct Lisp_Vector *v)
 {
   ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
+  ptrdiff_t nwords;
 
   if (size & PSEUDOVECTOR_FLAG)
     {
       if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
         {
           struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v;
-          ptrdiff_t payload_bytes = bool_vector_payload_bytes (bv->size);
-          size = bool_header_size + payload_bytes;
+         ptrdiff_t word_bytes = (bool_vector_words (bv->size)
+                                 * sizeof (bits_word));
+         ptrdiff_t boolvec_bytes = bool_header_size + word_bytes;
+         verify (header_size <= bool_header_size);
+         nwords = (boolvec_bytes - header_size + word_size - 1) / word_size;
         }
       else
-       size = (header_size
-               + ((size & PSEUDOVECTOR_SIZE_MASK)
-                  + ((size & PSEUDOVECTOR_REST_MASK)
-                     >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
+       nwords = ((size & PSEUDOVECTOR_SIZE_MASK)
+                 + ((size & PSEUDOVECTOR_REST_MASK)
+                    >> PSEUDOVECTOR_SIZE_BITS));
     }
   else
-    size = header_size + size * word_size;
-  return vroundup (size);
+    nwords = size;
+  return vroundup (header_size + word_size * nwords);
 }
 
 /* Release extra resources still in use by VECTOR, which may be any

=== modified file 'src/data.c'
--- a/src/data.c        2013-11-05 07:11:24 +0000
+++ b/src/data.c        2013-11-14 02:39:28 +0000
@@ -2962,9 +2962,7 @@
 
 /* Because we round up the bool vector allocate size to word_size
    units, we can safely read past the "end" of the vector in the
-   operations below.  These extra bits are always zero.  Also, we
-   always allocate bool vectors with at least one bits_word of storage so
-   that we don't have to special-case empty bit vectors.  */
+   operations below.  These extra bits are always zero.  */
 
 static bits_word
 bool_vector_spare_mask (EMACS_INT nr_bits)
@@ -2972,16 +2970,47 @@
   return (((bits_word) 1) << (nr_bits % BITS_PER_BITS_WORD)) - 1;
 }
 
-#if BITS_WORD_MAX <= UINT_MAX
-# define popcount_bits_word count_one_bits
-#elif BITS_WORD_MAX <= ULONG_MAX
-# define popcount_bits_word count_one_bits_l
-#elif BITS_WORD_MAX <= ULLONG_MAX
-# define popcount_bits_word count_one_bits_ll
+/* Info about unsigned long long, falling back on unsigned long
+   if unsigned long long is not available.  */
+
+#if HAVE_UNSIGNED_LONG_LONG_INT
+enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long long) };
 #else
-# error "bits_word wider than long long? Please file a bug report."
+enum { BITS_PER_ULL = CHAR_BIT * sizeof (unsigned long) };
+# define ULLONG_MAX ULONG_MAX
+# define count_one_bits_ll count_one_bits_l
 #endif
 
+/* Shift VAL right by the width of an unsigned long long.
+   BITS_PER_ULL must be less than BITS_PER_BITS_WORD.  */
+
+static bits_word
+shift_right_ull (bits_word w)
+{
+  /* Pacify bogus GCC warning about shift count exceeding type width.  */
+  int shift = BITS_PER_ULL - BITS_PER_BITS_WORD < 0 ? BITS_PER_ULL : 0;
+  return w >> shift;
+}
+
+/* Return the number of 1 bits in W.  */
+
+static int
+count_one_bits_word (bits_word w)
+{
+  if (BITS_WORD_MAX <= UINT_MAX)
+    return count_one_bits (w);
+  else if (BITS_WORD_MAX <= ULONG_MAX)
+    return count_one_bits_l (w);
+  else
+    {
+      int i = 0, count = 0;
+      while (count += count_one_bits_ll (w),
+            BITS_PER_BITS_WORD <= (i += BITS_PER_ULL))
+       w = shift_right_ull (w);
+      return count;
+    }
+}
+
 enum bool_vector_op { bool_vector_exclusive_or,
                       bool_vector_union,
                       bool_vector_intersection,
@@ -2997,7 +3026,7 @@
   EMACS_INT nr_bits;
   bits_word *adata, *bdata, *cdata;
   ptrdiff_t i;
-  bits_word changed = 0;
+  bool changed = 0;
   bits_word mword;
   ptrdiff_t nr_words;
 
@@ -3010,7 +3039,7 @@
 
   if (NILP (dest))
     {
-      dest = Fmake_bool_vector (make_number (nr_bits), Qnil);
+      dest = make_uninit_bool_vector (nr_bits);
       changed = 1;
     }
   else
@@ -3025,8 +3054,8 @@
   adata = bool_vector_data (dest);
   bdata = bool_vector_data (op1);
   cdata = bool_vector_data (op2);
-  i = 0;
-  do
+
+  for (i = 0; i < nr_words; i++)
     {
       if (op == bool_vector_exclusive_or)
         mword = bdata[i] ^ cdata[i];
@@ -3039,14 +3068,12 @@
       else
         abort ();
 
-      changed |= adata[i] ^ mword;
+      if (! changed)
+       changed = adata[i] != mword;
 
       if (op != bool_vector_subsetp)
         adata[i] = mword;
-
-      i++;
     }
-  while (i < nr_words);
 
   return changed ? dest : Qnil;
 }
@@ -3060,27 +3087,33 @@
     return count_trailing_zeros (val);
   if (BITS_WORD_MAX == ULONG_MAX)
     return count_trailing_zeros_l (val);
-# if HAVE_UNSIGNED_LONG_LONG_INT
   if (BITS_WORD_MAX == ULLONG_MAX)
     return count_trailing_zeros_ll (val);
-# endif
 
   /* The rest of this code is for the unlikely platform where bits_word differs
      in width from unsigned int, unsigned long, and unsigned long long.  */
-  if (val == 0)
-    return CHAR_BIT * sizeof (val);
+  val |= ~ BITS_WORD_MAX;
   if (BITS_WORD_MAX <= UINT_MAX)
     return count_trailing_zeros (val);
   if (BITS_WORD_MAX <= ULONG_MAX)
     return count_trailing_zeros_l (val);
-  {
-# if HAVE_UNSIGNED_LONG_LONG_INT
-    verify (BITS_WORD_MAX <= ULLONG_MAX);
-    return count_trailing_zeros_ll (val);
-# else
-    verify (BITS_WORD_MAX <= ULONG_MAX);
-# endif
-  }
+  else
+    {
+      int count;
+      for (count = 0;
+          count < BITS_PER_BITS_WORD - BITS_PER_ULL;
+          count += BITS_PER_ULL)
+       {
+         if (val & ULLONG_MAX)
+           return count + count_trailing_zeros_ll (val);
+         val = shift_right_ull (val);
+       }
+
+      if (BITS_PER_BITS_WORD % BITS_PER_ULL != 0
+         && BITS_WORD_MAX == (bits_word) -1)
+       val |= (bits_word) 1 << (BITS_PER_BITS_WORD % BITS_PER_ULL);
+      return count + count_trailing_zeros_ll (val);
+    }
 }
 
 static bits_word
@@ -3088,20 +3121,24 @@
 {
 #ifndef WORDS_BIGENDIAN
   return val;
-#elif BITS_WORD_MAX >> 31 == 1
-  return bswap_32 (val);
-#elif BITS_WORD_MAX >> 31 >> 31 >> 1 == 1
-  return bswap_64 (val);
 #else
-  int i;
-  bits_word r = 0;
-  for (i = 0; i < sizeof val; i++)
-    {
-      r = ((r << 1 << (CHAR_BIT - 1))
-          | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
-      val = val >> 1 >> (CHAR_BIT - 1);
-    }
-  return r;
+  if (BITS_WORD_MAX >> 31 == 1)
+    return bswap_32 (val);
+# if HAVE_UNSIGNED_LONG_LONG
+  if (BITS_WORD_MAX >> 31 >> 31 >> 1 == 1)
+    return bswap_64 (val);
+# endif
+  {
+    int i;
+    bits_word r = 0;
+    for (i = 0; i < sizeof val; i++)
+      {
+       r = ((r << 1 << (CHAR_BIT - 1))
+            | (val & ((1u << 1 << (CHAR_BIT - 1)) - 1)));
+       val = val >> 1 >> (CHAR_BIT - 1);
+      }
+    return r;
+  }
 #endif
 }
 
@@ -3174,7 +3211,7 @@
   nr_bits = bool_vector_size (a);
 
   if (NILP (b))
-    b = Fmake_bool_vector (make_number (nr_bits), Qnil);
+    b = make_uninit_bool_vector (nr_bits);
   else
     {
       CHECK_BOOL_VECTOR (b);
@@ -3208,27 +3245,20 @@
   EMACS_INT count;
   EMACS_INT nr_bits;
   bits_word *adata;
-  bits_word match;
-  ptrdiff_t i;
+  ptrdiff_t i, nwords;
 
   CHECK_BOOL_VECTOR (a);
 
   nr_bits = bool_vector_size (a);
+  nwords = bool_vector_words (nr_bits);
   count = 0;
-  match = NILP (b) ? BITS_WORD_MAX : 0;
   adata = bool_vector_data (a);
 
-  for (i = 0; i < nr_bits / BITS_PER_BITS_WORD; ++i)
-    count += popcount_bits_word (adata[i] ^ match);
-
-  /* Mask out trailing parts of final mword.  */
-  if (nr_bits % BITS_PER_BITS_WORD)
-    {
-      bits_word mword = adata[i] ^ match;
-      mword = bits_word_to_host_endian (mword);
-      count += popcount_bits_word (mword & bool_vector_spare_mask (nr_bits));
-    }
-
+  for (i = 0; i < nwords; i++)
+    count += count_one_bits_word (adata[i]);
+
+  if (NILP (b))
+    count = nr_bits - count;
   return make_number (count);
 }
 
@@ -3246,7 +3276,7 @@
   bits_word *adata;
   bits_word twiddle;
   bits_word mword; /* Machine word.  */
-  ptrdiff_t pos;
+  ptrdiff_t pos, pos0;
   ptrdiff_t nr_words;
 
   CHECK_BOOL_VECTOR (a);
@@ -3273,8 +3303,8 @@
       mword = bits_word_to_host_endian (adata[pos]);
       mword ^= twiddle;
       mword >>= offset;
+      mword |= (bits_word) 1 << (BITS_PER_BITS_WORD - offset);
       count = count_trailing_zero_bits (mword);
-      count = min (count, BITS_PER_BITS_WORD - offset);
       pos++;
       if (count + offset < BITS_PER_BITS_WORD)
         return make_number (count);
@@ -3283,11 +3313,10 @@
   /* Scan whole words until we either reach the end of the vector or
      find an mword that doesn't completely match.  twiddle is
      endian-independent.  */
+  pos0 = pos;
   while (pos < nr_words && adata[pos] == twiddle)
-    {
-      count += BITS_PER_BITS_WORD;
-      ++pos;
-    }
+    pos++;
+  count += (pos - pos0) * BITS_PER_BITS_WORD;
 
   if (pos < nr_words)
     {

=== modified file 'src/fns.c'
--- a/src/fns.c 2013-11-05 07:11:24 +0000
+++ b/src/fns.c 2013-11-14 02:39:28 +0000
@@ -435,13 +435,10 @@
 
   if (BOOL_VECTOR_P (arg))
     {
-      Lisp_Object val;
-      ptrdiff_t size_in_chars
-       = ((bool_vector_size (arg) + BOOL_VECTOR_BITS_PER_CHAR - 1)
-          / BOOL_VECTOR_BITS_PER_CHAR);
-
-      val = Fmake_bool_vector (Flength (arg), Qnil);
-      memcpy (bool_vector_data (val), bool_vector_data (arg), size_in_chars);
+      EMACS_INT nbits = bool_vector_size (arg);
+      ptrdiff_t nbytes = bool_vector_bytes (nbits);
+      Lisp_Object val = make_uninit_bool_vector (nbits);
+      memcpy (bool_vector_data (val), bool_vector_data (arg), nbytes);
       return val;
     }
 
@@ -2066,8 +2063,7 @@
            if (size != bool_vector_size (o2))
              return 0;
            if (memcmp (bool_vector_data (o1), bool_vector_data (o2),
-                       ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
-                        / BOOL_VECTOR_BITS_PER_CHAR)))
+                       bool_vector_bytes (size)))
              return 0;
            return 1;
          }
@@ -2157,7 +2153,7 @@
          p[idx] = charval;
     }
   else if (BOOL_VECTOR_P (array))
-    bool_vector_fill (array, item);
+    return bool_vector_fill (array, item);
   else
     wrong_type_argument (Qarrayp, array);
   return array;

=== modified file 'src/lisp.h'
--- a/src/lisp.h        2013-11-05 22:45:44 +0000
+++ b/src/lisp.h        2013-11-14 02:39:28 +0000
@@ -92,16 +92,16 @@
 /* An unsigned integer type representing a fixed-length bit sequence,
    suitable for words in a Lisp bool vector.  Normally it is size_t
    for speed, but it is unsigned char on weird platforms.  */
-#if (BITSIZEOF_SIZE_T == CHAR_BIT * SIZEOF_SIZE_T \
-     && BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT)
+#if BOOL_VECTOR_BITS_PER_CHAR == CHAR_BIT
 typedef size_t bits_word;
-#define BITS_WORD_MAX SIZE_MAX
+# define BITS_WORD_MAX SIZE_MAX
 enum { BITS_PER_BITS_WORD = CHAR_BIT * sizeof (bits_word) };
 #else
 typedef unsigned char bits_word;
-#define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
+# define BITS_WORD_MAX ((1u << BOOL_VECTOR_BITS_PER_CHAR) - 1)
 enum { BITS_PER_BITS_WORD = BOOL_VECTOR_BITS_PER_CHAR };
 #endif
+verify (BITS_WORD_MAX >> (BITS_PER_BITS_WORD - 1) == 1);
 
 /* Number of bits in some machine integer types.  */
 enum
@@ -1212,7 +1212,9 @@
     struct vectorlike_header header;
     /* This is the size in bits.  */
     EMACS_INT size;
-    /* This contains the actual bits, packed into bytes.  */
+    /* The actual bits, packed into bytes.
+       The bits are in little-endian order in the bytes, and
+       the bytes are in little-endian order in the words.  */
     bits_word data[FLEXIBLE_ARRAY_MEMBER];
   };
 
@@ -1236,7 +1238,7 @@
   return (unsigned char *) bool_vector_data (a);
 }
 
-/* The number of data words in a bool vector with SIZE bits.  */
+/* The number of data words and bytes in a bool vector with SIZE bits.  */
 
 INLINE EMACS_INT
 bool_vector_words (EMACS_INT size)
@@ -1245,6 +1247,13 @@
   return (size + BITS_PER_BITS_WORD - 1) / BITS_PER_BITS_WORD;
 }
 
+INLINE EMACS_INT
+bool_vector_bytes (EMACS_INT size)
+{
+  eassume (0 <= size && size <= EMACS_INT_MAX - (BITS_PER_BITS_WORD - 1));
+  return (size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
+}
+
 /* True if A's Ith bit is set.  */
 
 INLINE bool
@@ -3588,7 +3597,8 @@
                make_number (w), make_number (h));
 }
 
-extern void bool_vector_fill (Lisp_Object, Lisp_Object);
+extern Lisp_Object make_uninit_bool_vector (EMACS_INT);
+extern Lisp_Object bool_vector_fill (Lisp_Object, Lisp_Object);
 extern _Noreturn void string_overflow (void);
 extern Lisp_Object make_string (const char *, ptrdiff_t);
 extern Lisp_Object make_formatted_string (char *, const char *, ...)

=== modified file 'src/lread.c'
--- a/src/lread.c       2013-11-05 07:11:24 +0000
+++ b/src/lread.c       2013-11-14 02:39:28 +0000
@@ -2577,9 +2577,7 @@
          if (c == '"')
            {
              Lisp_Object tmp, val;
-             EMACS_INT size_in_chars
-               = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
-                  / BOOL_VECTOR_BITS_PER_CHAR);
+             EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length));
              unsigned char *data;
 
              UNREAD (c);
@@ -2594,7 +2592,7 @@
                            == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
                invalid_syntax ("#&...");
 
-             val = Fmake_bool_vector (length, Qnil);
+             val = make_uninit_bool_vector (XFASTINT (length));
              data = bool_vector_uchar_data (val);
              memcpy (data, SDATA (tmp), size_in_chars);
              /* Clear the extraneous bits in the last byte.  */

=== modified file 'src/print.c'
--- a/src/print.c       2013-11-05 07:11:24 +0000
+++ b/src/print.c       2013-11-14 02:39:28 +0000
@@ -1705,8 +1705,7 @@
          unsigned char c;
          struct gcpro gcpro1;
          EMACS_INT size = bool_vector_size (obj);
-         ptrdiff_t size_in_chars = ((size + BOOL_VECTOR_BITS_PER_CHAR - 1)
-                                    / BOOL_VECTOR_BITS_PER_CHAR);
+         ptrdiff_t size_in_chars = bool_vector_bytes (size);
          ptrdiff_t real_size_in_chars = size_in_chars;
          GCPRO1 (obj);
 


reply via email to

[Prev in Thread] Current Thread [Next in Thread]