alloc.c 199 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-2018 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"
Paul Eggert's avatar
Paul Eggert committed
34
#include "bignum.h"
35
#include "dispextern.h"
36
#include "intervals.h"
37
#include "ptr-bounds.h"
Jim Blandy's avatar
Jim Blandy committed
38
#include "puresize.h"
39
#include "sheap.h"
40
#include "systime.h"
41
#include "character.h"
Jim Blandy's avatar
Jim Blandy committed
42 43
#include "buffer.h"
#include "window.h"
44
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
45
#include "frame.h"
46
#include "blockinput.h"
47
#include "termhooks.h"		/* For struct terminal.  */
48 49 50
#ifdef HAVE_WINDOW_SYSTEM
#include TERM_HEADER
#endif /* HAVE_WINDOW_SYSTEM */
51

52
#include <flexmember.h>
53
#include <verify.h>
54
#include <execinfo.h>           /* For backtrace.  */
55

56 57 58 59
#ifdef HAVE_LINUX_SYSINFO
#include <sys/sysinfo.h>
#endif

60 61 62 63
#ifdef MSDOS
#include "dosfns.h"		/* For dos_memory_info.  */
#endif

64 65 66 67
#ifdef HAVE_MALLOC_H
# include <malloc.h>
#endif

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

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

80 81 82 83 84 85 86
/* 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
87

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

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

97
#include <unistd.h>
98 99
#include <fcntl.h>

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

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

120
#ifdef DOUG_LEA_MALLOC
121 122 123 124

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

125 126
#define MMAP_MAX_AREAS 100000000

Paul Eggert's avatar
Paul Eggert committed
127 128 129 130 131 132 133 134 135 136 137 138 139 140
/* 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
141
#ifdef GNU_LINUX
Paul Eggert's avatar
Paul Eggert committed
142
      my_heap_start ();
Paul Eggert's avatar
Paul Eggert committed
143
#endif
Paul Eggert's avatar
Paul Eggert committed
144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
      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;
		}
	}

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

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

#endif
184

185 186
#if defined DOUG_LEA_MALLOC || !defined CANNOT_DUMP

187 188 189 190 191
/* Allocator-related actions to do just before and after unexec.  */

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

void
alloc_unexec_post (void)
{
205
# ifdef DOUG_LEA_MALLOC
206
  free (malloc_state_ptr);
207 208
# endif
# ifdef HYBRID_MALLOC
209
  bss_sbrk_did_unexec = false;
210
# endif
211
}
212
#endif
213

214 215 216
/* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
   to a struct Lisp_String.  */

217 218 219
#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)
220

221 222 223
#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)
224

225 226
/* Default value of gc_cons_threshold (see below).  */

227
#define GC_DEFAULT_THRESHOLD (100000 * word_size)
228

229 230 231
/* Global variables.  */
struct emacs_globals globals;

232 233
/* Number of bytes of consing done since the last gc.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
234
EMACS_INT consing_since_gc;
Jim Blandy's avatar
Jim Blandy committed
235

236 237
/* Similar minimum, computed from Vgc_cons_percentage.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
238
EMACS_INT gc_relative_threshold;
239

240 241 242
/* Minimum number of bytes of consing since GC before next GC,
   when memory is full.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
243
EMACS_INT memory_full_cons_threshold;
244

245
/* True during GC.  */
246

247
bool gc_in_progress;
Jim Blandy's avatar
Jim Blandy committed
248

249 250
/* Number of live and free conses etc.  */

251 252
static EMACS_INT total_conses, total_symbols, total_buffers;
static EMACS_INT total_free_conses, total_free_symbols;
253
static EMACS_INT total_free_floats, total_floats;
254

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

259
static char *spare_memory[7];
260

261 262
/* 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.  */
263

264
#define SPARE_MEMORY (1 << 14)
265

Richard M. Stallman's avatar
Richard M. Stallman committed
266 267 268 269 270
/* 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.  */
271

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

275
/* Pointer to the pure area, and its size.  */
276

277
static char *purebeg;
278
static ptrdiff_t pure_size;
279 280 281 282

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

283
static ptrdiff_t pure_bytes_used_before_overflow;
Jim Blandy's avatar
Jim Blandy committed
284

