alloc.c 206 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Storage allocation and gc for GNU Emacs Lisp interpreter.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2017 Free Software
4
Foundation, Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
19
along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

21
#include <config.h>
22

23
#include <errno.h>
24
#include <stdio.h>
Paul Eggert's avatar
Paul Eggert committed
25
#include <stdlib.h>
26
#include <limits.h>		/* For CHAR_BIT.  */
27
#include <signal.h>		/* For SIGABRT, SIGDANGER.  */
28

29
#ifdef HAVE_PTHREAD
30 31 32
#include <pthread.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
33
#include "lisp.h"
34
#include "dispextern.h"
35
#include "intervals.h"
Jim Blandy's avatar
Jim Blandy committed
36
#include "puresize.h"
37
#include "sheap.h"
38
#include "systime.h"
39
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
40 41
#include "buffer.h"
#include "window.h"
42
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
43
#include "frame.h"
44
#include "blockinput.h"
45
#include "termhooks.h"		/* For struct terminal.  */
46 47 48
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
49

50
#include <flexmember.h>
51
#include <verify.h>
52
#include <execinfo.h>           /* For backtrace.  */
53

54 55 56 57
#ifdef HAVE_LINUX_SYSINFO
#include <sys/sysinfo.h>
#endif

58 59 60 61
#ifdef MSDOS
#include "dosfns.h"		/* For dos_memory_info.  */
#endif

62 63 64 65
#ifdef HAVE_MALLOC_H
# include <malloc.h>
#endif

66 67 68 69 70 71
#if (defined ENABLE_CHECKING			\
     && defined HAVE_VALGRIND_VALGRIND_H	\
     && !defined USE_VALGRIND)
# define USE_VALGRIND 1
#endif

72 73 74
#if USE_VALGRIND
#include <valgrind/valgrind.h>
#include <valgrind/memcheck.h>
75
static bool valgrind_p;
76 77
#endif

78 79 80 81 82 83 84
/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
   We turn that on by default when ENABLE_CHECKING is defined;
   define GC_CHECK_MARKED_OBJECTS to zero to disable.  */

#if defined ENABLE_CHECKING && !defined GC_CHECK_MARKED_OBJECTS
# define GC_CHECK_MARKED_OBJECTS 1
#endif
85

Kenichi Handa's avatar
Kenichi Handa committed
86
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
87 88
   memory.  Can do this only if using gmalloc.c and if not checking
   marked objects.  */
Kenichi Handa's avatar
Kenichi Handa committed
89

90
#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
91
     || defined HYBRID_MALLOC || GC_CHECK_MARKED_OBJECTS)
Kenichi Handa's avatar
Kenichi Handa committed
92 93 94
#undef GC_MALLOC_CHECK
#endif

95
#include <unistd.h>
96 97
#include <fcntl.h>

Paul Eggert's avatar
Paul Eggert committed
98 99 100
#ifdef USE_GTK
# include "gtkutil.h"
#endif
101
#ifdef WINDOWSNT
Eli Zaretskii's avatar
Eli Zaretskii committed
102
#include "w32.h"
103
#include "w32heap.h"	/* for sbrk */
104 105
#endif

Paul Eggert's avatar
Paul Eggert committed
106
#ifdef GNU_LINUX
Paul Eggert's avatar
Paul Eggert committed
107 108 109 110 111 112 113 114 115 116 117
/* The address where the heap starts.  */
void *
my_heap_start (void)
{
  static void *start;
  if (! start)
    start = sbrk (0);
  return start;
}
#endif

118
#ifdef DOUG_LEA_MALLOC
119 120 121 122

/* Specify maximum number of areas to mmap.  It would be nice to use a
   value that explicitly means "no limit".  */

123 124
#define MMAP_MAX_AREAS 100000000

Paul Eggert's avatar
Paul Eggert committed
125 126 127 128 129 130 131 132 133 134 135 136 137 138
/* A pointer to the memory allocated that copies that static data
   inside glibc's malloc.  */
static void *malloc_state_ptr;

/* Restore the dumped malloc state.  Because malloc can be invoked
   even before main (e.g. by the dynamic linker), the dumped malloc
   state must be restored as early as possible using this special hook.  */
