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

Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2012
  Free Software 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 <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

21
#include <config.h>
22 23 24

#define LISP_INLINE EXTERN_INLINE

25
#include <stdio.h>
26
#include <limits.h>		/* For CHAR_BIT.  */
27
#include <setjmp.h>
28

29
#include <signal.h>
30

31
#ifdef HAVE_PTHREAD
32 33 34
#include <pthread.h>
#endif

Jim Blandy's avatar
Jim Blandy committed
35
#include "lisp.h"
36
#include "process.h"
37
#include "intervals.h"
Jim Blandy's avatar
Jim Blandy committed
38
#include "puresize.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"
Jim Blandy's avatar
Jim Blandy committed
45
#include "syssignal.h"
46
#include "termhooks.h"		/* For struct terminal.  */
47
#include <setjmp.h>
48
#include <verify.h>
Jim Blandy's avatar
Jim Blandy committed
49

50 51 52 53 54 55
/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
   Doable only if GC_MARK_STACK.  */
#if ! GC_MARK_STACK
# undef GC_CHECK_MARKED_OBJECTS
#endif

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

60 61
#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
     || defined GC_CHECK_MARKED_OBJECTS)
Kenichi Handa's avatar
Kenichi Handa committed
62 63 64
#undef GC_MALLOC_CHECK
#endif

65
#include <unistd.h>
Paul Eggert's avatar
Paul Eggert committed
66
#ifndef HAVE_UNISTD_H
Paul Eggert's avatar
Paul Eggert committed
67
extern void *sbrk ();
68
#endif
Karl Heuer's avatar
Karl Heuer committed
69

70 71
#include <fcntl.h>

72
#ifdef WINDOWSNT
Eli Zaretskii's avatar
Eli Zaretskii committed
73
#include "w32.h"
74 75
#endif

76
#ifdef DOUG_LEA_MALLOC
77

78
#include <malloc.h>
79

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

83 84
#define MMAP_MAX_AREAS 100000000

85 86
#else /* not DOUG_LEA_MALLOC */

87 88
/* The following come from gmalloc.c.  */

89 90
extern size_t _bytes_used;
extern size_t __malloc_extra_blocks;
91 92
extern void *_malloc_internal (size_t);
extern void _free_internal (void *);
93 94

#endif /* not DOUG_LEA_MALLOC */
95

96
#if ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT
97
#ifdef HAVE_PTHREAD
98

99 100 101 102 103
/* When GTK uses the file chooser dialog, different backends can be loaded
   dynamically.  One such a backend is the Gnome VFS backend that gets loaded
   if you run Gnome.  That backend creates several threads and also allocates
   memory with malloc.

104 105
   Also, gconf and gsettings may create several threads.

106 107 108
   If Emacs sets malloc hooks (! SYSTEM_MALLOC) and the emacs_blocked_*
   functions below are called from malloc, there is a chance that one
   of these threads preempts the Emacs main thread and the hook variables
109
   end up in an inconsistent state.  So we have a mutex to prevent that (note
110 111 112
   that the backend handles concurrent access to malloc within its own threads
   but Emacs code running in the main thread is not included in that control).

113
   When UNBLOCK_INPUT is called, reinvoke_input_signal may be called.  If this
114 115 116 117
   happens in one of the backend threads we will have two threads that tries
   to run Emacs code at once, and the code is not prepared for that.
   To prevent that, we only call BLOCK/UNBLOCK from the main thread.  */

118 119
static pthread_mutex_t alloc_mutex;

120 121 122 123
#define BLOCK_INPUT_ALLOC                               \
  do                                                    \
    {                                                   \
      if (pthread_equal (pthread_self (), main_thread)) \
124
        BLOCK_INPUT;					\
125 126
      pthread_mutex_lock (&alloc_mutex);                \
    }                                                   \
127
  while (0)
128 129 130 131 132
#define UNBLOCK_INPUT_ALLOC                             \
  do                                                    \
    {                                                   \
      pthread_mutex_unlock (&alloc_mutex);              \
      if (pthread_equal (pthread_self (), main_thread)) \
133
        UNBLOCK_INPUT;					\
134
    }                                                   \
