static void *pure_alloc (size_t, int);
+/* Return X rounded to the next multiple of Y. Arguments should not
+ have side effects, as they are evaluated more than once. Assume X
+ + Y - 1 does not overflow. Tune for Y being a power of 2. */
-/* Value is SZ rounded up to the next multiple of ALIGNMENT.
- ALIGNMENT must be a power of 2. */
+#define ROUNDUP(x, y) ((y) & ((y) - 1) \
+ ? ((x) + (y) - 1) - ((x) + (y) - 1) % (y) \
+ : ((x) + (y) - 1) & ~ ((y) - 1))
-#define ALIGN(ptr, ALIGNMENT) \
- ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
- & ~ ((ALIGNMENT) - 1)))
+/* Return PTR rounded up to the next multiple of ALIGNMENT. */
+
+static void *
+ALIGN (void *ptr, int alignment)
+{
+ return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
+}
static void
XFLOAT_INIT (Lisp_Object f, double n)
/* The entry point is lisp_align_malloc which returns blocks of at most
BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
-#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
-#define USE_POSIX_MEMALIGN 1
+#if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC
+# define USE_ALIGNED_ALLOC 1
+/* Defined in gmalloc.c. */
+void *aligned_alloc (size_t, size_t);
+#elif defined HAVE_ALIGNED_ALLOC
+# define USE_ALIGNED_ALLOC 1
+#elif defined HAVE_POSIX_MEMALIGN
+# define USE_ALIGNED_ALLOC 1
+static void *
+aligned_alloc (size_t alignment, size_t size)
+{
+ void *p;
+ return posix_memalign (&p, alignment, size) == 0 ? p : 0;
+}
#endif
/* BLOCK_ALIGN has to be a power of 2. */
malloc a chance to minimize the amount of memory wasted to alignment.
It should be tuned to the particular malloc library used.
On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
- posix_memalign on the other hand would ideally prefer a value of 4
+ aligned_alloc on the other hand would ideally prefer a value of 4
because otherwise, there's 1020 bytes wasted between each ablocks.
In Emacs, testing shows that those 1020 can most of the time be
efficiently used by malloc to place other objects, so a value of 0 can
struct ablock blocks[ABLOCKS_SIZE];
};
-/* Size of the block requested from malloc or posix_memalign. */
+/* Size of the block requested from malloc or aligned_alloc. */
#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
#define ABLOCK_ABASE(block) \
#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
/* Pointer to the (not necessarily aligned) malloc block. */
-#ifdef USE_POSIX_MEMALIGN
+#ifdef USE_ALIGNED_ALLOC
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
mallopt (M_MMAP_MAX, 0);
#endif
-#ifdef USE_POSIX_MEMALIGN
- {
- int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
- if (err)
- base = NULL;
- abase = base;
- }
+#ifdef USE_ALIGNED_ALLOC
+ abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES);
#else
base = malloc (ABLOCKS_BYTES);
abase = ALIGN (base, BLOCK_ALIGN);
return val;
}
-verify (sizeof (size_t) * CHAR_BIT == BITS_PER_BITS_WORD);
-verify ((BITS_PER_BITS_WORD & (BITS_PER_BITS_WORD - 1)) == 0);
+/* Fill A with 1 bits if INIT is non-nil, and with 0 bits otherwise.
+ Return A. */
-static ptrdiff_t
-bool_vector_payload_bytes (ptrdiff_t nr_bits,
- ptrdiff_t *exact_needed_bytes_out)
+Lisp_Object
+bool_vector_fill (Lisp_Object a, Lisp_Object init)
{
- ptrdiff_t exact_needed_bytes;
- ptrdiff_t needed_bytes;
-
- eassume (nr_bits >= 0);
-
- exact_needed_bytes = ROUNDUP ((size_t) nr_bits, CHAR_BIT) / CHAR_BIT;
- needed_bytes = ROUNDUP ((size_t) nr_bits, BITS_PER_BITS_WORD) / CHAR_BIT;
-
- if (needed_bytes == 0)
+ EMACS_INT nbits = bool_vector_size (a);
+ if (0 < 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. */
- needed_bytes = sizeof (bits_word);
+ unsigned char *data = bool_vector_uchar_data (a);
+ int pattern = NILP (init) ? 0 : (1 << BOOL_VECTOR_BITS_PER_CHAR) - 1;
+ 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;
+}
- if (exact_needed_bytes_out != NULL)
- *exact_needed_bytes_out = exact_needed_bytes;
+/* Return a newly allocated, uninitialized bool vector of size NBITS. */
+
+Lisp_Object
+make_uninit_bool_vector (EMACS_INT nbits)
+{
+ Lisp_Object val;
+ EMACS_INT words = bool_vector_words (nbits);
+ EMACS_INT word_bytes = words * sizeof (bits_word);
+ EMACS_INT needed_elements = ((bool_header_size - header_size + word_bytes
+ + word_size - 1)
+ / word_size);
+ struct Lisp_Bool_Vector *p
+ = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
+ XSETVECTOR (val, p);
+ XSETPVECTYPESIZE (XVECTOR (val), PVEC_BOOL_VECTOR, 0, 0);
+ p->size = nbits;
- return needed_bytes;
+ /* Clear padding at the end. */
+ if (words)
+ p->data[words - 1] = 0;
+
+ return val;
}
DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
LENGTH must be a number. INIT matters only in whether it is t or nil. */)
(Lisp_Object length, Lisp_Object init)
{
- register Lisp_Object val;
- struct Lisp_Bool_Vector *p;
- ptrdiff_t exact_payload_bytes;
- ptrdiff_t total_payload_bytes;
- ptrdiff_t needed_elements;
+ Lisp_Object val;
CHECK_NATNUM (length);
- if (PTRDIFF_MAX < XFASTINT (length))
- memory_full (SIZE_MAX);
-
- total_payload_bytes = bool_vector_payload_bytes
- (XFASTINT (length), &exact_payload_bytes);
-
- eassume (exact_payload_bytes <= total_payload_bytes);
- eassume (0 <= exact_payload_bytes);
-
- needed_elements = ROUNDUP ((size_t) ((bool_header_size - header_size)
- + total_payload_bytes),
- word_size) / 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);
- if (exact_payload_bytes)
- {
- memset (p->data, ! NILP (init) ? -1 : 0, exact_payload_bytes);
-
- /* Clear any extraneous bits in the last byte. */
- p->data[exact_payload_bytes - 1]
- &= (1 << ((XFASTINT (length) - 1) % BOOL_VECTOR_BITS_PER_CHAR + 1)) - 1;
- }
-
- /* Clear padding at the end. */
- memset (p->data + exact_payload_bytes,
- 0,
- total_payload_bytes - exact_payload_bytes);
-
- return val;
+ val = make_uninit_bool_vector (XFASTINT (length));
+ return bool_vector_fill (val, init);
}
verify (VECTOR_BLOCK_SIZE <= (1 << PSEUDOVECTOR_SIZE_BITS));
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at compile time. */
-#define vroundup_ct(x) ROUNDUP ((size_t) (x), roundup_size)
+#define vroundup_ct(x) ROUNDUP (x, roundup_size)
/* Round up X to nearest mult-of-ROUNDUP_SIZE --- use at runtime. */
#define vroundup(x) (eassume ((x) >= 0), vroundup_ct (x))
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, NULL);
-
- eassume (payload_bytes >= 0);
- size = bool_header_size + ROUNDUP (payload_bytes, word_size);
+ 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
return val;
}
-#if defined HAVE_MENUS && ! (defined USE_X_TOOLKIT || defined USE_GTK)
+#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
make_save_ptr_ptr (void *a, void *b)
{
void dump_zombies (void) EXTERNALLY_VISIBLE;
/* Array of objects that are kept alive because the C stack contains
- a pattern that looks like a reference to them . */
+ a pattern that looks like a reference to them. */
#define MAX_ZOMBIES 10
static Lisp_Object zombies[MAX_ZOMBIES];
\f
-/* Sweep: find all structures not marked, and free them. */
+/* Sweep: find all structures not marked, and free them. */
static void
gc_sweep (void)
sweep_strings ();
check_string_bytes (!noninteractive);
- /* Put all unmarked conses on free list */
+ /* Put all unmarked conses on free list. */
{
register struct cons_block *cblk;
struct cons_block **cprev = &cons_block;
total_free_conses = num_free;
}
- /* Put all unmarked floats on free list */
+ /* Put all unmarked floats on free list. */
{
register struct float_block *fblk;
struct float_block **fprev = &float_block;
total_free_floats = num_free;
}
- /* Put all unmarked intervals on free list */
+ /* Put all unmarked intervals on free list. */
{
register struct interval_block *iblk;
struct interval_block **iprev = &interval_block;
total_free_intervals = num_free;
}
- /* Put all unmarked symbols on free list */
+ /* Put all unmarked symbols on free list. */
{
register struct symbol_block *sblk;
struct symbol_block **sprev = &symbol_block;
{
++num_used;
if (!pure_p)
- UNMARK_STRING (XSTRING (sym->s.name));
+ eassert (!STRING_MARKED_P (XSTRING (sym->s.name)));
sym->s.gcmarkbit = 0;
}
}
{
Lisp_Object end;
+#ifdef HAVE_NS
+ /* Avoid warning. sbrk has no relation to memory allocated anyway. */
+ XSETINT (end, 0);
+#else
XSETINT (end, (intptr_t) (char *) sbrk (0) / 1024);
+#endif
return end;
}