static void
malloc_initialize_hook (void)
{
  static bool malloc_using_checking;

  if (! initialized)
    {
Paul Eggert's avatar
Paul Eggert committed
139
#ifdef GNU_LINUX
Paul Eggert's avatar
Paul Eggert committed
140
      my_heap_start ();
Paul Eggert's avatar
Paul Eggert committed
141
#endif
Paul Eggert's avatar
Paul Eggert committed
142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
      malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL;
    }
  else
    {
      if (!malloc_using_checking)
	{
	  /* Work around a bug in glibc's malloc.  MALLOC_CHECK_ must be
	     ignored if the heap to be restored was constructed without
	     malloc checking.  Can't use unsetenv, since that calls malloc.  */
	  char **p = environ;
	  if (p)
	    for (; *p; p++)
	      if (strncmp (*p, "MALLOC_CHECK_=", 14) == 0)
		{
		  do
		    *p = p[1];
		  while (*++p);

		  break;
		}
	}

164 165
      if (malloc_set_state (malloc_state_ptr) != 0)
	emacs_abort ();
Paul Eggert's avatar
Paul Eggert committed
166 167 168 169 170 171
# ifndef XMALLOC_OVERRUN_CHECK
      alloc_unexec_post ();
# endif
    }
}

Paul Eggert's avatar
Paul Eggert committed
172 173
/* Declare the malloc initialization hook, which runs before 'main' starts.
   EXTERNALLY_VISIBLE works around Bug#22522.  */
Paul Eggert's avatar
Paul Eggert committed
174 175 176
# ifndef __MALLOC_HOOK_VOLATILE
#  define __MALLOC_HOOK_VOLATILE
# endif
Paul Eggert's avatar
Paul Eggert committed
177
voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE
Paul Eggert's avatar
Paul Eggert committed
178 179 180
  = malloc_initialize_hook;

#endif
181

182 183
#if defined DOUG_LEA_MALLOC || !defined CANNOT_DUMP

184 185 186 187 188
/* Allocator-related actions to do just before and after unexec.  */

void
alloc_unexec_pre (void)
{
189
# ifdef DOUG_LEA_MALLOC
190
  malloc_state_ptr = malloc_get_state ();
191 192
  if (!malloc_state_ptr)
    fatal ("malloc_get_state: %s", strerror (errno));
193 194
# endif
# ifdef HYBRID_MALLOC
195
  bss_sbrk_did_unexec = true;
196
# endif
197 198 199 200 201
}

void
alloc_unexec_post (void)
{
202
# ifdef DOUG_LEA_MALLOC
203
  free (malloc_state_ptr);
204 205
# endif
# ifdef HYBRID_MALLOC
206
  bss_sbrk_did_unexec = false;
207
# endif
208
}
209
#endif
210

211 212 213
/* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
   to a struct Lisp_String.  */

214 215 216
#define MARK_STRING(S)		((S)->u.s.size |= ARRAY_MARK_FLAG)
#define UNMARK_STRING(S)	((S)->u.s.size &= ~ARRAY_MARK_FLAG)
#define STRING_MARKED_P(S)	(((S)->u.s.size & ARRAY_MARK_FLAG) != 0)
217

218 219 220
#define VECTOR_MARK(V)		((V)->header.size |= ARRAY_MARK_FLAG)
#define VECTOR_UNMARK(V)	((V)->header.size &= ~ARRAY_MARK_FLAG)
#define VECTOR_MARKED_P(V)	(((V)->header.size & ARRAY_MARK_FLAG) != 0)
221

222 223
/* Default value of gc_cons_threshold (see below).  */

224
#define GC_DEFAULT_THRESHOLD (100000 * word_size)
225

226 227 228
/* Global variables.  */
struct emacs_globals globals;

229 230
/* Number of bytes of consing done since the last gc.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
231
EMACS_INT consing_since_gc;
Jim Blandy's avatar
Jim Blandy committed
232

233 234
/* Similar minimum, computed from Vgc_cons_percentage.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
235
EMACS_INT gc_relative_threshold;
236

237 238 239
/* Minimum number of bytes of consing since GC before next GC,
   when memory is full.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
240
EMACS_INT memory_full_cons_threshold;
241

242
/* True during GC.  */
243

244
bool gc_in_progress;
Jim Blandy's avatar
Jim Blandy committed
245

246 247
/* Number of live and free conses etc.  */

248
static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
249
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
250
static EMACS_INT total_free_floats, total_floats;
251

252
/* Points to memory space allocated as "spare", to be freed if we run
253 254
   out of memory.  We keep one large block, four cons-blocks, and
   two string blocks.  */
255

256
static char *spare_memory[7];
257