135 136
  while (0)

137
#else /* ! defined HAVE_PTHREAD */
138 139 140 141

#define BLOCK_INPUT_ALLOC BLOCK_INPUT
#define UNBLOCK_INPUT_ALLOC UNBLOCK_INPUT

142
#endif /* ! defined HAVE_PTHREAD */
143
#endif /* ! defined SYSTEM_MALLOC && ! defined SYNC_INPUT */
144

145 146 147
/* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
   to a struct Lisp_String.  */

148 149
#define MARK_STRING(S)		((S)->size |= ARRAY_MARK_FLAG)
#define UNMARK_STRING(S)	((S)->size &= ~ARRAY_MARK_FLAG)
150
#define STRING_MARKED_P(S)	(((S)->size & ARRAY_MARK_FLAG) != 0)
151

152 153 154
#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)
155

156 157
/* Default value of gc_cons_threshold (see below).  */

158
#define GC_DEFAULT_THRESHOLD (100000 * word_size)
159

160 161 162
/* Global variables.  */
struct emacs_globals globals;

163 164
/* Number of bytes of consing done since the last gc.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
165
EMACS_INT consing_since_gc;
Jim Blandy's avatar
Jim Blandy committed
166

167 168
/* Similar minimum, computed from Vgc_cons_percentage.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
169
EMACS_INT gc_relative_threshold;
170

171 172 173
/* Minimum number of bytes of consing since GC before next GC,
   when memory is full.  */

Dmitry Antipov's avatar
Dmitry Antipov committed
174
EMACS_INT memory_full_cons_threshold;
175

176
/* True during GC.  */
177

178
bool gc_in_progress;
Jim Blandy's avatar
Jim Blandy committed
179

180
/* True means abort if try to GC.
181 182 183
   This is for code which is written on the assumption that
   no GC will happen, so as to verify that assumption.  */

184
bool abort_on_gc;
185

186 187
/* Number of live and free conses etc.  */

188
static EMACS_INT total_conses, total_markers, total_symbols, total_buffers;
189
static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
190
static EMACS_INT total_free_floats, total_floats;
191

192
/* Points to memory space allocated as "spare", to be freed if we run
193 194
   out of memory.  We keep one large block, four cons-blocks, and
   two string blocks.  */
195

196
static char *spare_memory[7];
197

198 199
/* 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.  */
200

201
#define SPARE_MEMORY (1 << 14)
202

203
/* Number of extra blocks malloc should get when it needs more core.  */
204

205 206
static int malloc_hysteresis;

Richard M. Stallman's avatar
Richard M. Stallman committed
207 208 209 210 211
/* 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.  */
212

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

216
/* Pointer to the pure area, and its size.  */
217

218
static char *purebeg;
219
static ptrdiff_t pure_size;
220 221 222 223

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

224
static ptrdiff_t pure_bytes_used_before_overflow;
Jim Blandy's avatar
Jim Blandy committed
225

226
/* True if P points into pure space.  */
227 228

#define PURE_POINTER_P(P)					\
229
  ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
230

231
/* Index in pure at which next pure Lisp object will be allocated..  */
232

233
static ptrdiff_t pure_bytes_used_lisp;
234 235 236

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

237
static ptrdiff_t pure_bytes_used_non_lisp;
238

239 240 241
/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

242
const char *pending_malloc_warning;
Jim Blandy's avatar
Jim Blandy committed
243 244 245 246 247 248 249 250 251

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

252
#if MAX_SAVE_STACK > 0
253
static char *stack_copy;
254
static ptrdiff_t stack_copy_size;
255
#endif
Jim Blandy's avatar
Jim Blandy committed
256

257 258 259 260 261 262 263 264
static Lisp_Object Qconses;
static Lisp_Object Qsymbols;
static Lisp_Object Qmiscs;
static Lisp_Object Qstrings;
static Lisp_Object Qvectors;
static Lisp_Object Qfloats;
static Lisp_Object Qintervals;
static Lisp_Object Qbuffers;
265
static Lisp_Object Qstring_bytes, Qvector_slots, Qheap;
266 267
static Lisp_Object Qgc_cons_threshold;
Lisp_Object Qchar_table_extra_slots;
268

269 270
/* Hook run after GC has finished.  */

271
static Lisp_Object Qpost_gc_hook;
272

273 274
static void mark_terminals (void);
static void gc_sweep (void);
275
static Lisp_Object make_pure_vector (ptrdiff_t);
276 277
static void mark_glyph_matrix (struct glyph_matrix *);
static void mark_face_cache (struct face_cache *);
278

279 280 281
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
static void refill_memory_reserve (void);
#endif
282 283 284 285
static struct Lisp_String *allocate_string (void);
static void compact_small_strings (void);
static void free_large_strings (void);
static void sweep_strings (void);
286
static void free_misc (Lisp_Object);
287
extern Lisp_Object which_symbols (Lisp_Object, EMACS_INT) EXTERNALLY_VISIBLE;
288 289 290 291 292 293 294 295 296 297 298 299 300 301

/* When scanning the C stack for live Lisp objects, Emacs keeps track
   of what memory allocated via lisp_malloc is intended for what
   purpose.  This enumeration specifies the type of memory.  */

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,
302 303 304 305
  /* We used to keep separate mem_types for subtypes of vectors such as
     process, hash_table, frame, terminal, and window, but we never made
     use of the distinction, so it only caused source-code complexity
     and runtime slowdown.  Minor but pointless.  */
306 307 308
  MEM_TYPE_VECTORLIKE,
  /* Special type to denote vector blocks.  */
  MEM_TYPE_VECTOR_BLOCK
309 310
};

Paul Eggert's avatar
Paul Eggert committed
311
static void *lisp_malloc (size_t, enum mem_type);
312

313

314
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
315 316 317 318 319 320 321 322

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
#include <stdio.h>		/* For fprintf.  */
#endif

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

323
static Lisp_Object Vdead;
324
#define DEADP(x) EQ (x, Vdead)
325

326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357
#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
358 359 360 361 362 363
  /* 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;
364 365 366 367 368 369

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

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

371 372 373 374 375 376 377 378 379 380 381 382
  /* Memory type.  */
  enum mem_type type;
};

/* Base address of stack.  Set in main.  */

Lisp_Object *stack_base;

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

static struct mem_node *mem_root;

383 384 385 386
/* Lowest and highest known address in the heap.  */

static void *min_heap_address, *max_heap_address;

387 388 389 390 391
/* Sentinel node of the tree.  */

static struct mem_node mem_z;
#define MEM_NIL &mem_z

392
static struct Lisp_Vector *allocate_vectorlike (ptrdiff_t);
Paul Eggert's avatar
Paul Eggert committed
393
static void lisp_free (void *);
394
static void mark_stack (void);
395 396 397 398 399 400 401
static bool live_vector_p (struct mem_node *, void *);
static bool live_buffer_p (struct mem_node *, void *);
static bool live_string_p (struct mem_node *, void *);
static bool live_cons_p (struct mem_node *, void *);
static bool live_symbol_p (struct mem_node *, void *);
static bool live_float_p (struct mem_node *, void *);
static bool live_misc_p (struct mem_node *, void *);
402
static void mark_maybe_object (Lisp_Object);
403
static void mark_memory (void *, void *);
404
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
405 406 407
static void mem_init (void);
static struct mem_node *mem_insert (void *, void *, enum mem_type);
static void mem_insert_fixup (struct mem_node *);
408
#endif
409 410 411 412
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 *);
Paul Eggert's avatar
Paul Eggert committed
413
static inline struct mem_node *mem_find (void *);
414 415 416


#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
417
static void check_gcpros (void);
418 419
#endif

420
#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
421

422 423 424 425
#ifndef DEADP
# define DEADP(x) 0
#endif

