Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
emacs
emacs
Commits
a7af7fde
Commit
a7af7fde
authored
Jun 15, 2011
by
Paul Eggert
Browse files
Integer overflow and signedness fixes (Bug#8873).
parents
8c9b2106
b1c46f02
Changes
46
Hide whitespace changes
Inline
Side-by-side
Showing
20 changed files
with
529 additions
and
275 deletions
+529
-275
src/ChangeLog
src/ChangeLog
+250
-0
src/alloc.c
src/alloc.c
+80
-101
src/buffer.c
src/buffer.c
+4
-4
src/buffer.h
src/buffer.h
+2
-2
src/bytecode.c
src/bytecode.c
+9
-7
src/callint.c
src/callint.c
+10
-6
src/callproc.c
src/callproc.c
+6
-6
src/casefiddle.c
src/casefiddle.c
+1
-1
src/ccl.c
src/ccl.c
+6
-2
src/character.c
src/character.c
+7
-7
src/character.h
src/character.h
+14
-9
src/charset.c
src/charset.c
+7
-6
src/charset.h
src/charset.h
+26
-22
src/chartab.c
src/chartab.c
+3
-3
src/coding.c
src/coding.c
+5
-5
src/composite.c
src/composite.c
+3
-2
src/composite.h
src/composite.h
+1
-1
src/data.c
src/data.c
+62
-61
src/dbusbind.c
src/dbusbind.c
+25
-25
src/dired.c
src/dired.c
+8
-5
No files found.
src/ChangeLog
View file @
a7af7fde
2011-06-15 Paul Eggert <eggert@cs.ucla.edu>
Integer overflow and signedness fixes (Bug#8873).
* ccl.c (ASCENDING_ORDER): New macro, to work around GCC bug 43772.
(GET_CCL_RANGE, IN_INT_RANGE): Use it.
* fileio.c: Don't assume EMACS_INT fits in off_t.
(emacs_lseek): New static function.
(Finsert_file_contents, Fwrite_region): Use it.
Use SEEK_SET, SEEK_CUR, SEEK_END as appropriate.
* fns.c (Fload_average): Don't assume 100 * load average fits in int.
* fns.c: Don't overflow int when computing a list length.
* fns.c (QUIT_COUNT_HEURISTIC): New constant.
(Flength, Fsafe_length): Use EMACS_INT, not int, to avoid unwanted
truncation on 64-bit hosts. Check for QUIT every
QUIT_COUNT_HEURISTIC entries rather than every other entry; that's
faster and is responsive enough.
(Flength): Report an error instead of overflowing an integer.
(Fsafe_length): Return a float if the value is not representable
as a fixnum. This shouldn't happen except in contrived situations.
(Fnthcdr, Fsort): Don't assume list length fits in int.
(Fcopy_sequence): Don't assume vector length fits in int.
* alloc.c: Check that resized vectors' lengths fit in fixnums.
(header_size, word_size): New constants.
(allocate_vectorlike): Don't check size overflow here.
(allocate_vector): Check it here instead, since this is the only
caller of allocate_vectorlike that could cause overflow.
Check that the new vector's length is representable as a fixnum.
* fns.c (next_almost_prime): Don't return a multiple of 3 or 5.
The previous code was bogus. For example, next_almost_prime (32)
returned 39, which is undesirable as it is a multiple of 3; and
next_almost_prime (24) returned 25, which is a multiple of 5 so
why was the code bothering to check for multiples of 7?
* bytecode.c (exec_byte_code): Use ptrdiff_t, not int, for vector length.
* eval.c, doprnt.c (SIZE_MAX): Remove; inttypes.h defines this now.
Variadic C functions now count arguments with ptrdiff_t.
This partly undoes my 2011-03-30 change, which replaced int with size_t.
Back then I didn't know that the Emacs coding style prefers signed int.
Also, in the meantime I found a few more instances where arguments
were being counted with int, which may truncate counts on 64-bit
machines, or EMACS_INT, which may be unnecessarily wide.
* lisp.h (struct Lisp_Subr.function.aMANY)
(DEFUN_ARGS_MANY, internal_condition_case_n, safe_call):
Arg counts are now ptrdiff_t, not size_t.
All variadic functions and their callers changed accordingly.
(struct gcpro.nvars): Now size_t, not size_t. All uses changed.
* bytecode.c (exec_byte_code): Check maxdepth for overflow,
to avoid potential buffer overrun. Don't assume arg counts fit in 'int'.
* callint.c (Fcall_interactively): Check arg count for overflow,
to avoid potential buffer overrun. Use signed char, not 'int',
for 'varies' array, so that we needn't bother to check its size
calculation for overflow.
* editfns.c (Fformat): Use ptrdiff_t, not EMACS_INT, to count args.
* eval.c (apply_lambda):
* fns.c (Fmapconcat): Use XFASTINT, not XINT, to get args length.
(struct textprop_rec.argnum): Now ptrdiff_t, not int. All uses changed.
(mapconcat): Use ptrdiff_t, not int and EMACS_INT, to count args.
* callint.c (Fcall_interactively): Don't use index var as event count.
* vm-limit.c (check_memory_limits): Fix incorrect extern function decls.
* mem-limits.h (SIZE): Remove; no longer used.
* xterm.c (x_alloc_nearest_color_1): Prefer int to long when int works.
Remove unnecessary casts.
* xterm.c (x_term_init):
* xfns.c (x_set_border_pixel):
* widget.c (create_frame_gcs): Remove casts to unsigned long etc.
These aren't needed now that we assume ANSI C.
* sound.c (Fplay_sound_internal): Remove cast to unsigned long.
It's more likely to cause problems (due to unsigned overflow)
than to cure them.
* dired.c (Ffile_attributes): Don't use 32-bit hack on 64-bit hosts.
* unexelf.c (unexec): Don't assume BSS addr fits in unsigned.
* xterm.c (handle_one_xevent): Omit unnecessary casts to unsigned.
* keyboard.c (modify_event_symbol): Don't limit alist len to UINT_MAX.
* lisp.h (CHAR_TABLE_SET): Omit now-redundant test.
* lread.c (Fload): Don't compare a possibly-garbage time_t value.
GLYPH_CODE_FACE returns EMACS_INT, not int.
* dispextern.h (merge_faces):
* xfaces.c (merge_faces):
* xdisp.c (get_next_display_element, next_element_from_display_vector):
Don't assume EMACS_INT fits in int.
* character.h (CHAR_VALID_P): Remove unused parameter.
* fontset.c, lisp.h, xdisp.c: All uses changed.
* editfns.c (Ftranslate_region_internal): Omit redundant test.
* fns.c (concat): Minor tuning based on overflow analysis.
This doesn't fix any bugs. Use int to hold character, instead
of constantly refetching from Emacs object. Use XFASTINT, not
XINT, for value known to be a character. Don't bother comparing
a single byte to 0400, as it's always less.
* floatfns.c (Fexpt):
* fileio.c (make_temp_name): Omit unnecessary cast to unsigned.
* editfns.c (Ftranslate_region_internal): Use int, not EMACS_INT
for characters.
* doc.c (get_doc_string): Omit (unsigned)c that mishandled negatives.
* data.c (Faset): If ARRAY is a string, check that NEWELT is a char.
Without this fix, on a 64-bit host (aset S 0 4294967386) would
incorrectly succeed when S was a string, because 4294967386 was
truncated before it was used.
* chartab.c (Fchar_table_range): Use CHARACTERP to check range.
Otherwise, an out-of-range integer could cause undefined behavior
on a 64-bit host.
* composite.c: Use int, not EMACS_INT, for characters.
(fill_gstring_body, composition_compute_stop_pos): Use int, not
EMACS_INT, for values that are known to be in character range.
This doesn't fix any bugs but is the usual style inside Emacs and
may generate better code on 32-bit machines.
Make sure a 64-bit char is never passed to ENCODE_CHAR.
This is for reasons similar to the recent CHAR_STRING fix.
* charset.c (Fencode_char): Check that character arg is actually
a character. Pass an int to ENCODE_CHAR.
* charset.h (ENCODE_CHAR): Verify that the character argument is no
wider than 'int', as a compile-time check to prevent future regressions
in this area.
* character.c (char_string): Remove unnecessary casts.
Make sure a 64-bit char is never passed to CHAR_STRING.
Otherwise, CHAR_STRING would do the wrong thing on a 64-bit platform,
by silently ignoring the top 32 bits, allowing some values
that were far too large to be valid characters.
* character.h: Include <verify.h>.
(CHAR_STRING, CHAR_STRING_ADVANCE): Verify that the character
arguments are no wider than unsigned, as a compile-time check
to prevent future regressions in this area.
* data.c (Faset):
* editfns.c (Fchar_to_string, general_insert_function, Finsert_char)
(Fsubst_char_in_region):
* fns.c (concat):
* xdisp.c (decode_mode_spec_coding):
Adjust to CHAR_STRING's new requirement.
* editfns.c (Finsert_char, Fsubst_char_in_region):
* fns.c (concat): Check that character args are actually
characters. Without this test, these functions did the wrong
thing with wildly out-of-range values on 64-bit hosts.
Remove incorrect casts to 'unsigned' that lose info on 64-bit hosts.
These casts should not be needed on 32-bit hosts, either.
* keyboard.c (read_char):
* lread.c (Fload): Remove casts to unsigned.
* lisp.h (UNSIGNED_CMP): New macro.
This fixes comparison bugs on 64-bit hosts.
(ASCII_CHAR_P): Use it.
* casefiddle.c (casify_object):
* character.h (ASCII_BYTE_P, CHAR_VALID_P)
(SINGLE_BYTE_CHAR_P, CHAR_STRING):
* composite.h (COMPOSITION_ENCODE_RULE_VALID):
* dispextern.h (FACE_FROM_ID):
* keyboard.c (read_char): Use UNSIGNED_CMP.
* xmenu.c (dialog_selection_callback) [!USE_GTK]: Cast to intptr_t,
not to EMACS_INT, to avoid GCC warning.
* xfns.c (x_set_scroll_bar_default_width): Remove unused 'int' locals.
* buffer.h (PTR_BYTE_POS, BUF_PTR_BYTE_POS): Remove harmful cast.
The cast incorrectly truncated 64-bit byte offsets to 32 bits, and
isn't needed on 32-bit machines.
* buffer.c (Fgenerate_new_buffer_name):
Use EMACS_INT for count, not int.
(advance_to_char_boundary): Return EMACS_INT, not int.
* data.c (Qcompiled_function): Now static.
* window.c (window_body_lines): Now static.
* image.c (gif_load): Rename local to avoid shadowing.
* lisp.h (SAFE_ALLOCA_LISP): Check for integer overflow.
(struct Lisp_Save_Value): Use ptrdiff_t, not int, for 'integer' member.
* alloc.c (make_save_value): Integer argument is now of type
ptrdiff_t, not int.
(mark_object): Use ptrdiff_t, not int.
* lisp.h (pD): New macro.
* print.c (print_object): Use it.
* alloc.c: Use EMACS_INT, not int, to count objects.
(total_conses, total_markers, total_symbols, total_vector_size)
(total_free_conses, total_free_markers, total_free_symbols)
(total_free_floats, total_floats, total_free_intervals)
(total_intervals, total_strings, total_free_strings):
Now EMACS_INT, not int. All uses changed.
(Fgarbage_collect): Compute overall total using a double, so that
integer overflow is less likely to be a problem. Check for overflow
when converting back to an integer.
(n_interval_blocks, n_string_blocks, n_float_blocks, n_cons_blocks)
(n_vectors, n_symbol_blocks, n_marker_blocks): Remove.
These were 'int' variables that could overflow on 64-bit hosts;
they were never used, so remove them instead of repairing them.
(nzombies, ngcs, max_live, max_zombies): Now EMACS_INT, not 'int'.
(inhibit_garbage_collection): Set gc_cons_threshold to max value.
Previously, this ceilinged at INT_MAX, but that doesn't work on
64-bit machines.
(allocate_pseudovector): Don't use EMACS_INT when int would do.
* alloc.c (Fmake_bool_vector): Don't assume vector size fits in int.
(allocate_vectorlike): Check for ptrdiff_t overflow.
(mark_vectorlike, mark_char_table, mark_object): Avoid EMACS_UINT
when a (possibly-narrower) signed value would do just as well.
We prefer using signed arithmetic, to avoid comparison confusion.
* alloc.c: Catch some string size overflows that we were missing.
(XMALLOC_OVERRUN_CHECK_SIZE) [!XMALLOC_OVERRUN_CHECK]: Define to 0,
for convenience in STRING_BYTES_MAX.
(STRING_BYTES_MAX): New macro, superseding the old one in lisp.h.
The definition here is exact; the one in lisp.h was approximate.
(allocate_string_data): Check for string overflow. This catches
some instances we weren't catching before. Also, it catches
size_t overflow on (unusual) hosts where SIZE_MAX <= min
(PTRDIFF_MAX, MOST_POSITIVE_FIXNUM), e.g., when size_t is 32 bits
and ptrdiff_t and EMACS_INT are both 64 bits.
* character.c, coding.c, doprnt.c, editfns.c, eval.c:
All uses of STRING_BYTES_MAX replaced by STRING_BYTES_BOUND.
* lisp.h (STRING_BYTES_BOUND): Renamed from STRING_BYTES_MAX.
* character.c (string_escape_byte8): Fix nbytes/nchars typo.
* alloc.c (Fmake_string): Check for out-of-range init.
2011-06-15 Stefan Monnier <monnier@iro.umontreal.ca>
* eval.c (Fdefvaralias): Also mark the target as variable-special-p.
...
...
src/alloc.c
View file @
a7af7fde
...
...
@@ -180,9 +180,9 @@ int abort_on_gc;
/* Number of live and free conses etc. */
static
int
total_conses
,
total_markers
,
total_symbols
,
total_vector_size
;
static
int
total_free_conses
,
total_free_markers
,
total_free_symbols
;
static
int
total_free_floats
,
total_floats
;
static
EMACS_INT
total_conses
,
total_markers
,
total_symbols
,
total_vector_size
;
static
EMACS_INT
total_free_conses
,
total_free_markers
,
total_free_symbols
;
static
EMACS_INT
total_free_floats
,
total_floats
;
/* Points to memory space allocated as "spare", to be freed if we run
out of memory. We keep one large block, four cons-blocks, and
...
...
@@ -485,7 +485,9 @@ buffer_memory_full (EMACS_INT nbytes)
}
#ifdef XMALLOC_OVERRUN_CHECK
#ifndef XMALLOC_OVERRUN_CHECK
#define XMALLOC_OVERRUN_CHECK_SIZE 0
#else
/* Check for overrun in malloc'ed buffers by wrapping a 16 byte header
and a 16 byte trailer around each block.
...
...
@@ -1336,16 +1338,12 @@ static int interval_block_index;
/* Number of free and live intervals. */
static
int
total_free_intervals
,
total_intervals
;
static
EMACS_INT
total_free_intervals
,
total_intervals
;
/* List of free intervals. */
static
INTERVAL
interval_free_list
;
/* Total number of interval blocks now in use. */
static
int
n_interval_blocks
;
/* Initialize interval allocation. */
...
...
@@ -1355,7 +1353,6 @@ init_intervals (void)
interval_block
=
NULL
;
interval_block_index
=
INTERVAL_BLOCK_SIZE
;
interval_free_list
=
0
;
n_interval_blocks
=
0
;
}
...
...
@@ -1387,7 +1384,6 @@ make_interval (void)
newi
->
next
=
interval_block
;
interval_block
=
newi
;
interval_block_index
=
0
;
n_interval_blocks
++
;
}
val
=
&
interval_block
->
intervals
[
interval_block_index
++
];
}
...
...
@@ -1580,10 +1576,9 @@ static struct sblock *oldest_sblock, *current_sblock;
static
struct
sblock
*
large_sblocks
;
/* List of string_block structures
, and how many there are
. */
/* List of string_block structures. */
static
struct
string_block
*
string_blocks
;
static
int
n_string_blocks
;
/* Free-list of Lisp_Strings. */
...
...
@@ -1591,7 +1586,7 @@ static struct Lisp_String *string_free_list;
/* Number of live and free Lisp_Strings. */
static
int
total_strings
,
total_free_strings
;
static
EMACS_INT
total_strings
,
total_free_strings
;
/* Number of bytes used by live strings. */
...
...
@@ -1659,6 +1654,18 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
#define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE)
/* Exact bound on the number of bytes in a string, not counting the
terminating null. A string cannot contain more bytes than
STRING_BYTES_BOUND, nor can it be so long that the size_t
arithmetic in allocate_string_data would overflow while it is
calculating a value to be passed to malloc. */
#define STRING_BYTES_MAX \
min (STRING_BYTES_BOUND, \
((SIZE_MAX - XMALLOC_OVERRUN_CHECK_SIZE - GC_STRING_EXTRA \
- offsetof (struct sblock, first_data) \
- SDATA_DATA_OFFSET) \
& ~(sizeof (EMACS_INT) - 1)))
/* Initialize string allocation. Called from init_alloc_once. */
static
void
...
...
@@ -1667,7 +1674,6 @@ init_strings (void)
total_strings
=
total_free_strings
=
total_string_size
=
0
;
oldest_sblock
=
current_sblock
=
large_sblocks
=
NULL
;
string_blocks
=
NULL
;
n_string_blocks
=
0
;
string_free_list
=
NULL
;
empty_unibyte_string
=
make_pure_string
(
""
,
0
,
0
,
0
);
empty_multibyte_string
=
make_pure_string
(
""
,
0
,
0
,
1
);
...
...
@@ -1799,7 +1805,6 @@ allocate_string (void)
memset
(
b
,
0
,
sizeof
*
b
);
b
->
next
=
string_blocks
;
string_blocks
=
b
;
++
n_string_blocks
;
for
(
i
=
STRING_BLOCK_SIZE
-
1
;
i
>=
0
;
--
i
)
{
...
...
@@ -1858,6 +1863,9 @@ allocate_string_data (struct Lisp_String *s,
struct
sblock
*
b
;
EMACS_INT
needed
,
old_nbytes
;
if
(
STRING_BYTES_MAX
<
nbytes
)
string_overflow
();
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
needed
=
SDATA_SIZE
(
nbytes
);
...
...
@@ -2025,7 +2033,6 @@ sweep_strings (void)
&&
total_free_strings
>
STRING_BLOCK_SIZE
)
{
lisp_free
(
b
);
--
n_string_blocks
;
string_free_list
=
free_list_before
;
}
else
...
...
@@ -2186,9 +2193,9 @@ INIT must be an integer that represents a character. */)
EMACS_INT
nbytes
;
CHECK_NATNUM
(
length
);
CHECK_
NUMB
ER
(
init
);
CHECK_
CHARACT
ER
(
init
);
c
=
XINT
(
init
);
c
=
X
FAST
INT
(
init
);
if
(
ASCII_CHAR_P
(
c
))
{
nbytes
=
XINT
(
length
);
...
...
@@ -2229,7 +2236,6 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
{
register
Lisp_Object
val
;
struct
Lisp_Bool_Vector
*
p
;
int
real_init
,
i
;
EMACS_INT
length_in_chars
,
length_in_elts
;
int
bits_per_value
;
...
...
@@ -2251,9 +2257,7 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
p
=
XBOOL_VECTOR
(
val
);
p
->
size
=
XFASTINT
(
length
);
real_init
=
(
NILP
(
init
)
?
0
:
-
1
);
for
(
i
=
0
;
i
<
length_in_chars
;
i
++
)
p
->
data
[
i
]
=
real_init
;
memset
(
p
->
data
,
NILP
(
init
)
?
0
:
-
1
,
length_in_chars
);
/* Clear the extraneous bits in the last byte. */
if
(
XINT
(
length
)
!=
length_in_chars
*
BOOL_VECTOR_BITS_PER_CHAR
)
...
...
@@ -2463,10 +2467,6 @@ static struct float_block *float_block;
static
int
float_block_index
;
/* Total number of float blocks now in use. */
static
int
n_float_blocks
;
/* Free-list of Lisp_Floats. */
static
struct
Lisp_Float
*
float_free_list
;
...
...
@@ -2480,7 +2480,6 @@ init_float (void)
float_block
=
NULL
;
float_block_index
=
FLOAT_BLOCK_SIZE
;
/* Force alloc of new float_block. */
float_free_list
=
0
;
n_float_blocks
=
0
;
}
...
...
@@ -2514,7 +2513,6 @@ make_float (double float_value)
memset
(
new
->
gcmarkbits
,
0
,
sizeof
new
->
gcmarkbits
);
float_block
=
new
;
float_block_index
=
0
;
n_float_blocks
++
;
}
XSETFLOAT
(
val
,
&
float_block
->
floats
[
float_block_index
]);
float_block_index
++
;
...
...
@@ -2579,10 +2577,6 @@ static int cons_block_index;
static
struct
Lisp_Cons
*
cons_free_list
;
/* Total number of cons blocks now in use. */
static
int
n_cons_blocks
;
/* Initialize cons allocation. */
...
...
@@ -2592,7 +2586,6 @@ init_cons (void)
cons_block
=
NULL
;
cons_block_index
=
CONS_BLOCK_SIZE
;
/* Force alloc of new cons_block. */
cons_free_list
=
0
;
n_cons_blocks
=
0
;
}
...
...
@@ -2636,7 +2629,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
new
->
next
=
cons_block
;
cons_block
=
new
;
cons_block_index
=
0
;
n_cons_blocks
++
;
}
XSETCONS
(
val
,
&
cons_block
->
conses
[
cons_block_index
]);
cons_block_index
++
;
...
...
@@ -2705,7 +2697,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0,
doc
:
/* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (list &rest OBJECTS) */
)
(
size
_t
nargs
,
register
Lisp_Object
*
args
)
(
ptrdiff
_t
nargs
,
Lisp_Object
*
args
)
{
register
Lisp_Object
val
;
val
=
Qnil
;
...
...
@@ -2775,10 +2767,12 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
static
struct
Lisp_Vector
*
all_vectors
;
/* Total number of vector-like objects now in use. */
static
int
n_vectors
;
/* Handy constants for vectorlike objects. */
enum
{
header_size
=
offsetof
(
struct
Lisp_Vector
,
contents
),
word_size
=
sizeof
(
Lisp_Object
)
};
/* Value is a pointer to a newly allocated Lisp_Vector structure
with room for LEN Lisp_Objects. */
...
...
@@ -2788,11 +2782,6 @@ allocate_vectorlike (EMACS_INT len)
{
struct
Lisp_Vector
*
p
;
size_t
nbytes
;
int
header_size
=
offsetof
(
struct
Lisp_Vector
,
contents
);
int
word_size
=
sizeof
p
->
contents
[
0
];
if
((
SIZE_MAX
-
header_size
)
/
word_size
<
len
)
memory_full
(
SIZE_MAX
);
MALLOC_BLOCK_INPUT
;
...
...
@@ -2822,18 +2811,22 @@ allocate_vectorlike (EMACS_INT len)
MALLOC_UNBLOCK_INPUT
;
++
n_vectors
;
return
p
;
}
/* Allocate a vector with
NSLOTS
slots. */
/* Allocate a vector with
LEN
slots. */
struct
Lisp_Vector
*
allocate_vector
(
EMACS_INT
nslots
)
allocate_vector
(
EMACS_INT
len
)
{
struct
Lisp_Vector
*
v
=
allocate_vectorlike
(
nslots
);
v
->
header
.
size
=
nslots
;
struct
Lisp_Vector
*
v
;
ptrdiff_t
nbytes_max
=
min
(
PTRDIFF_MAX
,
SIZE_MAX
);
if
(
min
((
nbytes_max
-
header_size
)
/
word_size
,
MOST_POSITIVE_FIXNUM
)
<
len
)
memory_full
(
SIZE_MAX
);
v
=
allocate_vectorlike
(
len
);
v
->
header
.
size
=
len
;
return
v
;
}
...
...
@@ -2844,7 +2837,7 @@ struct Lisp_Vector *
allocate_pseudovector
(
int
memlen
,
int
lisplen
,
EMACS_INT
tag
)
{
struct
Lisp_Vector
*
v
=
allocate_vectorlike
(
memlen
);
EMACS_INT
i
;
int
i
;
/* Only the first lisplen slots will be traced normally by the GC. */
for
(
i
=
0
;
i
<
lisplen
;
++
i
)
...
...
@@ -2925,10 +2918,10 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
doc
:
/* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */
)
(
register
size
_t
nargs
,
Lisp_Object
*
args
)
(
ptrdiff
_t
nargs
,
Lisp_Object
*
args
)
{
register
Lisp_Object
len
,
val
;
register
size
_t
i
;
ptrdiff
_t
i
;
register
struct
Lisp_Vector
*
p
;
XSETFASTINT
(
len
,
nargs
);
...
...
@@ -2956,15 +2949,15 @@ argument to catch the left-over arguments. If such an integer is used, the
arguments will not be dynamically bound but will be instead pushed on the
stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */
)
(
register
size
_t
nargs
,
Lisp_Object
*
args
)
(
ptrdiff
_t
nargs
,
Lisp_Object
*
args
)
{
register
Lisp_Object
len
,
val
;
register
size
_t
i
;
ptrdiff
_t
i
;
register
struct
Lisp_Vector
*
p
;
XSETFASTINT
(
len
,
nargs
);
if
(
!
NILP
(
Vpurify_flag
))
val
=
make_pure_vector
(
(
EMACS_INT
)
nargs
);
val
=
make_pure_vector
(
nargs
);
else
val
=
Fmake_vector
(
len
,
Qnil
);
...
...
@@ -3018,10 +3011,6 @@ static int symbol_block_index;
static
struct
Lisp_Symbol
*
symbol_free_list
;
/* Total number of symbol blocks now in use. */
static
int
n_symbol_blocks
;
/* Initialize symbol allocation. */
...
...
@@ -3031,7 +3020,6 @@ init_symbol (void)
symbol_block
=
NULL
;
symbol_block_index
=
SYMBOL_BLOCK_SIZE
;
symbol_free_list
=
0
;
n_symbol_blocks
=
0
;
}
...
...
@@ -3064,7 +3052,6 @@ Its value and function definition are void, and its property list is nil. */)
new
->
next
=
symbol_block
;
symbol_block
=
new
;
symbol_block_index
=
0
;
n_symbol_blocks
++
;
}
XSETSYMBOL
(
val
,
&
symbol_block
->
symbols
[
symbol_block_index
]);
symbol_block_index
++
;
...
...
@@ -3112,17 +3099,12 @@ static int marker_block_index;
static
union
Lisp_Misc
*
marker_free_list
;
/* Total number of marker blocks now in use. */
static
int
n_marker_blocks
;
static
void
init_marker
(
void
)
{
marker_block
=
NULL
;
marker_block_index
=
MARKER_BLOCK_SIZE
;
marker_free_list
=
0
;
n_marker_blocks
=
0
;
}
/* Return a newly allocated Lisp_Misc object, with no substructure. */
...
...
@@ -3151,7 +3133,6 @@ allocate_misc (void)
new
->
next
=
marker_block
;
marker_block
=
new
;
marker_block_index
=
0
;
n_marker_blocks
++
;
total_free_markers
+=
MARKER_BLOCK_SIZE
;
}
XSETMISC
(
val
,
&
marker_block
->
markers
[
marker_block_index
]);
...
...
@@ -3184,7 +3165,7 @@ free_misc (Lisp_Object misc)
The unwind function can get the C values back using XSAVE_VALUE. */
Lisp_Object
make_save_value
(
void
*
pointer
,
in
t
integer
)
make_save_value
(
void
*
pointer
,
ptrdiff_
t
integer
)
{
register
Lisp_Object
val
;
register
struct
Lisp_Save_Value
*
p
;
...
...
@@ -3929,11 +3910,11 @@ static Lisp_Object zombies[MAX_ZOMBIES];
/* Number of zombie objects. */
static
int
nzombies
;
static
EMACS_INT
nzombies
;
/* Number of garbage collections. */
static
int
ngcs
;
static
EMACS_INT
ngcs
;
/* Average percentage of zombies per collection. */
...
...
@@ -3941,7 +3922,7 @@ static double avg_zombies;
/* Max. number of live and zombie objects. */
static
int
max_live
,
max_zombies
;
static
EMACS_INT
max_live
,
max_zombies
;
/* Average number of live objects per GC. */
...
...
@@ -3952,7 +3933,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
(
void
)
{
Lisp_Object
args
[
8
],
zombie_list
=
Qnil
;
int
i
;
EMACS_INT
i
;
for
(
i
=
0
;
i
<
nzombies
;
i
++
)
zombie_list
=
Fcons
(
zombies
[
i
],
zombie_list
);
args
[
0
]
=
build_string
(
"%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d
\n
zombies: %S"
);
...
...
@@ -4262,7 +4243,7 @@ static void