Streamline and fix vector-size checks

* src/alloc.c (VECTOR_ELTS_MAX): New constant.
(allocate_vectorlike): LEN now must be positive.  Assume LEN
is in range.  All callers changed.
(allocate_vector): Arg is now ptrdiff_t, not EMACS_INT.
All callers changed.  Return zero vector here, not in
allocate_vectorlike.
* src/lisp.h (make_uninit_vector): Simplify.
* src/xwidget.c (webkit_js_to_lisp):
Check for overflow in ptrdiff_t calculations.

diff --git a/src/alloc.c b/src/alloc.c
index 8eaa810e53ad64e8e1ac05a7f17d27ad10a051f8..3bc9277a7b284937da06d48a580edbc53519ecf2 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2398,6 +2398,8 @@ make_uninit_bool_vector (EMACS_INT nbits)
   EMACS_INT needed_elements = ((bool_header_size - header_size + word_bytes
                                + word_size - 1)
                               / word_size);
+  if (PTRDIFF_MAX < needed_elements)
+    memory_full (SIZE_MAX);
   struct Lisp_Bool_Vector *p
     = (struct Lisp_Bool_Vector *) allocate_vector (needed_elements);
   XSETVECTOR (val, p);
@@ -3334,67 +3336,68 @@ sweep_vectors (void)
     }
 }
 
+static ptrdiff_t const VECTOR_ELTS_MAX
+  = min (((min (PTRDIFF_MAX, SIZE_MAX) - header_size - large_vector_offset)
+         / word_size),
+        MOST_POSITIVE_FIXNUM);
+
 /* Value is a pointer to a newly allocated Lisp_Vector structure
-   with room for LEN Lisp_Objects.  */
+   with room for LEN Lisp_Objects.  LEN must be positive and
+   at most VECTOR_ELTS_MAX.  */
 
 static struct Lisp_Vector *
 allocate_vectorlike (ptrdiff_t len)
 {
-  if (len == 0)
-    return XVECTOR (zero_vector);
-  else
-    {
-      size_t nbytes = header_size + len * word_size;
-      struct Lisp_Vector *p;
+  eassert (0 < len && len <= VECTOR_ELTS_MAX);
+  size_t nbytes = header_size + len * word_size;
+  struct Lisp_Vector *p;
 
-      MALLOC_BLOCK_INPUT;
+  MALLOC_BLOCK_INPUT;
 
 #ifdef DOUG_LEA_MALLOC
-      if (!mmap_lisp_allowed_p ())
-        mallopt (M_MMAP_MAX, 0);
+  if (!mmap_lisp_allowed_p ())
+    mallopt (M_MMAP_MAX, 0);
 #endif
 
-      if (nbytes <= VBLOCK_BYTES_MAX)
-       p = allocate_vector_from_block (vroundup (nbytes));
-      else
-       {
-         struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes,
-                                                MEM_TYPE_VECTORLIKE);
-         lv->next = large_vectors;
-         large_vectors = lv;
-         p = large_vector_vec (lv);
-       }
+  if (nbytes <= VBLOCK_BYTES_MAX)
+    p = allocate_vector_from_block (vroundup (nbytes));
+  else
+    {
+      struct large_vector *lv = lisp_malloc (large_vector_offset + nbytes,
+                                            MEM_TYPE_VECTORLIKE);
+      lv->next = large_vectors;
+      large_vectors = lv;
+      p = large_vector_vec (lv);
+    }
 
 #ifdef DOUG_LEA_MALLOC
-      if (!mmap_lisp_allowed_p ())
-        mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+  if (!mmap_lisp_allowed_p ())
+    mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
 #endif
 
-      if (find_suspicious_object_in_range (p, (char *) p + nbytes))
-        emacs_abort ();
+  if (find_suspicious_object_in_range (p, (char *) p + nbytes))
+    emacs_abort ();
 
-      consing_since_gc += nbytes;
-      vector_cells_consed += len;
+  consing_since_gc += nbytes;
+  vector_cells_consed += len;
 
-      MALLOC_UNBLOCK_INPUT;
+  MALLOC_UNBLOCK_INPUT;
 
-      return ptr_bounds_clip (p, nbytes);
-    }
+  return ptr_bounds_clip (p, nbytes);
 }
 
 
 /* Allocate a vector with LEN slots.  */
 
 struct Lisp_Vector *
-allocate_vector (EMACS_INT len)
+allocate_vector (ptrdiff_t len)
 {
-  ptrdiff_t wordbytes_max = (min (PTRDIFF_MAX, SIZE_MAX)
-                            - header_size - large_vector_offset);
-  if (min (wordbytes_max / word_size, MOST_POSITIVE_FIXNUM) < len)
+  if (len == 0)
+    return XVECTOR (zero_vector);
+  if (VECTOR_ELTS_MAX < len)
     memory_full (SIZE_MAX);
   struct Lisp_Vector *v = allocate_vectorlike (len);
-  if (len)
-    v->header.size = len;
+  v->header.size = len;
   return v;
 }
 
@@ -3405,14 +3408,16 @@ struct Lisp_Vector *
 allocate_pseudovector (int memlen, int lisplen,
                       int zerolen, enum pvec_type tag)
 {
-  struct Lisp_Vector *v = allocate_vectorlike (memlen);
-
   /* Catch bogus values.  */
+  enum { size_max = (1 << PSEUDOVECTOR_SIZE_BITS) - 1 };
+  enum { rest_max = (1 << PSEUDOVECTOR_REST_BITS) - 1 };
+  verify (size_max + rest_max <= VECTOR_ELTS_MAX);
   eassert (0 <= tag && tag <= PVEC_FONT);
   eassert (0 <= lisplen && lisplen <= zerolen && zerolen <= memlen);
-  eassert (memlen - lisplen <= (1 << PSEUDOVECTOR_REST_BITS) - 1);
-  eassert (lisplen <= PSEUDOVECTOR_SIZE_MASK);
+  eassert (lisplen <= size_max);
+  eassert (memlen <= size_max + rest_max);
 
+  struct Lisp_Vector *v = allocate_vectorlike (memlen);
   /* Only the first LISPLEN slots will be traced normally by the GC.  */
   memclear (v->contents, zerolen * word_size);
   XSETPVECTYPESIZE (v, tag, lisplen, memlen - lisplen);
@@ -3485,7 +3490,8 @@ DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
 See also the function `vector'.  */)
   (Lisp_Object length, Lisp_Object init)
 {
-  CHECK_FIXNAT (length);
+  CHECK_TYPE (FIXNATP (length) && XFIXNAT (length) <= PTRDIFF_MAX,
+             Qwholenump, length);
   struct Lisp_Vector *p = allocate_vector (XFIXNAT (length));
   for (ptrdiff_t i = 0; i < XFIXNAT (length); i++)
     p->contents[i] = init;

diff --git a/src/lisp.h b/src/lisp.h
index 7e7dba631f34ada04353ff3213ae64b4adeccbe0..77b8b63e196bb54729d0fae19e10ebb127e20d73 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3695,7 +3695,7 @@ build_string (const char *str)
 
 extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object);
 extern void make_byte_code (struct Lisp_Vector *);
-extern struct Lisp_Vector *allocate_vector (EMACS_INT);
+extern struct Lisp_Vector *allocate_vector (ptrdiff_t);
 
 /* Make an uninitialized vector for SIZE objects.  NOTE: you must
    be sure that GC cannot happen until the vector is completely
@@ -3709,12 +3709,7 @@ extern struct Lisp_Vector *allocate_vector (EMACS_INT);
 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;
+  return make_lisp_ptr (allocate_vector (size), Lisp_Vectorlike);
 }
 
 /* Like above, but special for sub char-tables.  */

diff --git a/src/xwidget.c b/src/xwidget.c
index 5a8b105f2faeb885d5e0ba07454ce3b47b99e2fe..791dad43c76dcd641928b7703808b1c420ced4e4 100644 (file)
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -310,11 +310,15 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
         if (JSValueIsArray (context, value))
           {
             JSStringRef pname = JSStringCreateWithUTF8CString("length");
-            JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value, pname, NULL);
-            EMACS_INT n = JSValueToNumber (context, len, NULL);
+           JSValueRef len = JSObjectGetProperty (context, (JSObjectRef) value,
+                                                 pname, NULL);
+           double dlen = JSValueToNumber (context, len, NULL);
             JSStringRelease(pname);
 
             Lisp_Object obj;
+           if (! (0 <= dlen && dlen < PTRDIFF_MAX + 1.0))
+             memory_full (SIZE_MAX);
+           ptrdiff_t n = dlen;
             struct Lisp_Vector *p = allocate_vector (n);
 
             for (ptrdiff_t i = 0; i < n; ++i)
@@ -333,10 +337,12 @@ webkit_js_to_lisp (JSContextRef context, JSValueRef value)
             JSPropertyNameArrayRef properties =
               JSObjectCopyPropertyNames (context, (JSObjectRef) value);
 
-            ptrdiff_t n = JSPropertyNameArrayGetCount (properties);
+           size_t n = JSPropertyNameArrayGetCount (properties);
             Lisp_Object obj;
 
             /* TODO: can we use a regular list here?  */
+           if (PTRDIFF_MAX < n)
+             memory_full (n);
             struct Lisp_Vector *p = allocate_vector (n);
 
             for (ptrdiff_t i = 0; i < n; ++i)