285
/* Index in pure at which next pure Lisp object will be allocated..  */
286

287
static ptrdiff_t pure_bytes_used_lisp;
288 289 290

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

291
static ptrdiff_t pure_bytes_used_non_lisp;
292

293 294 295
/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

296
const char *pending_malloc_warning;
Jim Blandy's avatar
Jim Blandy committed
297

298 299 300 301 302 303 304 305 306 307 308
#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
309 310
struct suspicious_free_record
{
311 312
  void *suspicious_object;
  void *backtrace[128];
313
};
314
static void *suspicious_objects[32];
315
static int suspicious_object_index;
316
struct suspicious_free_record suspicious_free_history[64] EXTERNALLY_VISIBLE;
317 318 319
static int suspicious_free_history_index;
/* Find the first currently-monitored suspicious pointer in range
   [begin,end) or NULL if no such pointer exists.  */
320 321
static void *find_suspicious_object_in_range (void *begin, void *end);
static void detect_suspicious_free (void *ptr);
322
#else
323 324
# define find_suspicious_object_in_range(begin, end) NULL
# define detect_suspicious_free(ptr) (void)
325 326
#endif

Jim Blandy's avatar
Jim Blandy committed
327 328 329 330 331 332 333 334
/* 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.  */

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

/* 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
359

360
static void unchain_finalizer (struct Lisp_Finalizer *);
361 362
static void mark_terminals (void);
static void gc_sweep (void);
363
static Lisp_Object make_pure_vector (ptrdiff_t);
364
static void mark_buffer (struct buffer *);
365

366
#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC
367 368
static void refill_memory_reserve (void);
#endif
369 370
static void compact_small_strings (void);
static void free_large_strings (void);
371
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
372

373 374 375
/* 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.  */
376 377 378 379 380 381 382 383 384

enum mem_type
{
  MEM_TYPE_NON_LISP,
  MEM_TYPE_BUFFER,
  MEM_TYPE_CONS,
  MEM_TYPE_STRING,
  MEM_TYPE_SYMBOL,
  MEM_TYPE_FLOAT,
385 386 387
  /* 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.  */
388 389
  MEM_TYPE_VECTORLIKE,
  /* Special type to denote vector blocks.  */
390 391 392
  MEM_TYPE_VECTOR_BLOCK,
  /* Special type to denote reserved memory.  */
  MEM_TYPE_SPARE
393 394
};

395 396 397
/* A unique object in pure space used to make some Lisp objects
   on free lists recognizable in O(1).  */

398
static Lisp_Object Vdead;
399
#define DEADP(x) EQ (x, Vdead)
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 430 431 432
#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
433 434 435 436 437 438
  /* 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;
439 440 441 442 443 444

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

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

446 447 448 449 450 451 452 453
  /* Memory type.  */
  enum mem_type type;
};

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

static struct mem_node *mem_root;

454 455 456 457
/* Lowest and highest known address in the heap.  */

static void *min_heap_address, *max_heap_address;

458 459 460 461 462
/* Sentinel node of the tree.  */

static struct mem_node mem_z;
#define MEM_NIL &mem_z

463 464 465 466 467 468
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 *);
469
static struct mem_node *mem_find (void *);
470

471 472 473 474
#ifndef DEADP
# define DEADP(x) 0
#endif

475 476
/* Addresses of staticpro'd variables.  Initialize it to a nonzero
   value; otherwise some compilers put it into BSS.  */
477

478
enum { NSTATICS = 2048 };
479
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
480 481 482

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

483
static int staticidx;
484

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

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

Paul Eggert's avatar
Paul Eggert committed
489 490 491 492 493 494 495 496 497 498
#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))
499

500 501 502
/* Return PTR rounded up to the next multiple of ALIGNMENT.  */

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

508 509 510 511 512
/* Define PNTR_ADD and XPNTR as functions, which are cleaner and can
   be used in debuggers.  Also, define them as macros if
   DEFINE_KEY_OPS_AS_MACROS, for performance in that case.
   The macro_* macros are private to this section of code.  */

Paul Eggert's avatar
Paul Eggert committed
513 514
/* Add a pointer P to an integer I without gcc -fsanitize complaining
   about the result being out of range of the underlying array.  */
515 516 517

#define macro_PNTR_ADD(p, i) ((p) + (i))

518
static ATTRIBUTE_NO_SANITIZE_UNDEFINED ATTRIBUTE_UNUSED char *
519 520 521 522 523 524 525 526 527 528
PNTR_ADD (char *p, EMACS_UINT i)
{
  return macro_PNTR_ADD (p, i);
}

#if DEFINE_KEY_OPS_AS_MACROS
# define PNTR_ADD(p, i) macro_PNTR_ADD (p, i)
#endif

/* Extract the pointer hidden within O.  */
529 530 531 532

#define macro_XPNTR(o)                                                 \
  ((void *) \
   (SYMBOLP (o)							       \
533 534 535
    ? PNTR_ADD ((char *) lispsym,				       \
		(XLI (o)						\
		 - ((EMACS_UINT) Lisp_Symbol << (USE_LSB_TAG ? 0 : VALBITS)))) \
536
    : (char *) XLP (o) - (XLI (o) & ~VALMASK)))
Paul Eggert's avatar
Paul Eggert committed
537

538
static ATTRIBUTE_UNUSED void *
Paul Eggert's avatar
Paul Eggert committed
539 540
XPNTR (Lisp_Object a)
{
541
  return macro_XPNTR (a);
Paul Eggert's avatar
Paul Eggert committed
542 543
}

544 545 546 547
#if DEFINE_KEY_OPS_AS_MACROS
# define XPNTR(a) macro_XPNTR (a)
#endif

548 549 550 551 552
static void
XFLOAT_INIT (Lisp_Object f, double n)
{
  XFLOAT (f)->u.data = n;
}
553

554
#ifdef DOUG_LEA_MALLOC
555 556 557 558 559 560 561 562 563 564 565 566
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
567
     if we might dump: unexec doesn't preserve the contents of mmapped
568 569 570
     regions.  */
  return pointers_fit_in_lispobj_p () && !might_dump;
}
571
#endif
572

Daniel Colascione's avatar
Daniel Colascione committed
573 574 575 576 577 578 579 580 581
/* 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
582

583 584 585 586
/************************************************************************
				Malloc
 ************************************************************************/

587 588
#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC)

589
/* Function malloc calls this if it finds we are near exhausting storage.  */
590 591

void
592
malloc_warning (const char *str)
Jim Blandy's avatar
Jim Blandy committed
593 594 595 596
{
  pending_malloc_warning = str;
}

597
#endif
598

599
/* Display an already-pending malloc warning.  */
600

601
void
602
display_malloc_warning (void)
Jim Blandy's avatar
Jim Blandy committed
603
{
604 605 606 607
  call3 (intern ("display-warning"),
	 intern ("alloc"),
	 build_string (pending_malloc_warning),
	 intern ("emergency"));
Jim Blandy's avatar
Jim Blandy committed
608 609
  pending_malloc_warning = 0;
}
610

611 612 613
/* Called if we can't allocate relocatable space for a buffer.  */

void
614
buffer_memory_full (ptrdiff_t nbytes)
615
{
616 617 618 619 620 621
  /* 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.  */
622 623

#ifndef REL_ALLOC
Paul Eggert's avatar
Paul Eggert committed
624
  memory_full (nbytes);
Paul Eggert's avatar
Paul Eggert committed
625
#else
626 627
  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
628
  xsignal (Qnil, Vmemory_signal_data);
Paul Eggert's avatar
Paul Eggert committed
629
#endif
Jim Blandy's avatar
Jim Blandy committed
630 631
}

632 633 634 635 636 637
/* 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))

638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658
/* LISP_ALIGNMENT is the alignment of Lisp objects.  It must be at
   least GCALIGNMENT so that pointers can be tagged.  It also must be
   at least as strict as the alignment of all the C types used to
   implement Lisp objects; since pseudovectors can contain any C type,
   this is max_align_t.  On recent GNU/Linux x86 and x86-64 this can
   often waste up to 8 bytes, since alignof (max_align_t) is 16 but
   typical vectors need only an alignment of 8.  However, it is not
   worth the hassle to avoid this waste.  */
