Pure storage removal: Main part
* src/alloc.c (pure, PUREBEG, purebeg, pure_size) (pure_bytes_used_before_overflow, pure_bytes_used_lisp) (pure_bytes_used_non_lisp): Remove definitions. (init_strings): Make empty strings impure. (cons_listn): Drop 'cons' argument. (pure_listn): Remove function. (init_vectors): Allocate zero vector manually to avoid freelist issues. (pure_alloc, check_pure_size, find_string_data_in_pure) (make_pure_string, make_pure_c_string, pure_cons, make_pure_float) (make_pure_bignum, make_pure_vector, purecopy_hash_table): Remove functions. (purecopy): Reduce to hash consing our argument. (init_alloc_once_for_pdumper): Adjust to lack of pure space. (pure-bytes-used): Adjust docstring to mark as obsolete. (purify-flag): Keep for hash consing, but adjust docstring. * src/bytecode.c: * src/comp.c: Don't include "puresize.h". * src/conf_post.h (SYSTEM_PURESIZE_EXTRA): Remove definition. * src/data.c (pure_write_error): Remove function. * src/deps.mk: Remove puresize.h dependency throughout. * src/emacs.c: * src/fns.c: * src/intervals.c: * src/keymap.c: Don't include "puresize.h". * src/lisp.h (struct Lisp_Hash_Table): Adjust comment. (pure_listn, pure_list, build_pure_c_string): Remove. * src/w32heap.c (FREEABLE_P): Don't do use 'dumped_data'. (malloc_before_dump, realloc_before_dump, free_before_dump): Remove functions. * src/w32heap.h: Adjust prototype. * lisp/loadup.el: * lisp/startup.el: Remove purespace code.
This commit is contained in:
Pip Cet
Stefan Kangas
parent
d359858b5d
commit
f84ccff5a6
15 changed files with 85 additions and 687 deletions
|
|
@ -184,12 +184,6 @@
|
|||
(file-error
|
||||
(load "ldefs-boot.el")))
|
||||
|
||||
(let ((new (make-hash-table :test #'equal)))
|
||||
;; Now that loaddefs has populated definition-prefixes, purify its contents.
|
||||
(maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new))
|
||||
definition-prefixes)
|
||||
(setq definition-prefixes new))
|
||||
|
||||
(load "button") ;After loaddefs, because of define-minor-mode!
|
||||
|
||||
(when (interpreted-function-p (symbol-function 'add-hook))
|
||||
|
|
@ -503,11 +497,6 @@ lost after dumping")))
|
|||
;; Avoid storing references to build directory in the binary.
|
||||
(setq custom-current-group-alist nil)
|
||||
|
||||
;; We keep the load-history data in PURE space.
|
||||
;; Make sure that the spine of the list is not in pure space because it can
|
||||
;; be destructively mutated in lread.c:build_load_history.
|
||||
(setq load-history (mapcar #'purecopy load-history))
|
||||
|
||||
(set-buffer-modified-p nil)
|
||||
|
||||
(remove-hook 'after-load-functions (lambda (_) (garbage-collect)))
|
||||
|
|
@ -659,8 +648,7 @@ directory got moved. This is set to be a pair in the form of:
|
|||
(dump-emacs-portable (expand-file-name output invocation-directory))
|
||||
(dump-emacs output (if (eq system-type 'ms-dos)
|
||||
"temacs.exe"
|
||||
"temacs"))
|
||||
(message "%d pure bytes used" pure-bytes-used))
|
||||
"temacs")))
|
||||
(setq success t))
|
||||
(unless success
|
||||
(ignore-errors
|
||||
|
|
|
|||
|
|
@ -355,7 +355,7 @@ looked for.
|
|||
Setting `init-file-user' does not prevent Emacs from loading
|
||||
`site-start.el'. The only way to do that is to use `--no-site-file'.")
|
||||
|
||||
(defcustom site-run-file (purecopy "site-start")
|
||||
(defcustom site-run-file "site-start"
|
||||
"File containing site-wide run-time initializations.
|
||||
This file is loaded at run-time before `user-init-file'. It contains
|
||||
inits that need to be in place for the entire site, but which, due to
|
||||
|
|
@ -430,10 +430,6 @@ from being initialized."
|
|||
(defvar pure-space-overflow nil
|
||||
"Non-nil if building Emacs overflowed pure space.")
|
||||
|
||||
(defvar pure-space-overflow-message (purecopy "\
|
||||
Warning Warning!!! Pure space overflow !!!Warning Warning
|
||||
\(See the node Pure Storage in the Lisp manual for details.)\n"))
|
||||
|
||||
(defcustom tutorial-directory
|
||||
(file-name-as-directory (expand-file-name "tutorials" data-directory))
|
||||
"Directory containing the Emacs TUTORIAL files."
|
||||
|
|
@ -1693,11 +1689,11 @@ Changed settings will be marked as \"CHANGED outside of Customize\"."
|
|||
`((changed ((t :background ,color)))))
|
||||
(put 'cursor 'face-modified t))))
|
||||
|
||||
(defcustom initial-scratch-message (purecopy "\
|
||||
(defcustom initial-scratch-message "\
|
||||
;; This buffer is for text that is not saved, and for Lisp evaluation.
|
||||
;; To create a file, visit it with `\\[find-file]' and enter text in its buffer.
|
||||
|
||||
")
|
||||
"
|
||||
"Initial documentation displayed in *scratch* buffer at startup.
|
||||
If this is nil, no message will be displayed."
|
||||
:type '(choice (text :tag "Message")
|
||||
|
|
@ -2096,8 +2092,6 @@ splash screen in another window."
|
|||
(erase-buffer)
|
||||
(setq default-directory command-line-default-directory)
|
||||
(make-local-variable 'startup-screen-inhibit-startup-screen)
|
||||
(if pure-space-overflow
|
||||
(insert pure-space-overflow-message))
|
||||
;; Insert the permissions notice if the user has yet to grant Emacs
|
||||
;; storage permissions.
|
||||
(when (fboundp 'android-before-splash-screen)
|
||||
|
|
@ -2139,8 +2133,6 @@ splash screen in another window."
|
|||
(setq buffer-undo-list t)
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(if pure-space-overflow
|
||||
(insert pure-space-overflow-message))
|
||||
(fancy-splash-head)
|
||||
(dolist (text fancy-about-text)
|
||||
(apply #'fancy-splash-insert text)
|
||||
|
|
@ -2206,8 +2198,6 @@ splash screen in another window."
|
|||
(setq default-directory command-line-default-directory)
|
||||
(setq-local tab-width 8)
|
||||
|
||||
(if pure-space-overflow
|
||||
(insert pure-space-overflow-message))
|
||||
;; Insert the permissions notice if the user has yet to grant
|
||||
;; Emacs storage permissions.
|
||||
(when (fboundp 'android-before-splash-screen)
|
||||
|
|
@ -2529,17 +2519,6 @@ A fancy display is used on graphic displays, normal otherwise."
|
|||
(defun command-line-1 (args-left)
|
||||
"A subroutine of `command-line'."
|
||||
(display-startup-echo-area-message)
|
||||
(when (and pure-space-overflow
|
||||
(not noninteractive)
|
||||
;; If we were dumped with pdumper, we don't care about
|
||||
;; pure-space overflow.
|
||||
(or (not (fboundp 'pdumper-stats))
|
||||
(null (pdumper-stats))))
|
||||
(display-warning
|
||||
'initialization
|
||||
"Building Emacs overflowed pure space.\
|
||||
(See the node Pure Storage in the Lisp manual for details.)"
|
||||
:warning))
|
||||
|
||||
;; `displayable-buffers' is a list of buffers that may be displayed,
|
||||
;; which includes files parsed from the command line arguments and
|
||||
|
|
|
|||
520
src/alloc.c
520
src/alloc.c
|
|
@ -33,7 +33,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "bignum.h"
|
||||
#include "dispextern.h"
|
||||
#include "intervals.h"
|
||||
#include "puresize.h"
|
||||
#include "sysstdio.h"
|
||||
#include "systime.h"
|
||||
#include "character.h"
|
||||
|
|
@ -380,33 +379,6 @@ static char *spare_memory[7];
|
|||
|
||||
#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;
|
||||
|
|
@ -457,7 +429,6 @@ static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool);
|
|||
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
|
||||
|
|
@ -578,15 +549,13 @@ Lisp_Object const *staticvec[NSTATICS];
|
|||
|
||||
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. */
|
||||
|
||||
|
|
@ -1720,12 +1689,30 @@ static ptrdiff_t const STRING_BYTES_MAX =
|
|||
|
||||
/* 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);
|
||||
}
|
||||
|
||||
|
|
@ -2924,17 +2911,16 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4,
|
|||
}
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
|
@ -2947,18 +2933,7 @@ listn (ptrdiff_t count, Lisp_Object arg1, ...)
|
|||
{
|
||||
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;
|
||||
}
|
||||
|
|
@ -3139,7 +3114,7 @@ static ptrdiff_t last_inserted_vector_free_idx = VECTOR_FREE_LIST_ARRAY_SIZE;
|
|||
|
||||
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;
|
||||
|
||||
|
|
@ -3191,14 +3166,8 @@ allocate_vector_block (void)
|
|||
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
|
||||
|
|
@ -3211,6 +3180,31 @@ pseudovector_nbytes (const union vectorlike_header *hdr)
|
|||
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 *
|
||||
|
|
@ -5657,320 +5651,8 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes)
|
|||
}
|
||||
|
||||
|
||||
/***********************************************************************
|
||||
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.
|
||||
|
|
@ -5996,89 +5678,17 @@ static struct pinned_object
|
|||
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;
|
||||
}
|
||||
|
||||
|
|
@ -8093,8 +7703,6 @@ init_alloc_once (void)
|
|||
static void
|
||||
init_alloc_once_for_pdumper (void)
|
||||
{
|
||||
purebeg = PUREBEG;
|
||||
pure_size = PURESIZE;
|
||||
mem_init ();
|
||||
|
||||
#ifdef DOUG_LEA_MALLOC
|
||||
|
|
@ -8148,7 +7756,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
|
|||
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. */);
|
||||
|
|
@ -8174,9 +7782,13 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
|
|||
|
||||
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. */);
|
||||
|
|
|
|||
|
|
@ -27,7 +27,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "keyboard.h"
|
||||
#include "syntax.h"
|
||||
#include "window.h"
|
||||
#include "puresize.h"
|
||||
|
||||
/* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
|
||||
useful for debugging the byte compiler. It defaults to false. */
|
||||
|
|
|
|||
|
|
@ -31,7 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include <libgccjit.h>
|
||||
#include <epaths.h>
|
||||
|
||||
#include "puresize.h"
|
||||
#include "window.h"
|
||||
#include "dynlib.h"
|
||||
#include "buffer.h"
|
||||
|
|
|
|||
|
|
@ -157,41 +157,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */
|
|||
|
||||
/* DATA_START is needed by vm-limit.c and unexcoff.c. */
|
||||
#define DATA_START (&etext + 1)
|
||||
|
||||
/* Define one of these for easier conditionals. */
|
||||
#ifdef HAVE_X_WINDOWS
|
||||
/* We need a little extra space, see ../../lisp/loadup.el and the
|
||||
commentary below, in the non-X branch. The 140KB number was
|
||||
measured on GNU/Linux and on MS-Windows. */
|
||||
#define SYSTEM_PURESIZE_EXTRA (-170000+140000)
|
||||
#else
|
||||
/* We need a little extra space, see ../../lisp/loadup.el.
|
||||
As of 20091024, DOS-specific files use up 62KB of pure space. But
|
||||
overall, we end up wasting 130KB of pure space, because
|
||||
BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including
|
||||
non-DOS specific files and load history; the latter is about 55K,
|
||||
but depends on the depth of the top-level Emacs directory in the
|
||||
directory tree). Given the unknown policy of different DPMI
|
||||
hosts regarding loading of untouched pages, I'm not going to risk
|
||||
enlarging Emacs footprint by another 100+ KBytes. */
|
||||
#define SYSTEM_PURESIZE_EXTRA (-170000+90000)
|
||||
#endif
|
||||
#endif /* MSDOS */
|
||||
|
||||
/* macOS / GNUstep need a bit more pure memory. Of the existing knobs,
|
||||
SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */
|
||||
#ifdef HAVE_NS
|
||||
#if defined NS_IMPL_GNUSTEP
|
||||
# define SYSTEM_PURESIZE_EXTRA 30000
|
||||
#elif defined DARWIN_OS
|
||||
# define SYSTEM_PURESIZE_EXTRA 200000
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef CYGWIN
|
||||
#define SYSTEM_PURESIZE_EXTRA 50000
|
||||
#endif
|
||||
|
||||
#if defined HAVE_NTGUI && !defined DebPrint
|
||||
# ifdef EMACSDEBUG
|
||||
extern void _DebPrint (const char *fmt, ...);
|
||||
|
|
|
|||
|
|
@ -27,7 +27,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
|
||||
#include "lisp.h"
|
||||
#include "bignum.h"
|
||||
#include "puresize.h"
|
||||
#include "character.h"
|
||||
#include "buffer.h"
|
||||
#include "keyboard.h"
|
||||
|
|
@ -135,12 +134,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
|
|||
xsignal2 (Qwrong_type_argument, predicate, value);
|
||||
}
|
||||
|
||||
void
|
||||
pure_write_error (Lisp_Object obj)
|
||||
{
|
||||
xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj);
|
||||
}
|
||||
|
||||
void
|
||||
args_out_of_range (Lisp_Object a1, Lisp_Object a2)
|
||||
{
|
||||
|
|
|
|||
10
src/deps.mk
10
src/deps.mk
|
|
@ -132,10 +132,10 @@ insdel.o: insdel.c window.h buffer.h $(INTERVALS_H) blockinput.h character.h \
|
|||
keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \
|
||||
commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \
|
||||
systime.h syntax.h $(INTERVALS_H) blockinput.h atimer.h composite.h \
|
||||
xterm.h puresize.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \
|
||||
xterm.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \
|
||||
process.h ../lib/unistd.h gnutls.h lisp.h globals.h $(config_h)
|
||||
keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \
|
||||
atimer.h systime.h puresize.h character.h charset.h $(INTERVALS_H) \
|
||||
atimer.h systime.h character.h charset.h $(INTERVALS_H) \
|
||||
keymap.h window.h coding.h frame.h lisp.h globals.h $(config_h)
|
||||
lastfile.o: lastfile.c $(config_h)
|
||||
macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h msdos.h \
|
||||
|
|
@ -267,12 +267,12 @@ xsettings.o: xterm.h xsettings.h lisp.h frame.h termhooks.h $(config_h) \
|
|||
atimer.h termopts.h globals.h
|
||||
|
||||
## The files of Lisp proper.
|
||||
alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h \
|
||||
alloc.o: alloc.c process.h frame.h window.h buffer.h syssignal.h \
|
||||
keyboard.h blockinput.h atimer.h systime.h character.h lisp.h $(config_h) \
|
||||
$(INTERVALS_H) termhooks.h gnutls.h coding.h ../lib/unistd.h globals.h
|
||||
bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \
|
||||
lisp.h globals.h $(config_h) msdos.h
|
||||
data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \
|
||||
data.o: data.c buffer.h character.h syssignal.h keyboard.h frame.h \
|
||||
termhooks.h systime.h coding.h composite.h dispextern.h font.h ccl.h \
|
||||
lisp.h globals.h $(config_h) msdos.h
|
||||
eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \
|
||||
|
|
@ -295,7 +295,7 @@ lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \
|
|||
composite.o: composite.c composite.h buffer.h character.h coding.h font.h \
|
||||
ccl.h frame.h termhooks.h $(INTERVALS_H) window.h \
|
||||
lisp.h globals.h $(config_h)
|
||||
intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h puresize.h \
|
||||
intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h \
|
||||
keymap.h lisp.h globals.h $(config_h) systime.h coding.h
|
||||
textprop.o: textprop.c buffer.h window.h $(INTERVALS_H) \
|
||||
lisp.h globals.h $(config_h)
|
||||
|
|
|
|||
|
|
@ -113,7 +113,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "syntax.h"
|
||||
#include "sysselect.h"
|
||||
#include "systime.h"
|
||||
#include "puresize.h"
|
||||
|
||||
#include "getpagesize.h"
|
||||
#include "gnutls.h"
|
||||
|
|
|
|||
|
|
@ -36,7 +36,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "buffer.h"
|
||||
#include "intervals.h"
|
||||
#include "window.h"
|
||||
#include "puresize.h"
|
||||
#include "gnutls.h"
|
||||
|
||||
#ifdef HAVE_TREE_SITTER
|
||||
|
|
|
|||
|
|
@ -44,7 +44,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "lisp.h"
|
||||
#include "intervals.h"
|
||||
#include "buffer.h"
|
||||
#include "puresize.h"
|
||||
#include "keymap.h"
|
||||
|
||||
/* Test for membership, allowing for t (actually any non-cons) to mean the
|
||||
|
|
|
|||
|
|
@ -50,7 +50,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
|||
#include "keyboard.h"
|
||||
#include "termhooks.h"
|
||||
#include "blockinput.h"
|
||||
#include "puresize.h"
|
||||
#include "intervals.h"
|
||||
#include "keymap.h"
|
||||
#include "window.h"
|
||||
|
|
|
|||
18
src/lisp.h
18
src/lisp.h
|
|
@ -2628,8 +2628,8 @@ struct Lisp_Hash_Table
|
|||
bool_bf purecopy : 1;
|
||||
|
||||
/* True if the table is mutable. Ordinarily tables are mutable, but
|
||||
pure tables are not, and while a table is being mutated it is
|
||||
immutable for recursive attempts to mutate it. */
|
||||
some tables are not: while a table is being mutated it is immutable
|
||||
for recursive attempts to mutate it. */
|
||||
bool_bf mutable : 1;
|
||||
|
||||
/* Next weak hash table if this is a weak hash table. The head of
|
||||
|
|
@ -4436,7 +4436,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
|
|||
/* Defined in alloc.c. */
|
||||
extern intptr_t garbage_collection_inhibited;
|
||||
extern void *my_heap_start (void);
|
||||
extern void check_pure_size (void);
|
||||
unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int);
|
||||
extern void malloc_warning (const char *);
|
||||
extern AVOID memory_full (size_t);
|
||||
|
|
@ -4499,11 +4498,8 @@ extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
|
|||
extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object,
|
||||
Lisp_Object);
|
||||
extern Lisp_Object listn (ptrdiff_t, Lisp_Object, ...);
|
||||
extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...);
|
||||
#define list(...) \
|
||||
listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__)
|
||||
#define pure_list(...) \
|
||||
pure_listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__)
|
||||
|
||||
enum gc_root_type
|
||||
{
|
||||
|
|
@ -4577,18 +4573,8 @@ extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT);
|
|||
extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t);
|
||||
extern Lisp_Object make_specified_string (const char *,
|
||||
ptrdiff_t, ptrdiff_t, bool);
|
||||
extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool);
|
||||
extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t);
|
||||
extern void pin_string (Lisp_Object string);
|
||||
|
||||
/* Make a string allocated in pure space, use STR as string data. */
|
||||
|
||||
INLINE Lisp_Object
|
||||
build_pure_c_string (const char *str)
|
||||
{
|
||||
return make_pure_c_string (str, strlen (str));
|
||||
}
|
||||
|
||||
/* Make a string from the data at STR, treating it as multibyte if the
|
||||
data warrants. */
|
||||
|
||||
|
|
|
|||
135
src/w32heap.c
135
src/w32heap.c
|
|
@ -135,6 +135,12 @@ static struct
|
|||
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;
|
||||
|
|
@ -237,9 +243,7 @@ init_heap (void)
|
|||
|
||||
/* 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)
|
||||
|
|
@ -258,65 +262,6 @@ 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 *
|
||||
|
|
@ -349,39 +294,6 @@ realloc_after_dump (void *ptr, size_t size)
|
|||
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)
|
||||
|
|
@ -394,39 +306,6 @@ 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
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ extern void report_temacs_memory_usage (void);
|
|||
extern void *sbrk (ptrdiff_t size);
|
||||
|
||||
/* Initialize heap structures for sbrk on startup. */
|
||||
extern void init_heap (bool);
|
||||
extern void init_heap (void);
|
||||
|
||||
/* ----------------------------------------------------------------- */
|
||||
/* Useful routines for manipulating memory-mapped files. */
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue