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

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  <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 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];