diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 87 |
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 | ||
| 2044 | static EMACS_INT | 2044 | /* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise. |
| 2045 | bool_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 | |||
| 2051 | static EMACS_INT | ||
| 2052 | bool_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 | 2047 | Lisp_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 | |||
| 2063 | void | ||
| 2064 | bool_vector_fill (Lisp_Object a, Lisp_Object init) | 2048 | bool_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 | ||
| 2079 | DEFUN ("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 | |
| 2081 | LENGTH must be a number. INIT matters only in whether it is t or nil. */) | 2065 | Lisp_Object |
| 2082 | (Lisp_Object length, Lisp_Object init) | 2066 | make_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 | ||
| 2087 | DEFUN ("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. | ||
| 2089 | LENGTH 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 | |||
| 2858 | vector_nbytes (struct Lisp_Vector *v) | 2844 | vector_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 |