426 427 428 429
/* Recording what needs to be marked for gc.  */

struct gcpro *gcprolist;

430 431
/* Addresses of staticpro'd variables.  Initialize it to a nonzero
   value; otherwise some compilers put it into BSS.  */
432

Eli Zaretskii's avatar
Eli Zaretskii committed
433
#define NSTATICS 0x650
434
static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
435 436 437

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

438
static int staticidx;
439

Paul Eggert's avatar
Paul Eggert committed
440
static void *pure_alloc (size_t, int);
441 442 443 444 445


/* Value is SZ rounded up to the next multiple of ALIGNMENT.
   ALIGNMENT must be a power of 2.  */

446
#define ALIGN(ptr, ALIGNMENT) \
Paul Eggert's avatar
Paul Eggert committed
447 448
  ((void *) (((uintptr_t) (ptr) + (ALIGNMENT) - 1) \
	     & ~ ((ALIGNMENT) - 1)))
449

450

Jim Blandy's avatar
Jim Blandy committed
451

452 453 454 455
/************************************************************************
				Malloc
 ************************************************************************/

456
/* Function malloc calls this if it finds we are near exhausting storage.  */
457 458

void
459
malloc_warning (const char *str)
Jim Blandy's avatar
Jim Blandy committed
460 461 462 463
{
  pending_malloc_warning = str;
}

464

465
/* Display an already-pending malloc warning.  */
466

467
void
468
display_malloc_warning (void)
Jim Blandy's avatar
Jim Blandy committed
469
{
470 471 472 473
  call3 (intern ("display-warning"),
	 intern ("alloc"),
	 build_string (pending_malloc_warning),
	 intern ("emergency"));
Jim Blandy's avatar
Jim Blandy committed
474 475
  pending_malloc_warning = 0;
}
476

477 478 479
/* Called if we can't allocate relocatable space for a buffer.  */

void
480
buffer_memory_full (ptrdiff_t nbytes)
481
{
482 483 484 485 486 487
  /* 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.  */
488 489

#ifndef REL_ALLOC
Paul Eggert's avatar
Paul Eggert committed
490
  memory_full (nbytes);
491 492
#endif

493 494
  /* This used to call error, but if we've run out of memory, we could
     get infinite recursion trying to build the string.  */
495
  xsignal (Qnil, Vmemory_signal_data);
Jim Blandy's avatar
Jim Blandy committed
496 497
}

498 499 500 501 502
/* 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))
503

504
#ifndef XMALLOC_OVERRUN_CHECK
505
#define XMALLOC_OVERRUN_CHECK_OVERHEAD 0
506
#else
507

508 509
/* 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
510

511 512 513 514
   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
515 516

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

520
#define XMALLOC_OVERRUN_CHECK_SIZE 16
521
#define XMALLOC_OVERRUN_CHECK_OVERHEAD \
522 523 524
  (2 * XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE)

/* Define XMALLOC_OVERRUN_SIZE_SIZE so that (1) it's large enough to
525 526 527
   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.  */
#define XMALLOC_BASE_ALIGNMENT				\
528
  alignof (union { long double d; intmax_t i; void *p; })
529

530
#if USE_LSB_TAG
531
# define XMALLOC_HEADER_ALIGNMENT \
532
    COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
533 534 535 536
#else
# define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT
#endif
#define XMALLOC_OVERRUN_SIZE_SIZE				\
537 538 539 540
   (((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
541

542 543 544 545 546
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' };
547

548 549 550 551 552
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' };
553

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

556 557 558 559
static void
xmalloc_put_size (unsigned char *ptr, size_t size)
{
  int i;
560
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
561
    {
562
      *--ptr = size & ((1 << CHAR_BIT) - 1);
563 564 565
      size >>= CHAR_BIT;
    }
}
Kim F. Storm's avatar
Kim F. Storm committed
566

567 568 569 570 571
static size_t
xmalloc_get_size (unsigned char *ptr)
{
  size_t size = 0;
  int i;
572 573
  ptr -= XMALLOC_OVERRUN_SIZE_SIZE;
  for (i = 0; i < XMALLOC_OVERRUN_SIZE_SIZE; i++)
574 575 576 577 578 579
    {
      size <<= CHAR_BIT;
      size += *ptr++;
    }
  return size;
}
Kim F. Storm's avatar
Kim F. Storm committed
580 581


Jan Djärv's avatar
Jan Djärv committed
582 583 584 585 586 587 588 589 590
/* The call depth in overrun_check functions.  For example, this might happen:
   xmalloc()
     overrun_check_malloc()
       -> malloc -> (via hook)_-> emacs_blocked_malloc
          -> overrun_check_malloc
             call malloc  (hooks are NULL, so real malloc is called).
             malloc returns 10000.
             add overhead, return 10016.
      <- (back in overrun_check_malloc)
591
      add overhead again, return 10032
Jan Djärv's avatar
Jan Djärv committed
592
   xmalloc returns 10032.
593 594 595

   (time passes).

Jan Djärv's avatar
Jan Djärv committed
596 597
   xfree(10032)
     overrun_check_free(10032)
598
       decrease overhead
Jan Djärv's avatar
Jan Djärv committed
599
       free(10016)  <-  crash, because 10000 is the original pointer.  */
600

601
static ptrdiff_t check_depth;
602

Kim F. Storm's avatar
Kim F. Storm committed
603 604
/* Like malloc, but wraps allocated block with header and trailer.  */

Paul Eggert's avatar
Paul Eggert committed
605
static void *
606
overrun_check_malloc (size_t size)
607
{
Kim F. Storm's avatar
Kim F. Storm committed
608
  register unsigned char *val;
609 610 611
  int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
  if (SIZE_MAX - overhead < size)
    abort ();
612

613
  val = malloc (size + overhead);
614
  if (val && check_depth == 1)
615
    {
616
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
617
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
618
      xmalloc_put_size (val, size);
619 620
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
621
    }
622
  --check_depth;
Paul Eggert's avatar
Paul Eggert committed
623
  return val;
624 625
}

Kim F. Storm's avatar
Kim F. Storm committed
626 627 628 629

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

Paul Eggert's avatar
Paul Eggert committed
630 631
static void *
overrun_check_realloc (void *block, size_t size)
632
{
633
  register unsigned char *val = (unsigned char *) block;
634 635 636
  int overhead = ++check_depth == 1 ? XMALLOC_OVERRUN_CHECK_OVERHEAD : 0;
  if (SIZE_MAX - overhead < size)
    abort ();
637 638

  if (val
639
      && check_depth == 1
640
      && memcmp (xmalloc_overrun_check_header,
641
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
642
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
643
    {
644
      size_t osize = xmalloc_get_size (val);
645 646
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
647
	abort ();
648
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
649 650
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
651 652
    }

Paul Eggert's avatar
Paul Eggert committed
653
  val = realloc (val, size + overhead);
654

655
  if (val && check_depth == 1)
656
    {
657
      memcpy (val, xmalloc_overrun_check_header, XMALLOC_OVERRUN_CHECK_SIZE);
658
      val += XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
659
      xmalloc_put_size (val, size);
660 661
      memcpy (val + size, xmalloc_overrun_check_trailer,
	      XMALLOC_OVERRUN_CHECK_SIZE);
662
    }
663
  --check_depth;
Paul Eggert's avatar
Paul Eggert committed
664
  return val;
665 666
}

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

669
static void
Paul Eggert's avatar
Paul Eggert committed
670
overrun_check_free (void *block)
671
{
672
  unsigned char *val = (unsigned char *) block;
673

674
  ++check_depth;
675
  if (val
676
      && check_depth == 1
677
      && memcmp (xmalloc_overrun_check_header,
678
		 val - XMALLOC_OVERRUN_CHECK_SIZE - XMALLOC_OVERRUN_SIZE_SIZE,
679
		 XMALLOC_OVERRUN_CHECK_SIZE) == 0)
680
    {
681
      size_t osize = xmalloc_get_size (val);
682 683
      if (memcmp (xmalloc_overrun_check_trailer, val + osize,
		  XMALLOC_OVERRUN_CHECK_SIZE))
684
	abort ();
685
#ifdef XMALLOC_CLEAR_FREE_MEMORY
686
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
687
      memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_OVERHEAD);
688
#else
689
      memset (val + osize, 0, XMALLOC_OVERRUN_CHECK_SIZE);
690 691
      val -= XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE;
      memset (val, 0, XMALLOC_OVERRUN_CHECK_SIZE + XMALLOC_OVERRUN_SIZE_SIZE);
692
#endif
693 694 695
    }

  free (val);
696
  --check_depth;
697 698 699 700 701 702 703 704 705 706
}

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

707 708 709 710 711 712 713 714 715
#ifdef SYNC_INPUT
/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
   there's no need to block input around malloc.  */
#define MALLOC_BLOCK_INPUT   ((void)0)
#define MALLOC_UNBLOCK_INPUT ((void)0)
#else
#define MALLOC_BLOCK_INPUT   BLOCK_INPUT
#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
#endif
Kim F. Storm's avatar
Kim F. Storm committed
716

717
/* Like malloc but check for no memory and block interrupt input..  */
Jim Blandy's avatar
Jim Blandy committed
718

Paul Eggert's avatar
Paul Eggert committed
719
void *
720
xmalloc (size_t size)
Jim Blandy's avatar
Jim Blandy committed
721
{
Paul Eggert's avatar
Paul Eggert committed
722
  void *val;
Jim Blandy's avatar
Jim Blandy committed
723

724
  MALLOC_BLOCK_INPUT;
Paul Eggert's avatar
Paul Eggert committed
725
  val = malloc (size);
726
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
727

728
  if (!val && size)
Paul Eggert's avatar
Paul Eggert committed
729
    memory_full (size);
Jim Blandy's avatar
Jim Blandy committed
730 731 732
  return val;
}

Dmitry Antipov's avatar
Dmitry Antipov committed
733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748
/* Like the above, but zeroes out the memory just allocated.  */

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

  MALLOC_BLOCK_INPUT;
  val = malloc (size);
  MALLOC_UNBLOCK_INPUT;

  if (!val && size)
    memory_full (size);
  memset (val, 0, size);
  return val;
}
749 750 751

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

Paul Eggert's avatar
Paul Eggert committed
752 753
void *
xrealloc (void *block, size_t size)
Jim Blandy's avatar
Jim Blandy committed
754
{
Paul Eggert's avatar
Paul Eggert committed
755
  void *val;
Jim Blandy's avatar
Jim Blandy committed
756

757
  MALLOC_BLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
758 759 760
  /* 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
761
    val = malloc (size);
Noah Friedman's avatar
Noah Friedman committed
762
  else
Paul Eggert's avatar
Paul Eggert committed
763
    val = realloc (block, size);
764
  MALLOC_UNBLOCK_INPUT;
Jim Blandy's avatar
Jim Blandy committed
765

Paul Eggert's avatar
Paul Eggert committed
766 767
  if (!val && size)
    memory_full (size);
Jim Blandy's avatar
Jim Blandy committed
768 769
  return val;
}
770

771

Dave Love's avatar
Dave Love committed
772
/* Like free but block interrupt input.  */
773

774
void
Paul Eggert's avatar
Paul Eggert committed
775
xfree (void *block)
776
{
777 778
  if (!block)
    return;
779
  MALLOC_BLOCK_INPUT;
780
  free (block);
781
  MALLOC_UNBLOCK_INPUT;
782 783 784
  /* We don't call refill_memory_reserve here
     because that duplicates doing so in emacs_blocked_free
     and the criterion should go there.  */
785 786
}

787

788 789 790 791 792 793 794 795 796 797 798 799
/* 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)
{
800
  eassert (0 <= nitems && 0 < item_size);
801 802 803 804 805 806 807 808 809 810 811 812
  if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
    memory_full (SIZE_MAX);
  return xmalloc (nitems * item_size);
}


/* 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)
{
813
  eassert (0 <= nitems && 0 < item_size);
814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862
  if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
    memory_full (SIZE_MAX);
  return xrealloc (pa, nitems * item_size);
}


/* Grow PA, which points to an array of *NITEMS items, and return the
   location of the reallocated array, updating *NITEMS to reflect its
   new size.  The new array will contain at least NITEMS_INCR_MIN more
   items, but will not contain more than NITEMS_MAX items total.
   ITEM_SIZE is the size of each item, in bytes.

   ITEM_SIZE and NITEMS_INCR_MIN must be positive.  *NITEMS must be
   nonnegative.  If NITEMS_MAX is -1, it is treated as if it were
   infinity.

   If PA is null, then allocate a new array instead of reallocating
   the old one.  Thus, to grow an array A without saving its old
   contents, invoke xfree (A) immediately followed by xgrowalloc (0,
   &NITEMS, ...).

   Block interrupt input as needed.  If memory exhaustion occurs, set
   *NITEMS to zero if PA is null, and signal an error (i.e., do not
   return).  */

void *
xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
	 ptrdiff_t nitems_max, ptrdiff_t item_size)
{
  /* The approximate size to use for initial small allocation
     requests.  This is the largest "small" request for the GNU C
     library malloc.  */
  enum { DEFAULT_MXFAST = 64 * sizeof (size_t) / 4 };

  /* If the array is tiny, grow it to about (but no greater than)
     DEFAULT_MXFAST bytes.  Otherwise, grow it by about 50%.  */
  ptrdiff_t n = *nitems;
  ptrdiff_t tiny_max = DEFAULT_MXFAST / item_size - n;
  ptrdiff_t half_again = n >> 1;
  ptrdiff_t incr_estimate = max (tiny_max, half_again);

  /* Adjust the increment according to three constraints: NITEMS_INCR_MIN,
     NITEMS_MAX, and what the C language can represent safely.  */
  ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / item_size;
  ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
		     ? nitems_max : C_language_max);
  ptrdiff_t nitems_incr_max = n_max - n;
  ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));

863
  eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
864 865 866 867 868 869 870 871 872 873 874
  if (! pa)
    *nitems = 0;
  if (nitems_incr_max < incr)
    memory_full (SIZE_MAX);
  n += incr;
  pa = xrealloc (pa, n * item_size);
  *nitems = n;
  return pa;
}


