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

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

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

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

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

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

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

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

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

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

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

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

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

119
#ifdef DOUG_LEA_MALLOC
120 121 122 123

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

124 125
#define MMAP_MAX_AREAS 100000000

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

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

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

#endif
183

184 185
#if defined DOUG_LEA_MALLOC || !defined CANNOT_DUMP

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

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

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

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

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

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

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

226
#define GC_DEFAULT_THRESHOLD (100000 * word_size)
227

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

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

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

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

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

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

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

244
/* True during GC.  */
245

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

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

250
static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
251
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
252
static EMACS_INT total_free_floats, total_floats;
253

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

258
static char *spare_memory[7];
259

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

263
#define SPARE_MEMORY (1 << 14)
264

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

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

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

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

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

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

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

286
static ptrdiff_t pure_bytes_used_lisp;
287 288 289

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

290
static ptrdiff_t pure_bytes_used_non_lisp;
291

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

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

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

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

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

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

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

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

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

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,
384 385 386
  /* 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.  */
387 388
  MEM_TYPE_VECTORLIKE,
  /* Special type to denote vector blocks.  */
389 390 391
  MEM_TYPE_VECTOR_BLOCK,
  /* Special type to denote reserved memory.  */
  MEM_TYPE_SPARE
392 393
};

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

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

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

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

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

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

static struct mem_node *mem_root;

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

static void *min_heap_address, *max_heap_address;

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

static struct mem_node mem_z;
#define MEM_NIL &mem_z

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

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

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

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

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

482
static int staticidx;
483

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

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

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

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

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

507 508 509 510 511
/* 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
512 513
/* Add a pointer P to an integer I without gcc -fsanitize complaining
   about the result being out of range of the underlying array.  */
514 515 516

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

517
static ATTRIBUTE_NO_SANITIZE_UNDEFINED ATTRIBUTE_UNUSED char *
518 519 520 521 522 523 524 525 526 527
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.  */
528 529 530 531

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

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

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

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

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

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

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

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

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

596
#endif
597

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

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

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

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

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

637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657
/* 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 };

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

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

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

  free (val);
}

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

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

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

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

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

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

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

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

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

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

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

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

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

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

918

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

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

933

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