GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
#include <config.h>
+#include <errno.h>
#include <stdio.h>
#include <limits.h> /* For CHAR_BIT. */
#include <signal.h> /* For SIGABRT, SIGDANGER. */
}
}
- malloc_set_state (malloc_state_ptr);
+ if (malloc_set_state (malloc_state_ptr) != 0)
+ emacs_abort ();
# ifndef XMALLOC_OVERRUN_CHECK
alloc_unexec_post ();
# endif
{
#ifdef DOUG_LEA_MALLOC
malloc_state_ptr = malloc_get_state ();
+ if (!malloc_state_ptr)
+ fatal ("malloc_get_state: %s", strerror (errno));
#endif
#ifdef HYBRID_MALLOC
bss_sbrk_did_unexec = true;
/* Return PTR rounded up to the next multiple of ALIGNMENT. */
static void *
-ALIGN (void *ptr, int alignment)
+pointer_align (void *ptr, int alignment)
{
return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
}
malloc_probe (size); \
} while (0)
+static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+static void *lrealloc (void *, size_t);
-/* Like malloc but check for no memory and block interrupt input.. */
+/* Like malloc but check for no memory and block interrupt input. */
void *
xmalloc (size_t size)
void *val;
MALLOC_BLOCK_INPUT;
- val = malloc (size);
+ val = lmalloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
void *val;
MALLOC_BLOCK_INPUT;
- val = malloc (size);
+ val = lmalloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = malloc (size);
+ val = lmalloc (size);
else
- val = realloc (block, size);
+ val = lrealloc (block, size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
allocated_mem_type = type;
#endif
- val = malloc (nbytes);
+ val = lmalloc (nbytes);
#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
char payload[BLOCK_BYTES];
struct ablock *next_free;
} x;
- /* `abase' is the aligned base of the ablocks. */
- /* It is overloaded to hold the virtual `busy' field that counts
- the number of used ablock in the parent ablocks.
- The first ablock has the `busy' field, the others have the `abase'
- field. To tell the difference, we assume that pointers will have
- integer values larger than 2 * ABLOCKS_SIZE. The lowest bit of `busy'
- is used to tell whether the real base of the parent ablocks is `abase'
- (if not, the word before the first ablock holds a pointer to the
- real base). */
+
+ /* ABASE is the aligned base of the ablocks. It is overloaded to
+ hold a virtual "busy" field that counts twice the number of used
+ ablock values in the parent ablocks, plus one if the real base of
+ the parent ablocks is ABASE (if the "busy" field is even, the
+ word before the first ablock holds a pointer to the real base).
+ The first ablock has a "busy" ABASE, and the others have an
+ ordinary pointer ABASE. To tell the difference, the code assumes
+ that pointers, when cast to uintptr_t, are at least 2 *
+ ABLOCKS_SIZE + 1. */
struct ablocks *abase;
+
/* The padding of all but the last ablock is unused. The padding of
the last ablock in an ablocks is not allocated. */
#if BLOCK_PADDING
#define ABLOCK_ABASE(block) \
(((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE) \
- ? (struct ablocks *)(block) \
+ ? (struct ablocks *) (block) \
: (block)->abase)
/* Virtual `busy' field. */
-#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
+#define ABLOCKS_BUSY(a_base) ((a_base)->blocks[0].abase)
/* Pointer to the (not necessarily aligned) malloc block. */
#ifdef USE_ALIGNED_ALLOC
#define ABLOCKS_BASE(abase) (abase)
#else
#define ABLOCKS_BASE(abase) \
- (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **)abase)[-1])
+ (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1])
#endif
/* The list of free ablock. */
if (!free_ablock)
{
int i;
- intptr_t aligned; /* int gets warning casting to 64-bit pointer. */
+ bool aligned;
#ifdef DOUG_LEA_MALLOC
if (!mmap_lisp_allowed_p ())
abase = base = aligned_alloc (BLOCK_ALIGN, ABLOCKS_BYTES);
#else
base = malloc (ABLOCKS_BYTES);
- abase = ALIGN (base, BLOCK_ALIGN);
+ abase = pointer_align (base, BLOCK_ALIGN);
#endif
if (base == 0)
abase->blocks[i].x.next_free = free_ablock;
free_ablock = &abase->blocks[i];
}
- ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
+ intptr_t ialigned = aligned;
+ ABLOCKS_BUSY (abase) = (struct ablocks *) ialigned;
- eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN);
+ eassert ((uintptr_t) abase % BLOCK_ALIGN == 0);
eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
eassert (ABLOCKS_BASE (abase) == base);
- eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase));
+ eassert ((intptr_t) ABLOCKS_BUSY (abase) == aligned);
}
abase = ABLOCK_ABASE (free_ablock);
ablock->x.next_free = free_ablock;
free_ablock = ablock;
/* Update busy count. */
- ABLOCKS_BUSY (abase)
- = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
+ intptr_t busy = (intptr_t) ABLOCKS_BUSY (abase) - 2;
+ eassume (0 <= busy && busy <= 2 * ABLOCKS_SIZE - 1);
+ ABLOCKS_BUSY (abase) = (struct ablocks *) busy;
- if (2 > (intptr_t) ABLOCKS_BUSY (abase))
+ if (busy < 2)
{ /* All the blocks are free. */
- int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase);
+ int i = 0;
+ bool aligned = busy;
struct ablock **tem = &free_ablock;
struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
MALLOC_UNBLOCK_INPUT;
}
+#if !defined __GNUC__ && !defined __alignof__
+# define __alignof__(type) alignof (type)
+#endif
+
+/* True if malloc returns a multiple of GCALIGNMENT. In practice this
+ holds if __alignof__ (max_align_t) is a multiple. Use __alignof__
+ if available, as otherwise this check would fail with GCC x86.
+ This is a macro, not an enum constant, for portability to HP-UX
+ 10.20 cc and AIX 3.2.5 xlc. */
+#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0)
+
+/* True if P is suitably aligned for SIZE, where Lisp alignment may be
+ needed if SIZE is Lisp-aligned. */
+
+static bool
+laligned (void *p, size_t size)
+{
+ return (MALLOC_IS_GC_ALIGNED || (intptr_t) p % GCALIGNMENT == 0
+ || size % GCALIGNMENT != 0);
+}
+
+/* Like malloc and realloc except that if SIZE is Lisp-aligned, make
+ sure the result is too, if necessary by reallocating (typically
+ with larger and larger sizes) until the allocator returns a
+ Lisp-aligned pointer. Code that needs to allocate C heap memory
+ for a Lisp object should use one of these functions to obtain a
+ pointer P; that way, if T is an enum Lisp_Type value and L ==
+ make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T.
+
+ On typical modern platforms these functions' loops do not iterate.
+ On now-rare (and perhaps nonexistent) platforms, the loops in
+ theory could repeat forever. If an infinite loop is possible on a
+ platform, a build would surely loop and the builder can then send
+ us a bug report. Adding a counter to try to detect any such loop
+ would complicate the code (and possibly introduce bugs, in code
+ that's never really exercised) for little benefit. */
+
+static void *
+lmalloc (size_t size)
+{
+#if USE_ALIGNED_ALLOC
+ if (! MALLOC_IS_GC_ALIGNED)
+ return aligned_alloc (GCALIGNMENT, size);
+#endif
+
+ void *p;
+ while (true)
+ {
+ p = malloc (size);
+ if (laligned (p, size))
+ break;
+ free (p);
+ size_t bigger;
+ if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ size = bigger;
+ }
+
+ eassert ((intptr_t) p % GCALIGNMENT == 0);
+ return p;
+}
+
+static void *
+lrealloc (void *p, size_t size)
+{
+ while (true)
+ {
+ p = realloc (p, size);
+ if (laligned (p, size))
+ break;
+ size_t bigger;
+ if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ size = bigger;
+ }
+
+ eassert ((intptr_t) p % GCALIGNMENT == 0);
+ return p;
+}
+
\f
/***********************************************************************
Interval Allocation
static void
compact_small_strings (void)
{
- struct sblock *b, *tb, *next;
- sdata *from, *to, *end, *tb_end;
- sdata *to_end, *from_end;
-
/* TB is the sblock we copy to, TO is the sdata within TB we copy
to, and TB_END is the end of TB. */
- tb = oldest_sblock;
- tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = tb->data;
-
- /* Step through the blocks from the oldest to the youngest. We
- expect that old blocks will stabilize over time, so that less
- copying will happen this way. */
- for (b = oldest_sblock; b; b = b->next)
+ struct sblock *tb = oldest_sblock;
+ if (tb)
{
- end = b->next_free;
- eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+ sdata *tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
+ sdata *to = tb->data;
- for (from = b->data; from < end; from = from_end)
+ /* Step through the blocks from the oldest to the youngest. We
+ expect that old blocks will stabilize over time, so that less
+ copying will happen this way. */
+ struct sblock *b = tb;
+ do
{
- /* Compute the next FROM here because copying below may
- overwrite data we need to compute it. */
- ptrdiff_t nbytes;
- struct Lisp_String *s = from->string;
+ sdata *end = b->next_free;
+ eassert ((char *) end <= (char *) b + SBLOCK_SIZE);
+
+ for (sdata *from = b->data; from < end; )
+ {
+ /* Compute the next FROM here because copying below may
+ overwrite data we need to compute it. */
+ ptrdiff_t nbytes;
+ struct Lisp_String *s = from->string;
#ifdef GC_CHECK_STRING_BYTES
- /* Check that the string size recorded in the string is the
- same as the one recorded in the sdata structure. */
- if (s && string_bytes (s) != SDATA_NBYTES (from))
- emacs_abort ();
+ /* Check that the string size recorded in the string is the
+ same as the one recorded in the sdata structure. */
+ if (s && string_bytes (s) != SDATA_NBYTES (from))
+ emacs_abort ();
#endif /* GC_CHECK_STRING_BYTES */
- nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
- eassert (nbytes <= LARGE_STRING_BYTES);
+ nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+ eassert (nbytes <= LARGE_STRING_BYTES);
- nbytes = SDATA_SIZE (nbytes);
- from_end = (sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
+ nbytes = SDATA_SIZE (nbytes);
+ sdata *from_end = (sdata *) ((char *) from
+ + nbytes + GC_STRING_EXTRA);
#ifdef GC_CHECK_STRING_OVERRUN
- if (memcmp (string_overrun_cookie,
- (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
- GC_STRING_OVERRUN_COOKIE_SIZE))
- emacs_abort ();
+ if (memcmp (string_overrun_cookie,
+ (char *) from_end - GC_STRING_OVERRUN_COOKIE_SIZE,
+ GC_STRING_OVERRUN_COOKIE_SIZE))
+ emacs_abort ();
#endif
- /* Non-NULL S means it's alive. Copy its data. */
- if (s)
- {
- /* If TB is full, proceed with the next sblock. */
- to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
- if (to_end > tb_end)
+ /* Non-NULL S means it's alive. Copy its data. */
+ if (s)
{
- tb->next_free = to;
- tb = tb->next;
- tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
- to = tb->data;
- to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
- }
+ /* If TB is full, proceed with the next sblock. */
+ sdata *to_end = (sdata *) ((char *) to
+ + nbytes + GC_STRING_EXTRA);
+ if (to_end > tb_end)
+ {
+ tb->next_free = to;
+ tb = tb->next;
+ tb_end = (sdata *) ((char *) tb + SBLOCK_SIZE);
+ to = tb->data;
+ to_end = (sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
+ }
- /* Copy, and update the string's `data' pointer. */
- if (from != to)
- {
- eassert (tb != b || to < from);
- memmove (to, from, nbytes + GC_STRING_EXTRA);
- to->string->data = SDATA_DATA (to);
- }
+ /* Copy, and update the string's `data' pointer. */
+ if (from != to)
+ {
+ eassert (tb != b || to < from);
+ memmove (to, from, nbytes + GC_STRING_EXTRA);
+ to->string->data = SDATA_DATA (to);
+ }
- /* Advance past the sdata we copied to. */
- to = to_end;
+ /* Advance past the sdata we copied to. */
+ to = to_end;
+ }
+ from = from_end;
}
+ b = b->next;
}
- }
+ while (b);
- /* The rest of the sblocks following TB don't contain live data, so
- we can free them. */
- for (b = tb->next; b; b = next)
- {
- next = b->next;
- lisp_free (b);
+ /* The rest of the sblocks following TB don't contain live data, so
+ we can free them. */
+ for (b = tb->next; b; )
+ {
+ struct sblock *next = b->next;
+ lisp_free (b);
+ b = next;
+ }
+
+ tb->next_free = to;
+ tb->next = NULL;
}
- tb->next_free = to;
- tb->next = NULL;
current_sblock = tb;
}
return val;
}
-#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
make_save_ptr_ptr (void *a, void *b)
{
p->data[1].pointer = b;
return val;
}
-#endif
Lisp_Object
make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
{
/* Allocate space for a Lisp object from the beginning of the free
space with taking account of alignment. */
- result = ALIGN (purebeg + pure_bytes_used_lisp, GCALIGNMENT);
+ result = pointer_align (purebeg + pure_bytes_used_lisp, GCALIGNMENT);
pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
}
else
}
else
{
- Lisp_Object fmt = build_pure_c_string ("Don't know how to purify: %S");
+ AUTO_STRING (fmt, "Don't know how to purify: %S");
Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
}
return Qnil;
/* Record this function, so it appears on the profiler's backtraces. */
- record_in_backtrace (Qautomatic_gc, 0, 0);
+ record_in_backtrace (QAutomatic_GC, 0, 0);
check_cons_list ();
int i, j;
for (i = 0; i < c->used; ++i)
{
- struct face *face = FACE_FROM_ID (c->f, i);
+ struct face *face = FACE_FROM_ID_OR_NULL (c->f, i);
if (face)
{
#if defined (ENABLE_CHECKING) && USE_STACK_LISP_OBJECTS
-/* Debugging check whether STR is ASCII-only. */
-
-const char *
-verify_ascii (const char *str)
-{
- const unsigned char *ptr = (unsigned char *) str, *end = ptr + strlen (str);
- while (ptr < end)
- {
- int c = STRING_CHAR_ADVANCE (ptr);
- if (!ASCII_CHAR_P (c))
- emacs_abort ();
- }
- return str;
-}
-
/* Stress alloca with inconveniently sized requests and check
whether all allocated areas may be used for Lisp_Object. */
DEFSYM (Qstring_bytes, "string-bytes");
DEFSYM (Qvector_slots, "vector-slots");
DEFSYM (Qheap, "heap");
- DEFSYM (Qautomatic_gc, "Automatic GC");
+ DEFSYM (QAutomatic_GC, "Automatic GC");
DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");