875 876 877
/* Like strdup, but uses xmalloc.  */

char *
878
xstrdup (const char *s)
879
{
880
  size_t len = strlen (s) + 1;
Dmitry Antipov's avatar
Dmitry Antipov committed
881
  char *p = xmalloc (len);
882
  memcpy (p, s, len);
883 884 885 886
  return p;
}


887 888 889
/* Unwind for SAFE_ALLOCA */

Lisp_Object
890
safe_alloca_unwind (Lisp_Object arg)
891
{
892 893 894 895 896
  register struct Lisp_Save_Value *p = XSAVE_VALUE (arg);

  p->dogc = 0;
  xfree (p->pointer);
  p->pointer = 0;
897
  free_misc (arg);
898 899 900
  return Qnil;
}

901 902 903 904 905 906 907 908 909 910
/* Return a newly allocated memory block of SIZE bytes, remembering
   to free it when unwinding.  */
void *
record_xmalloc (size_t size)
{
  void *p = xmalloc (size);
  record_unwind_protect (safe_alloca_unwind, make_save_value (p, 0));
  return p;
}

911

912 913
/* Like malloc but used for allocating Lisp data.  NBYTES is the
   number of bytes to allocate, TYPE describes the intended use of the
Paul Eggert's avatar
Paul Eggert committed
914
   allocated memory block (for strings, for conses, ...).  */
915

916 917
#if ! USE_LSB_TAG
void *lisp_malloc_loser EXTERNALLY_VISIBLE;
918
#endif