enum { LISP_ALIGNMENT = alignof (union { max_align_t x; GCALIGNED_UNION }) };
verify (LISP_ALIGNMENT % GCALIGNMENT == 0);

/* True if malloc (N) is known to return storage suitably aligned for
   Lisp objects whenever N is a multiple of LISP_ALIGNMENT.  In
   practice this is true whenever alignof (max_align_t) is also a
   multiple of LISP_ALIGNMENT.  This works even for x86, where some
   platform combinations (e.g., GCC 7 and later, glibc 2.25 and
   earlier) have bugs where alignof (max_align_t) is 16 even though
   the malloc alignment is only 8, and where Emacs still works because
   it never does anything that requires an alignment of 16.  */
enum { MALLOC_IS_LISP_ALIGNED = alignof (max_align_t) % LISP_ALIGNMENT == 0 };

659
#ifndef XMALLOC_OVERRUN_CHECK
660
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
661
#else
662

663 664
/* 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
665

666 667 668 669
   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
670 671

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

675
#define XMALLOC_OVERRUN_CHECK_SIZE 16
676
#define XMALLOC_OVERRUN_CHECK_OVERHEAD \
677 678
  (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE)

Paul Eggert's avatar
Paul Eggert committed
679 680 681
/* 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.  */
682
#define XMALLOC_OVERRUN_SIZE_SIZE				\
683
   (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t)		\
684 685
      + LISP_ALIGNMENT - 1)					\
     / LISP_ALIGNMENT * LISP_ALIGNMENT)				\
686
    - XMALLOC_OVERRUN_CHECK_SIZE)
Kim F. Storm's avatar
Kim F. Storm committed
687

688 689 690 691 692
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' };
693

694 695 696 697 698
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' };
699

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

702 703 704 705
static void
xmalloc_put_size (unsigned char *ptr, size_t size)
{
  int i;
706
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
707
    {
708
      *--ptr = size & ((1 << CHAR_BIT) - 1);
709 710 711
      size >>= CHAR_BIT;
    }
}
Kim F. Storm's avatar
Kim F. Storm committed
712

713 714 715 716 717
static size_t
xmalloc_get_size (unsigned char *ptr)
{
  size_t size = 0;
  int i;
718 719
  ptr -= XMALLOC_OVERRUN_SIZE_SIZE;
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
720 721 722 723 724 725
    {
      size <<= CHAR_BIT;
      size += *ptr++;
    }
  return size;
}
Kim F. Storm's avatar
Kim F. Storm committed
726 727 728 729


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