258 259
/* Amount of spare memory to keep in large reserve block, or to see
   whether this much is available when malloc fails on a larger request.  */
260

261
#define SPARE_MEMORY (1 << 14)
262

Richard M. Stallman's avatar
Richard M. Stallman committed
263 264 265 266 267
/* Initialize it to a nonzero value to force it into data space
   (rather than bss space).  That way unexec will remap it into text
   space (pure), on some systems.  We have not implemented the
   remapping on more recent systems because this is less important
   nowadays than in the days of small memories and timesharing.  */
268

Andreas Schwab's avatar
Andreas Schwab committed
269
EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
Jim Blandy's avatar
Jim Blandy committed
270
#define PUREBEG (char *) pure
271

272
/* Pointer to the pure area, and its size.  */
273

274
static char *purebeg;
275
static ptrdiff_t pure_size;
276 277 278 279

/* Number of bytes of pure storage used before pure storage overflowed.
   If this is non-zero, this implies that an overflow occurred.  */

280
static ptrdiff_t pure_bytes_used_before_overflow;
Jim Blandy's avatar
Jim Blandy committed
281

282
/* Index in pure at which next pure Lisp object will be allocated..  */
283

284
static ptrdiff_t pure_bytes_used_lisp;
285 286 287

/* Number of bytes allocated for non-Lisp objects in pure storage.  */

288
static ptrdiff_t pure_bytes_used_non_lisp;
289

290 291 292
/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

293
const char *pending_malloc_warning;
Jim Blandy's avatar
Jim Blandy committed
294

295 296 297 298 299 300 301 302 303 304 305
#if 0 /* Normally, pointer sanity only on request... */
#ifdef ENABLE_CHECKING
#define SUSPICIOUS_OBJECT_CHECKING 1
#endif
#endif

/* ... but unconditionally use SUSPICIOUS_OBJECT_CHECKING while the GC
   bug is unresolved.  */
#define SUSPICIOUS_OBJECT_CHECKING 1

#ifdef SUSPICIOUS_OBJECT_CHECKING
306 307
struct suspicious_free_record
{
308 309
  void *suspicious_object;
  void *backtrace[128];
310
};
311
static void *suspicious_objects[32];
312
static int suspicious_object_index;
313
struct suspicious_free_record suspicious_free_history[64] EXTERNALLY_VISIBLE;
314 315 316
static int suspicious_free_history_index;
/* Find the first currently-monitored suspicious pointer in range
   [begin,end) or NULL if no such pointer exists.  */
317 318
static void *find_suspicious_object_in_range (void *begin, void *end);
static void detect_suspicious_free (void *ptr);
319
#else
320 321
# define find_suspicious_object_in_range(begin, end) NULL
# define detect_suspicious_free(ptr) (void)
322 323
#endif

Jim Blandy's avatar
Jim Blandy committed
324 325 326 327 328 329 330 331
/* Maximum amount of C stack to save when a GC happens.  */

#ifndef MAX_SAVE_STACK
#define MAX_SAVE_STACK 16000
#endif

/* Buffer in which we save a copy of the C stack at each GC.  */

332
#if MAX_SAVE_STACK > 0
333
static char *stack_copy;
334
static ptrdiff_t stack_copy_size;
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355

/* Copy to DEST a block of memory from SRC of size SIZE bytes,
   avoiding any address sanitization.  */

static void * ATTRIBUTE_NO_SANITIZE_ADDRESS
no_sanitize_memcpy (void *dest, void const *src, size_t size)
{
  if (! ADDRESS_SANITIZER)
    return memcpy (dest, src, size);
  else
    {
      size_t i;
      char *d = dest;
      char const *s = src;
      for (i = 0; i < size; i++)
	d[i] = s[i];
      return dest;
    }
}

#endif /* MAX_SAVE_STACK > 0 */
Jim Blandy's avatar
Jim Blandy committed
356

357 358
static void mark_terminals (void);
static void gc_sweep (void);
359
static Lisp_Object make_pure_vector (ptrdiff_t);
360
static void mark_buffer (struct buffer *);
361

362
#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC
363 364
static void refill_memory_reserve (void);
#endif
365 366
static void compact_small_strings (void);
static void free_large_strings (void);
367
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
368

369 370 371
/* When scanning the C stack for live Lisp objects, Emacs keeps track of
   what memory allocated via lisp_malloc and lisp_align_malloc is intended
   for what purpose.  This enumeration specifies the type of memory.  */
372 373 374 375 376 377 378 379 380 381

enum mem_type
{
  MEM_TYPE_NON_LISP,
  MEM_TYPE_BUFFER,
  MEM_TYPE_CONS,
  MEM_TYPE_STRING,
  MEM_TYPE_MISC,
  MEM_TYPE_SYMBOL,
  MEM_TYPE_FLOAT,
382 383 384
  /* Since all non-bool pseudovectors are small enough to be
     allocated from vector blocks, this memory type denotes
     large regular vectors and large bool pseudovectors.  */
385 386
  MEM_TYPE_VECTORLIKE,
  /* Special type to denote vector blocks.  */
387 388 389
  MEM_TYPE_VECTOR_BLOCK,
  /* Special type to denote reserved memory.  */
  MEM_TYPE_SPARE
390 391
};

392 393 394
/* A unique object in pure space used to make some Lisp objects
   on free lists recognizable in O(1).  */

395
static Lisp_Object Vdead;
396
#define DEADP(x) EQ (x, Vdead)
397

398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429
#ifdef GC_MALLOC_CHECK

enum mem_type allocated_mem_type;

#endif /* GC_MALLOC_CHECK */

/* A node in the red-black tree describing allocated memory containing
   Lisp data.  Each such block is recorded with its start and end
   address when it is allocated, and removed from the tree when it
   is freed.

   A red-black tree is a balanced binary tree with the following
   properties:

   1. Every node is either red or black.
   2. Every leaf is black.
   3. If a node is red, then both of its children are black.
   4. Every simple path from a node to a descendant leaf contains
   the same number of black nodes.
   5. The root is always black.

   When nodes are inserted into the tree, or deleted from the tree,
   the tree is "fixed" so that these properties are always true.

   A red-black tree with N internal nodes has height at most 2
   log(N+1).  Searches, insertions and deletions are done in O(log N).
   Please see a text book about data structures for a detailed
   description of red-black trees.  Any book worth its salt should
   describe them.  */

struct mem_node
{
Richard M. Stallman's avatar
Richard M. Stallman committed
430 431 432 433 434 435
  /* Children of this node.  These pointers are never NULL.  When there
     is no child, the value is MEM_NIL, which points to a dummy node.  */
  struct mem_node *left, *right;

  /* The parent of this node.  In the root node, this is NULL.  */
  struct mem_node *parent;
436 437 438 439 440 441

  /* Start and end of allocated region.  */
  void *start, *end;

  /* Node color.  */
  enum {MEM_BLACK, MEM_RED} color;
442

443 444 445 446 447 448 449 450
  /* Memory type.  */
  enum mem_type type;
};

/* Root of the tree describing allocated Lisp memory.  */

static struct mem_node *mem_root;

451 452 453 454
/* Lowest and highest known address in the heap.  */

static void *min_heap_address, *max_heap_address;

455 456 457 458 459
/* Sentinel node of the tree.  */

static struct mem_node mem_z;
#define MEM_NIL &mem_z

460 461 462 463 464 465
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
static void mem_rotate_left (struct mem_node *);
static void mem_rotate_right (struct mem_node *);
static void mem_delete (struct mem_node *);
static void mem_delete_fixup (struct mem_node *);
466
static struct mem_node *mem_find (void *);
467

468 469 470 471
#ifndef DEADP
# define DEADP(x) 0
#endif

472 473
/* Addresses of staticpro'd variables.  Initialize it to a nonzero
   value; otherwise some compilers put it into BSS.  */
474

475
enum { NSTATICS = 2048 };
476
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
477 478 479

/* Index of next unused slot in staticvec.  */

480
static int staticidx;
481

Paul Eggert's avatar
Paul Eggert committed
482
static void *pure_alloc (size_t, int);
483

Paul Eggert's avatar
Paul Eggert committed
484
/* True if N is a power of 2.  N should be positive.  */
485

Paul Eggert's avatar
Paul Eggert committed
486 487 488 489 490 491 492 493 494 495
#define POWER_OF_2(n) (((n) & ((n) - 1)) == 0)

/* Return X rounded to the next multiple of Y.  Y should be positive,
   and Y - 1 + X should not overflow.  Arguments should not have side
   effects, as they are evaluated more than once.  Tune for Y being a
   power of 2.  */

