* 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.

diff --git a/src/ChangeLog b/src/ChangeLog
index 9ffe133..0732272 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,22 @@
+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

diff --git a/src/alloc.c b/src/alloc.c
index 2624650..8008643 100644 (file)
--- 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 9bfd437..7f77e1d 100644 (file)
--- 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 c3a4538..fdb8eeb 100644 (file)
--- 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 c7bfe25..b881f16 100644 (file)
--- 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 ddd9238..54cebc0 100644 (file)
--- 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 3cffe25..bed0ac8 100644 (file)
--- 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 b7f3e46..3578bc9 100644 (file)
--- 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 03e40bf..1fb1b57 100644 (file)
--- 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 45b6afb..44ecbbc 100644 (file)
--- 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 251b5e0..c15e83b 100644 (file)
--- 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 903448c..49380f8 100644 (file)
--- 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 72d9049..6febcd2 100644 (file)
--- 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 8822748..56931ad 100644 (file)
--- 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 5679c15..cc115c0 100644 (file)
--- 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 43535b9..33a221f 100644 (file)
--- 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 d769f86..decea69 100644 (file)
--- 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];