Paul Eggert's avatar
Paul Eggert committed
730
static void *
731
overrun_check_malloc (size_t size)
732
{
Kim F. Storm's avatar
Kim F. Storm committed
733
  register unsigned char *val;
734
  if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
735
    emacs_abort ();
736

737 738
  val = malloc (size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
  if (val)
739
    {
740
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
741
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
742
      xmalloc_put_size (val, size);
743 744
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
745
    }
Paul Eggert's avatar
Paul Eggert committed
746
  return val;
747 748
}

Kim F. Storm's avatar
Kim F. Storm committed
749 750 751 752

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

Paul Eggert's avatar
Paul Eggert committed
753 754
static void *
overrun_check_realloc (void *block, size_t size)
755
{
756
  register unsigned char *val = (unsigned char *) block;
757
  if (SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD < size)
758
    emacs_abort ();
759 760

  if (val
761
      && memcmp (xmalloc_overrun_check_header,
762
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
763
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
764
    {
765
      size_t osize = xmalloc_get_size (val);
766 767
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
768
	emacs_abort ();
769
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
770 771
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
772 773
    }

774
  val = realloc (val, size + XMALLOC_OVERRUN_CHECK_OVERHEAD);
775

776
  if (val)
777
    {
778
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
779
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
780
      xmalloc_put_size (val, size);
781 782
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
783
    }
Paul Eggert's avatar
Paul Eggert committed
784
  return val;
785 786
}

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

789
static void
Paul Eggert's avatar
Paul Eggert committed
790
overrun_check_free (void *block)
791
{
792
  unsigned char *val = (unsigned char *) block;
793 794

  if (val
795
      && memcmp (xmalloc_overrun_check_header,
796
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
797
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
798
    {
799
      size_t osize = xmalloc_get_size (val);
800 801
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
802
	emacs_abort ();
803
#ifdef XMALLOC_CLEAR_FREE_MEMORY
804
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
805
      memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
806
#else
807
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
808 809
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
810
#endif
811 812 813 814 815 816 817 818 819 820 821 822 823
    }

  free (val);
}

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

824 825 826 827 828 829 830 831 832 833 834 835 836 837
/* 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)
838
    block_input ();
839 840 841 842 843
}
static void
malloc_unblock_input (void)
{
  if (block_input_in_memory_allocators)
844
    unblock_input ();
845 846 847
}
# define MALLOC_BLOCK_INPUT malloc_block_input ()
# define MALLOC_UNBLOCK_INPUT malloc_unblock_input ()
848
#else
849 850
# define MALLOC_BLOCK_INPUT ((void) 0)
# define MALLOC_UNBLOCK_INPUT ((void) 0)
851
#endif
Kim F. Storm's avatar
Kim F. Storm committed
852

Stefan Monnier's avatar
Stefan Monnier committed
853 854 855 856 857 858
#define MALLOC_PROBE(size)			\
  do {						\
    if (profiler_memory_running)		\
      malloc_probe (size);			\
  } while (0)

Paul Eggert's avatar
Paul Eggert committed
859 860
static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
static void *lrealloc (void *, size_t);
Stefan Monnier's avatar
Stefan Monnier committed
861

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

Paul Eggert's avatar
Paul Eggert committed
864
void *
865
xmalloc (size_t size)
Jim Blandy's avatar
Jim Blandy committed
866
{
Paul Eggert's avatar
Paul Eggert committed
867
  void *val;
Jim Blandy's avatar
Jim Blandy committed
868

869
  MALLOC_BLOCK_INPUT;
Paul Eggert's avatar
Paul Eggert committed
870
  val = lmalloc (size);
871
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
872

873
  if (!val && size)
Paul Eggert's avatar
Paul Eggert committed
874
    memory_full (size);
875
  MALLOC_PROBE (size);
Jim Blandy's avatar
Jim Blandy committed
876 877 878
  return val;
}

Dmitry Antipov's avatar
Dmitry Antipov committed
879 880 881 882 883 884 885 886
/* 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
887
  val = lmalloc (size);
Dmitry Antipov's avatar
Dmitry Antipov committed
888 889 890 891 892
  MALLOC_UNBLOCK_INPUT;

  if (!val && size)
    memory_full (size);
  memset (val, 0, size);
893
  MALLOC_PROBE (size);
Dmitry Antipov's avatar
Dmitry Antipov committed
894 895
  return val;
}
896 897 898

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

Paul Eggert's avatar
Paul Eggert committed
899 900
void *
xrealloc (void *block, size_t size)
Jim Blandy's avatar
Jim Blandy committed
901
{
Paul Eggert's avatar
Paul Eggert committed
902
  void *val;
Jim Blandy's avatar
Jim Blandy committed
903

904
  MALLOC_BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
905 906 907
  /* 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
908
    val = lmalloc (size);
Noah Friedman's avatar
Noah Friedman committed
909
  else
Paul Eggert's avatar
Paul Eggert committed
910
    val = lrealloc (block, size);
911
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
912

Paul Eggert's avatar
Paul Eggert committed
913 914
  if (!val && size)
    memory_full (size);
915
  MALLOC_PROBE (size);
Jim Blandy's avatar
Jim Blandy committed
916 917
  return val;
}
918

919

Dave Love's avatar
Dave Love committed
920
/* Like free but block interrupt input.  */
921

922
void
Paul Eggert's avatar
Paul Eggert committed
923
xfree (void *block)
924
{
925 926
  if (!block)
    return;
927
  MALLOC_BLOCK_INPUT;
928
  free (block);
929
  MALLOC_UNBLOCK_INPUT;
930
  /* We don't call refill_memory_reserve here
931
     because in practice the call in r_alloc_free seems to suffice.  */
932 933
}

934

935 936 937 938 939 940 941 942 943 944 945 946
/* 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
947
  eassert (0 <= nitems && 0 < item_size);
948 949
  ptrdiff_t nbytes;
  if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)