aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c87
1 files changed, 38 insertions, 49 deletions
diff --git a/src/alloc.c b/src/alloc.c
index bc5ed6d94bb..f12fdc5c861 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2041,26 +2041,10 @@ INIT must be an integer that represents a character. */)
2041 return val; 2041 return val;
2042} 2042}
2043 2043
2044static EMACS_INT 2044/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
2045bool_vector_exact_payload_bytes (EMACS_INT nbits) 2045 Return A. */
2046{
2047 eassume (0 <= nbits);
2048 return (nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR;
2049}
2050
2051static EMACS_INT
2052bool_vector_payload_bytes (EMACS_INT nbits)
2053{
2054 EMACS_INT exact_needed_bytes = bool_vector_exact_payload_bytes (nbits);
2055 2046
2056 /* Always allocate at least one machine word of payload so that 2047Lisp_Object
2057 bool-vector operations in data.c don't need a special case
2058 for empty vectors. */
2059 return ROUNDUP (exact_needed_bytes + !exact_needed_bytes,
2060 sizeof (bits_word));
2061}
2062
2063void
2064bool_vector_fill (Lisp_Object a, Lisp_Object init) 2048bool_vector_fill (Lisp_Object a, Lisp_Object init)
2065{ 2049{
2066 EMACS_INT nbits = bool_vector_size (a); 2050 EMACS_INT nbits = bool_vector_size (a);
@@ -2068,48 +2052,50 @@ bool_vector_fill (Lisp_Object a, Lisp_Object init)
2068 { 2052 {
2069 unsigned char *data = bool_vector_uchar_data (a); 2053 unsigned char *data = bool_vector_uchar_data (a);
2070 int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1; 2054 int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1;
2071 ptrdiff_t nbytes = ((nbits + BOOL_VECTOR_BITS_PER_CHAR - 1) 2055 ptrdiff_t nbytes = bool_vector_bytes (nbits);
2072 / BOOL_VECTOR_BITS_PER_CHAR);
2073 int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)); 2056 int last_mask = ~ (~0 << ((nbits - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1));
2074 memset (data, pattern, nbytes - 1); 2057 memset (data, pattern, nbytes - 1);
2075 data[nbytes - 1] = pattern & last_mask; 2058 data[nbytes - 1] = pattern & last_mask;
2076 } 2059 }
2060 return a;
2077} 2061}
2078 2062
2079DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0, 2063/* Return a newly allocated, uninitialized bool vector of size NBITS. */
2080 doc: /* Return a new bool-vector of length LENGTH, using INIT for each element. 2064
2081LENGTH must be a number. INIT matters only in whether it is t or nil. */) 2065Lisp_Object
2082 (Lisp_Object length, Lisp_Object init) 2066make_uninit_bool_vector (EMACS_INT nbits)
2083{ 2067{
2084 Lisp_Object val; 2068 Lisp_Object val;
2085 struct Lisp_Bool_Vector *p; 2069 struct Lisp_Bool_Vector *p;
2086 EMACS_INT exact_payload_bytes, total_payload_bytes, needed_elements; 2070 EMACS_INT word_bytes, needed_elements;
2087 2071 word_bytes = bool_vector_words (nbits) * sizeof (bits_word);
2088 CHECK_NATNUM (length); 2072 needed_elements = ((bool_header_size - header_size + word_bytes
2089
2090 exact_payload_bytes = bool_vector_exact_payload_bytes (XFASTINT (length));
2091 total_payload_bytes = bool_vector_payload_bytes (XFASTINT (length));
2092
2093 needed_elements = ((bool_header_size - header_size + total_payload_bytes
2094 + word_size - 1) 2073 + word_size - 1)
2095 / word_size); 2074 / word_size);
2096
2097 p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements); 2075 p = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
2098 XSETVECTOR (val, p); 2076 XSETVECTOR (val, p);
2099 XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0); 2077 XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
2100 2078 p->size = nbits;
2101 p->size = XFASTINT (length);
2102 bool_vector_fill (val, init);
2103 2079
2104 /* Clear padding at the end. */ 2080 /* Clear padding at the end. */
2105 eassume (exact_payload_bytes <= total_payload_bytes); 2081 if (nbits)
2106 memset (bool_vector_uchar_data (val) + exact_payload_bytes, 2082 p->data[bool_vector_words (nbits) - 1] = 0;
2107 0,
2108 total_payload_bytes - exact_payload_bytes);
2109 2083
2110 return val; 2084 return val;
2111} 2085}
2112 2086
2087DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
2088 doc: /* Return a new bool-vector of length LENGTH, using INIT for each element.
2089LENGTH must be a number. INIT matters only in whether it is t or nil. */)
2090 (Lisp_Object length, Lisp_Object init)
2091{
2092 Lisp_Object val;
2093
2094 CHECK_NATNUM (length);
2095 val = make_uninit_bool_vector (XFASTINT (length));
2096 return bool_vector_fill (val, init);
2097}
2098
2113 2099
2114/* Make a string from NBYTES bytes at CONTENTS, and compute the number 2100/* Make a string from NBYTES bytes at CONTENTS, and compute the number
2115 of characters from the contents. This string may be unibyte or 2101 of characters from the contents. This string may be unibyte or
@@ -2858,24 +2844,27 @@ static ptrdiff_t
2858vector_nbytes (struct Lisp_Vector *v) 2844vector_nbytes (struct Lisp_Vector *v)
2859{ 2845{
2860 ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG; 2846 ptrdiff_t size = v->header.size & ~ARRAY_MARK_FLAG;
2847 ptrdiff_t nwords;
2861 2848
2862 if (size & PSEUDOVECTOR_FLAG) 2849 if (size & PSEUDOVECTOR_FLAG)
2863 { 2850 {
2864 if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR)) 2851 if (PSEUDOVECTOR_TYPEP (&v->header, PVEC_BOOL_VECTOR))
2865 { 2852 {
2866 struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v; 2853 struct Lisp_Bool_Vector *bv = (struct Lisp_Bool_Vector *) v;
2867 ptrdiff_t payload_bytes = bool_vector_payload_bytes (bv->size); 2854 ptrdiff_t word_bytes = (bool_vector_words (bv->size)
2868 size = bool_header_size + payload_bytes; 2855 * sizeof (bits_word));
2856 ptrdiff_t boolvec_bytes = bool_header_size + word_bytes;
2857 verify (header_size <= bool_header_size);
2858 nwords = (boolvec_bytes - header_size + word_size - 1) / word_size;
2869 } 2859 }
2870 else 2860 else
2871 size = (header_size 2861 nwords = ((size & PSEUDOVECTOR_SIZE_MASK)
2872 + ((size & PSEUDOVECTOR_SIZE_MASK) 2862 + ((size & PSEUDOVECTOR_REST_MASK)
2873 + ((size & PSEUDOVECTOR_REST_MASK) 2863 >> PSEUDOVECTOR_SIZE_BITS));
2874 >> PSEUDOVECTOR_SIZE_BITS)) * word_size);
2875 } 2864 }
2876 else 2865 else
2877 size = header_size + size * word_size; 2866 nwords = size;
2878 return vroundup (size); 2867 return vroundup (header_size + word_size * nwords);
2879} 2868}
2880 2869
2881/* Release extra resources still in use by VECTOR, which may be any 2870/* Release extra resources still in use by VECTOR, which may be any