From 25721f5bb5681c22f666a0b4e61d94687d92a671 Mon Sep 17 00:00:00 2001 From: Dmitry Antipov Date: Fri, 8 Feb 2013 09:28:52 +0400 Subject: [PATCH] * 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. --- src/ChangeLog | 19 +++++++++++++++++++ src/alloc.c | 15 ++++----------- src/ccl.c | 3 +-- src/charset.c | 4 ++-- src/coding.c | 8 +++++--- src/composite.c | 2 +- src/font.c | 8 +++++--- src/fontset.c | 5 +++-- src/ftfont.c | 3 +-- src/indent.c | 2 +- src/lisp.h | 21 +++++++++++++++++++++ src/nsselect.m | 2 +- src/syntax.c | 4 ++-- src/w32uniscribe.c | 4 ++-- src/window.c | 4 ++-- src/xfaces.c | 2 +- src/xselect.c | 12 ++++++------ 17 files changed, 77 insertions(+), 41 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 9ffe133e758..073227281f0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,22 @@ +2013-02-08 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. + 2013-02-07 Dmitry Antipov * coding.c (Fdefine_coding_system_internal): Use AREF where diff --git a/src/alloc.c b/src/alloc.c index 2624650ed2c..80086433e65 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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); diff --git a/src/ccl.c b/src/ccl.c index 9bfd437d885..7f77e1d22fa 100644 --- a/src/ccl.c +++ b/src/ccl.c @@ -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); diff --git a/src/charset.c b/src/charset.c index c3a4538f223..fdb8eebde8b 100644 --- a/src/charset.c +++ b/src/charset.c @@ -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; diff --git a/src/coding.c b/src/coding.c index c7bfe25e0cc..b881f162ab9 100644 --- a/src/coding.c +++ b/src/coding.c @@ -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); diff --git a/src/composite.c b/src/composite.c index ddd92389725..54cebc00eb7 100644 --- a/src/composite.c +++ b/src/composite.c @@ -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); diff --git a/src/font.c b/src/font.c index 3cffe2558ae..bed0ac8caf2 100644 --- a/src/font.c +++ b/src/font.c @@ -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); diff --git a/src/fontset.c b/src/fontset.c index b7f3e46d69c..3578bc9403d 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -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); diff --git a/src/ftfont.c b/src/ftfont.c index 03e40bf2e46..1fb1b574a1c 100644 --- a/src/ftfont.c +++ b/src/ftfont.c @@ -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)); diff --git a/src/indent.c b/src/indent.c index 45b6afbd395..44ecbbc8a58 100644 --- a/src/indent.c +++ b/src/indent.c @@ -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); diff --git a/src/lisp.h b/src/lisp.h index 251b5e069ec..c15e83bd51c 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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*) \ diff --git a/src/nsselect.m b/src/nsselect.m index 903448ce0a5..49380f87945 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -117,7 +117,7 @@ clean_local_selection_data (Lisp_Object obj) 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; diff --git a/src/syntax.c b/src/syntax.c index 72d904914ec..6febcd266c0 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -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 diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 88227487d35..56931adfac5 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -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 diff --git a/src/window.c b/src/window.c index 5679c150efa..cc115c094f0 100644 --- a/src/window.c +++ b/src/window.c @@ -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); diff --git a/src/xfaces.c b/src/xfaces.c index 43535b9ea0c..33a221fdd52 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -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; diff --git a/src/xselect.c b/src/xselect.c index d769f86cdef..decea696bfd 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -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]; -- 2.11.4.GIT