#define ROUNDUP(x, y) (POWER_OF_2 (y)					\
		       ? ((y) - 1 + (x)) & ~ ((y) - 1)			\
		       : ((y) - 1 + (x)) - ((y) - 1 + (x)) % (y))
496

497 498 499
/* Return PTR rounded up to the next multiple of ALIGNMENT.  */

static void *
Paul Eggert's avatar
Paul Eggert committed
500
pointer_align (void *ptr, int alignment)
501 502 503
{
  return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
}
504

Paul Eggert's avatar
Paul Eggert committed
505 506 507 508
/* Extract the pointer hidden within A, if A is not a symbol.
   If A is a symbol, extract the hidden pointer's offset from lispsym,
   converted to void *.  */

509 510
#define macro_XPNTR_OR_SYMBOL_OFFSET(a) \
  ((void *) (intptr_t) (USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK))
Paul Eggert's avatar
Paul Eggert committed
511 512 513

/* Extract the pointer hidden within A.  */

514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529
#define macro_XPNTR(a) \
  ((void *) ((intptr_t) XPNTR_OR_SYMBOL_OFFSET (a) \
	     + (SYMBOLP (a) ? (char *) lispsym : NULL)))

/* For pointer access, define XPNTR and XPNTR_OR_SYMBOL_OFFSET as
   functions, as functions are cleaner and can be used in debuggers.
   Also, define them as macros if being compiled with GCC without
   optimization, for performance in that case.  The macro_* names are
   private to this section of code.  */

static ATTRIBUTE_UNUSED void *
XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
{
  return macro_XPNTR_OR_SYMBOL_OFFSET (a);
}
static ATTRIBUTE_UNUSED void *
Paul Eggert's avatar
Paul Eggert committed
530 531
XPNTR (Lisp_Object a)
{
532
  return macro_XPNTR (a);
Paul Eggert's avatar
Paul Eggert committed
533 534
}

535 536 537 538 539
#if DEFINE_KEY_OPS_AS_MACROS
# define XPNTR_OR_SYMBOL_OFFSET(a) macro_XPNTR_OR_SYMBOL_OFFSET (a)
# define XPNTR(a) macro_XPNTR (a)
#endif

540 541 542 543 544
static void
XFLOAT_INIT (Lisp_Object f, double n)
{
  XFLOAT (f)->u.data = n;
}
545

546
#ifdef DOUG_LEA_MALLOC
547 548 549 550 551 552 553 554 555 556 557 558
static bool
pointers_fit_in_lispobj_p (void)
{
  return (UINTPTR_MAX <= VAL_MAX) || USE_LSB_TAG;
}

static bool
mmap_lisp_allowed_p (void)
{
  /* If we can't store all memory addresses in our lisp objects, it's
     risky to let the heap use mmap and give us addresses from all
     over our address space.  We also can't use mmap for lisp objects
Paul Eggert's avatar
Paul Eggert committed
559
     if we might dump: unexec doesn't preserve the contents of mmapped
560 561 562
     regions.  */
  return pointers_fit_in_lispobj_p () && !might_dump;
}
563
#endif
564

Daniel Colascione's avatar
Daniel Colascione committed
565 566 567 568 569 570 571 572 573
/* Head of a circularly-linked list of extant finalizers. */
static struct Lisp_Finalizer finalizers;

/* Head of a circularly-linked list of finalizers that must be invoked
   because we deemed them unreachable.  This list must be global, and
   not a local inside garbage_collect_1, in case we GC again while
   running finalizers.  */
static struct Lisp_Finalizer doomed_finalizers;

Jim Blandy's avatar
Jim Blandy committed
574

575 576 577 578
/************************************************************************
				Malloc
 ************************************************************************/

579 580
#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC)

581
/* Function malloc calls this if it finds we are near exhausting storage.  */
582 583

void
584
malloc_warning (const char *str)
Jim Blandy's avatar
Jim Blandy committed
585 586 587 588
{
  pending_malloc_warning = str;
}

589
#endif
590

591
/* Display an already-pending malloc warning.  */
592

593
void
594
display_malloc_warning (void)
Jim Blandy's avatar
Jim Blandy committed
595
{
596 597 598 599
  call3 (intern ("display-warning"),
	 intern ("alloc"),
	 build_string (pending_malloc_warning),
	 intern ("emergency"));
Jim Blandy's avatar
Jim Blandy committed
600 601
  pending_malloc_warning = 0;
}
602

603 604 605
/* Called if we can't allocate relocatable space for a buffer.  */

void
606
buffer_memory_full (ptrdiff_t nbytes)
607
{
608 609 610 611 612 613
  /* If buffers use the relocating allocator, no need to free
     spare_memory, because we may have plenty of malloc space left
     that we could get, and if we don't, the malloc that fails will
     itself cause spare_memory to be freed.  If buffers don't use the
     relocating allocator, treat this like any other failing
     malloc.  */
614 615

#ifndef REL_ALLOC
Paul Eggert's avatar
Paul Eggert committed
616
  memory_full (nbytes);
Paul Eggert's avatar
Paul Eggert committed
617
#else
618 619
  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
620
  xsignal (Qnil, Vmemory_signal_data);
Paul Eggert's avatar
Paul Eggert committed
621
#endif
Jim Blandy's avatar
Jim Blandy committed
622 623
}

624 625 626 627 628 629
/* A common multiple of the positive integers A and B.  Ideally this
   would be the least common multiple, but there's no way to do that
   as a constant expression in C, so do the best that we can easily do.  */
#define COMMON_MULTIPLE(a, b) \
  ((a) % (b) == 0 ? (a) : (b) % (a) == 0 ? (b) : (a) * (b))

630
#ifndef XMALLOC_OVERRUN_CHECK
631
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
632
#else
633

634 635
/* Check for overrun in malloc'ed buffers by wrapping a header and trailer
   around each block.
Kim F. Storm's avatar
Kim F. Storm committed
636

637 638 639 640
   The header consists of XMALLOC_OVERRUN_CHECK_SIZE fixed bytes
   followed by XMALLOC_OVERRUN_SIZE_SIZE bytes containing the original
   block size in little-endian order.  The trailer consists of
   XMALLOC_OVERRUN_CHECK_SIZE fixed bytes.
Kim F. Storm's avatar
Kim F. Storm committed
641 642

   The header is used to detect whether this block has been allocated
643 644
   through these functions, as some low-level libc functions may
   bypass the malloc hooks.  */
Kim F. Storm's avatar
Kim F. Storm committed
645

646
#define XMALLOC_OVERRUN_CHECK_SIZE 16
647
#define XMALLOC_OVERRUN_CHECK_OVERHEAD \
648 649
  (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE)

650
#define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
651

652 653
#define XMALLOC_HEADER_ALIGNMENT \
   COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
Paul Eggert's avatar
Paul Eggert committed
654 655 656 657

/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
   hold a size_t value and (2) the header size is a multiple of the
   alignment that Emacs needs for C types and for USE_LSB_TAG.  */
658
#define XMALLOC_OVERRUN_SIZE_SIZE				\
659 660 661 662
   (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t)		\
      + XMALLOC_HEADER_ALIGNMENT - 1)				\
     / XMALLOC_HEADER_ALIGNMENT * XMALLOC_HEADER_ALIGNMENT)	\
    - XMALLOC_OVERRUN_CHECK_SIZE)
Kim F. Storm's avatar
Kim F. Storm committed
663

664 665 666 667 668
static char const xmalloc_overrun_check_header[XMALLOC_OVERRUN_CHECK_SIZE] =
  { '\x9a', '\x9b', '\xae', '\xaf',
    '\xbf', '\xbe', '\xce', '\xcf',
    '\xea', '\xeb', '\xec', '\xed',
    '\xdf', '\xde', '\x9c', '\x9d' };
669

670 671 672 673 674
static char const xmalloc_overrun_check_trailer[XMALLOC_OVERRUN_CHECK_SIZE] =
  { '\xaa', '\xab', '\xac', '\xad',
    '\xba', '\xbb', '\xbc', '\xbd',
    '\xca', '\xcb', '\xcc', '\xcd',
    '\xda', '\xdb', '\xdc', '\xdd' };
675

676
/* Insert and extract the block size in the header.  */
Kim F. Storm's avatar
Kim F. Storm committed
677

678 679 680 681
static void
xmalloc_put_size (unsigned char *ptr, size_t size)
{
  int i;
682
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
683
    {
684
      *--ptr = size & ((1 << CHAR_BIT) - 1);
685 686 687
      size >>= CHAR_BIT;
    }
}
Kim F. Storm's avatar
Kim F. Storm committed
688

689 690 691 692 693
static size_t
xmalloc_get_size (unsigned char *ptr)
{
  size_t size = 0;
  int i;
694 695
  ptr -= XMALLOC_OVERRUN_SIZE_SIZE;
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
696 697 698 699 700 701
    {
      size <<= CHAR_BIT;
      size += *ptr++;
    }
  return size;
}
Kim F. Storm's avatar
Kim F. Storm committed
702 703 704 705


/* Like malloc, but wraps allocated block with header and trailer.  */

Paul Eggert's avatar
Paul Eggert committed
706
static void *
707
overrun_check_malloc (size_t size)
708
{
Kim F. Storm's avatar
Kim F. Storm committed
709
  register unsigned char *val;
710
  if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
711
    emacs_abort ();
712

713 714
  val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
  if (val)
715
    {
716
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
717
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
718
      xmalloc_put_size (val, size);
719 720
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
721
    }
Paul Eggert's avatar
Paul Eggert committed
722
  return val;
723 724
}

Kim F. Storm's avatar
Kim F. Storm committed
725 726 727 728

/* Like realloc, but checks old block for overrun, and wraps new block
   with header and trailer.  */

Paul Eggert's avatar
Paul Eggert committed
729 730
static void *
overrun_check_realloc (void *block, size_t size)
731
{
732
  register unsigned char *val = (unsigned char *) block;
733
  if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
734
    emacs_abort ();
735 736

  if (val
737
      && memcmp (xmalloc_overrun_check_header,
738
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
739
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
740
    {
741
      size_t osize = xmalloc_get_size (val);
742 743
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
744
	emacs_abort ();
745
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
746 747
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
748 749
    }

750
  val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
751

752
  if (val)
753
    {
754
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
755
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
756
      xmalloc_put_size (val, size);
757 758
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
759
    }
Paul Eggert's avatar
Paul Eggert committed
760
  return val;
761 762
}

Kim F. Storm's avatar
Kim F. Storm committed
763 764
/* Like free, but checks block for overrun.  */

765
static void
Paul Eggert's avatar
Paul Eggert committed
766
overrun_check_free (void *block)
767
{
768
  unsigned char *val = (unsigned char *) block;
769 770

  if (val
771
      && memcmp (xmalloc_overrun_check_header,
772
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
773
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
774
    {
775
      size_t osize = xmalloc_get_size (val);
776 777
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
778
	emacs_abort ();
779
#ifdef XMALLOC_CLEAR_FREE_MEMORY
780
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
781
      memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
782
#else
783
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
784 785
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
786
#endif
787 788 789 790 791 792 793 794 795 796 797 798 799
    }

  free (val);
}

#undef malloc
#undef realloc
#undef free
#define malloc overrun_check_malloc
#define realloc overrun_check_realloc
#define free overrun_check_free
#endif

800 801 802 803 804 805 806 807 808 809 810 811 812 813
/* If compiled with XMALLOC_BLOCK_INPUT_CHECK, define a symbol
   BLOCK_INPUT_IN_MEMORY_ALLOCATORS that is visible to the debugger.
   If that variable is set, block input while in one of Emacs's memory
   allocation functions.  There should be no need for this debugging
   option, since signal handlers do not allocate memory, but Emacs
   formerly allocated memory in signal handlers and this compile-time
   option remains as a way to help debug the issue should it rear its
   ugly head again.  */
#ifdef XMALLOC_BLOCK_INPUT_CHECK
bool block_input_in_memory_allocators EXTERNALLY_VISIBLE;
static void
malloc_block_input (void)
{
  if (block_input_in_memory_allocators)
814
    block_input ();
815 816 817 818 819
}
static void
malloc_unblock_input (void)
{
  if (block_input_in_memory_allocators)
820
    unblock_input ();
821 822 823
}
# define MALLOC_BLOCK_INPUT malloc_block_input ()
# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
824
#else
825 826
# define MALLOC_BLOCK_INPUT ((void) 0)
# define MALLOC_UNBLOCK_INPUT ((void) 0)
827
#endif
Kim F. Storm's avatar
Kim F. Storm committed
828

Stefan Monnier's avatar
Stefan Monnier committed
829 830 831 832 833 834
#define MALLOC_PROBE(size)			\
  do {						\
    if (profiler_memory_running)		\
      malloc_probe (size);			\
  } while (0)

Paul Eggert's avatar
Paul Eggert committed
835 836
static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
static void *lrealloc (void *, size_t);
Stefan Monnier's avatar
Stefan Monnier committed
837

Paul Eggert's avatar
Paul Eggert committed
838
/* Like malloc but check for no memory and block interrupt input.  */
Jim Blandy's avatar
Jim Blandy committed
839

Paul Eggert's avatar
Paul Eggert committed
840
void *
841
xmalloc (size_t size)
Jim Blandy's avatar
Jim Blandy committed
842
{
Paul Eggert's avatar
Paul Eggert committed
843
  void *val;
Jim Blandy's avatar
Jim Blandy committed
844

845
  MALLOC_BLOCK_INPUT;
Paul Eggert's avatar
Paul Eggert committed
846
  val = lmalloc (size);
847
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
848

849
  if (!val && size)
Paul Eggert's avatar
Paul Eggert committed
850
    memory_full (size);
851
  MALLOC_PROBE (size);
Jim Blandy's avatar
Jim Blandy committed
852 853 854
  return val;
}

Dmitry Antipov's avatar
Dmitry Antipov committed
855 856 857 858 859 860 861 862
/* Like the above, but zeroes out the memory just allocated.  */

void *
xzalloc (size_t size)
{
  void *val;

  MALLOC_BLOCK_INPUT;
Paul Eggert's avatar
Paul Eggert committed
863
  val = lmalloc (size);
Dmitry Antipov's avatar
Dmitry Antipov committed
864 865 866 867 868
  MALLOC_UNBLOCK_INPUT;

  if (!val && size)
    memory_full (size);
  memset (val, 0, size);
869
  MALLOC_PROBE (size);
Dmitry Antipov's avatar
Dmitry Antipov committed
870 871
  return val;
}
872 873 874

/* Like realloc but check for no memory and block interrupt input..  */

Paul Eggert's avatar
Paul Eggert committed
875 876
void *
xrealloc (void *block, size_t size)
Jim Blandy's avatar
Jim Blandy committed
877
{
Paul Eggert's avatar
Paul Eggert committed
878
  void *val;
Jim Blandy's avatar
Jim Blandy committed
879

880
  MALLOC_BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
881 882 883
  /* We must call malloc explicitly when BLOCK is 0, since some
     reallocs don't do this.  */
  if (! block)
Paul Eggert's avatar
Paul Eggert committed
884
    val = lmalloc (size);
Noah Friedman's avatar
Noah Friedman committed
885
  else
Paul Eggert's avatar
Paul Eggert committed
886
    val = lrealloc (block, size);
887
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
888

Paul Eggert's avatar
Paul Eggert committed
889 890
  if (!val && size)
    memory_full (size);
891
  MALLOC_PROBE (size);
Jim Blandy's avatar
Jim Blandy committed
892 893
  return val;
}
894

895

Dave Love's avatar
Dave Love committed
896
/* Like free but block interrupt input.  */
897

898
void
Paul Eggert's avatar
Paul Eggert committed
899
xfree (void *block)
900
{
901 902
  if (!block)
    return;
903
  MALLOC_BLOCK_INPUT;
904
  free (block);
905
  MALLOC_UNBLOCK_INPUT;
906
  /* We don't call refill_memory_reserve here
907
     because in practice the call in r_alloc_free seems to suffice.  */
908 909
}

910

911 912 913 914 915 916 917 918 919 920 921 922
/* Other parts of Emacs pass large int values to allocator functions
   expecting ptrdiff_t.  This is portable in practice, but check it to
   be safe.  */
verify (INT_MAX <= PTRDIFF_MAX);


/* Allocate an array of NITEMS items, each of size ITEM_SIZE.
   Signal an error on memory exhaustion, and block interrupt input.  */

void *
xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
{
Paul Eggert's avatar
Paul Eggert committed
923
  eassert (0 <= nitems && 0 < item_size);
924 925
  ptrdiff_t nbytes;
  if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
926
    memory_full (SIZE_MAX);
927
  return xmalloc (nbytes);
928 929 930 931 932 933 934 935 936
}


/* Reallocate an array PA to make it of NITEMS items, each of size ITEM_SIZE.
   Signal an error on memory exhaustion, and block interrupt input.  */

void *
xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
{
Paul Eggert's avatar
Paul Eggert committed
937
  eassert (0 <= nitems && 0 < item_size);
938 939
  ptrdiff_t nbytes;
  if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
940
    memory_full (SIZE_MAX);
941
  return xrealloc (pa, nbytes);
942 943 944 945 946 947 948 949 950 951 952 953 954 955
}


/* Grow PA, which points to an array of *NITEMS items, and return the
   location of the reallocated array, updating *NITEMS to reflect its