Commit 25721f5b authored by Dmitry Antipov's avatar Dmitry Antipov

* lisp.h (make_uninit_vector): New function.

* alloc.c (Fvector, Fmake_byte_code):
* ccl.c (Fregister_ccl_program):
* charset.c (Fdefine_charset_internal, define_charset_internal):
* coding.c (make_subsidiaries, Fdefine_coding_system_internal):
* composite.c (syms_of_composite):
* font.c (Fquery_font, Ffont_info, syms_of_font):
* fontset.c (FONT_DEF_NEW, Fset_fontset_font):
* ftfont.c (ftfont_shape_by_flt):
* indent.c (recompute_width_table):
* nsselect.m (clean_local_selection_data):
* syntax.c (init_syntax_once):
* w32unsubscribe.c (uniscribe_shape):
* window.c (Fcurrent_window_configuration):
* xfaces.c (Fx_family_fonts):
* xselect.c (selection_data_to_lisp_data): Use it.
parent 9a9d91d9
2013-02-08 Dmitry Antipov <dmantipov@yandex.ru>
* lisp.h (make_uninit_vector): New function.
* alloc.c (Fvector, Fmake_byte_code):
* ccl.c (Fregister_ccl_program):
* charset.c (Fdefine_charset_internal, define_charset_internal):
* coding.c (make_subsidiaries, Fdefine_coding_system_internal):
* composite.c (syms_of_composite):
* font.c (Fquery_font, Ffont_info, syms_of_font):
* fontset.c (FONT_DEF_NEW, Fset_fontset_font):
* ftfont.c (ftfont_shape_by_flt):
* indent.c (recompute_width_table):
* nsselect.m (clean_local_selection_data):
* syntax.c (init_syntax_once):
* w32unsubscribe.c (uniscribe_shape):
* window.c (Fcurrent_window_configuration):
* xfaces.c (Fx_family_fonts):
* xselect.c (selection_data_to_lisp_data): Use it.
2013-02-07 Dmitry Antipov <dmantipov@yandex.ru>
* coding.c (Fdefine_coding_system_internal): Use AREF where
......
......@@ -3105,13 +3105,10 @@ Any number of arguments, even zero arguments, are allowed.
usage: (vector &rest OBJECTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
ptrdiff_t i;
register struct Lisp_Vector *p;
register Lisp_Object val = make_uninit_vector (nargs);
register struct Lisp_Vector *p = XVECTOR (val);
XSETFASTINT (len, nargs);
val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
for (i = 0; i < nargs; i++)
p->contents[i] = args[i];
return val;
......@@ -3149,9 +3146,9 @@ stack before executing the byte-code.
usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */)
(ptrdiff_t nargs, Lisp_Object *args)
{
register Lisp_Object len, val;
ptrdiff_t i;
register struct Lisp_Vector *p;
register Lisp_Object val = make_uninit_vector (nargs);
register struct Lisp_Vector *p = XVECTOR (val);
/* We used to purecopy everything here, if purify-flag was set. This worked
OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
......@@ -3161,10 +3158,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
just wasteful and other times plainly wrong (e.g. those free vars may want
to be setcar'd). */
XSETFASTINT (len, nargs);
val = Fmake_vector (len, Qnil);
p = XVECTOR (val);
for (i = 0; i < nargs; i++)
p->contents[i] = args[i];
make_byte_code (p);
......
......@@ -2228,9 +2228,8 @@ Return index number of the registered CCL program. */)
Vccl_program_table = larger_vector (Vccl_program_table, 1, -1);
{
Lisp_Object elt;
Lisp_Object elt = make_uninit_vector (4);
elt = Fmake_vector (make_number (4), Qnil);
ASET (elt, 0, name);
ASET (elt, 1, ccl_prog);
ASET (elt, 2, resolved);
......
......@@ -1053,7 +1053,7 @@ usage: (define-charset-internal ...) */)
CHECK_NATNUM (parent_max_code);
parent_code_offset = Fnth (make_number (3), val);
CHECK_NUMBER (parent_code_offset);
val = Fmake_vector (make_number (4), Qnil);
val = make_uninit_vector (4);
ASET (val, 0, make_number (parent_charset->id));
ASET (val, 1, parent_min_code);
ASET (val, 2, parent_max_code);
......@@ -1259,7 +1259,7 @@ define_charset_internal (Lisp_Object name,
args[charset_arg_name] = name;
args[charset_arg_dimension] = make_number (dimension);
val = Fmake_vector (make_number (8), make_number (0));
val = make_uninit_vector (8);
for (i = 0; i < 8; i++)
ASET (val, i, make_number (code_space[i]));
args[charset_arg_code_space] = val;
......
......@@ -9483,7 +9483,7 @@ make_subsidiaries (Lisp_Object base)
int i;
memcpy (buf, SDATA (SYMBOL_NAME (base)), base_name_len);
subsidiaries = Fmake_vector (make_number (3), Qnil);
subsidiaries = make_uninit_vector (3);
for (i = 0; i < 3; i++)
{
strcpy (buf + base_name_len, suffixes[i]);
......@@ -9988,7 +9988,8 @@ usage: (define-coding-system-internal ...) */)
this_name = AREF (eol_type, i);
this_aliases = Fcons (this_name, Qnil);
this_eol_type = (i == 0 ? Qunix : i == 1 ? Qdos : Qmac);
this_spec = Fmake_vector (make_number (3), attrs);
this_spec = make_uninit_vector (3);
ASET (this_spec, 0, attrs);
ASET (this_spec, 1, this_aliases);
ASET (this_spec, 2, this_eol_type);
Fputhash (this_name, this_spec, Vcoding_system_hash_table);
......@@ -10001,7 +10002,8 @@ usage: (define-coding-system-internal ...) */)
}
}
spec_vec = Fmake_vector (make_number (3), attrs);
spec_vec = make_uninit_vector (3);
ASET (spec_vec, 0, attrs);
ASET (spec_vec, 1, aliases);
ASET (spec_vec, 2, eol_type);
......
......@@ -1958,7 +1958,7 @@ syms_of_composite (void)
}
staticpro (&gstring_work_headers);
gstring_work_headers = Fmake_vector (make_number (8), Qnil);
gstring_work_headers = make_uninit_vector (8);
for (i = 0; i < 8; i++)
ASET (gstring_work_headers, i, Fmake_vector (make_number (i + 2), Qnil));
staticpro (&gstring_work);
......
......@@ -4603,7 +4603,7 @@ If the font is not OpenType font, CAPABILITY is nil. */)
CHECK_FONT_GET_OBJECT (font_object, font);
val = Fmake_vector (make_number (9), Qnil);
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_number (font->pixel_size));
......@@ -4614,6 +4614,8 @@ If the font is not OpenType font, CAPABILITY is nil. */)
ASET (val, 7, make_number (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;
}
......@@ -4870,7 +4872,7 @@ If the named font is not yet loaded, return nil. */)
return Qnil;
font = XFONT_OBJECT (font_object);
info = Fmake_vector (make_number (7), Qnil);
info = make_uninit_vector (7);
ASET (info, 0, AREF (font_object, FONT_NAME_INDEX));
ASET (info, 1, AREF (font_object, FONT_FULLNAME_INDEX));
ASET (info, 2, make_number (font->pixel_size));
......@@ -5163,7 +5165,7 @@ See `font-weight-table' for the format of the vector. */);
XSYMBOL (intern_c_string ("font-width-table"))->constant = 1;
staticpro (&font_style_table);
font_style_table = Fmake_vector (make_number (3), Qnil);
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);
......
......@@ -271,7 +271,8 @@ set_fontset_fallback (Lisp_Object fontset, Lisp_Object fallback)
/* Macros for FONT-DEF and RFONT-DEF of fontset. */
#define FONT_DEF_NEW(font_def, font_spec, encoding, repertory) \
do { \
(font_def) = Fmake_vector (make_number (3), (font_spec)); \
(font_def) = make_uninit_vector (3); \
ASET ((font_def), 0, font_spec); \
ASET ((font_def), 1, encoding); \
ASET ((font_def), 2, repertory); \
} while (0)
......@@ -1591,7 +1592,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */)
{
Lisp_Object arg;
arg = Fmake_vector (make_number (5), Qnil);
arg = make_uninit_vector (5);
ASET (arg, 0, fontset);
ASET (arg, 1, font_def);
ASET (arg, 2, add);
......
......@@ -2555,9 +2555,8 @@ ftfont_shape_by_flt (Lisp_Object lgstring, struct font *font,
LGLYPH_SET_DESCENT (lglyph, g->descent >> 6);
if (g->adjusted)
{
Lisp_Object vec;
Lisp_Object vec = make_uninit_vector (3);
vec = Fmake_vector (make_number (3), Qnil);
ASET (vec, 0, make_number (g->xoff >> 6));
ASET (vec, 1, make_number (g->yoff >> 6));
ASET (vec, 2, make_number (g->xadv >> 6));
......
......@@ -138,7 +138,7 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab)
struct Lisp_Vector *widthtab;
if (!VECTORP (BVAR (buf, width_table)))
bset_width_table (buf, Fmake_vector (make_number (256), make_number (0)));
bset_width_table (buf, make_uninit_vector (256));
widthtab = XVECTOR (BVAR (buf, width_table));
eassert (widthtab->header.size == 256);
......
......@@ -3043,6 +3043,27 @@ extern void make_byte_code (struct Lisp_Vector *);
extern Lisp_Object Qautomatic_gc;
extern Lisp_Object Qchar_table_extra_slots;
extern struct Lisp_Vector *allocate_vector (EMACS_INT);
/* Make an unitialized vector for SIZE objects. NOTE: you must
be sure that GC cannot happen until the vector is completely
initialized. E.g. the following code is likely to crash:
v = make_uninit_vector (3);
ASET (v, 0, obj0);
ASET (v, 1, Ffunction_can_gc ());
ASET (v, 2, obj1); */
LISP_INLINE Lisp_Object
make_uninit_vector (ptrdiff_t size)
{
Lisp_Object v;
struct Lisp_Vector *p;
p = allocate_vector (size);
XSETVECTOR (v, p);
return v;
}
extern struct Lisp_Vector *allocate_pseudovector (int, int, enum pvec_type);
#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
((typ*) \
......
......@@ -117,7 +117,7 @@ Updated by Christian Limpach (chris@nice.ch)
if (size == 1)
return clean_local_selection_data (AREF (obj, 0));
copy = Fmake_vector (make_number (size), Qnil);
copy = make_uninit_vector (size);
for (i = 0; i < size; i++)
ASET (copy, i, clean_local_selection_data (AREF (obj, i)));
return copy;
......
......@@ -3389,8 +3389,8 @@ init_syntax_once (void)
Qchar_table_extra_slots = intern_c_string ("char-table-extra-slots");
/* Create objects which can be shared among syntax tables. */
Vsyntax_code_object = Fmake_vector (make_number (Smax), Qnil);
for (i = 0; i < ASIZE (Vsyntax_code_object); i++)
Vsyntax_code_object = make_uninit_vector (Smax);
for (i = 0; i < Smax; i++)
ASET (Vsyntax_code_object, i, Fcons (make_number (i), Qnil));
/* Now we are ready to set up this property, so we can
......
......@@ -435,8 +435,8 @@ uniscribe_shape (Lisp_Object lgstring)
are zero. */
|| (!attributes[j].fClusterStart && items[i].a.fRTL))
{
Lisp_Object vec;
vec = Fmake_vector (make_number (3), Qnil);
Lisp_Object vec = make_uninit_vector (3);
if (items[i].a.fRTL)
{
/* Empirically, it looks like Uniscribe
......
......@@ -6190,11 +6190,11 @@ saved by this function. */)
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);
tem = Fmake_vector (make_number (n_windows), Qnil);
tem = make_uninit_vector (n_windows);
data->saved_windows = tem;
for (i = 0; i < n_windows; i++)
ASET (tem, i,
Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil));
Fmake_vector (make_number (VECSIZE (struct saved_window)), Qnil));
save_window_save (FRAME_ROOT_WINDOW (f), XVECTOR (tem), 0);
XSETWINDOW_CONFIGURATION (tem, data);
return (tem);
......
......@@ -1585,7 +1585,7 @@ the face font sort order. */)
for (i = nfonts - 1; i >= 0; --i)
{
Lisp_Object font = AREF (vec, i);
Lisp_Object v = Fmake_vector (make_number (8), Qnil);
Lisp_Object v = make_uninit_vector (8);
int point;
Lisp_Object spacing;
......
......@@ -1670,8 +1670,8 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
return x_atom_to_symbol (display, (Atom) idata[0]);
else
{
Lisp_Object v = Fmake_vector (make_number (size / sizeof (int)),
make_number (0));
Lisp_Object v = make_uninit_vector (size / sizeof (int));
for (i = 0; i < size / sizeof (int); i++)
ASET (v, i, x_atom_to_symbol (display, (Atom) idata[i]));
return v;
......@@ -1693,8 +1693,8 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
else if (format == 16)
{
ptrdiff_t i;
Lisp_Object v;
v = Fmake_vector (make_number (size / 2), make_number (0));
Lisp_Object v = make_uninit_vector (size / 2);
for (i = 0; i < size / 2; i++)
{
short j = ((short *) data) [i];
......@@ -1705,8 +1705,8 @@ selection_data_to_lisp_data (Display *display, const unsigned char *data,
else
{
ptrdiff_t i;
Lisp_Object v = Fmake_vector (make_number (size / X_LONG_SIZE),
make_number (0));
Lisp_Object v = make_uninit_vector (size / X_LONG_SIZE);
for (i = 0; i < size / X_LONG_SIZE; i++)
{
int j = ((int *) data) [i];
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment