* Re: master 669aeaf: Prefer make_nil_vector to make-vector with nil
2020-08-12 13:05 ` Pip Cet
@ 2020-08-15 18:48 ` Paul Eggert
2020-08-15 19:53 ` Pip Cet
0 siblings, 1 reply; 5+ messages in thread
From: Paul Eggert @ 2020-08-15 18:48 UTC (permalink / raw)
To: Pip Cet; +Cc: emacs-devel
[-- Attachment #1: Type: text/plain, Size: 3090 bytes --]
On 8/12/20 6:05 AM, Pip Cet wrote:
> bugs like the one we currently have in fns.c (Fdelete allocates an
> uninitialized vector, then calls Fequal, which can call quit, leaving
> a half-initialized vector on the stack and potentially marked by
> conservative GC) are bound to bite us one day
Good catch; I hadn't noticed this GC-related bug. I looked through the Emacs
source code for similar instances of the bug, and fixed the ones I found with
the first attached patch.
> Particularly for
> small-ish fixed-size vectors, it seems to me uninitialized vectors are
> more trouble than they're worth (in fact, I could see make_vector (n,
> Qnil) being faster on many CPUs, because the cache lines are written
> to completely and don't have to be brought in from RAM.
I don't quite follow. If Fmake_vector (n, Qnil) invokes memset to clear the
memory, then it should work the same way as (make_uninit_vector followed by
immediate initialization) as far as the hardware cache is concerned. And if
Fmake_vector (n, Qnil) doesn't invoke memset but instead relies on calloc (which
in turn just mmaps /dev/zero or whatever), then Fmake_vector should be slower
than uninitialized vectors due to the cache effects that you mention. (If this
is a significant performance issue with Fmake_vector then we should fix it, but
that issue is independent of this discussion.)
> Of the 40 places in *.c that use make_uninit_vector, only three look
> like there might be a tangible benefit: alloc.c, fns.c, and pdumper.c
> (but looking over that last one, I don't understand how
> hash_table_contents is functionally different from Fcopy_sequence
> (h->key_and_value) at this point, with the obvious mutation in
> hash_table_rehash).
If we changed hash_table_contents to use Fcopy_sequence, wouldn't
hash_table_rehash become a bit slower? hash_table_rehash would need to look at
the entire sequence instead of just its first first h->count elements.
That being said, you're right that the Emacs code was using make_uninit_vector
too often, even aside from the GC bugs noted above. Inspired by your comment, I
went through the Emacs source and replaced all calls to make_uninit_vector (and
allocate_vector) that were easy to replace and didn't seem to make any
performance difference, by installing the second attached patch.
This patch isn't as aggressive as your comment suggested, though, as it doesn't
replace code like this from charset.c:
val = make_uninit_vector (8);
for (i = 0; i < 8; i++)
ASET (val, i, make_fixnum (code_space[i]));
Here, changing make_uninit_vector to make_nil_vector initializes unnecessarily,
there's no chance of GC before the vector is initialized, and readability is not
significantly improved by changing the code to something like the following:
val = CALLN (Fvector,
make_fixnum (code_space[0]), make_fixnum (code_space[1]),
make_fixnum (code_space[2]), make_fixnum (code_space[3]),
make_fixnum (code_space[4]), make_fixnum (code_space[5]),
make_fixnum (code_space[6]), make_fixnum (code_space[7]));
[-- Attachment #2: 0001-Fix-GC-bugs-related-to-uninitialized-vectors.patch --]
[-- Type: text/x-patch, Size: 10989 bytes --]
From d0145537fa511a44e2a4af01da3947e92f0b8331 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Sat, 15 Aug 2020 10:48:36 -0700
Subject: [PATCH 1/2] Fix GC bugs related to uninitialized vectors
Avoid problems if GC occurs while initializing a vector.
Problem with Fdelete reported by Pip Cet in:
https://lists.gnu.org/r/emacs-devel/2020-08/msg00313.html
I looked for similar problems elsewhere and found quite a few.
* src/coding.c (make_subsidiaries):
* src/composite.c (syms_of_composite):
* src/font.c (build_style_table, Ffont_get_glyphs):
* src/nsselect.m (clean_local_selection_data):
* src/nsxwidget.m (js_to_lisp):
* src/syntax.c (init_syntax_once):
* src/window.c (Fcurrent_window_configuration):
* src/xselect.c (selection_data_to_lisp_data)
(clean_local_selection_data):
Use make_nil_vector instead of make_uninit_vector.
* src/fns.c (Fdelete):
* src/xwidget.c (webkit_js_to_lisp):
Use allocate_nil_vector instead of allocate_vector.
* src/search.c (Fnewline_cache_check):
Use make_vector instead of make_uninit_vector.
---
src/coding.c | 9 +++------
src/composite.c | 2 +-
src/fns.c | 2 +-
src/font.c | 6 +++---
src/lisp.h | 7 +++++--
src/nsselect.m | 2 +-
src/nsxwidget.m | 4 ++--
src/search.c | 9 ++-------
src/syntax.c | 4 ++--
src/window.c | 2 +-
src/xselect.c | 6 +++---
src/xwidget.c | 4 ++--
12 files changed, 26 insertions(+), 31 deletions(-)
diff --git a/src/coding.c b/src/coding.c
index 1d79c703a3..51bd441de9 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -10856,20 +10856,17 @@ DEFUN ("coding-system-priority-list", Fcoding_system_priority_list,
return Fnreverse (val);
}
-static const char *const suffixes[] = { "-unix", "-dos", "-mac" };
-
static Lisp_Object
make_subsidiaries (Lisp_Object base)
{
- Lisp_Object subsidiaries;
+ static char const suffixes[][8] = { "-unix", "-dos", "-mac" };
ptrdiff_t base_name_len = SBYTES (SYMBOL_NAME (base));
USE_SAFE_ALLOCA;
char *buf = SAFE_ALLOCA (base_name_len + 6);
- int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
- subsidiaries = make_uninit_vector (3);
- for (i = 0; i < 3; i++)
+ Lisp_Object subsidiaries = make_nil_vector (3);
+ for (int i = 0; i < 3; i++)
{
strcpy (buf + base_name_len, suffixes[i]);
ASET (subsidiaries, i, intern (buf));
diff --git a/src/composite.c b/src/composite.c
index ec2b8328f7..396d456f8c 100644
--- a/src/composite.c
+++ b/src/composite.c
@@ -1939,7 +1939,7 @@ syms_of_composite (void)
staticpro (&gstring_hash_table);
staticpro (&gstring_work_headers);
- gstring_work_headers = make_uninit_vector (8);
+ gstring_work_headers = make_nil_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, make_nil_vector (i + 2));
staticpro (&gstring_work);
diff --git a/src/fns.c b/src/fns.c
index 9199178212..ded6f344aa 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1755,7 +1755,7 @@ DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
if (n != ASIZE (seq))
{
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (i = n = 0; i < ASIZE (seq); ++i)
if (NILP (Fequal (AREF (seq, i), elt)))
diff --git a/src/font.c b/src/font.c
index ab00402b40..ccbd3fc9ce 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4889,7 +4889,7 @@ DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
ptrdiff_t len;
- Lisp_Object *chars, vec;
+ Lisp_Object *chars;
USE_SAFE_ALLOCA;
if (NILP (object))
@@ -4957,7 +4957,7 @@ DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
else
wrong_type_argument (Qarrayp, object);
- vec = make_uninit_vector (len);
+ Lisp_Object vec = make_nil_vector (len);
for (ptrdiff_t i = 0; i < len; i++)
{
Lisp_Object g;
@@ -5203,7 +5203,7 @@ #define BUILD_STYLE_TABLE(TBL) build_style_table (TBL, ARRAYELTS (TBL))
static Lisp_Object
build_style_table (const struct table_entry *entry, int nelement)
{
- Lisp_Object table = make_uninit_vector (nelement);
+ Lisp_Object table = make_nil_vector (nelement);
for (int i = 0; i < nelement; i++)
{
int j;
diff --git a/src/lisp.h b/src/lisp.h
index eaf1c6ce6d..7983339ac5 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3916,7 +3916,6 @@ build_string (const char *str)
extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object);
-extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t);
/* Make an uninitialized vector for SIZE objects. NOTE: you must
@@ -3926,7 +3925,11 @@ build_string (const char *str)
v = make_uninit_vector (3);
ASET (v, 0, obj0);
ASET (v, 1, Ffunction_can_gc ());
- ASET (v, 2, obj1); */
+ ASET (v, 2, obj1);
+
+ allocate_vector has a similar problem. */
+
+extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
diff --git a/src/nsselect.m b/src/nsselect.m
index 38ac66e9c7..7b1937f5d9 100644
--- a/src/nsselect.m
+++ b/src/nsselect.m
@@ -114,7 +114,7 @@ Updated by Christian Limpach (chris@nice.ch)
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/nsxwidget.m b/src/nsxwidget.m
index 370abee395..e81ca7fc0c 100644
--- a/src/nsxwidget.m
+++ b/src/nsxwidget.m
@@ -388,7 +388,7 @@ - (void)userContentController:(WKUserContentController *)userContentController
NSArray *nsarr = (NSArray *) value;
EMACS_INT n = nsarr.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
p->contents[i] = js_to_lisp ([nsarr objectAtIndex:i]);
@@ -401,7 +401,7 @@ - (void)userContentController:(WKUserContentController *)userContentController
NSArray *keys = nsdict.allKeys;
ptrdiff_t n = keys.count;
Lisp_Object obj;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
diff --git a/src/search.c b/src/search.c
index 38c64caf7c..23b31d9281 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3271,7 +3271,7 @@ DEFUN ("newline-cache-check", Fnewline_cache_check, Snewline_cache_check,
TYPE_MAXIMUM (ptrdiff_t), &nl_count_cache, NULL, true);
/* Create vector and populate it. */
- cache_newlines = make_uninit_vector (nl_count_cache);
+ cache_newlines = make_vector (nl_count_cache, make_fixnum (-1));
if (nl_count_cache)
{
@@ -3285,15 +3285,12 @@ DEFUN ("newline-cache-check", Fnewline_cache_check, Snewline_cache_check,
break;
ASET (cache_newlines, i, make_fixnum (found - 1));
}
- /* Fill the rest of slots with an invalid position. */
- for ( ; i < nl_count_cache; i++)
- ASET (cache_newlines, i, make_fixnum (-1));
}
/* Now do the same, but without using the cache. */
find_newline1 (BEGV, BEGV_BYTE, ZV, ZV_BYTE,
TYPE_MAXIMUM (ptrdiff_t), &nl_count_buf, NULL, true);
- buf_newlines = make_uninit_vector (nl_count_buf);
+ buf_newlines = make_vector (nl_count_buf, make_fixnum (-1));
if (nl_count_buf)
{
for (from = BEGV, found = from, i = 0; from < ZV; from = found, i++)
@@ -3306,8 +3303,6 @@ DEFUN ("newline-cache-check", Fnewline_cache_check, Snewline_cache_check,
break;
ASET (buf_newlines, i, make_fixnum (found - 1));
}
- for ( ; i < nl_count_buf; i++)
- ASET (buf_newlines, i, make_fixnum (-1));
}
/* Construct the value and return it. */
diff --git a/src/syntax.c b/src/syntax.c
index a03202d386..9f77ea5f9b 100644
--- a/src/syntax.c
+++ b/src/syntax.c
@@ -3617,9 +3617,9 @@ init_syntax_once (void)
DEFSYM (Qsyntax_table, "syntax-table");
/* Create objects which can be shared among syntax tables. */
- Vsyntax_code_object = make_uninit_vector (Smax);
+ Vsyntax_code_object = make_nil_vector (Smax);
for (i = 0; i < Smax; i++)
- ASET (Vsyntax_code_object, i, Fcons (make_fixnum (i), Qnil));
+ ASET (Vsyntax_code_object, i, list1 (make_fixnum (i)));
/* Now we are ready to set up this property, so we can
create syntax tables. */
diff --git a/src/window.c b/src/window.c
index e2dea8b70e..ef58f43a0b 100644
--- a/src/window.c
+++ b/src/window.c
@@ -7465,7 +7465,7 @@ redirection (see `redirect-frame-focus'). The variable
data->minibuf_selected_window = minibuf_level > 0 ? minibuf_selected_window : Qnil;
data->root_window = FRAME_ROOT_WINDOW (f);
data->focus_frame = FRAME_FOCUS_FRAME (f);
- Lisp_Object tem = make_uninit_vector (n_windows);
+ Lisp_Object tem = make_nil_vector (n_windows);
data->saved_windows = tem;
for (ptrdiff_t i = 0; i < n_windows; i++)
ASET (tem, i, make_nil_vector (VECSIZE (struct saved_window)));
diff --git a/src/xselect.c b/src/xselect.c
index 48d6215a7b..bf50c598b2 100644
--- a/src/xselect.c
+++ b/src/xselect.c
@@ -1594,7 +1594,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
return x_atom_to_symbol (dpyinfo, (Atom) idata[0]);
else
{
- Lisp_Object v = make_uninit_vector (size / sizeof (int));
+ Lisp_Object v = make_nil_vector (size / sizeof (int));
for (i = 0; i < size / sizeof (int); i++)
ASET (v, i, x_atom_to_symbol (dpyinfo, (Atom) idata[i]));
@@ -1653,7 +1653,7 @@ selection_data_to_lisp_data (struct x_display_info *dpyinfo,
else
{
ptrdiff_t i;
- Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
+ Lisp_Object v = make_nil_vector (size / X_LONG_SIZE);
if (type == XA_INTEGER)
{
@@ -1860,7 +1860,7 @@ clean_local_selection_data (Lisp_Object obj)
Lisp_Object copy;
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
- copy = make_uninit_vector (size);
+ copy = make_nil_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
diff --git a/src/xwidget.c b/src/xwidget.c
index c61f5bef88..154b3e9c82 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -343,7 +343,7 @@ webkit_js_to_lisp (JSCValue *value)
memory_full (SIZE_MAX);
ptrdiff_t n = dlen;
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
@@ -361,7 +361,7 @@ webkit_js_to_lisp (JSCValue *value)
Lisp_Object obj;
if (PTRDIFF_MAX < n)
memory_full (n);
- struct Lisp_Vector *p = allocate_vector (n);
+ struct Lisp_Vector *p = allocate_nil_vector (n);
for (ptrdiff_t i = 0; i < n; ++i)
{
--
2.17.1
[-- Attachment #3: 0002-Prefer-Fvector-to-make_uninit_vector.patch --]
[-- Type: text/x-patch, Size: 13597 bytes --]
From f1b06fd5fc66377f85b420d3d40c666da9dca2a5 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Sat, 15 Aug 2020 10:48:36 -0700
Subject: [PATCH 2/2] Prefer Fvector to make_uninit_vector
Fvector is less error-prone than make_uninit_vector, as it
avoids the possibility of a GC crash due to an uninitialized
vector. So prefer Fvector to make_uninit_vector when this is
easy (and when there's no significant performance difference).
Inspired by a suggestion by Pip Cet in:
https://lists.gnu.org/r/emacs-devel/2020-08/msg00313.html
* src/ccl.c (Fregister_ccl_program):
* src/ccl.c (Fregister_ccl_program):
* src/charset.c (Fdefine_charset_internal):
* src/font.c (Fquery_font, Ffont_info, syms_of_font):
* src/fontset.c (font_def_new, Fset_fontset_font):
* src/ftfont.c (ftfont_shape_by_flt):
* src/hbfont.c (hbfont_shape):
* src/macfont.m (macfont_shape):
* src/search.c (Fnewline_cache_check):
* src/xfaces.c (Fx_family_fonts):
* src/xfns.c (Fx_window_property_attributes):
Prefer Fvector to make_uninit_vector when either is easy.
* src/fontset.c (font_def_new): Now a function with one less
arg instead of a do-while macro, and renamed from FONT_DEF_NEW.
All uses changed.
---
src/ccl.c | 11 ++-------
src/charset.c | 9 +++----
src/font.c | 68 +++++++++++++++++++++++----------------------------
src/fontset.c | 27 ++++++++------------
src/ftfont.c | 12 +++------
src/hbfont.c | 11 +++------
src/macfont.m | 6 ++---
src/search.c | 4 +--
src/xfaces.c | 28 +++++++++------------
src/xfns.c | 8 +++---
10 files changed, 73 insertions(+), 111 deletions(-)
diff --git a/src/ccl.c b/src/ccl.c
index ef059ffff2..e85cfa6cdf 100644
--- a/src/ccl.c
+++ b/src/ccl.c
@@ -2219,15 +2219,8 @@ DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
/* Extend the table. */
Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
- {
- Lisp_Object elt = make_uninit_vector (4);
-
- ASET (elt, 0, name);
- ASET (elt, 1, ccl_prog);
- ASET (elt, 2, resolved);
- ASET (elt, 3, Qt);
- ASET (Vccl_program_table, idx, elt);
- }
+ ASET (Vccl_program_table, idx,
+ CALLN (Fvector, name, ccl_prog, resolved, Qt));
Fput (name, Qccl_program_idx, make_fixnum (idx));
return make_fixnum (idx);
diff --git a/src/charset.c b/src/charset.c
index 8635aad3ed..520dd3a960 100644
--- a/src/charset.c
+++ b/src/charset.c
@@ -1035,12 +1035,9 @@ DEFUN ("define-charset-internal", Fdefine_charset_internal,
CHECK_FIXNAT (parent_max_code);
parent_code_offset = Fnth (make_fixnum (3), val);
CHECK_FIXNUM (parent_code_offset);
- val = make_uninit_vector (4);
- ASET (val, 0, make_fixnum (parent_charset->id));
- ASET (val, 1, parent_min_code);
- ASET (val, 2, parent_max_code);
- ASET (val, 3, parent_code_offset);
- ASET (attrs, charset_subset, val);
+ ASET (attrs, charset_subset,
+ CALLN (Fvector, make_fixnum (parent_charset->id),
+ parent_min_code, parent_max_code, parent_code_offset));
charset.method = CHARSET_METHOD_SUBSET;
/* Here, we just copy the parent's fast_map. It's not accurate,
diff --git a/src/font.c b/src/font.c
index ccbd3fc9ce..5c01c7ff79 100644
--- a/src/font.c
+++ b/src/font.c
@@ -4847,21 +4847,18 @@ DEFUN ("query-font", Fquery_font, Squery_font, 1, 1, 0,
(Lisp_Object font_object)
{
struct font *font = CHECK_FONT_GET_OBJECT (font_object);
- Lisp_Object val = make_uninit_vector (9);
-
- ASET (val, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (val, 1, AREF (font_object, FONT_FILE_INDEX));
- ASET (val, 2, make_fixnum (font->pixel_size));
- ASET (val, 3, make_fixnum (font->max_width));
- ASET (val, 4, make_fixnum (font->ascent));
- ASET (val, 5, make_fixnum (font->descent));
- ASET (val, 6, make_fixnum (font->space_width));
- ASET (val, 7, make_fixnum (font->average_width));
- if (font->driver->otf_capability)
- ASET (val, 8, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (val, 8, Qnil);
- return val;
+ return CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FILE_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
}
DEFUN ("font-get-glyphs", Ffont_get_glyphs, Sfont_get_glyphs, 3, 4, 0,
@@ -5168,24 +5165,23 @@ DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
return Qnil;
font = XFONT_OBJECT (font_object);
- info = make_uninit_vector (14);
- ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
- ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
- ASET (info, 2, make_fixnum (font->pixel_size));
- ASET (info, 3, make_fixnum (font->height));
- ASET (info, 4, make_fixnum (font->baseline_offset));
- ASET (info, 5, make_fixnum (font->relative_compose));
- ASET (info, 6, make_fixnum (font->default_ascent));
- ASET (info, 7, make_fixnum (font->max_width));
- ASET (info, 8, make_fixnum (font->ascent));
- ASET (info, 9, make_fixnum (font->descent));
- ASET (info, 10, make_fixnum (font->space_width));
- ASET (info, 11, make_fixnum (font->average_width));
- ASET (info, 12, AREF (font_object, FONT_FILE_INDEX));
- if (font->driver->otf_capability)
- ASET (info, 13, Fcons (Qopentype, font->driver->otf_capability (font)));
- else
- ASET (info, 13, Qnil);
+ info = CALLN (Fvector,
+ AREF (font_object, FONT_NAME_INDEX),
+ AREF (font_object, FONT_FULLNAME_INDEX),
+ make_fixnum (font->pixel_size),
+ make_fixnum (font->height),
+ make_fixnum (font->baseline_offset),
+ make_fixnum (font->relative_compose),
+ make_fixnum (font->default_ascent),
+ make_fixnum (font->max_width),
+ make_fixnum (font->ascent),
+ make_fixnum (font->descent),
+ make_fixnum (font->space_width),
+ make_fixnum (font->average_width),
+ AREF (font_object, FONT_FILE_INDEX),
+ (font->driver->otf_capability
+ ? Fcons (Qopentype, font->driver->otf_capability (font))
+ : Qnil));
#if 0
/* As font_object is still in FONT_OBJLIST of the entity, we can't
@@ -5494,10 +5490,8 @@ syms_of_font (void)
make_symbol_constant (intern_c_string ("font-width-table"));
staticpro (&font_style_table);
- font_style_table = make_uninit_vector (3);
- ASET (font_style_table, 0, Vfont_weight_table);
- ASET (font_style_table, 1, Vfont_slant_table);
- ASET (font_style_table, 2, Vfont_width_table);
+ font_style_table = CALLN (Fvector, Vfont_weight_table, Vfont_slant_table,
+ Vfont_width_table);
DEFVAR_LISP ("font-log", Vfont_log, doc: /*
A list that logs font-related actions and results, for debugging.
diff --git a/src/fontset.c b/src/fontset.c
index c2bb8b21f2..8c86075c07 100644
--- a/src/fontset.c
+++ b/src/fontset.c
@@ -252,14 +252,13 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
#define BASE_FONTSET_P(fontset) (NILP (FONTSET_BASE (fontset)))
-/* Macros for FONT-DEF and RFONT-DEF of fontset. */
-#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
- do { \
- (font_def) = make_uninit_vector (3); \
- ASET ((font_def), 0, font_spec); \
- ASET ((font_def), 1, encoding); \
- ASET ((font_def), 2, repertory); \
- } while (0)
+/* Definitions for FONT-DEF and RFONT-DEF of fontset. */
+static Lisp_Object
+font_def_new (Lisp_Object font_spec, Lisp_Object encoding,
+ Lisp_Object repertory)
+{
+ return CALLN (Fvector, font_spec, encoding, repertory);
+}
#define FONT_DEF_SPEC(font_def) AREF (font_def, 0)
#define FONT_DEF_ENCODING(font_def) AREF (font_def, 1)
@@ -1547,7 +1546,7 @@ DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
repertory = CHARSET_SYMBOL_ID (repertory);
}
}
- FONT_DEF_NEW (font_def, font_spec, encoding, repertory);
+ font_def = font_def_new (font_spec, encoding, repertory);
}
else
font_def = Qnil;
@@ -1619,14 +1618,8 @@ DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0,
if (charset)
{
- Lisp_Object arg;
-
- arg = make_uninit_vector (5);
- ASET (arg, 0, fontset);
- ASET (arg, 1, font_def);
- ASET (arg, 2, add);
- ASET (arg, 3, ascii_changed ? Qt : Qnil);
- ASET (arg, 4, range_list);
+ Lisp_Object arg = CALLN (Fvector, fontset, font_def, add,
+ ascii_changed ? Qt : Qnil, range_list);
map_charset_chars (set_fontset_font, Qnil, arg, charset,
CHARSET_MIN_CODE (charset),
diff --git a/src/ftfont.c b/src/ftfont.c
index 696f5e6534..a904007a32 100644
--- a/src/ftfont.c
+++ b/src/ftfont.c
@@ -2826,14 +2826,10 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
LGLYPH_SET_ASCENT (lglyph, g->g.ascent >> 6);
LGLYPH_SET_DESCENT (lglyph, g->g.descent >> 6);
if (g->g.adjusted)
- {
- Lisp_Object vec = make_uninit_vector (3);
-
- ASET (vec, 0, make_fixnum (g->g.xoff >> 6));
- ASET (vec, 1, make_fixnum (g->g.yoff >> 6));
- ASET (vec, 2, make_fixnum (g->g.xadv >> 6));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (g->g.xoff >> 6),
+ make_fixnum (g->g.yoff >> 6),
+ make_fixnum (g->g.xadv >> 6)));
}
return make_fixnum (i);
}
diff --git a/src/hbfont.c b/src/hbfont.c
index 4b3f64ef50..82b115e686 100644
--- a/src/hbfont.c
+++ b/src/hbfont.c
@@ -594,13 +594,10 @@ hbfont_shape (Lisp_Object lgstring, Lisp_Object direction)
yoff = - lround (pos[i].y_offset * position_unit);
wadjust = lround (pos[i].x_advance * position_unit);
if (xoff || yoff || wadjust != metrics.width)
- {
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
- LGLYPH_SET_ADJUSTMENT (lglyph, vec);
- }
+ LGLYPH_SET_ADJUSTMENT (lglyph, CALLN (Fvector,
+ make_fixnum (xoff),
+ make_fixnum (yoff),
+ make_fixnum (wadjust)));
}
return make_fixnum (glyph_len);
diff --git a/src/macfont.m b/src/macfont.m
index c7430d3277..904814647f 100644
--- a/src/macfont.m
+++ b/src/macfont.m
@@ -3137,10 +3137,8 @@ So we use CTFontDescriptorCreateMatchingFontDescriptor (no
wadjust = lround (gl->advance);
if (xoff != 0 || yoff != 0 || wadjust != metrics.width)
{
- Lisp_Object vec = make_uninit_vector (3);
- ASET (vec, 0, make_fixnum (xoff));
- ASET (vec, 1, make_fixnum (yoff));
- ASET (vec, 2, make_fixnum (wadjust));
+ Lisp_Object vec = CALLN (Fvector, make_fixnum (xoff),
+ make_fixnum (yoff), make_fixnum (wadjust));
LGLYPH_SET_ADJUSTMENT (lglyph, vec);
}
}
diff --git a/src/search.c b/src/search.c
index 23b31d9281..6fb3716cd4 100644
--- a/src/search.c
+++ b/src/search.c
@@ -3306,9 +3306,7 @@ DEFUN ("newline-cache-check", Fnewline_cache_check, Snewline_cache_check,
}
/* Construct the value and return it. */
- val = make_uninit_vector (2);
- ASET (val, 0, cache_newlines);
- ASET (val, 1, buf_newlines);
+ val = CALLN (Fvector, cache_newlines, buf_newlines);
if (old != NULL)
set_buffer_internal_1 (old);
diff --git a/src/xfaces.c b/src/xfaces.c
index 2c6e593f63..06d2f994de 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -1572,22 +1572,18 @@ DEFUN ("x-family-fonts", Fx_family_fonts, Sx_family_fonts, 0, 2, 0,
for (i = nfonts - 1; i >= 0; --i)
{
Lisp_Object font = AREF (vec, i);
- Lisp_Object v = make_uninit_vector (8);
- int point;
- Lisp_Object spacing;
-
- ASET (v, 0, AREF (font, FONT_FAMILY_INDEX));
- ASET (v, 1, FONT_WIDTH_SYMBOLIC (font));
- point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
- FRAME_RES_Y (f));
- ASET (v, 2, make_fixnum (point));
- ASET (v, 3, FONT_WEIGHT_SYMBOLIC (font));
- ASET (v, 4, FONT_SLANT_SYMBOLIC (font));
- spacing = Ffont_get (font, QCspacing);
- ASET (v, 5, (NILP (spacing) || EQ (spacing, Qp)) ? Qnil : Qt);
- ASET (v, 6, Ffont_xlfd_name (font, Qnil));
- ASET (v, 7, AREF (font, FONT_REGISTRY_INDEX));
-
+ int point = PIXEL_TO_POINT (XFIXNUM (AREF (font, FONT_SIZE_INDEX)) * 10,
+ FRAME_RES_Y (f));
+ Lisp_Object spacing = Ffont_get (font, QCspacing);
+ Lisp_Object v = CALLN (Fvector,
+ AREF (font, FONT_FAMILY_INDEX),
+ FONT_WIDTH_SYMBOLIC (font),
+ make_fixnum (point),
+ FONT_WEIGHT_SYMBOLIC (font),
+ FONT_SLANT_SYMBOLIC (font),
+ NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt,
+ Ffont_xlfd_name (font, Qnil),
+ AREF (font, FONT_REGISTRY_INDEX));
result = Fcons (v, result);
}
diff --git a/src/xfns.c b/src/xfns.c
index 09dcbbfb92..07bba90eaf 100644
--- a/src/xfns.c
+++ b/src/xfns.c
@@ -6196,10 +6196,10 @@ DEFUN ("x-window-property-attributes", Fx_window_property_attributes, Sx_window_
{
XFree (tmp_data);
- prop_attr = make_uninit_vector (3);
- ASET (prop_attr, 0, make_fixnum (actual_type));
- ASET (prop_attr, 1, make_fixnum (actual_format));
- ASET (prop_attr, 2, make_fixnum (bytes_remaining / (actual_format >> 3)));
+ prop_attr = CALLN (Fvector,
+ make_fixnum (actual_type),
+ make_fixnum (actual_format),
+ make_fixnum (bytes_remaining / (actual_format >> 3)));
}
unblock_input ();
--
2.17.1
^ permalink raw reply related [flat|nested] 5+ messages in thread