forked from Github/emacs
Compare commits
2 commits
master
...
scratch/no
| Author | SHA1 | Date | |
|---|---|---|---|
|
b6a526361b | ||
|
|
3daf833ff3 |
42 changed files with 245 additions and 1050 deletions
|
|
@ -1626,7 +1626,6 @@ Tips and Conventions
|
|||
GNU Emacs Internals
|
||||
|
||||
* Building Emacs:: How the dumped Emacs is made.
|
||||
* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
|
||||
* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
|
||||
* Stack-allocated Objects:: Temporary conses and strings on C stack.
|
||||
* Memory Usage:: Info about total size of Lisp objects made so far.
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@ internal aspects of GNU Emacs that may be of interest to C programmers.
|
|||
|
||||
@menu
|
||||
* Building Emacs:: How the dumped Emacs is made.
|
||||
* Pure Storage:: Kludge to make preloaded Lisp functions shareable.
|
||||
* Garbage Collection:: Reclaiming space for Lisp objects no longer used.
|
||||
* Stack-allocated Objects:: Temporary conses and strings on C stack.
|
||||
* Memory Usage:: Info about total size of Lisp objects made so far.
|
||||
|
|
@ -251,71 +250,6 @@ If the current session was not restored from a dump file, the
|
|||
value is nil.
|
||||
@end defun
|
||||
|
||||
@node Pure Storage
|
||||
@section Pure Storage
|
||||
@cindex pure storage
|
||||
|
||||
Emacs Lisp uses two kinds of storage for user-created Lisp objects:
|
||||
@dfn{normal storage} and @dfn{pure storage}. Normal storage is where
|
||||
all the new data created during an Emacs session are kept
|
||||
(@pxref{Garbage Collection}). Pure storage is used for certain data
|
||||
in the preloaded standard Lisp files---data that should never change
|
||||
during actual use of Emacs.
|
||||
|
||||
Pure storage is allocated only while @command{temacs} is loading the
|
||||
standard preloaded Lisp libraries. In the file @file{emacs}, it is
|
||||
marked as read-only (on operating systems that permit this), so that
|
||||
the memory space can be shared by all the Emacs jobs running on the
|
||||
machine at once. Pure storage is not expandable; a fixed amount is
|
||||
allocated when Emacs is compiled, and if that is not sufficient for
|
||||
the preloaded libraries, @file{temacs} allocates dynamic memory for
|
||||
the part that didn't fit. If Emacs will be dumped using the
|
||||
@code{pdump} method (@pxref{Building Emacs}), the pure-space overflow
|
||||
is of no special importance (it just means some of the preloaded stuff
|
||||
cannot be shared with other Emacs jobs). However, if Emacs will be
|
||||
dumped using the now obsolete @code{unexec} method, the resulting
|
||||
image will work, but garbage collection (@pxref{Garbage Collection})
|
||||
is disabled in this situation, causing a memory leak. Such an
|
||||
overflow normally won't happen unless you try to preload additional
|
||||
libraries or add features to the standard ones. Emacs will display a
|
||||
warning about the overflow when it starts, if it was dumped using
|
||||
@code{unexec}. If this happens, you should increase the compilation
|
||||
parameter @code{SYSTEM_PURESIZE_EXTRA} in the file
|
||||
@file{src/puresize.h} and rebuild Emacs.
|
||||
|
||||
@defun purecopy object
|
||||
This function makes a copy in pure storage of @var{object}, and returns
|
||||
it. It copies a string by simply making a new string with the same
|
||||
characters, but without text properties, in pure storage. It
|
||||
recursively copies the contents of vectors and cons cells. It does
|
||||
not make copies of other objects such as symbols, but just returns
|
||||
them unchanged. It signals an error if asked to copy markers.
|
||||
|
||||
This function is a no-op except while Emacs is being built and dumped;
|
||||
it is usually called only in preloaded Lisp files.
|
||||
@end defun
|
||||
|
||||
@defvar pure-bytes-used
|
||||
The value of this variable is the number of bytes of pure storage
|
||||
allocated so far. Typically, in a dumped Emacs, this number is very
|
||||
close to the total amount of pure storage available---if it were not,
|
||||
we would preallocate less.
|
||||
@end defvar
|
||||
|
||||
@defvar purify-flag
|
||||
This variable determines whether @code{defun} should make a copy of the
|
||||
function definition in pure storage. If it is non-@code{nil}, then the
|
||||
function definition is copied into pure storage.
|
||||
|
||||
This flag is @code{t} while loading all of the basic functions for
|
||||
building Emacs initially (allowing those functions to be shareable and
|
||||
non-collectible). Dumping Emacs as an executable always writes
|
||||
@code{nil} in this variable, regardless of the value it actually has
|
||||
before and after dumping.
|
||||
|
||||
You should not change this flag in a running Emacs.
|
||||
@end defvar
|
||||
|
||||
@node Garbage Collection
|
||||
@section Garbage Collection
|
||||
|
||||
|
|
@ -526,12 +460,6 @@ Total heap size, in @var{unit-size} units.
|
|||
@item free-size
|
||||
Heap space which is not currently used, in @var{unit-size} units.
|
||||
@end table
|
||||
|
||||
If there was overflow in pure space (@pxref{Pure Storage}), and Emacs
|
||||
was dumped using the (now obsolete) @code{unexec} method
|
||||
(@pxref{Building Emacs}), then @code{garbage-collect} returns
|
||||
@code{nil}, because a real garbage collection cannot be done in that
|
||||
case.
|
||||
@end deffn
|
||||
|
||||
@defopt garbage-collection-messages
|
||||
|
|
@ -950,7 +878,6 @@ improves user experience.
|
|||
the variables are never written once Emacs is dumped. These variables
|
||||
with initializers are allocated in an area of memory that becomes
|
||||
read-only (on certain operating systems) as a result of dumping Emacs.
|
||||
@xref{Pure Storage}.
|
||||
|
||||
@cindex @code{defsubr}, Lisp symbol for a primitive
|
||||
Defining the C function is not enough to make a Lisp primitive
|
||||
|
|
|
|||
|
|
@ -596,8 +596,7 @@ modes. @xref{Setting Hooks}.
|
|||
If the value is non-@code{nil}, the named function is considered to be
|
||||
pure (@pxref{What Is a Function}). Calls with constant arguments can
|
||||
be evaluated at compile time. This may shift run time errors to
|
||||
compile time. Not to be confused with pure storage (@pxref{Pure
|
||||
Storage}).
|
||||
compile time.
|
||||
|
||||
@item risky-local-variable
|
||||
If the value is non-@code{nil}, the named variable is considered risky
|
||||
|
|
|
|||
560
src/alloc.c
560
src/alloc.c
|
|
@ -34,7 +34,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 "sheap.h"
|
||||
#include "sysstdio.h"
|
||||
#include "systime.h"
|
||||
|
|
@ -334,33 +333,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. */
|
||||
|
||||
static intptr_t garbage_collection_inhibited;
|
||||
|
|
@ -435,7 +407,6 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size)
|
|||
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 || defined HYBRID_MALLOC
|
||||
|
|
@ -562,16 +533,6 @@ Lisp_Object const *staticvec[NSTATICS]
|
|||
|
||||
int staticidx;
|
||||
|
||||
static void *pure_alloc (size_t, int);
|
||||
|
||||
/* Return PTR rounded up to the next multiple of ALIGNMENT. */
|
||||
|
||||
static void *
|
||||
pointer_align (void *ptr, int alignment)
|
||||
{
|
||||
return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
|
||||
}
|
||||
|
||||
/* Extract the pointer hidden within O. */
|
||||
|
||||
static ATTRIBUTE_NO_SANITIZE_UNDEFINED void *
|
||||
|
|
@ -1153,6 +1114,16 @@ struct ablocks
|
|||
(1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1])
|
||||
#endif
|
||||
|
||||
/* Return PTR rounded up to the next multiple of ALIGNMENT. */
|
||||
|
||||
#ifndef USE_ALIGNED_ALLOC
|
||||
static void *
|
||||
pointer_align (void *ptr, int alignment)
|
||||
{
|
||||
return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* The list of free ablock. */
|
||||
static struct ablock *free_ablock;
|
||||
|
||||
|
|
@ -1674,12 +1645,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);
|
||||
}
|
||||
|
||||
|
|
@ -1697,7 +1686,7 @@ string_bytes (struct Lisp_String *s)
|
|||
ptrdiff_t nbytes =
|
||||
(s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte);
|
||||
|
||||
if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data
|
||||
if (!pdumper_object_p (s) && s->u.s.data
|
||||
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
|
||||
emacs_abort ();
|
||||
return nbytes;
|
||||
|
|
@ -2512,7 +2501,7 @@ pin_string (Lisp_Object string)
|
|||
unsigned char *data = s->u.s.data;
|
||||
|
||||
if (!(size > LARGE_STRING_BYTES
|
||||
|| PURE_P (data) || pdumper_object_p (data)
|
||||
|| pdumper_object_p (data)
|
||||
|| s->u.s.size_byte == -3))
|
||||
{
|
||||
eassert (s->u.s.size_byte == -1);
|
||||
|
|
@ -2772,17 +2761,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;
|
||||
}
|
||||
|
|
@ -2795,18 +2783,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;
|
||||
}
|
||||
|
|
@ -2972,7 +2949,7 @@ static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX];
|
|||
|
||||
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;
|
||||
|
||||
|
|
@ -3008,12 +2985,25 @@ allocate_vector_block (void)
|
|||
return block;
|
||||
}
|
||||
|
||||
static struct Lisp_Vector *
|
||||
allocate_vector_from_block (ptrdiff_t nbytes);
|
||||
|
||||
/* Called once to initialize vector allocation. */
|
||||
|
||||
static void
|
||||
init_vectors (void)
|
||||
{
|
||||
zero_vector = make_pure_vector (0);
|
||||
/* 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 Lisp_Vector *zv = allocate_vector_from_block (vroundup (header_size));
|
||||
zv->header.size = 0;
|
||||
zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike);
|
||||
staticpro (&zero_vector);
|
||||
}
|
||||
|
||||
|
|
@ -3598,13 +3588,6 @@ struct symbol_block
|
|||
|
||||
static struct symbol_block *symbol_block;
|
||||
static int symbol_block_index = SYMBOL_BLOCK_SIZE;
|
||||
/* Pointer to the first symbol_block that contains pinned symbols.
|
||||
Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols,
|
||||
10K of which are pinned (and all but 250 of them are interned in obarray),
|
||||
whereas a "typical session" has in the order of 30K symbols.
|
||||
`symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather
|
||||
than 30K to find the 10K symbols we need to mark. */
|
||||
static struct symbol_block *symbol_block_pinned;
|
||||
|
||||
/* List of free symbols. */
|
||||
|
||||
|
|
@ -3630,7 +3613,6 @@ init_symbol (Lisp_Object val, Lisp_Object name)
|
|||
p->u.s.interned = SYMBOL_UNINTERNED;
|
||||
p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE;
|
||||
p->u.s.declared_special = false;
|
||||
p->u.s.pinned = false;
|
||||
}
|
||||
|
||||
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
|
||||
|
|
@ -5238,8 +5220,6 @@ valid_lisp_object_p (Lisp_Object obj)
|
|||
return 1;
|
||||
|
||||
void *p = XPNTR (obj);
|
||||
if (PURE_P (p))
|
||||
return 1;
|
||||
|
||||
if (BARE_SYMBOL_P (obj) && c_symbol_p (p))
|
||||
return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0;
|
||||
|
|
@ -5295,297 +5275,8 @@ valid_lisp_object_p (Lisp_Object obj)
|
|||
return 0;
|
||||
}
|
||||
|
||||
/***********************************************************************
|
||||
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;
|
||||
|
||||
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;
|
||||
|
||||
/* 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;
|
||||
}
|
||||
|
||||
|
||||
#ifdef HAVE_UNEXEC
|
||||
|
||||
/* 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. %"pI"d"
|
||||
" bytes needed)"),
|
||||
pure_bytes_used + pure_bytes_used_before_overflow);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/* 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;
|
||||
|
||||
/* 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 (NILP (table->weak));
|
||||
eassert (table->purecopy);
|
||||
|
||||
struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
|
||||
struct hash_table_test pure_test = table->test;
|
||||
|
||||
/* Purecopy the hash table test. */
|
||||
pure_test.name = purecopy (table->test.name);
|
||||
pure_test.user_hash_function = purecopy (table->test.user_hash_function);
|
||||
pure_test.user_cmp_function = purecopy (table->test.user_cmp_function);
|
||||
|
||||
pure->header = table->header;
|
||||
pure->weak = purecopy (Qnil);
|
||||
pure->hash = purecopy (table->hash);
|
||||
pure->next = purecopy (table->next);
|
||||
pure->index = purecopy (table->index);
|
||||
pure->count = table->count;
|
||||
pure->next_free = table->next_free;
|
||||
pure->purecopy = table->purecopy;
|
||||
eassert (!pure->mutable);
|
||||
pure->rehash_threshold = table->rehash_threshold;
|
||||
pure->rehash_size = table->rehash_size;
|
||||
pure->key_and_value = purecopy (table->key_and_value);
|
||||
pure->test = pure_test;
|
||||
|
||||
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.
|
||||
|
|
@ -5601,104 +5292,23 @@ Does not copy symbols. Copies strings without text properties. */)
|
|||
return purecopy (obj);
|
||||
}
|
||||
|
||||
/* Pinned objects are marked before every GC cycle. */
|
||||
static struct pinned_object
|
||||
{
|
||||
Lisp_Object object;
|
||||
struct pinned_object *next;
|
||||
} *pinned_objects;
|
||||
|
||||
static Lisp_Object
|
||||
purecopy (Lisp_Object obj)
|
||||
{
|
||||
if (FIXNUMP (obj)
|
||||
|| (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
|
||||
|| SUBRP (obj))
|
||||
if (FIXNUMP (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 (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 (!NILP (table->weak) || !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. */
|
||||
}
|
||||
|
||||
struct Lisp_Hash_Table *h = purecopy_hash_table (table);
|
||||
XSET_HASH_TABLE (obj, h);
|
||||
}
|
||||
else if (COMPILEDP (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 (COMPILEDP (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;
|
||||
}
|
||||
|
||||
|
||||
|
||||
/***********************************************************************
|
||||
Protection from GC
|
||||
|
|
@ -5889,31 +5499,6 @@ compact_undo_list (Lisp_Object list)
|
|||
return list;
|
||||
}
|
||||
|
||||
static void
|
||||
mark_pinned_objects (void)
|
||||
{
|
||||
for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next)
|
||||
mark_object (pobj->object);
|
||||
}
|
||||
|
||||
static void
|
||||
mark_pinned_symbols (void)
|
||||
{
|
||||
struct symbol_block *sblk;
|
||||
int lim = (symbol_block_pinned == symbol_block
|
||||
? symbol_block_index : SYMBOL_BLOCK_SIZE);
|
||||
|
||||
for (sblk = symbol_block_pinned; sblk; sblk = sblk->next)
|
||||
{
|
||||
struct Lisp_Symbol *sym = sblk->symbols, *end = sym + lim;
|
||||
for (; sym < end; ++sym)
|
||||
if (sym->u.s.pinned)
|
||||
mark_object (make_lisp_symbol (sym));
|
||||
|
||||
lim = SYMBOL_BLOCK_SIZE;
|
||||
}
|
||||
}
|
||||
|
||||
static void
|
||||
visit_vectorlike_root (struct gc_root_visitor visitor,
|
||||
struct Lisp_Vector *ptr,
|
||||
|
|
@ -6178,8 +5763,6 @@ garbage_collect (void)
|
|||
struct gc_root_visitor visitor = { .visit = mark_object_root_visitor };
|
||||
visit_static_gc_roots (visitor);
|
||||
|
||||
mark_pinned_objects ();
|
||||
mark_pinned_symbols ();
|
||||
mark_lread ();
|
||||
mark_terminals ();
|
||||
mark_kboards ();
|
||||
|
|
@ -6306,10 +5889,6 @@ where each entry has the form (NAME SIZE USED FREE), where:
|
|||
keeps around for future allocations (maybe because it does not know how
|
||||
to return them to the OS).
|
||||
|
||||
However, if there was overflow in pure space, and Emacs was dumped
|
||||
using the \"unexec\" method, `garbage-collect' returns nil, because
|
||||
real GC can't be done.
|
||||
|
||||
Note that calling this function does not guarantee that absolutely all
|
||||
unreachable objects will be garbage-collected. Emacs uses a
|
||||
mark-and-sweep garbage collector, but is conservative when it comes to
|
||||
|
|
@ -6737,8 +6316,6 @@ process_mark_stack (ptrdiff_t base_sp)
|
|||
Lisp_Object obj = mark_stack_pop ();
|
||||
mark_obj: ;
|
||||
void *po = XPNTR (obj);
|
||||
if (PURE_P (po))
|
||||
continue;
|
||||
|
||||
#if GC_REMEMBER_LAST_MARKED
|
||||
last_marked[last_marked_index++] = obj;
|
||||
|
|
@ -6964,8 +6541,7 @@ process_mark_stack (ptrdiff_t base_sp)
|
|||
break;
|
||||
default: emacs_abort ();
|
||||
}
|
||||
if (!PURE_P (XSTRING (ptr->u.s.name)))
|
||||
set_string_marked (XSTRING (ptr->u.s.name));
|
||||
set_string_marked (XSTRING (ptr->u.s.name));
|
||||
mark_interval_tree (string_intervals (ptr->u.s.name));
|
||||
/* Inner loop to mark next symbol in this bucket, if any. */
|
||||
po = ptr = ptr->u.s.next;
|
||||
|
|
@ -7099,7 +6675,7 @@ survives_gc_p (Lisp_Object obj)
|
|||
emacs_abort ();
|
||||
}
|
||||
|
||||
return survives_p || PURE_P (XPNTR (obj));
|
||||
return survives_p;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -7700,7 +7276,7 @@ init_alloc_once (void)
|
|||
{
|
||||
gc_cons_threshold = GC_DEFAULT_THRESHOLD;
|
||||
/* Even though Qt's contents are not set up, its address is known. */
|
||||
Vpurify_flag = Qt;
|
||||
Vpurify_flag = Qt; /* FIXME: Redundant with setting in lread.c. */
|
||||
|
||||
PDUMPER_REMEMBER_SCALAR (buffer_defaults.header);
|
||||
PDUMPER_REMEMBER_SCALAR (buffer_local_symbols.header);
|
||||
|
|
@ -7719,8 +7295,6 @@ init_alloc_once (void)
|
|||
static void
|
||||
init_alloc_once_for_pdumper (void)
|
||||
{
|
||||
purebeg = PUREBEG;
|
||||
pure_size = PURESIZE;
|
||||
mem_init ();
|
||||
|
||||
#ifdef DOUG_LEA_MALLOC
|
||||
|
|
@ -7764,7 +7338,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. */);
|
||||
|
|
@ -7790,9 +7364,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 may still apply, but objects are not allocated in purespace
|
||||
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. */);
|
||||
|
|
@ -7808,10 +7386,10 @@ do hash-consing of the objects allocated to pure space. */);
|
|||
/* We build this in advance because if we wait until we need it, we might
|
||||
not be able to allocate the memory to hold it. */
|
||||
Vmemory_signal_data
|
||||
= pure_list (Qerror,
|
||||
build_pure_c_string ("Memory exhausted--use"
|
||||
" M-x save-some-buffers then"
|
||||
" exit and restart Emacs"));
|
||||
= list (Qerror,
|
||||
build_string ("Memory exhausted--use"
|
||||
" M-x save-some-buffers then"
|
||||
" exit and restart Emacs"));
|
||||
|
||||
DEFVAR_LISP ("memory-full", Vmemory_full,
|
||||
doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
|
||||
|
|
|
|||
16
src/buffer.c
16
src/buffer.c
|
|
@ -5308,8 +5308,8 @@ init_buffer_once (void)
|
|||
set_buffer_intervals (&buffer_defaults, NULL);
|
||||
set_buffer_intervals (&buffer_local_symbols, NULL);
|
||||
/* This is not strictly necessary, but let's make them initialized. */
|
||||
bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*"));
|
||||
bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*"));
|
||||
bset_name (&buffer_defaults, build_string (" *buffer-defaults*"));
|
||||
bset_name (&buffer_local_symbols, build_string (" *buffer-local-symbols*"));
|
||||
BUFFER_PVEC_INIT (&buffer_defaults);
|
||||
BUFFER_PVEC_INIT (&buffer_local_symbols);
|
||||
|
||||
|
|
@ -5317,7 +5317,7 @@ init_buffer_once (void)
|
|||
/* Must do these before making the first buffer! */
|
||||
|
||||
/* real setup is done in bindings.el */
|
||||
bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-"));
|
||||
bset_mode_line_format (&buffer_defaults, build_string ("%-"));
|
||||
bset_header_line_format (&buffer_defaults, Qnil);
|
||||
bset_tab_line_format (&buffer_defaults, Qnil);
|
||||
bset_abbrev_mode (&buffer_defaults, Qnil);
|
||||
|
|
@ -5384,7 +5384,7 @@ init_buffer_once (void)
|
|||
current_buffer = 0;
|
||||
pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike);
|
||||
|
||||
QSFundamental = build_pure_c_string ("Fundamental");
|
||||
QSFundamental = build_string ("Fundamental");
|
||||
|
||||
DEFSYM (Qfundamental_mode, "fundamental-mode");
|
||||
bset_major_mode (&buffer_defaults, Qfundamental_mode);
|
||||
|
|
@ -5398,10 +5398,10 @@ init_buffer_once (void)
|
|||
|
||||
/* Super-magic invisible buffer. */
|
||||
Vprin1_to_string_buffer =
|
||||
Fget_buffer_create (build_pure_c_string (" prin1"), Qt);
|
||||
Fget_buffer_create (build_string (" prin1"), Qt);
|
||||
Vbuffer_alist = Qnil;
|
||||
|
||||
Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil));
|
||||
Fset_buffer (Fget_buffer_create (build_string ("*scratch*"), Qnil));
|
||||
|
||||
inhibit_modification_hooks = 0;
|
||||
}
|
||||
|
|
@ -5584,9 +5584,9 @@ syms_of_buffer (void)
|
|||
Qoverwrite_mode_binary));
|
||||
|
||||
Fput (Qprotected_field, Qerror_conditions,
|
||||
pure_list (Qprotected_field, Qerror));
|
||||
list (Qprotected_field, Qerror));
|
||||
Fput (Qprotected_field, Qerror_message,
|
||||
build_pure_c_string ("Attempt to modify a protected field"));
|
||||
build_string ("Attempt to modify a protected field"));
|
||||
|
||||
DEFSYM (Qclone_indirect_buffer_hook, "clone-indirect-buffer-hook");
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
/* Work around GCC bug 54561. */
|
||||
#if GNUC_PREREQ (4, 3, 0)
|
||||
|
|
@ -1582,7 +1581,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
|
|||
Lisp_Object newval = POP;
|
||||
Lisp_Object cell = TOP;
|
||||
CHECK_CONS (cell);
|
||||
CHECK_IMPURE (cell, XCONS (cell));
|
||||
XSETCAR (cell, newval);
|
||||
TOP = newval;
|
||||
NEXT;
|
||||
|
|
@ -1593,7 +1591,6 @@ exec_byte_code (Lisp_Object fun, ptrdiff_t args_template,
|
|||
Lisp_Object newval = POP;
|
||||
Lisp_Object cell = TOP;
|
||||
CHECK_CONS (cell);
|
||||
CHECK_IMPURE (cell, XCONS (cell));
|
||||
XSETCDR (cell, newval);
|
||||
TOP = newval;
|
||||
NEXT;
|
||||
|
|
|
|||
|
|
@ -862,10 +862,10 @@ syms_of_callint (void)
|
|||
callint_message = Qnil;
|
||||
staticpro (&callint_message);
|
||||
|
||||
preserved_fns = pure_list (intern_c_string ("region-beginning"),
|
||||
intern_c_string ("region-end"),
|
||||
intern_c_string ("point"),
|
||||
intern_c_string ("mark"));
|
||||
preserved_fns = list (intern_c_string ("region-beginning"),
|
||||
intern_c_string ("region-end"),
|
||||
intern_c_string ("point"),
|
||||
intern_c_string ("mark"));
|
||||
staticpro (&preserved_fns);
|
||||
|
||||
DEFSYM (Qlist, "list");
|
||||
|
|
|
|||
|
|
@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set)
|
|||
(table, 1,
|
||||
make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
|
||||
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false));
|
||||
Qnil));
|
||||
struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]);
|
||||
Lisp_Object hash;
|
||||
ptrdiff_t i = hash_lookup (h, category_set, &hash);
|
||||
|
|
@ -120,8 +120,6 @@ the current buffer's category table. */)
|
|||
|
||||
if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category))))
|
||||
error ("Category `%c' is already defined", (int) XFIXNAT (category));
|
||||
if (!NILP (Vpurify_flag))
|
||||
docstring = Fpurecopy (docstring);
|
||||
SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring);
|
||||
|
||||
return Qnil;
|
||||
|
|
|
|||
18
src/coding.c
18
src/coding.c
|
|
@ -11682,7 +11682,7 @@ syms_of_coding (void)
|
|||
Vcode_conversion_reused_workbuf = Qnil;
|
||||
|
||||
staticpro (&Vcode_conversion_workbuf_name);
|
||||
Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*");
|
||||
Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*");
|
||||
|
||||
reused_workbuf_in_use = false;
|
||||
PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use);
|
||||
|
|
@ -11746,9 +11746,9 @@ syms_of_coding (void)
|
|||
/* Error signaled when there's a problem with detecting a coding system. */
|
||||
DEFSYM (Qcoding_system_error, "coding-system-error");
|
||||
Fput (Qcoding_system_error, Qerror_conditions,
|
||||
pure_list (Qcoding_system_error, Qerror));
|
||||
list (Qcoding_system_error, Qerror));
|
||||
Fput (Qcoding_system_error, Qerror_message,
|
||||
build_pure_c_string ("Invalid coding system"));
|
||||
build_string ("Invalid coding system"));
|
||||
|
||||
DEFSYM (Qtranslation_table, "translation-table");
|
||||
Fput (Qtranslation_table, Qchar_table_extra_slots, make_fixnum (2));
|
||||
|
|
@ -12023,22 +12023,22 @@ encoding standard output and error streams. */);
|
|||
DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix,
|
||||
doc: /*
|
||||
String displayed in mode line for UNIX-like (LF) end-of-line format. */);
|
||||
eol_mnemonic_unix = build_pure_c_string (":");
|
||||
eol_mnemonic_unix = build_string (":");
|
||||
|
||||
DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos,
|
||||
doc: /*
|
||||
String displayed in mode line for DOS-like (CRLF) end-of-line format. */);
|
||||
eol_mnemonic_dos = build_pure_c_string ("\\");
|
||||
eol_mnemonic_dos = build_string ("\\");
|
||||
|
||||
DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac,
|
||||
doc: /*
|
||||
String displayed in mode line for MAC-like (CR) end-of-line format. */);
|
||||
eol_mnemonic_mac = build_pure_c_string ("/");
|
||||
eol_mnemonic_mac = build_string ("/");
|
||||
|
||||
DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided,
|
||||
doc: /*
|
||||
String displayed in mode line when end-of-line format is not yet determined. */);
|
||||
eol_mnemonic_undecided = build_pure_c_string (":");
|
||||
eol_mnemonic_undecided = build_string (":");
|
||||
|
||||
DEFVAR_LISP ("enable-character-translation", Venable_character_translation,
|
||||
doc: /*
|
||||
|
|
@ -12178,7 +12178,7 @@ internal character representation. */);
|
|||
intern_c_string (":for-unibyte"),
|
||||
args[coding_arg_for_unibyte] = Qt,
|
||||
intern_c_string (":docstring"),
|
||||
(build_pure_c_string
|
||||
(build_string
|
||||
("Do no conversion.\n"
|
||||
"\n"
|
||||
"When you visit a file with this coding, the file is read into a\n"
|
||||
|
|
@ -12198,7 +12198,7 @@ internal character representation. */);
|
|||
plist[8] = intern_c_string (":charset-list");
|
||||
plist[9] = args[coding_arg_charset_list] = list1 (Qascii);
|
||||
plist[11] = args[coding_arg_for_unibyte] = Qnil;
|
||||
plist[13] = build_pure_c_string ("No conversion on encoding, "
|
||||
plist[13] = build_string ("No conversion on encoding, "
|
||||
"automatic conversion on decoding.");
|
||||
plist[15] = args[coding_arg_eol_type] = Qnil;
|
||||
args[coding_arg_plist] = CALLMANY (Flist, plist);
|
||||
|
|
|
|||
72
src/comp.c
72
src/comp.c
|
|
@ -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"
|
||||
|
|
@ -676,7 +675,6 @@ helper_GET_SYMBOL_WITH_POSITION (Lisp_Object);
|
|||
static void *helper_link_table[] =
|
||||
{ wrong_type_argument,
|
||||
helper_PSEUDOVECTOR_TYPEP_XUNTAG,
|
||||
pure_write_error,
|
||||
push_handler,
|
||||
record_unwind_protect_excursion,
|
||||
helper_unbind_n,
|
||||
|
|
@ -3945,52 +3943,6 @@ static void define_SYMBOL_WITH_POS_SYM (void)
|
|||
comp.lisp_symbol_with_position_sym));
|
||||
}
|
||||
|
||||
static void
|
||||
define_CHECK_IMPURE (void)
|
||||
{
|
||||
gcc_jit_param *param[] =
|
||||
{ gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
comp.lisp_obj_type,
|
||||
"obj"),
|
||||
gcc_jit_context_new_param (comp.ctxt,
|
||||
NULL,
|
||||
comp.void_ptr_type,
|
||||
"ptr") };
|
||||
comp.check_impure =
|
||||
gcc_jit_context_new_function (comp.ctxt, NULL,
|
||||
GCC_JIT_FUNCTION_INTERNAL,
|
||||
comp.void_type,
|
||||
"CHECK_IMPURE",
|
||||
2,
|
||||
param,
|
||||
0);
|
||||
|
||||
DECL_BLOCK (entry_block, comp.check_impure);
|
||||
DECL_BLOCK (err_block, comp.check_impure);
|
||||
DECL_BLOCK (ok_block, comp.check_impure);
|
||||
|
||||
comp.block = entry_block;
|
||||
comp.func = comp.check_impure;
|
||||
|
||||
emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */
|
||||
err_block,
|
||||
ok_block);
|
||||
gcc_jit_block_end_with_void_return (ok_block, NULL);
|
||||
|
||||
gcc_jit_rvalue *pure_write_error_arg =
|
||||
gcc_jit_param_as_rvalue (param[0]);
|
||||
|
||||
comp.block = err_block;
|
||||
gcc_jit_block_add_eval (comp.block,
|
||||
NULL,
|
||||
emit_call (intern_c_string ("pure_write_error"),
|
||||
comp.void_type, 1,&pure_write_error_arg,
|
||||
false));
|
||||
|
||||
gcc_jit_block_end_with_void_return (err_block, NULL);
|
||||
}
|
||||
|
||||
static void
|
||||
define_maybe_gc_or_quit (void)
|
||||
{
|
||||
|
|
@ -5114,10 +5066,10 @@ maybe_defer_native_compilation (Lisp_Object function_name,
|
|||
|
||||
Lisp_Object src =
|
||||
concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name),
|
||||
build_pure_c_string (".el"));
|
||||
build_string (".el"));
|
||||
if (NILP (Ffile_exists_p (src)))
|
||||
{
|
||||
src = concat2 (src, build_pure_c_string (".gz"));
|
||||
src = concat2 (src, build_string (".gz"));
|
||||
if (NILP (Ffile_exists_p (src)))
|
||||
return;
|
||||
}
|
||||
|
|
@ -5317,10 +5269,6 @@ load_comp_unit (struct Lisp_Native_Comp_Unit *comp_u, bool loading_dump,
|
|||
comp_u->data_vec = load_static_obj (comp_u, TEXT_DATA_RELOC_SYM);
|
||||
comp_u->data_impure_vec =
|
||||
load_static_obj (comp_u, TEXT_DATA_RELOC_IMPURE_SYM);
|
||||
|
||||
if (!NILP (Vpurify_flag))
|
||||
/* Non impure can be copied into pure space. */
|
||||
comp_u->data_vec = Fpurecopy (comp_u->data_vec);
|
||||
}
|
||||
|
||||
EMACS_INT d_vec_len = XFIXNUM (Flength (comp_u->data_vec));
|
||||
|
|
@ -5690,40 +5638,40 @@ compiled one. */);
|
|||
Fput (Qnative_compiler_error, Qerror_conditions,
|
||||
pure_list (Qnative_compiler_error, Qerror));
|
||||
Fput (Qnative_compiler_error, Qerror_message,
|
||||
build_pure_c_string ("Native compiler error"));
|
||||
build_string ("Native compiler error"));
|
||||
|
||||
DEFSYM (Qnative_ice, "native-ice");
|
||||
Fput (Qnative_ice, Qerror_conditions,
|
||||
pure_list (Qnative_ice, Qnative_compiler_error, Qerror));
|
||||
Fput (Qnative_ice, Qerror_message,
|
||||
build_pure_c_string ("Internal native compiler error"));
|
||||
build_string ("Internal native compiler error"));
|
||||
|
||||
/* By the load machinery. */
|
||||
DEFSYM (Qnative_lisp_load_failed, "native-lisp-load-failed");
|
||||
Fput (Qnative_lisp_load_failed, Qerror_conditions,
|
||||
pure_list (Qnative_lisp_load_failed, Qerror));
|
||||
Fput (Qnative_lisp_load_failed, Qerror_message,
|
||||
build_pure_c_string ("Native elisp load failed"));
|
||||
build_string ("Native elisp load failed"));
|
||||
|
||||
DEFSYM (Qnative_lisp_wrong_reloc, "native-lisp-wrong-reloc");
|
||||
Fput (Qnative_lisp_wrong_reloc, Qerror_conditions,
|
||||
pure_list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror));
|
||||
Fput (Qnative_lisp_wrong_reloc, Qerror_message,
|
||||
build_pure_c_string ("Primitive redefined or wrong relocation"));
|
||||
build_string ("Primitive redefined or wrong relocation"));
|
||||
|
||||
DEFSYM (Qwrong_register_subr_call, "wrong-register-subr-call");
|
||||
Fput (Qwrong_register_subr_call, Qerror_conditions,
|
||||
pure_list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror));
|
||||
Fput (Qwrong_register_subr_call, Qerror_message,
|
||||
build_pure_c_string ("comp--register-subr can only be called during "
|
||||
"native lisp load phase."));
|
||||
build_string ("comp--register-subr can only be called during "
|
||||
"native lisp load phase."));
|
||||
|
||||
DEFSYM (Qnative_lisp_file_inconsistent, "native-lisp-file-inconsistent");
|
||||
Fput (Qnative_lisp_file_inconsistent, Qerror_conditions,
|
||||
pure_list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror));
|
||||
Fput (Qnative_lisp_file_inconsistent, Qerror_message,
|
||||
build_pure_c_string ("eln file inconsistent with current runtime "
|
||||
"configuration, please recompile"));
|
||||
build_string ("eln file inconsistent with current runtime "
|
||||
"configuration, please recompile"));
|
||||
|
||||
defsubr (&Scomp__subr_signature);
|
||||
defsubr (&Scomp_el_to_eln_rel_filename);
|
||||
|
|
|
|||
|
|
@ -210,41 +210,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, ...);
|
||||
|
|
|
|||
37
src/data.c
37
src/data.c
|
|
@ -30,7 +30,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"
|
||||
|
|
@ -143,12 +142,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)
|
||||
{
|
||||
|
|
@ -645,7 +638,6 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
|
|||
(register Lisp_Object cell, Lisp_Object newcar)
|
||||
{
|
||||
CHECK_CONS (cell);
|
||||
CHECK_IMPURE (cell, XCONS (cell));
|
||||
XSETCAR (cell, newcar);
|
||||
return newcar;
|
||||
}
|
||||
|
|
@ -655,7 +647,6 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
|
|||
(register Lisp_Object cell, Lisp_Object newcdr)
|
||||
{
|
||||
CHECK_CONS (cell);
|
||||
CHECK_IMPURE (cell, XCONS (cell));
|
||||
XSETCDR (cell, newcdr);
|
||||
return newcdr;
|
||||
}
|
||||
|
|
@ -943,10 +934,6 @@ The return value is undefined. */)
|
|||
(register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring)
|
||||
{
|
||||
CHECK_SYMBOL (symbol);
|
||||
if (!NILP (Vpurify_flag)
|
||||
/* If `definition' is a keymap, immutable (and copying) is wrong. */
|
||||
&& !KEYMAPP (definition))
|
||||
definition = Fpurecopy (definition);
|
||||
|
||||
defalias (symbol, definition);
|
||||
|
||||
|
|
@ -2590,7 +2577,6 @@ bool-vector. IDX starts at 0. */)
|
|||
|
||||
if (VECTORP (array))
|
||||
{
|
||||
CHECK_IMPURE (array, XVECTOR (array));
|
||||
if (idxval < 0 || idxval >= ASIZE (array))
|
||||
args_out_of_range (array, idx);
|
||||
ASET (array, idxval, newelt);
|
||||
|
|
@ -2614,7 +2600,6 @@ bool-vector. IDX starts at 0. */)
|
|||
}
|
||||
else /* STRINGP */
|
||||
{
|
||||
CHECK_IMPURE (array, XSTRING (array));
|
||||
if (idxval < 0 || idxval >= SCHARS (array))
|
||||
args_out_of_range (array, idx);
|
||||
CHECK_CHARACTER (newelt);
|
||||
|
|
@ -4143,7 +4128,7 @@ syms_of_data (void)
|
|||
|
||||
DEFSYM (Qcdr, "cdr");
|
||||
|
||||
error_tail = pure_cons (Qerror, Qnil);
|
||||
error_tail = Fcons (Qerror, Qnil);
|
||||
|
||||
/* ERROR is used as a signaler for random errors for which nothing else is
|
||||
right. */
|
||||
|
|
@ -4151,14 +4136,14 @@ syms_of_data (void)
|
|||
Fput (Qerror, Qerror_conditions,
|
||||
error_tail);
|
||||
Fput (Qerror, Qerror_message,
|
||||
build_pure_c_string ("error"));
|
||||
build_string ("error"));
|
||||
|
||||
#define PUT_ERROR(sym, tail, msg) \
|
||||
Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \
|
||||
Fput (sym, Qerror_message, build_pure_c_string (msg))
|
||||
Fput (sym, Qerror_conditions, Fcons (sym, tail)); \
|
||||
Fput (sym, Qerror_message, build_string (msg))
|
||||
|
||||
PUT_ERROR (Qquit, Qnil, "Quit");
|
||||
PUT_ERROR (Qminibuffer_quit, pure_cons (Qquit, Qnil), "Quit");
|
||||
PUT_ERROR (Qminibuffer_quit, Fcons (Qquit, Qnil), "Quit");
|
||||
|
||||
PUT_ERROR (Quser_error, error_tail, "");
|
||||
PUT_ERROR (Qwrong_length_argument, error_tail, "Wrong length argument");
|
||||
|
|
@ -4184,14 +4169,14 @@ syms_of_data (void)
|
|||
PUT_ERROR (Qno_catch, error_tail, "No catch for tag");
|
||||
PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing");
|
||||
|
||||
arith_tail = pure_cons (Qarith_error, error_tail);
|
||||
arith_tail = Fcons (Qarith_error, error_tail);
|
||||
Fput (Qarith_error, Qerror_conditions, arith_tail);
|
||||
Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error"));
|
||||
Fput (Qarith_error, Qerror_message, build_string ("Arithmetic error"));
|
||||
|
||||
PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer");
|
||||
PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer");
|
||||
PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only");
|
||||
PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail),
|
||||
PUT_ERROR (Qtext_read_only, Fcons (Qbuffer_read_only, error_tail),
|
||||
"Text is read-only");
|
||||
PUT_ERROR (Qinhibited_interaction, error_tail,
|
||||
"User interaction while inhibited");
|
||||
|
|
@ -4214,10 +4199,10 @@ syms_of_data (void)
|
|||
PUT_ERROR (Qunderflow_error, Fcons (Qrange_error, arith_tail),
|
||||
"Arithmetic underflow error");
|
||||
|
||||
recursion_tail = pure_cons (Qrecursion_error, error_tail);
|
||||
recursion_tail = Fcons (Qrecursion_error, error_tail);
|
||||
Fput (Qrecursion_error, Qerror_conditions, recursion_tail);
|
||||
Fput (Qrecursion_error, Qerror_message, build_pure_c_string
|
||||
("Excessive recursive calling error"));
|
||||
Fput (Qrecursion_error, Qerror_message,
|
||||
build_string ("Excessive recursive calling error"));
|
||||
|
||||
PUT_ERROR (Qexcessive_variable_binding, recursion_tail,
|
||||
"Variable binding depth exceeds max-specpdl-size");
|
||||
|
|
|
|||
|
|
@ -1869,7 +1869,7 @@ syms_of_dbusbind (void)
|
|||
Fput (Qdbus_error, Qerror_conditions,
|
||||
list2 (Qdbus_error, Qerror));
|
||||
Fput (Qdbus_error, Qerror_message,
|
||||
build_pure_c_string ("D-Bus error"));
|
||||
build_string ("D-Bus error"));
|
||||
|
||||
/* Lisp symbols of the system and session buses. */
|
||||
DEFSYM (QCsystem, ":system");
|
||||
|
|
@ -1912,7 +1912,7 @@ syms_of_dbusbind (void)
|
|||
Vdbus_compiled_version,
|
||||
doc: /* The version of D-Bus Emacs is compiled against. */);
|
||||
#ifdef DBUS_VERSION_STRING
|
||||
Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING);
|
||||
Vdbus_compiled_version = build_string (DBUS_VERSION_STRING);
|
||||
#else
|
||||
Vdbus_compiled_version = Qnil;
|
||||
#endif
|
||||
|
|
|
|||
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)
|
||||
|
|
|
|||
|
|
@ -450,8 +450,6 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset)
|
|||
{
|
||||
tem = Fcdr (Fcdr (fun));
|
||||
if (CONSP (tem) && FIXNUMP (XCAR (tem)))
|
||||
/* FIXME: This modifies typically pure hash-cons'd data, so its
|
||||
correctness is quite delicate. */
|
||||
XSETCAR (tem, make_fixnum (offset));
|
||||
}
|
||||
}
|
||||
|
|
@ -541,7 +539,6 @@ the same file name is found in the `doc-directory'. */)
|
|||
int i = ARRAYELTS (buildobj);
|
||||
while (0 <= --i)
|
||||
Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files);
|
||||
Vbuild_files = Fpurecopy (Vbuild_files);
|
||||
}
|
||||
|
||||
fd = emacs_open (name, O_RDONLY, 0);
|
||||
|
|
|
|||
|
|
@ -1598,44 +1598,44 @@ syms_of_module (void)
|
|||
Vmodule_refs_hash
|
||||
= make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
|
||||
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
Qnil);
|
||||
|
||||
DEFSYM (Qmodule_load_failed, "module-load-failed");
|
||||
Fput (Qmodule_load_failed, Qerror_conditions,
|
||||
pure_list (Qmodule_load_failed, Qerror));
|
||||
list (Qmodule_load_failed, Qerror));
|
||||
Fput (Qmodule_load_failed, Qerror_message,
|
||||
build_pure_c_string ("Module load failed"));
|
||||
build_string ("Module load failed"));
|
||||
|
||||
DEFSYM (Qmodule_open_failed, "module-open-failed");
|
||||
Fput (Qmodule_open_failed, Qerror_conditions,
|
||||
pure_list (Qmodule_open_failed, Qmodule_load_failed, Qerror));
|
||||
list (Qmodule_open_failed, Qmodule_load_failed, Qerror));
|
||||
Fput (Qmodule_open_failed, Qerror_message,
|
||||
build_pure_c_string ("Module could not be opened"));
|
||||
build_string ("Module could not be opened"));
|
||||
|
||||
DEFSYM (Qmodule_not_gpl_compatible, "module-not-gpl-compatible");
|
||||
Fput (Qmodule_not_gpl_compatible, Qerror_conditions,
|
||||
pure_list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror));
|
||||
list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror));
|
||||
Fput (Qmodule_not_gpl_compatible, Qerror_message,
|
||||
build_pure_c_string ("Module is not GPL compatible"));
|
||||
build_string ("Module is not GPL compatible"));
|
||||
|
||||
DEFSYM (Qmissing_module_init_function, "missing-module-init-function");
|
||||
Fput (Qmissing_module_init_function, Qerror_conditions,
|
||||
pure_list (Qmissing_module_init_function, Qmodule_load_failed,
|
||||
Qerror));
|
||||
list (Qmissing_module_init_function, Qmodule_load_failed,
|
||||
Qerror));
|
||||
Fput (Qmissing_module_init_function, Qerror_message,
|
||||
build_pure_c_string ("Module does not export an "
|
||||
build_string ("Module does not export an "
|
||||
"initialization function"));
|
||||
|
||||
DEFSYM (Qmodule_init_failed, "module-init-failed");
|
||||
Fput (Qmodule_init_failed, Qerror_conditions,
|
||||
pure_list (Qmodule_init_failed, Qmodule_load_failed, Qerror));
|
||||
list (Qmodule_init_failed, Qmodule_load_failed, Qerror));
|
||||
Fput (Qmodule_init_failed, Qerror_message,
|
||||
build_pure_c_string ("Module initialization failed"));
|
||||
build_string ("Module initialization failed"));
|
||||
|
||||
DEFSYM (Qinvalid_arity, "invalid-arity");
|
||||
Fput (Qinvalid_arity, Qerror_conditions, pure_list (Qinvalid_arity, Qerror));
|
||||
Fput (Qinvalid_arity, Qerror_conditions, list (Qinvalid_arity, Qerror));
|
||||
Fput (Qinvalid_arity, Qerror_message,
|
||||
build_pure_c_string ("Invalid function arity"));
|
||||
build_string ("Invalid function arity"));
|
||||
|
||||
DEFSYM (Qmodule_function_p, "module-function-p");
|
||||
DEFSYM (Qunicode_string_p, "unicode-string-p");
|
||||
|
|
|
|||
|
|
@ -104,7 +104,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"
|
||||
|
|
@ -3029,8 +3028,6 @@ You must run Emacs in batch mode in order to dump it. */)
|
|||
Lisp_Object symbol;
|
||||
specpdl_ref count = SPECPDL_INDEX ();
|
||||
|
||||
check_pure_size ();
|
||||
|
||||
if (! noninteractive)
|
||||
error ("Dumping Emacs works only in batch mode");
|
||||
|
||||
|
|
|
|||
12
src/eval.c
12
src/eval.c
|
|
@ -748,8 +748,6 @@ value. */)
|
|||
XSYMBOL (symbol)->u.s.declared_special = true;
|
||||
if (!NILP (doc))
|
||||
{
|
||||
if (!NILP (Vpurify_flag))
|
||||
doc = Fpurecopy (doc);
|
||||
Fput (symbol, Qvariable_documentation, doc);
|
||||
}
|
||||
LOADHIST_ATTACH (symbol);
|
||||
|
|
@ -892,8 +890,6 @@ More specifically, behaves like (defconst SYM 'INITVALUE DOCSTRING). */)
|
|||
CHECK_SYMBOL (sym);
|
||||
Lisp_Object tem = initvalue;
|
||||
Finternal__define_uninitialized_variable (sym, docstring);
|
||||
if (!NILP (Vpurify_flag))
|
||||
tem = Fpurecopy (tem);
|
||||
Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */
|
||||
Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why? */
|
||||
return sym;
|
||||
|
|
@ -2195,12 +2191,6 @@ this does nothing and returns nil. */)
|
|||
&& !AUTOLOADP (XSYMBOL (function)->u.s.function))
|
||||
return Qnil;
|
||||
|
||||
if (!NILP (Vpurify_flag) && BASE_EQ (docstring, make_fixnum (0)))
|
||||
/* `read1' in lread.c has found the docstring starting with "\
|
||||
and assumed the docstring will be provided by Snarf-documentation, so it
|
||||
passed us 0 instead. But that leads to accidental sharing in purecopy's
|
||||
hash-consing, so we use a (hopefully) unique integer instead. */
|
||||
docstring = make_ufixnum (XHASH (function));
|
||||
return Fdefalias (function,
|
||||
list5 (Qautoload, file, docstring, interactive, type),
|
||||
Qnil);
|
||||
|
|
@ -4360,7 +4350,7 @@ alist of active lexical bindings. */);
|
|||
also use something like Fcons (Qnil, Qnil), but json.c treats any
|
||||
cons cell as error data, so use an uninterned symbol instead. */
|
||||
Qcatch_all_memory_full
|
||||
= Fmake_symbol (build_pure_c_string ("catch-all-memory-full"));
|
||||
= Fmake_symbol (build_string ("catch-all-memory-full"));
|
||||
|
||||
defsubr (&Sor);
|
||||
defsubr (&Sand);
|
||||
|
|
|
|||
28
src/fileio.c
28
src/fileio.c
|
|
@ -6462,39 +6462,39 @@ behaves as if file names were encoded in `utf-8'. */);
|
|||
DEFSYM (Qcar_less_than_car, "car-less-than-car");
|
||||
|
||||
Fput (Qfile_error, Qerror_conditions,
|
||||
Fpurecopy (list2 (Qfile_error, Qerror)));
|
||||
list2 (Qfile_error, Qerror));
|
||||
Fput (Qfile_error, Qerror_message,
|
||||
build_pure_c_string ("File error"));
|
||||
build_string ("File error"));
|
||||
|
||||
Fput (Qfile_already_exists, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror)));
|
||||
list3 (Qfile_already_exists, Qfile_error, Qerror));
|
||||
Fput (Qfile_already_exists, Qerror_message,
|
||||
build_pure_c_string ("File already exists"));
|
||||
build_string ("File already exists"));
|
||||
|
||||
Fput (Qfile_date_error, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror)));
|
||||
list3 (Qfile_date_error, Qfile_error, Qerror));
|
||||
Fput (Qfile_date_error, Qerror_message,
|
||||
build_pure_c_string ("Cannot set file date"));
|
||||
build_string ("Cannot set file date"));
|
||||
|
||||
Fput (Qfile_missing, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror)));
|
||||
list3 (Qfile_missing, Qfile_error, Qerror));
|
||||
Fput (Qfile_missing, Qerror_message,
|
||||
build_pure_c_string ("File is missing"));
|
||||
build_string ("File is missing"));
|
||||
|
||||
Fput (Qpermission_denied, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qpermission_denied, Qfile_error, Qerror)));
|
||||
list3 (Qpermission_denied, Qfile_error, Qerror));
|
||||
Fput (Qpermission_denied, Qerror_message,
|
||||
build_pure_c_string ("Cannot access file or directory"));
|
||||
build_string ("Cannot access file or directory"));
|
||||
|
||||
Fput (Qfile_notify_error, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror)));
|
||||
list3 (Qfile_notify_error, Qfile_error, Qerror));
|
||||
Fput (Qfile_notify_error, Qerror_message,
|
||||
build_pure_c_string ("File notification error"));
|
||||
build_string ("File notification error"));
|
||||
|
||||
Fput (Qremote_file_error, Qerror_conditions,
|
||||
Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror)));
|
||||
list3 (Qremote_file_error, Qfile_error, Qerror));
|
||||
Fput (Qremote_file_error, Qerror_message,
|
||||
build_pure_c_string ("Remote file error"));
|
||||
build_string ("Remote file error"));
|
||||
|
||||
DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist,
|
||||
doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially.
|
||||
|
|
|
|||
33
src/fns.c
33
src/fns.c
|
|
@ -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"
|
||||
|
||||
enum equal_kind { EQUAL_NO_QUIT, EQUAL_PLAIN, EQUAL_INCLUDING_PROPERTIES };
|
||||
|
|
@ -2653,7 +2652,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
|
|||
size = SCHARS (array);
|
||||
if (size != 0)
|
||||
{
|
||||
CHECK_IMPURE (array, XSTRING (array));
|
||||
unsigned char str[MAX_MULTIBYTE_LENGTH];
|
||||
int len;
|
||||
if (STRING_MULTIBYTE (array))
|
||||
|
|
@ -2695,7 +2693,6 @@ This makes STRING unibyte and may change its length. */)
|
|||
ptrdiff_t len = SBYTES (string);
|
||||
if (len != 0 || STRING_MULTIBYTE (string))
|
||||
{
|
||||
CHECK_IMPURE (string, XSTRING (string));
|
||||
memset (SDATA (string), 0, len);
|
||||
STRING_SET_CHARS (string, len);
|
||||
STRING_SET_UNIBYTE (string);
|
||||
|
|
@ -4263,16 +4260,12 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size)
|
|||
size exceeds REHASH_THRESHOLD.
|
||||
|
||||
WEAK specifies the weakness of the table. If non-nil, it must be
|
||||
one of the symbols `key', `value', `key-or-value', or `key-and-value'.
|
||||
|
||||
If PURECOPY is non-nil, the table can be copied to pure storage via
|
||||
`purecopy' when Emacs is being dumped. Such tables can no longer be
|
||||
changed after purecopy. */
|
||||
one of the symbols `key', `value', `key-or-value', or `key-and-value'. */
|
||||
|
||||
Lisp_Object
|
||||
make_hash_table (struct hash_table_test test, EMACS_INT size,
|
||||
float rehash_size, float rehash_threshold,
|
||||
Lisp_Object weak, bool purecopy)
|
||||
Lisp_Object weak)
|
||||
{
|
||||
struct Lisp_Hash_Table *h;
|
||||
Lisp_Object table;
|
||||
|
|
@ -4301,7 +4294,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size,
|
|||
h->next = make_vector (size, make_fixnum (-1));
|
||||
h->index = make_vector (hash_index_size (h, size), make_fixnum (-1));
|
||||
h->next_weak = NULL;
|
||||
h->purecopy = purecopy;
|
||||
h->mutable = true;
|
||||
|
||||
/* Set up the free list. */
|
||||
|
|
@ -4402,11 +4394,6 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
|
|||
set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket));
|
||||
set_hash_index_slot (h, start_of_bucket, i);
|
||||
}
|
||||
|
||||
#ifdef ENABLE_CHECKING
|
||||
if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h)
|
||||
message ("Growing hash table to: %"pD"d", next_size);
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -4470,7 +4457,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h)
|
|||
{
|
||||
if (!h->mutable)
|
||||
signal_error ("hash table test modifies table", obj);
|
||||
eassert (!PURE_P (h));
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -4998,16 +4984,10 @@ key, value, one of key or value, or both key and value, depending on
|
|||
WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK
|
||||
is nil.
|
||||
|
||||
:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied
|
||||
to pure storage when Emacs is being dumped, making the contents of the
|
||||
table read only. Any further changes to purified tables will result
|
||||
in an error.
|
||||
|
||||
usage: (make-hash-table &rest KEYWORD-ARGS) */)
|
||||
(ptrdiff_t nargs, Lisp_Object *args)
|
||||
{
|
||||
Lisp_Object test, weak;
|
||||
bool purecopy;
|
||||
struct hash_table_test testdesc;
|
||||
ptrdiff_t i;
|
||||
USE_SAFE_ALLOCA;
|
||||
|
|
@ -5041,9 +5021,9 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
|
|||
testdesc.cmpfn = cmpfn_user_defined;
|
||||
}
|
||||
|
||||
/* See if there's a `:purecopy PURECOPY' argument. */
|
||||
i = get_key_arg (QCpurecopy, nargs, args, used);
|
||||
purecopy = i && !NILP (args[i]);
|
||||
/* Ignore a `:purecopy PURECOPY' argument. We used to accept those, but
|
||||
they were only meaningful when we had the purespace. */
|
||||
get_key_arg (QCpurecopy, nargs, args, used);
|
||||
/* See if there's a `:size SIZE' argument. */
|
||||
i = get_key_arg (QCsize, nargs, args, used);
|
||||
Lisp_Object size_arg = i ? args[i] : Qnil;
|
||||
|
|
@ -5093,8 +5073,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */)
|
|||
signal_error ("Invalid argument list", args[i]);
|
||||
|
||||
SAFE_FREE ();
|
||||
return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak,
|
||||
purecopy);
|
||||
return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak);
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -2138,7 +2138,7 @@ syms_of_fontset (void)
|
|||
set_fontset_id (Vdefault_fontset, make_fixnum (0));
|
||||
set_fontset_name
|
||||
(Vdefault_fontset,
|
||||
build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
|
||||
build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default"));
|
||||
ASET (Vfontset_table, 0, Vdefault_fontset);
|
||||
next_fontset_id = 1;
|
||||
PDUMPER_REMEMBER_SCALAR (next_fontset_id);
|
||||
|
|
@ -2196,7 +2196,7 @@ alternate fontnames (if any) are tried instead. */);
|
|||
doc: /* Alist of fontset names vs the aliases. */);
|
||||
Vfontset_alias_alist
|
||||
= list1 (Fcons (FONTSET_NAME (Vdefault_fontset),
|
||||
build_pure_c_string ("fontset-default")));
|
||||
build_string ("fontset-default")));
|
||||
|
||||
DEFVAR_LISP ("vertical-centering-font-regexp",
|
||||
Vvertical_centering_font_regexp,
|
||||
|
|
|
|||
|
|
@ -1028,7 +1028,7 @@ make_frame (bool mini_p)
|
|||
|
||||
fset_face_hash_table
|
||||
(f, make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil, false));
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil));
|
||||
|
||||
if (mini_p)
|
||||
{
|
||||
|
|
@ -1192,7 +1192,7 @@ make_initial_frame (void)
|
|||
Vframe_list = Fcons (frame, Vframe_list);
|
||||
|
||||
tty_frame_count = 1;
|
||||
fset_name (f, build_pure_c_string ("F1"));
|
||||
fset_name (f, build_string ("F1"));
|
||||
|
||||
SET_FRAME_VISIBLE (f, 1);
|
||||
|
||||
|
|
|
|||
|
|
@ -5442,7 +5442,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int,
|
|||
*get_func = xpm_get_color_table_h;
|
||||
return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE,
|
||||
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
Qnil);
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -101,7 +100,6 @@ create_root_interval (Lisp_Object parent)
|
|||
}
|
||||
else
|
||||
{
|
||||
CHECK_IMPURE (parent, XSTRING (parent));
|
||||
new->total_length = SCHARS (parent);
|
||||
eassert (TOTAL_LENGTH (new) >= 0);
|
||||
set_string_intervals (parent, new);
|
||||
|
|
|
|||
|
|
@ -1102,8 +1102,8 @@ define_error (Lisp_Object name, const char *message, Lisp_Object parent)
|
|||
eassert (CONSP (parent_conditions));
|
||||
eassert (!NILP (Fmemq (parent, parent_conditions)));
|
||||
eassert (NILP (Fmemq (name, parent_conditions)));
|
||||
Fput (name, Qerror_conditions, pure_cons (name, parent_conditions));
|
||||
Fput (name, Qerror_message, build_pure_c_string (message));
|
||||
Fput (name, Qerror_conditions, Fcons (name, parent_conditions));
|
||||
Fput (name, Qerror_message, build_string (message));
|
||||
}
|
||||
|
||||
void
|
||||
|
|
|
|||
|
|
@ -12045,14 +12045,14 @@ syms_of_keyboard (void)
|
|||
pending_funcalls = Qnil;
|
||||
staticpro (&pending_funcalls);
|
||||
|
||||
Vlispy_mouse_stem = build_pure_c_string ("mouse");
|
||||
Vlispy_mouse_stem = build_string ("mouse");
|
||||
staticpro (&Vlispy_mouse_stem);
|
||||
|
||||
regular_top_level_message = build_pure_c_string ("Back to top level");
|
||||
regular_top_level_message = build_string ("Back to top level");
|
||||
staticpro (®ular_top_level_message);
|
||||
#ifdef HAVE_STACK_OVERFLOW_HANDLING
|
||||
recover_top_level_message
|
||||
= build_pure_c_string ("Re-entering top level after C stack overflow");
|
||||
= build_string ("Re-entering top level after C stack overflow");
|
||||
staticpro (&recover_top_level_message);
|
||||
#endif
|
||||
DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message,
|
||||
|
|
|
|||
35
src/keymap.c
35
src/keymap.c
|
|
@ -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"
|
||||
|
|
@ -121,8 +120,6 @@ in case you use it as a menu with `x-popup-menu'. */)
|
|||
{
|
||||
if (!NILP (string))
|
||||
{
|
||||
if (!NILP (Vpurify_flag))
|
||||
string = Fpurecopy (string);
|
||||
return list2 (Qkeymap, string);
|
||||
}
|
||||
return list1 (Qkeymap);
|
||||
|
|
@ -301,7 +298,6 @@ Return PARENT. PARENT should be nil or another keymap. */)
|
|||
If we came to the end, add the parent in PREV. */
|
||||
if (!CONSP (list) || KEYMAPP (list))
|
||||
{
|
||||
CHECK_IMPURE (prev, XCONS (prev));
|
||||
XSETCDR (prev, parent);
|
||||
return parent;
|
||||
}
|
||||
|
|
@ -744,7 +740,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
|
|||
|
||||
/* If we are preparing to dump, and DEF is a menu element
|
||||
with a menu item indicator, copy it to ensure it is not pure. */
|
||||
if (CONSP (def) && PURE_P (XCONS (def))
|
||||
if (CONSP (def)
|
||||
&& (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
|
||||
def = Fcons (XCAR (def), XCDR (def));
|
||||
|
||||
|
|
@ -788,7 +784,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
|
|||
{
|
||||
if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt))
|
||||
{
|
||||
CHECK_IMPURE (elt, XVECTOR (elt));
|
||||
ASET (elt, XFIXNAT (idx), def);
|
||||
return def;
|
||||
}
|
||||
|
|
@ -846,7 +841,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
|
|||
}
|
||||
else if (EQ (idx, XCAR (elt)))
|
||||
{
|
||||
CHECK_IMPURE (elt, XCONS (elt));
|
||||
if (remove)
|
||||
/* Remove the element. */
|
||||
insertion_point = Fdelq (elt, insertion_point);
|
||||
|
|
@ -900,7 +894,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx,
|
|||
}
|
||||
else
|
||||
elt = Fcons (idx, def);
|
||||
CHECK_IMPURE (insertion_point, XCONS (insertion_point));
|
||||
XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
|
||||
}
|
||||
}
|
||||
|
|
@ -3340,12 +3333,12 @@ syms_of_keymap (void)
|
|||
current_global_map = Qnil;
|
||||
staticpro (¤t_global_map);
|
||||
|
||||
exclude_keys = pure_list
|
||||
(pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
|
||||
pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
|
||||
pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
|
||||
pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
|
||||
pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
|
||||
exclude_keys = list
|
||||
(Fcons (build_string ("DEL"), build_string ("\\d")),
|
||||
Fcons (build_string ("TAB"), build_string ("\\t")),
|
||||
Fcons (build_string ("RET"), build_string ("\\r")),
|
||||
Fcons (build_string ("ESC"), build_string ("\\e")),
|
||||
Fcons (build_string ("SPC"), build_string (" ")));
|
||||
staticpro (&exclude_keys);
|
||||
|
||||
DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
|
||||
|
|
@ -3407,13 +3400,13 @@ that describe key bindings. That is why the default is nil. */);
|
|||
DEFSYM (Qmode_line, "mode-line");
|
||||
|
||||
staticpro (&Vmouse_events);
|
||||
Vmouse_events = pure_list (Qmenu_bar, Qtab_bar, Qtool_bar,
|
||||
Qtab_line, Qheader_line, Qmode_line,
|
||||
intern_c_string ("mouse-1"),
|
||||
intern_c_string ("mouse-2"),
|
||||
intern_c_string ("mouse-3"),
|
||||
intern_c_string ("mouse-4"),
|
||||
intern_c_string ("mouse-5"));
|
||||
Vmouse_events = list (Qmenu_bar, Qtab_bar, Qtool_bar, Qtab_line,
|
||||
Qheader_line, Qmode_line,
|
||||
intern_c_string ("mouse-1"),
|
||||
intern_c_string ("mouse-2"),
|
||||
intern_c_string ("mouse-3"),
|
||||
intern_c_string ("mouse-4"),
|
||||
intern_c_string ("mouse-5"));
|
||||
|
||||
/* Keymap used for minibuffers when doing completion. */
|
||||
/* Keymap used for minibuffers when doing completion and require a match. */
|
||||
|
|
|
|||
26
src/lisp.h
26
src/lisp.h
|
|
@ -859,9 +859,6 @@ struct Lisp_Symbol
|
|||
special (with `defvar' etc), and shouldn't be lexically bound. */
|
||||
bool_bf declared_special : 1;
|
||||
|
||||
/* True if pointed to from purespace and hence can't be GC'd. */
|
||||
bool_bf pinned : 1;
|
||||
|
||||
/* The symbol's name, as a Lisp string. */
|
||||
Lisp_Object name;
|
||||
|
||||
|
|
@ -2426,12 +2423,8 @@ struct Lisp_Hash_Table
|
|||
/* Index of first free entry in free list, or -1 if none. */
|
||||
ptrdiff_t next_free;
|
||||
|
||||
/* True if the table can be purecopied. The table cannot be
|
||||
changed afterwards. */
|
||||
bool purecopy;
|
||||
|
||||
/* True if the table is mutable. Ordinarily tables are mutable, but
|
||||
pure tables are not, and while a table is being mutated it is
|
||||
some tables are not, and while a table is being mutated it is
|
||||
immutable for recursive attempts to mutate it. */
|
||||
bool mutable;
|
||||
|
||||
|
|
@ -4010,7 +4003,7 @@ EMACS_UINT hash_string (char const *, ptrdiff_t);
|
|||
EMACS_UINT sxhash (Lisp_Object);
|
||||
Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *);
|
||||
Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float,
|
||||
Lisp_Object, bool);
|
||||
Lisp_Object);
|
||||
ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *);
|
||||
ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object,
|
||||
Lisp_Object);
|
||||
|
|
@ -4177,7 +4170,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t,
|
|||
|
||||
/* Defined in alloc.c. */
|
||||
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);
|
||||
|
|
@ -4236,11 +4228,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
|
||||
{
|
||||
|
|
@ -4313,18 +4302,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. */
|
||||
|
||||
|
|
@ -4334,7 +4313,6 @@ build_string (const char *str)
|
|||
return make_string (str, strlen (str));
|
||||
}
|
||||
|
||||
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
|
||||
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
|
||||
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t)
|
||||
ATTRIBUTE_RETURNS_NONNULL;
|
||||
|
|
|
|||
76
src/lread.c
76
src/lread.c
|
|
@ -1537,7 +1537,7 @@ Return t if the file exists and loads successfully. */)
|
|||
}
|
||||
|
||||
if (! NILP (Vpurify_flag))
|
||||
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
|
||||
Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
|
||||
|
||||
if (NILP (nomessage) || force_load_messages)
|
||||
{
|
||||
|
|
@ -2288,36 +2288,32 @@ readevalloop (Lisp_Object readcharfun,
|
|||
read_objects_map
|
||||
= make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
|
||||
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
Qnil);
|
||||
if (! HASH_TABLE_P (read_objects_completed)
|
||||
|| XHASH_TABLE (read_objects_completed)->count)
|
||||
read_objects_completed
|
||||
= make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
|
||||
DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
if (!NILP (Vpurify_flag) && c == '(')
|
||||
val = read0 (readcharfun, false);
|
||||
else
|
||||
Qnil);
|
||||
if (!NILP (readfun))
|
||||
{
|
||||
if (!NILP (readfun))
|
||||
{
|
||||
val = call1 (readfun, readcharfun);
|
||||
val = call1 (readfun, readcharfun);
|
||||
|
||||
/* If READCHARFUN has set point to ZV, we should
|
||||
/* If READCHARFUN has set point to ZV, we should
|
||||
stop reading, even if the form read sets point
|
||||
to a different value when evaluated. */
|
||||
if (BUFFERP (readcharfun))
|
||||
{
|
||||
struct buffer *buf = XBUFFER (readcharfun);
|
||||
if (BUF_PT (buf) == BUF_ZV (buf))
|
||||
continue_reading_p = 0;
|
||||
}
|
||||
if (BUFFERP (readcharfun))
|
||||
{
|
||||
struct buffer *buf = XBUFFER (readcharfun);
|
||||
if (BUF_PT (buf) == BUF_ZV (buf))
|
||||
continue_reading_p = 0;
|
||||
}
|
||||
else if (! NILP (Vload_read_function))
|
||||
val = call1 (Vload_read_function, readcharfun);
|
||||
else
|
||||
val = read_internal_start (readcharfun, Qnil, Qnil, false);
|
||||
}
|
||||
else if (! NILP (Vload_read_function))
|
||||
val = call1 (Vload_read_function, readcharfun);
|
||||
else
|
||||
val = read_internal_start (readcharfun, Qnil, Qnil, false);
|
||||
|
||||
/* Empty hashes can be reused; otherwise, reset on next call. */
|
||||
if (HASH_TABLE_P (read_objects_map)
|
||||
&& XHASH_TABLE (read_objects_map)->count > 0)
|
||||
|
|
@ -2539,12 +2535,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
|
|||
|| XHASH_TABLE (read_objects_map)->count)
|
||||
read_objects_map
|
||||
= make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil, false);
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil);
|
||||
if (! HASH_TABLE_P (read_objects_completed)
|
||||
|| XHASH_TABLE (read_objects_completed)->count)
|
||||
read_objects_completed
|
||||
= make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil, false);
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil);
|
||||
|
||||
if (STRINGP (stream)
|
||||
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
|
||||
|
|
@ -4150,10 +4146,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
|
|||
if (uninterned_symbol)
|
||||
{
|
||||
Lisp_Object name
|
||||
= (!NILP (Vpurify_flag)
|
||||
? make_pure_string (read_buffer, nchars, nbytes, multibyte)
|
||||
: make_specified_string (read_buffer, nchars, nbytes,
|
||||
multibyte));
|
||||
= make_specified_string (read_buffer, nchars, nbytes, multibyte);
|
||||
result = Fmake_symbol (name);
|
||||
}
|
||||
else
|
||||
|
|
@ -4645,16 +4638,8 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
|
|||
Lisp_Object tem = oblookup (obarray, str, len, len);
|
||||
|
||||
if (!SYMBOLP (tem))
|
||||
{
|
||||
Lisp_Object string;
|
||||
tem = intern_driver (make_string (str, len), obarray, tem);
|
||||
|
||||
if (NILP (Vpurify_flag))
|
||||
string = make_string (str, len);
|
||||
else
|
||||
string = make_pure_c_string (str, len);
|
||||
|
||||
tem = intern_driver (string, obarray, tem);
|
||||
}
|
||||
return tem;
|
||||
}
|
||||
|
||||
|
|
@ -4662,7 +4647,7 @@ static void
|
|||
define_symbol (Lisp_Object sym, char const *str)
|
||||
{
|
||||
ptrdiff_t len = strlen (str);
|
||||
Lisp_Object string = make_pure_c_string (str, len);
|
||||
Lisp_Object string = make_string (str, len);
|
||||
init_symbol (sym, string);
|
||||
|
||||
/* Qunbound is uninterned, so that it's not confused with any symbol
|
||||
|
|
@ -4706,8 +4691,7 @@ it defaults to the value of `obarray'. */)
|
|||
xfree (longhand);
|
||||
}
|
||||
else
|
||||
tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string),
|
||||
obarray, tem);
|
||||
tem = intern_driver (string, obarray, tem);
|
||||
}
|
||||
return tem;
|
||||
}
|
||||
|
|
@ -5002,7 +4986,7 @@ init_obarray_once (void)
|
|||
XSYMBOL (Qt)->u.s.declared_special = true;
|
||||
|
||||
/* Qt is correct even if not dumping. loadup.el will set to nil at end. */
|
||||
Vpurify_flag = Qt;
|
||||
Vpurify_flag = Qt; /* FIXME: Redundant with setting in alloc.c. */
|
||||
|
||||
DEFSYM (Qvariable_documentation, "variable-documentation");
|
||||
}
|
||||
|
|
@ -5019,7 +5003,7 @@ defsubr (union Aligned_Lisp_Subr *aname)
|
|||
set_symbol_function (sym, tem);
|
||||
#ifdef HAVE_NATIVE_COMP
|
||||
eassert (NILP (Vcomp_abi_hash));
|
||||
Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list));
|
||||
Vcomp_subr_list = Fcons (tem, Vcomp_subr_list);
|
||||
#endif
|
||||
}
|
||||
|
||||
|
|
@ -5412,20 +5396,20 @@ This list includes suffixes for both compiled and source Emacs Lisp files.
|
|||
This list should not include the empty string.
|
||||
`load' and related functions try to append these suffixes, in order,
|
||||
to the specified file name if a suffix is allowed or required. */);
|
||||
Vload_suffixes = list2 (build_pure_c_string (".elc"),
|
||||
build_pure_c_string (".el"));
|
||||
Vload_suffixes = list2 (build_string (".elc"),
|
||||
build_string (".el"));
|
||||
#ifdef HAVE_MODULES
|
||||
Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes);
|
||||
Vload_suffixes = Fcons (build_string (MODULES_SUFFIX), Vload_suffixes);
|
||||
#ifdef MODULES_SECONDARY_SUFFIX
|
||||
Vload_suffixes =
|
||||
Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
|
||||
Fcons (build_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
|
||||
doc: /* Suffix of loadable module file, or nil if modules are not supported. */);
|
||||
#ifdef HAVE_MODULES
|
||||
Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
|
||||
Vmodule_file_suffix = build_string (MODULES_SUFFIX);
|
||||
#else
|
||||
Vmodule_file_suffix = Qnil;
|
||||
#endif
|
||||
|
|
@ -5575,7 +5559,7 @@ from the file, and matches them against this regular expression.
|
|||
When the regular expression matches, the file is considered to be safe
|
||||
to load. */);
|
||||
Vbytecomp_version_regexp
|
||||
= build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
|
||||
= build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
|
||||
|
||||
DEFSYM (Qlexical_binding, "lexical-binding");
|
||||
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
|
||||
|
|
|
|||
|
|
@ -2412,7 +2412,7 @@ dump_symbol (struct dump_context *ctx,
|
|||
Lisp_Object object,
|
||||
dump_off offset)
|
||||
{
|
||||
#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC
|
||||
#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_DD2E6013B4
|
||||
# error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h."
|
||||
#endif
|
||||
#if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113)
|
||||
|
|
@ -2449,7 +2449,6 @@ dump_symbol (struct dump_context *ctx,
|
|||
DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write);
|
||||
DUMP_FIELD_COPY (&out, symbol, u.s.interned);
|
||||
DUMP_FIELD_COPY (&out, symbol, u.s.declared_special);
|
||||
DUMP_FIELD_COPY (&out, symbol, u.s.pinned);
|
||||
dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG);
|
||||
switch (symbol->u.s.redirect)
|
||||
{
|
||||
|
|
@ -2666,7 +2665,7 @@ dump_hash_table (struct dump_context *ctx,
|
|||
Lisp_Object object,
|
||||
dump_off offset)
|
||||
{
|
||||
#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618
|
||||
#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_203821C7EF
|
||||
# error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h."
|
||||
#endif
|
||||
const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object);
|
||||
|
|
@ -2682,7 +2681,6 @@ dump_hash_table (struct dump_context *ctx,
|
|||
them as close to the hash table as possible. */
|
||||
DUMP_FIELD_COPY (out, hash, count);
|
||||
DUMP_FIELD_COPY (out, hash, next_free);
|
||||
DUMP_FIELD_COPY (out, hash, purecopy);
|
||||
DUMP_FIELD_COPY (out, hash, mutable);
|
||||
DUMP_FIELD_COPY (out, hash, rehash_threshold);
|
||||
DUMP_FIELD_COPY (out, hash, rehash_size);
|
||||
|
|
|
|||
|
|
@ -2509,9 +2509,6 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
|
|||
print_object (Fhash_table_rehash_threshold (obj),
|
||||
printcharfun, escapeflag);
|
||||
|
||||
if (h->purecopy)
|
||||
print_c_string (" purecopy t", printcharfun);
|
||||
|
||||
print_c_string (" data (", printcharfun);
|
||||
|
||||
ptrdiff_t size = h->count;
|
||||
|
|
|
|||
|
|
@ -8750,7 +8750,7 @@ sentinel or a process filter function has an error. */);
|
|||
const struct socket_options *sopt;
|
||||
|
||||
#define ADD_SUBFEATURE(key, val) \
|
||||
subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures)
|
||||
subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures)
|
||||
|
||||
ADD_SUBFEATURE (QCnowait, Qt);
|
||||
#ifdef DATAGRAM_SOCKETS
|
||||
|
|
@ -8772,7 +8772,7 @@ sentinel or a process filter function has an error. */);
|
|||
ADD_SUBFEATURE (QCserver, Qt);
|
||||
|
||||
for (sopt = socket_options; sopt->name; sopt++)
|
||||
subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures);
|
||||
subfeatures = Fcons (intern_c_string (sopt->name), subfeatures);
|
||||
|
||||
Fprovide (intern_c_string ("make-network-process"), subfeatures);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -63,7 +63,7 @@ make_log (void)
|
|||
Lisp_Object log = make_hash_table (hashtest_profiler, heap_size,
|
||||
DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
Qnil);
|
||||
struct Lisp_Hash_Table *h = XHASH_TABLE (log);
|
||||
|
||||
/* What is special about our hash-tables is that the values are pre-filled
|
||||
|
|
|
|||
115
src/puresize.h
115
src/puresize.h
|
|
@ -1,115 +0,0 @@
|
|||
/* How much read-only Lisp storage a dumped Emacs needs.
|
||||
Copyright (C) 1993, 2001-2022 Free Software Foundation, Inc.
|
||||
|
||||
This file is part of GNU Emacs.
|
||||
|
||||
GNU Emacs is free software: you can redistribute it and/or modify
|
||||
it under the terms of the GNU General Public License as published by
|
||||
the Free Software Foundation, either version 3 of the License, or (at
|
||||
your option) any later version.
|
||||
|
||||
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
|
||||
along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
|
||||
|
||||
#ifndef EMACS_PURESIZE_H
|
||||
#define EMACS_PURESIZE_H
|
||||
|
||||
#include "lisp.h"
|
||||
|
||||
INLINE_HEADER_BEGIN
|
||||
|
||||
/* Define PURESIZE, the number of bytes of pure Lisp code to leave space for.
|
||||
|
||||
At one point, this was defined in config.h, meaning that changing
|
||||
PURESIZE would make Make recompile all of Emacs. But only a few
|
||||
files actually use PURESIZE, so we split it out to its own .h file.
|
||||
|
||||
Make sure to include this file after config.h, since that tells us
|
||||
whether we are running X windows, which tells us how much pure
|
||||
storage to allocate. */
|
||||
|
||||
/* First define a measure of the amount of data we have. */
|
||||
|
||||
/* A system configuration file may set this to request a certain extra
|
||||
amount of storage. This is a lot more update-robust that defining
|
||||
BASE_PURESIZE or even PURESIZE directly. */
|
||||
#ifndef SYSTEM_PURESIZE_EXTRA
|
||||
#define SYSTEM_PURESIZE_EXTRA 0
|
||||
#endif
|
||||
|
||||
#ifndef SITELOAD_PURESIZE_EXTRA
|
||||
#define SITELOAD_PURESIZE_EXTRA 0
|
||||
#endif
|
||||
|
||||
#ifndef BASE_PURESIZE
|
||||
#define BASE_PURESIZE (2000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA)
|
||||
#endif
|
||||
|
||||
/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */
|
||||
#ifndef PURESIZE_RATIO
|
||||
#if EMACS_INT_MAX >> 31 != 0
|
||||
#if PTRDIFF_MAX >> 31 != 0
|
||||
#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */
|
||||
#else
|
||||
#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */
|
||||
#endif
|
||||
#else
|
||||
#define PURESIZE_RATIO 1
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef ENABLE_CHECKING
|
||||
/* ENABLE_CHECKING somehow increases the purespace used, probably because
|
||||
it tends to cause some macro arguments to be evaluated twice. This is
|
||||
a bug, but it's difficult to track it down. */
|
||||
#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */
|
||||
#else
|
||||
#define PURESIZE_CHECKING_RATIO 1
|
||||
#endif
|
||||
|
||||
/* This is the actual size in bytes to allocate. */
|
||||
#ifndef PURESIZE
|
||||
#define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO)
|
||||
#endif
|
||||
|
||||
extern AVOID pure_write_error (Lisp_Object);
|
||||
|
||||
extern EMACS_INT pure[];
|
||||
|
||||
/* The puresize_h_* macros are private to this include file. */
|
||||
|
||||
/* True if PTR is pure. */
|
||||
|
||||
#define puresize_h_PURE_P(ptr) \
|
||||
((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE)
|
||||
|
||||
INLINE bool
|
||||
PURE_P (void *ptr)
|
||||
{
|
||||
return puresize_h_PURE_P (ptr);
|
||||
}
|
||||
|
||||
/* Signal an error if OBJ is pure. PTR is OBJ untagged. */
|
||||
|
||||
#define puresize_h_CHECK_IMPURE(obj, ptr) \
|
||||
(PURE_P (ptr) ? pure_write_error (obj) : (void) 0)
|
||||
|
||||
INLINE void
|
||||
CHECK_IMPURE (Lisp_Object obj, void *ptr)
|
||||
{
|
||||
puresize_h_CHECK_IMPURE (obj, ptr);
|
||||
}
|
||||
|
||||
#if DEFINE_KEY_OPS_AS_MACROS
|
||||
# define PURE_P(ptr) puresize_h_PURE_P (ptr)
|
||||
# define CHECK_IMPURE(obj, ptr) puresize_h_CHECK_IMPURE (obj, ptr)
|
||||
#endif
|
||||
|
||||
INLINE_HEADER_END
|
||||
|
||||
#endif /* EMACS_PURESIZE_H */
|
||||
12
src/search.c
12
src/search.c
|
|
@ -3385,19 +3385,19 @@ syms_of_search (void)
|
|||
DEFSYM (Qinvalid_regexp, "invalid-regexp");
|
||||
|
||||
Fput (Qsearch_failed, Qerror_conditions,
|
||||
pure_list (Qsearch_failed, Qerror));
|
||||
list (Qsearch_failed, Qerror));
|
||||
Fput (Qsearch_failed, Qerror_message,
|
||||
build_pure_c_string ("Search failed"));
|
||||
build_string ("Search failed"));
|
||||
|
||||
Fput (Quser_search_failed, Qerror_conditions,
|
||||
pure_list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror));
|
||||
list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror));
|
||||
Fput (Quser_search_failed, Qerror_message,
|
||||
build_pure_c_string ("Search failed"));
|
||||
build_string ("Search failed"));
|
||||
|
||||
Fput (Qinvalid_regexp, Qerror_conditions,
|
||||
pure_list (Qinvalid_regexp, Qerror));
|
||||
list (Qinvalid_regexp, Qerror));
|
||||
Fput (Qinvalid_regexp, Qerror_message,
|
||||
build_pure_c_string ("Invalid regexp"));
|
||||
build_string ("Invalid regexp"));
|
||||
|
||||
re_match_object = Qnil;
|
||||
staticpro (&re_match_object);
|
||||
|
|
|
|||
|
|
@ -769,9 +769,9 @@ syms_of_sqlite (void)
|
|||
|
||||
DEFSYM (Qsqlite_locked_error, "sqlite-locked-error");
|
||||
Fput (Qsqlite_locked_error, Qerror_conditions,
|
||||
Fpurecopy (list2 (Qsqlite_locked_error, Qerror)));
|
||||
list2 (Qsqlite_locked_error, Qerror));
|
||||
Fput (Qsqlite_locked_error, Qerror_message,
|
||||
build_pure_c_string ("Database locked"));
|
||||
build_string ("Database locked"));
|
||||
|
||||
DEFSYM (Qsqlitep, "sqlitep");
|
||||
DEFSYM (Qfalse, "false");
|
||||
|
|
|
|||
|
|
@ -3750,9 +3750,9 @@ syms_of_syntax (void)
|
|||
|
||||
DEFSYM (Qscan_error, "scan-error");
|
||||
Fput (Qscan_error, Qerror_conditions,
|
||||
pure_list (Qscan_error, Qerror));
|
||||
list (Qscan_error, Qerror));
|
||||
Fput (Qscan_error, Qerror_message,
|
||||
build_pure_c_string ("Scan error"));
|
||||
build_string ("Scan error"));
|
||||
|
||||
DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments,
|
||||
doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */);
|
||||
|
|
|
|||
|
|
@ -10554,9 +10554,9 @@ syms_of_w32fns (void)
|
|||
DEFSYM (Qjson, "json");
|
||||
|
||||
Fput (Qundefined_color, Qerror_conditions,
|
||||
pure_list (Qundefined_color, Qerror));
|
||||
list (Qundefined_color, Qerror));
|
||||
Fput (Qundefined_color, Qerror_message,
|
||||
build_pure_c_string ("Undefined color"));
|
||||
build_string ("Undefined color"));
|
||||
|
||||
staticpro (&w32_grabbed_keys);
|
||||
w32_grabbed_keys = Qnil;
|
||||
|
|
|
|||
16
src/xdisp.c
16
src/xdisp.c
|
|
@ -36064,7 +36064,7 @@ See also `overlay-arrow-string'. */);
|
|||
DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string,
|
||||
doc: /* String to display as an arrow in non-window frames.
|
||||
See also `overlay-arrow-position'. */);
|
||||
Voverlay_arrow_string = build_pure_c_string ("=>");
|
||||
Voverlay_arrow_string = build_string ("=>");
|
||||
|
||||
DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list,
|
||||
doc: /* List of variables (symbols) which hold markers for overlay arrows.
|
||||
|
|
@ -36194,17 +36194,17 @@ which no explicit name has been set (see `modify-frame-parameters'). */);
|
|||
This variable has the same structure as `mode-line-format' (which see),
|
||||
and is used only on frames for which no explicit name has been set
|
||||
\(see `modify-frame-parameters'). */);
|
||||
/* Do not nest calls to pure_list. This works around a bug in
|
||||
/* Do not nest calls to list. This works around a bug in
|
||||
Oracle Developer Studio 12.6. */
|
||||
Lisp_Object icon_title_name_format
|
||||
= pure_list (empty_unibyte_string,
|
||||
build_pure_c_string ("%b - GNU Emacs at "),
|
||||
intern_c_string ("system-name"));
|
||||
= list (empty_unibyte_string,
|
||||
build_string ("%b - GNU Emacs at "),
|
||||
intern_c_string ("system-name"));
|
||||
Vicon_title_format
|
||||
= Vframe_title_format
|
||||
= pure_list (intern_c_string ("multiple-frames"),
|
||||
build_pure_c_string ("%b"),
|
||||
icon_title_name_format);
|
||||
= list (intern_c_string ("multiple-frames"),
|
||||
build_string ("%b"),
|
||||
icon_title_name_format);
|
||||
|
||||
DEFVAR_LISP ("message-log-max", Vmessage_log_max,
|
||||
doc: /* Maximum number of lines to keep in the message log buffer.
|
||||
|
|
|
|||
|
|
@ -7122,14 +7122,14 @@ only for this purpose. */);
|
|||
Vface_new_frame_defaults =
|
||||
/* 33 entries is enough to fit all basic faces */
|
||||
make_hash_table (hashtest_eq, 33, DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil, false);
|
||||
DEFAULT_REHASH_THRESHOLD, Qnil);
|
||||
|
||||
DEFVAR_LISP ("face-default-stipple", Vface_default_stipple,
|
||||
doc: /* Default stipple pattern used on monochrome displays.
|
||||
This stipple pattern is used on monochrome displays
|
||||
instead of shades of gray for a face background color.
|
||||
See `set-face-stipple' for possible values for this variable. */);
|
||||
Vface_default_stipple = build_pure_c_string ("gray3");
|
||||
Vface_default_stipple = build_string ("gray3");
|
||||
|
||||
DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist,
|
||||
doc: /* An alist of defined terminal colors and their RGB values.
|
||||
|
|
|
|||
|
|
@ -9690,9 +9690,9 @@ syms_of_xfns (void)
|
|||
DEFSYM (QXdndActionPrivate, "XdndActionPrivate");
|
||||
|
||||
Fput (Qundefined_color, Qerror_conditions,
|
||||
pure_list (Qundefined_color, Qerror));
|
||||
list (Qundefined_color, Qerror));
|
||||
Fput (Qundefined_color, Qerror_message,
|
||||
build_pure_c_string ("Undefined color"));
|
||||
build_string ("Undefined color"));
|
||||
|
||||
DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape,
|
||||
doc: /* The shape of the pointer when over text.
|
||||
|
|
@ -9903,7 +9903,7 @@ eliminated in future versions of Emacs. */);
|
|||
char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)];
|
||||
int len = sprintf (gtk_version, "%d.%d.%d",
|
||||
GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION);
|
||||
Vgtk_version_string = make_pure_string (gtk_version, len, len, false);
|
||||
Vgtk_version_string = make_specified_string (gtk_version, len, len, false);
|
||||
}
|
||||
#endif /* USE_GTK */
|
||||
|
||||
|
|
@ -9917,7 +9917,8 @@ eliminated in future versions of Emacs. */);
|
|||
int len = sprintf (cairo_version, "%d.%d.%d",
|
||||
CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR,
|
||||
CAIRO_VERSION_MICRO);
|
||||
Vcairo_version_string = make_pure_string (cairo_version, len, len, false);
|
||||
Vcairo_version_string = make_specified_string (cairo_version, len, len,
|
||||
false);
|
||||
}
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -27815,7 +27815,7 @@ syms_of_xterm (void)
|
|||
DEFSYM (Qx_dnd_targets_list, "x-dnd-targets-list");
|
||||
|
||||
#ifdef USE_GTK
|
||||
xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg");
|
||||
xg_default_icon_file = build_string ("icons/hicolor/scalable/apps/emacs.svg");
|
||||
staticpro (&xg_default_icon_file);
|
||||
|
||||
DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock");
|
||||
|
|
@ -27950,7 +27950,7 @@ If set to a non-float value, there will be no wait at all. */);
|
|||
Vx_keysym_table = make_hash_table (hashtest_eql, 900,
|
||||
DEFAULT_REHASH_SIZE,
|
||||
DEFAULT_REHASH_THRESHOLD,
|
||||
Qnil, false);
|
||||
Qnil);
|
||||
|
||||
DEFVAR_BOOL ("x-frame-normalize-before-maximize",
|
||||
x_frame_normalize_before_maximize,
|
||||
|
|
|
|||
Loading…
Reference in a new issue