#include "bignum.h"
#include "dispextern.h"
#include "intervals.h"
-#include "puresize.h"
#include "sysstdio.h"
#include "systime.h"
#include "character.h"
#define SPARE_MEMORY (1 << 14)
-/* 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. */
-
-EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
-#define PUREBEG (char *) pure
-
-/* Pointer to the pure area, and its size. */
-
-static char *purebeg;
-static ptrdiff_t pure_size;
-
-/* Number of bytes of pure storage used before pure storage overflowed.
- If this is non-zero, this implies that an overflow occurred. */
-
-static ptrdiff_t pure_bytes_used_before_overflow;
-
-/* Index in pure at which next pure Lisp object will be allocated.. */
-
-static ptrdiff_t pure_bytes_used_lisp;
-
-/* Number of bytes allocated for non-Lisp objects in pure storage. */
-
-static ptrdiff_t pure_bytes_used_non_lisp;
-
/* If positive, garbage collection is inhibited. Otherwise, zero. */
intptr_t garbage_collection_inhibited;
static void unchain_finalizer (struct Lisp_Finalizer *);
static void mark_terminals (void);
static void gc_sweep (void);
-static Lisp_Object make_pure_vector (ptrdiff_t);
static void mark_buffer (struct buffer *);
#if !defined REL_ALLOC || defined SYSTEM_MALLOC
int staticidx;
-static void *pure_alloc (size_t, int);
-
-/* Return PTR rounded up to the next multiple of ALIGNMENT. */
-
+#ifndef HAVE_ALIGNED_ALLOC
static void *
pointer_align (void *ptr, int alignment)
{
return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
}
+#endif
/* Extract the pointer hidden within O. */
/* Initialize string allocation. Called from init_alloc_once. */
+static struct Lisp_String *allocate_string (void);
+static void
+allocate_string_data (struct Lisp_String *s,
+ EMACS_INT nchars, EMACS_INT nbytes, bool clearit,
+ bool immovable);
+
static void
init_strings (void)
{
- empty_unibyte_string = make_pure_string ("", 0, 0, 0);
+ /* String allocation code will return one of 'empty_*ibyte_string'
+ when asked to construct a new 0-length string, so in order to build
+ those special cases, we have to do it "by hand". */
+ struct Lisp_String *ems = allocate_string ();
+ struct Lisp_String *eus = allocate_string ();
+ ems->u.s.intervals = NULL;
+ eus->u.s.intervals = NULL;
+ allocate_string_data (ems, 0, 0, false, false);
+ allocate_string_data (eus, 0, 0, false, false);
+ /* We can't use 'STRING_SET_UNIBYTE' because this one includes a hack
+ * to redirect its arg to 'empty_unibyte_string' when nbytes == 0. */
+ eus->u.s.size_byte = -1;
+ XSETSTRING (empty_multibyte_string, ems);
+ XSETSTRING (empty_unibyte_string, eus);
staticpro (&empty_unibyte_string);
- empty_multibyte_string = make_pure_string ("", 0, 0, 1);
staticpro (&empty_multibyte_string);
}
}
/* Make a list of COUNT Lisp_Objects, where ARG is the first one.
- Use CONS to construct the pairs. AP has any remaining args. */
+ AP has any remaining args. */
static Lisp_Object
-cons_listn (ptrdiff_t count, Lisp_Object arg,
- Lisp_Object (*cons) (Lisp_Object, Lisp_Object), va_list ap)
+cons_listn (ptrdiff_t count, Lisp_Object arg, va_list ap)
{
eassume (0 < count);
- Lisp_Object val = cons (arg, Qnil);
+ Lisp_Object val = Fcons (arg, Qnil);
Lisp_Object tail = val;
for (ptrdiff_t i = 1; i < count; i++)
{
- Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil);
+ Lisp_Object elem = Fcons (va_arg (ap, Lisp_Object), Qnil);
XSETCDR (tail, elem);
tail = elem;
}
{
va_list ap;
va_start (ap, arg1);
- Lisp_Object val = cons_listn (count, arg1, Fcons, ap);
- va_end (ap);
- return val;
-}
-
-/* Make a pure list of COUNT Lisp_Objects, where ARG1 is the first one. */
-Lisp_Object
-pure_listn (ptrdiff_t count, Lisp_Object arg1, ...)
-{
- va_list ap;
- va_start (ap, arg1);
- Lisp_Object val = cons_listn (count, arg1, pure_cons, ap);
+ Lisp_Object val = cons_listn (count, arg1, ap);
va_end (ap);
return val;
}
static struct large_vector *large_vectors;
-/* The only vector with 0 slots, allocated from pure space. */
+/* The only vector with 0 slots. */
Lisp_Object zero_vector;
return block;
}
-/* Called once to initialize vector allocation. */
-
-static void
-init_vectors (void)
-{
- zero_vector = make_pure_vector (0);
- staticpro (&zero_vector);
-}
+static struct Lisp_Vector *
+allocate_vector_from_block (ptrdiff_t nbytes);
/* Memory footprint in bytes of a pseudovector other than a bool-vector. */
static ptrdiff_t
return vroundup (header_size + word_size * nwords);
}
+/* Called once to initialize vector allocation. */
+
+static void
+init_vectors (void)
+{
+ /* The normal vector allocation code refuses to allocate a 0-length vector
+ because we use the first field of vectors internally when they're on
+ the free list, so we can't put a zero-length vector on the free list.
+ This is not a problem for 'zero_vector' since it's always reachable.
+ An alternative approach would be to allocate zero_vector outside of the
+ normal heap, e.g. as a static object, and then to "hide" it from the GC,
+ for example by marking it by hand at the beginning of the GC and unmarking
+ it by hand at the end. */
+ struct vector_block *block = allocate_vector_block ();
+ struct Lisp_Vector *zv = (struct Lisp_Vector *)block->data;
+ zv->header.size = 0;
+ ssize_t nbytes = pseudovector_nbytes (&zv->header);
+ ssize_t restbytes = VECTOR_BLOCK_BYTES - nbytes;
+ eassert (restbytes % roundup_size == 0);
+ setup_on_free_list (ADVANCE (zv, nbytes), restbytes);
+
+ zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike);
+ staticpro (&zero_vector);
+}
+
/* Allocate vector from a vector block. */
static struct Lisp_Vector *
}
-/***********************************************************************
- Pure Storage Management
- ***********************************************************************/
-
-/* Allocate room for SIZE bytes from pure Lisp storage and return a
- pointer to it. TYPE is the Lisp type for which the memory is
- allocated. TYPE < 0 means it's not used for a Lisp object,
- and that the result should have an alignment of -TYPE.
-
- The bytes are initially zero.
-
- If pure space is exhausted, allocate space from the heap. This is
- merely an expedient to let Emacs warn that pure space was exhausted
- and that Emacs should be rebuilt with a larger pure space. */
-
-static void *
-pure_alloc (size_t size, int type)
-{
- void *result;
- static bool pure_overflow_warned = false;
-
- again:
- if (type >= 0)
- {
- /* Allocate space for a Lisp object from the beginning of the free
- space with taking account of alignment. */
- result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT);
- pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
- }
- else
- {
- /* Allocate space for a non-Lisp object from the end of the free
- space. */
- ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size;
- char *unaligned = purebeg + pure_size - unaligned_non_lisp;
- int decr = (intptr_t) unaligned & (-1 - type);
- pure_bytes_used_non_lisp = unaligned_non_lisp + decr;
- result = unaligned - decr;
- }
- pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
-
- if (pure_bytes_used <= pure_size)
- return result;
-
- if (!pure_overflow_warned)
- {
- message ("Pure Lisp storage overflowed");
- pure_overflow_warned = true;
- }
-
- /* Don't allocate a large amount here,
- because it might get mmap'd and then its address
- might not be usable. */
- int small_amount = 10000;
- eassert (size <= small_amount - LISP_ALIGNMENT);
- purebeg = xzalloc (small_amount);
- pure_size = small_amount;
- pure_bytes_used_before_overflow += pure_bytes_used - size;
- pure_bytes_used = 0;
- pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
-
- /* Can't GC if pure storage overflowed because we can't determine
- if something is a pure object or not. */
- garbage_collection_inhibited++;
- goto again;
-}
-
-/* Print a warning if PURESIZE is too small. */
-
-void
-check_pure_size (void)
-{
- if (pure_bytes_used_before_overflow)
- message (("emacs:0:Pure Lisp storage overflow (approx. %jd"
- " bytes needed)"),
- pure_bytes_used + pure_bytes_used_before_overflow);
-}
-
-/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
- the non-Lisp data pool of the pure storage, and return its start
- address. Return NULL if not found. */
-
-static char *
-find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
-{
- int i;
- ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
- const unsigned char *p;
- char *non_lisp_beg;
-
- if (pure_bytes_used_non_lisp <= nbytes)
- return NULL;
-
- /* The Android GCC generates code like:
-
- 0xa539e755 <+52>: lea 0x430(%esp),%esi
-=> 0xa539e75c <+59>: movdqa %xmm0,0x0(%ebp)
- 0xa539e761 <+64>: add $0x10,%ebp
-
- but data is not aligned appropriately, so a GP fault results. */
-
-#if defined __i386__ \
- && defined HAVE_ANDROID \
- && !defined ANDROID_STUBIFY \
- && !defined (__clang__)
- if ((intptr_t) data & 15)
- return NULL;
-#endif
-
- /* Set up the Boyer-Moore table. */
- skip = nbytes + 1;
- for (i = 0; i < 256; i++)
- bm_skip[i] = skip;
-
- p = (const unsigned char *) data;
- while (--skip > 0)
- bm_skip[*p++] = skip;
-
- last_char_skip = bm_skip['\0'];
-
- non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
- start_max = pure_bytes_used_non_lisp - (nbytes + 1);
-
- /* See the comments in the function `boyer_moore' (search.c) for the
- use of `infinity'. */
- infinity = pure_bytes_used_non_lisp + 1;
- bm_skip['\0'] = infinity;
-
- p = (const unsigned char *) non_lisp_beg + nbytes;
- start = 0;
- do
- {
- /* Check the last character (== '\0'). */
- do
- {
- start += bm_skip[*(p + start)];
- }
- while (start <= start_max);
-
- if (start < infinity)
- /* Couldn't find the last character. */
- return NULL;
-
- /* No less than `infinity' means we could find the last
- character at `p[start - infinity]'. */
- start -= infinity;
-
- /* Check the remaining characters. */
- if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
- /* Found. */
- return non_lisp_beg + start;
-
- start += last_char_skip;
- }
- while (start <= start_max);
-
- return NULL;
-}
-
-
-/* Return a string allocated in pure space. DATA is a buffer holding
- NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
- means make the result string multibyte.
-
- Must get an error if pure storage is full, since if it cannot hold
- a large string it may be able to hold conses that point to that
- string; then the string is not protected from gc. */
-
-Lisp_Object
-make_pure_string (const char *data,
- ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
-{
- Lisp_Object string;
- struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
- s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes);
- if (s->u.s.data == NULL)
- {
- s->u.s.data = pure_alloc (nbytes + 1, -1);
- memcpy (s->u.s.data, data, nbytes);
- s->u.s.data[nbytes] = '\0';
- }
- s->u.s.size = nchars;
- s->u.s.size_byte = multibyte ? nbytes : -1;
- s->u.s.intervals = NULL;
- XSETSTRING (string, s);
- return string;
-}
-
-/* Return a string allocated in pure space. Do not
- allocate the string data, just point to DATA. */
-
-Lisp_Object
-make_pure_c_string (const char *data, ptrdiff_t nchars)
-{
- Lisp_Object string;
- struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
- s->u.s.size = nchars;
- s->u.s.size_byte = -2;
- s->u.s.data = (unsigned char *) data;
- s->u.s.intervals = NULL;
- XSETSTRING (string, s);
- return string;
-}
-
static Lisp_Object purecopy (Lisp_Object obj);
-/* Return a cons allocated from pure space. Give it pure copies
- of CAR as car and CDR as cdr. */
-
-Lisp_Object
-pure_cons (Lisp_Object car, Lisp_Object cdr)
-{
- Lisp_Object new;
- struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons);
- XSETCONS (new, p);
- XSETCAR (new, purecopy (car));
- XSETCDR (new, purecopy (cdr));
- return new;
-}
-
-
-/* Value is a float object with value NUM allocated from pure space. */
-
-static Lisp_Object
-make_pure_float (double num)
-{
- Lisp_Object new;
- struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float);
- XSETFLOAT (new, p);
- XFLOAT_INIT (new, num);
- return new;
-}
-
-/* Value is a bignum object with value VALUE allocated from pure
- space. */
-
-static Lisp_Object
-make_pure_bignum (Lisp_Object value)
-{
- mpz_t const *n = xbignum_val (value);
- size_t i, nlimbs = mpz_size (*n);
- size_t nbytes = nlimbs * sizeof (mp_limb_t);
- mp_limb_t *pure_limbs;
- mp_size_t new_size;
-
- struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike);
- XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum));
-
- int limb_alignment = alignof (mp_limb_t);
- pure_limbs = pure_alloc (nbytes, - limb_alignment);
- for (i = 0; i < nlimbs; ++i)
- pure_limbs[i] = mpz_getlimbn (*n, i);
-
- new_size = nlimbs;
- if (mpz_sgn (*n) < 0)
- new_size = -new_size;
-
- mpz_roinit_n (b->value, pure_limbs, new_size);
-
- return make_lisp_ptr (b, Lisp_Vectorlike);
-}
-
-/* Return a vector with room for LEN Lisp_Objects allocated from
- pure space. */
-
-static Lisp_Object
-make_pure_vector (ptrdiff_t len)
-{
- Lisp_Object new;
- size_t size = header_size + len * word_size;
- struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike);
- XSETVECTOR (new, p);
- XVECTOR (new)->header.size = len;
- return new;
-}
-
-/* Copy all contents and parameters of TABLE to a new table allocated
- from pure space, return the purified table. */
-static struct Lisp_Hash_Table *
-purecopy_hash_table (struct Lisp_Hash_Table *table)
-{
- eassert (table->weakness == Weak_None);
- eassert (table->purecopy);
-
- struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
- *pure = *table;
- pure->mutable = false;
-
- if (table->table_size > 0)
- {
- ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash;
- pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash);
- memcpy (pure->hash, table->hash, hash_bytes);
-
- ptrdiff_t next_bytes = table->table_size * sizeof *table->next;
- pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next);
- memcpy (pure->next, table->next, next_bytes);
-
- ptrdiff_t nvalues = table->table_size * 2;
- ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value;
- pure->key_and_value = pure_alloc (kv_bytes,
- -(int)sizeof *table->key_and_value);
- for (ptrdiff_t i = 0; i < nvalues; i++)
- pure->key_and_value[i] = purecopy (table->key_and_value[i]);
-
- ptrdiff_t index_bytes = hash_table_index_size (table)
- * sizeof *table->index;
- pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index);
- memcpy (pure->index, table->index, index_bytes);
- }
-
- return pure;
-}
-
DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
doc: /* Make a copy of object OBJ in pure storage.
Recursively copies contents of vectors and cons cells.
static Lisp_Object
purecopy (Lisp_Object obj)
{
- if (FIXNUMP (obj)
- || (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
- || SUBRP (obj))
- return obj; /* Already pure. */
-
- if (STRINGP (obj) && XSTRING (obj)->u.s.intervals)
- message_with_string ("Dropping text-properties while making string `%s' pure",
- obj, true);
+ if (FIXNUMP (obj) || SUBRP (obj))
+ return obj; /* No need to hash. */
if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
{
Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil);
if (!NILP (tmp))
return tmp;
+ Fputhash (obj, obj, Vpurify_flag);
}
- if (CONSP (obj))
- obj = pure_cons (XCAR (obj), XCDR (obj));
- else if (FLOATP (obj))
- obj = make_pure_float (XFLOAT_DATA (obj));
- else if (STRINGP (obj))
- obj = make_pure_string (SSDATA (obj), SCHARS (obj),
- SBYTES (obj),
- STRING_MULTIBYTE (obj));
- else if (HASH_TABLE_P (obj))
- {
- struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
- /* Do not purify hash tables which haven't been defined with
- :purecopy as non-nil or are weak - they aren't guaranteed to
- not change. */
- if (table->weakness != Weak_None || !table->purecopy)
- {
- /* Instead, add the hash table to the list of pinned objects,
- so that it will be marked during GC. */
- struct pinned_object *o = xmalloc (sizeof *o);
- o->object = obj;
- o->next = pinned_objects;
- pinned_objects = o;
- return obj; /* Don't hash cons it. */
- }
-
- obj = make_lisp_hash_table (purecopy_hash_table (table));
- }
- else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
- {
- struct Lisp_Vector *objp = XVECTOR (obj);
- ptrdiff_t nbytes = vector_nbytes (objp);
- struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike);
- register ptrdiff_t i;
- ptrdiff_t size = ASIZE (obj);
- if (size & PSEUDOVECTOR_FLAG)
- size &= PSEUDOVECTOR_SIZE_MASK;
- memcpy (vec, objp, nbytes);
- for (i = 0; i < size; i++)
- vec->contents[i] = purecopy (vec->contents[i]);
- /* Byte code strings must be pinned. */
- if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1])
- && !STRING_MULTIBYTE (vec->contents[1]))
- pin_string (vec->contents[1]);
- XSETVECTOR (obj, vec);
- }
- else if (BARE_SYMBOL_P (obj))
- {
- if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj)))
- { /* We can't purify them, but they appear in many pure objects.
- Mark them as `pinned' so we know to mark them at every GC cycle. */
- XBARE_SYMBOL (obj)->u.s.pinned = true;
- symbol_block_pinned = symbol_block;
- }
- /* Don't hash-cons it. */
- return obj;
- }
- else if (BIGNUMP (obj))
- obj = make_pure_bignum (obj);
- else
- {
- AUTO_STRING (fmt, "Don't know how to purify: %S");
- Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
- }
-
- if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
- Fputhash (obj, obj, Vpurify_flag);
-
return obj;
}
static void
init_alloc_once_for_pdumper (void)
{
- purebeg = PUREBEG;
- pure_size = PURESIZE;
mem_init ();
#ifdef DOUG_LEA_MALLOC
Vgc_cons_percentage = make_float (0.1);
DEFVAR_INT ("pure-bytes-used", pure_bytes_used,
- doc: /* Number of bytes of shareable Lisp data allocated so far. */);
+ doc: /* No longer used. */);
DEFVAR_INT ("cons-cells-consed", cons_cells_consed,
doc: /* Number of cons cells that have been consed so far. */);
DEFVAR_LISP ("purify-flag", Vpurify_flag,
doc: /* Non-nil means loading Lisp code in order to dump an executable.
-This means that certain objects should be allocated in shared (pure) space.
-It can also be set to a hash-table, in which case this table is used to
-do hash-consing of the objects allocated to pure space. */);
+This used to mean that certain objects should be allocated in shared (pure)
+space. It can also be set to a hash-table, in which case this table is used
+to do hash-consing of the objects allocated to pure space.
+The hash-consing still applies, but objects are not allocated in pure
+storage any more.
+This flag is still used in a few places not to decide where objects are
+allocated but to know if we're in the preload phase of Emacs's build. */);
DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages,
doc: /* Non-nil means display messages at start and end of garbage collection. */);
static DWORD blocks_number = 0;
static unsigned char *bc_limit;
+/* Handle for the private heap:
+ - inside the dumped_data[] array before dump with unexec,
+ - outside of it after dump, or always if pdumper is used.
+*/
+HANDLE heap = NULL;
+
/* We redirect the standard allocation functions. */
malloc_fn the_malloc_fn;
realloc_fn the_realloc_fn;
/* FREEABLE_P checks if the block can be safely freed. */
#define FREEABLE_P(addr) \
- ((DWORD_PTR)(unsigned char *)(addr) > 0 \
- && ((unsigned char *)(addr) < dumped_data \
- || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE))
+ ((DWORD_PTR)(unsigned char *)(addr) > 0)
void *
malloc_after_dump (size_t size)
return p;
}
-/* FIXME: The *_before_dump functions should be removed when pdumper
- becomes the only dumping method. */
-void *
-malloc_before_dump (size_t size)
-{
- void *p;
-
- /* Before dumping. The private heap can handle only requests for
- less than MaxBlockSize. */
- if (size < MaxBlockSize)
- {
- /* Use the private heap if possible. */
- p = heap_alloc (size);
- }
- else
- {
- /* Find the first big chunk that can hold the requested size. */
- int i = 0;
-
- for (i = 0; i < blocks_number; i++)
- {
- if (blocks[i].occupied == 0 && blocks[i].size >= size)
- break;
- }
- if (i < blocks_number)
- {
- /* If found, use it. */
- p = blocks[i].address;
- blocks[i].occupied = TRUE;
- }
- else
- {
- /* Allocate a new big chunk from the end of the dumped_data
- array. */
- if (blocks_number >= MAX_BLOCKS)
- {
- fprintf (stderr,
- "malloc_before_dump: no more big chunks available.\nEnlarge MAX_BLOCKS!\n");
- exit (-1);
- }
- bc_limit -= size;
- bc_limit = (unsigned char *)ROUND_DOWN (bc_limit, 0x10);
- p = bc_limit;
- blocks[blocks_number].address = p;
- blocks[blocks_number].size = size;
- blocks[blocks_number].occupied = TRUE;
- blocks_number++;
- /* Check that areas do not overlap. */
- if (bc_limit < dumped_data + committed)
- {
- fprintf (stderr,
- "malloc_before_dump: memory exhausted.\nEnlarge dumped_data[]!\n");
- exit (-1);
- }
- }
- }
- return p;
-}
-
/* Re-allocate the previously allocated block in ptr, making the new
block SIZE bytes long. */
void *
return p;
}
-void *
-realloc_before_dump (void *ptr, size_t size)
-{
- void *p;
-
- /* Before dumping. */
- if (dumped_data < (unsigned char *)ptr
- && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize)
- {
- p = heap_realloc (ptr, size);
- }
- else
- {
- /* In this case, either the new block is too large for the heap,
- or the old block was already too large. In both cases,
- malloc_before_dump() and free_before_dump() will take care of
- reallocation. */
- p = malloc_before_dump (size);
- /* If SIZE is below MaxBlockSize, malloc_before_dump will try to
- allocate it in the fixed heap. If that fails, we could have
- kept the block in its original place, above bc_limit, instead
- of failing the call as below. But this doesn't seem to be
- worth the added complexity, as loadup allocates only a very
- small number of large blocks, and never reallocates them. */
- if (p && ptr)
- {
- CopyMemory (p, ptr, size);
- free_before_dump (ptr);
- }
- }
- return p;
-}
-
/* Free a block allocated by `malloc', `realloc' or `calloc'. */
void
free_after_dump (void *ptr)
}
}
-void
-free_before_dump (void *ptr)
-{
- if (!ptr)
- return;
-
- /* Before dumping. */
- if (dumped_data < (unsigned char *)ptr
- && (unsigned char *)ptr < bc_limit)
- {
- /* Free the block if it is allocated in the private heap. */
- HeapFree (heap, 0, ptr);
- }
- else
- {
- /* Look for the big chunk. */
- int i;
-
- for (i = 0; i < blocks_number; i++)
- {
- if (blocks[i].address == ptr)
- {
- /* Reset block occupation if found. */
- blocks[i].occupied = 0;
- break;
- }
- /* What if the block is not found? We should trigger an
- error here. */
- eassert (i < blocks_number);
- }
- }
-}
-
/* On Windows 9X, HeapAlloc may return pointers that are not aligned
on 8-byte boundary, alignment which is required by the Lisp memory
management. To circumvent this problem, manually enforce alignment
projects / emacs.git / commitdiff