1 files changed, 80 insertions, 101 deletions

diff --git a/src/alloc.c b/src/alloc.c
index cfbb79b2e61..00d330c1b6a 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -180,9 +180,9 @@ int abort_on_gc;
 
 /* Number of live and free conses etc.  */
 
-static int total_conses, total_markers, total_symbols, total_vector_size;
-static int total_free_conses, total_free_markers, total_free_symbols;
-static int total_free_floats, total_floats;
+static EMACS_INT total_conses, total_markers, total_symbols, total_vector_size;
+static EMACS_INT total_free_conses, total_free_markers, total_free_symbols;
+static EMACS_INT total_free_floats, total_floats;
 
 /* Points to memory space allocated as "spare", to be freed if we run
    out of memory.  We keep one large block, four cons-blocks, and
@@ -485,7 +485,9 @@ buffer_memory_full (EMACS_INT nbytes)
 }
 
 
-#ifdef XMALLOC_OVERRUN_CHECK
+#ifndef XMALLOC_OVERRUN_CHECK
+#define XMALLOC_OVERRUN_CHECK_SIZE 0
+#else
 
 /* Check for overrun in malloc'ed buffers by wrapping a 16 byte header
    and a 16 byte trailer around each block.
@@ -1336,16 +1338,12 @@ static int interval_block_index;
 
 /* Number of free and live intervals.  */
 
-static int total_free_intervals, total_intervals;
+static EMACS_INT total_free_intervals, total_intervals;
 
 /* List of free intervals.  */
 
 static INTERVAL interval_free_list;
 
-/* Total number of interval blocks now in use.  */
-
-static int n_interval_blocks;
-
 
 /* Initialize interval allocation.  */
 
@@ -1355,7 +1353,6 @@ init_intervals (void)
   interval_block = NULL;
   interval_block_index = INTERVAL_BLOCK_SIZE;
   interval_free_list = 0;
-  n_interval_blocks = 0;
 }
 
 
@@ -1387,7 +1384,6 @@ make_interval (void)
           newi->next = interval_block;
           interval_block = newi;
           interval_block_index = 0;
-          n_interval_blocks++;
         }
       val = &interval_block->intervals[interval_block_index++];
     }
@@ -1580,10 +1576,9 @@ static struct sblock *oldest_sblock, *current_sblock;
 
 static struct sblock *large_sblocks;
 
-/* List of string_block structures, and how many there are.  */
+/* List of string_block structures.  */
 
 static struct string_block *string_blocks;
-static int n_string_blocks;
 
 /* Free-list of Lisp_Strings.  */
 
@@ -1591,7 +1586,7 @@ static struct Lisp_String *string_free_list;
 
 /* Number of live and free Lisp_Strings.  */
 
-static int total_strings, total_free_strings;
+static EMACS_INT total_strings, total_free_strings;
 
 /* Number of bytes used by live strings.  */
 
@@ -1659,6 +1654,18 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
 
 #define GC_STRING_EXTRA (GC_STRING_OVERRUN_COOKIE_SIZE)
 
+/* Exact bound on the number of bytes in a string, not counting the
+   terminating null.  A string cannot contain more bytes than
+   STRING_BYTES_BOUND, nor can it be so long that the size_t
+   arithmetic in allocate_string_data would overflow while it is
+   calculating a value to be passed to malloc.  */
+#define STRING_BYTES_MAX                                          \
+  min (STRING_BYTES_BOUND,                                        \
+       ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_SIZE - GC_STRING_EXTRA  \
+         - offsetof (struct sblock, first_data)                   \
+         - SDATA_DATA_OFFSET)                                     \
+        & ~(sizeof (EMACS_INT) - 1)))
+
 /* Initialize string allocation.  Called from init_alloc_once.  */
 
 static void
@@ -1667,7 +1674,6 @@ init_strings (void)
   total_strings = total_free_strings = total_string_size = 0;
   oldest_sblock = current_sblock = large_sblocks = NULL;
   string_blocks = NULL;
-  n_string_blocks = 0;
   string_free_list = NULL;
   empty_unibyte_string = make_pure_string ("", 0, 0, 0);
   empty_multibyte_string = make_pure_string ("", 0, 0, 1);
@@ -1799,7 +1805,6 @@ allocate_string (void)
       memset (b, 0, sizeof *b);
       b->next = string_blocks;
       string_blocks = b;
-      ++n_string_blocks;
 
       for (i = STRING_BLOCK_SIZE - 1; i >= 0; --i)
         {
@@ -1858,6 +1863,9 @@ allocate_string_data (struct Lisp_String *s,
   struct sblock *b;
   EMACS_INT needed, old_nbytes;
 
+  if (STRING_BYTES_MAX < nbytes)
+    string_overflow ();
+
   /* Determine the number of bytes needed to store NBYTES bytes
      of string data.  */
   needed = SDATA_SIZE (nbytes);
@@ -2025,7 +2033,6 @@ sweep_strings (void)
           && total_free_strings > STRING_BLOCK_SIZE)
         {
           lisp_free (b);
-          --n_string_blocks;
           string_free_list = free_list_before;
         }
       else
@@ -2186,9 +2193,9 @@ INIT must be an integer that represents a character.  */)
   EMACS_INT nbytes;
 
   CHECK_NATNUM (length);
-  CHECK_NUMBER (init);
+  CHECK_CHARACTER (init);
 
-  c = XINT (init);
+  c = XFASTINT (init);
   if (ASCII_CHAR_P (c))
     {
       nbytes = XINT (length);
@@ -2229,7 +2236,6 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
 {
   register Lisp_Object val;
   struct Lisp_Bool_Vector *p;
-  int real_init, i;
   EMACS_INT length_in_chars, length_in_elts;
   int bits_per_value;
 
@@ -2251,9 +2257,7 @@ LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
   p = XBOOL_VECTOR (val);
   p->size = XFASTINT (length);
 
-  real_init = (NILP (init) ? 0 : -1);
-  for (i = 0; i < length_in_chars ; i++)
-    p->data[i] = real_init;
+  memset (p->data, NILP (init) ? 0 : -1, length_in_chars);
 
   /* Clear the extraneous bits in the last byte.  */
   if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
@@ -2463,10 +2467,6 @@ static struct float_block *float_block;
 
 static int float_block_index;
 
-/* Total number of float blocks now in use.  */
-
-static int n_float_blocks;
-
 /* Free-list of Lisp_Floats.  */
 
 static struct Lisp_Float *float_free_list;
@@ -2480,7 +2480,6 @@ init_float (void)
   float_block = NULL;
   float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block.   */
   float_free_list = 0;
-  n_float_blocks = 0;
 }
 
 
@@ -2514,7 +2513,6 @@ make_float (double float_value)
           memset (new->gcmarkbits, 0, sizeof new->gcmarkbits);
           float_block = new;
           float_block_index = 0;
-          n_float_blocks++;
         }
       XSETFLOAT (val, &float_block->floats[float_block_index]);
       float_block_index++;
@@ -2579,10 +2577,6 @@ static int cons_block_index;
 
 static struct Lisp_Cons *cons_free_list;
 
-/* Total number of cons blocks now in use.  */
-
-static int n_cons_blocks;
-
 
 /* Initialize cons allocation.  */
 
@@ -2592,7 +2586,6 @@ init_cons (void)
   cons_block = NULL;
   cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block.  */
   cons_free_list = 0;
-  n_cons_blocks = 0;
 }
 
 
@@ -2636,7 +2629,6 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
           new->next = cons_block;
           cons_block = new;
           cons_block_index = 0;
-          n_cons_blocks++;
         }
       XSETCONS (val, &cons_block->conses[cons_block_index]);
       cons_block_index++;
@@ -2705,7 +2697,7 @@ DEFUN ("list", Flist, Slist, 0, MANY, 0,
        doc: /* Return a newly created list with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
 usage: (list &rest OBJECTS)  */)
-  (size_t nargs, register Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   register Lisp_Object val;
   val = Qnil;
@@ -2775,10 +2767,12 @@ DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
 
 static struct Lisp_Vector *all_vectors;
 
-/* Total number of vector-like objects now in use.  */
-
-static int n_vectors;
-
+/* Handy constants for vectorlike objects.  */
+enum
+  {
+    header_size = offsetof (struct Lisp_Vector, contents),
+    word_size = sizeof (Lisp_Object)
+  };
 
 /* Value is a pointer to a newly allocated Lisp_Vector structure
    with room for LEN Lisp_Objects.  */
@@ -2788,11 +2782,6 @@ allocate_vectorlike (EMACS_INT len)
 {
   struct Lisp_Vector *p;
   size_t nbytes;
-  int header_size = offsetof (struct Lisp_Vector, contents);
-  int word_size = sizeof p->contents[0];
-
-  if ((SIZE_MAX - header_size) / word_size < len)
-    memory_full (SIZE_MAX);
 
   MALLOC_BLOCK_INPUT;
 
@@ -2822,18 +2811,22 @@ allocate_vectorlike (EMACS_INT len)
 
   MALLOC_UNBLOCK_INPUT;
 
-  ++n_vectors;
   return p;
 }
 
 
-/* Allocate a vector with NSLOTS slots.  */
+/* Allocate a vector with LEN slots.  */
 
 struct Lisp_Vector *
-allocate_vector (EMACS_INT nslots)
+allocate_vector (EMACS_INT len)
 {
-  struct Lisp_Vector *v = allocate_vectorlike (nslots);
-  v->header.size = nslots;
+  struct Lisp_Vector *v;
+  ptrdiff_t nbytes_max = min (PTRDIFF_MAX, SIZE_MAX);
+
+  if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
+    memory_full (SIZE_MAX);
+  v = allocate_vectorlike (len);
+  v->header.size = len;
   return v;
 }
 
@@ -2844,7 +2837,7 @@ struct Lisp_Vector *
 allocate_pseudovector (int memlen, int lisplen, EMACS_INT tag)
 {
   struct Lisp_Vector *v = allocate_vectorlike (memlen);
-  EMACS_INT i;
+  int i;
 
   /* Only the first lisplen slots will be traced normally by the GC.  */
   for (i = 0; i < lisplen; ++i)
@@ -2925,10 +2918,10 @@ DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
        doc: /* Return a newly created vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
 usage: (vector &rest OBJECTS)  */)
-  (register size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   register Lisp_Object len, val;
-  register size_t i;
+  ptrdiff_t i;
   register struct Lisp_Vector *p;
 
   XSETFASTINT (len, nargs);
@@ -2956,15 +2949,15 @@ argument to catch the left-over arguments.  If such an integer is used, the
 arguments will not be dynamically bound but will be instead pushed on the
 stack before executing the byte-code.
 usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS)  */)
-  (register size_t nargs, Lisp_Object *args)
+  (ptrdiff_t nargs, Lisp_Object *args)
 {
   register Lisp_Object len, val;
-  register size_t i;
+  ptrdiff_t i;
   register struct Lisp_Vector *p;
 
   XSETFASTINT (len, nargs);
   if (!NILP (Vpurify_flag))
-    val = make_pure_vector ((EMACS_INT) nargs);
+    val = make_pure_vector (nargs);
   else
     val = Fmake_vector (len, Qnil);
 
@@ -3018,10 +3011,6 @@ static int symbol_block_index;
 
 static struct Lisp_Symbol *symbol_free_list;
 
-/* Total number of symbol blocks now in use.  */
-
-static int n_symbol_blocks;
-
 
 /* Initialize symbol allocation.  */
 
@@ -3031,7 +3020,6 @@ init_symbol (void)
   symbol_block = NULL;
   symbol_block_index = SYMBOL_BLOCK_SIZE;
   symbol_free_list = 0;
-  n_symbol_blocks = 0;
 }
 
 
@@ -3064,7 +3052,6 @@ Its value and function definition are void, and its property list is nil.  */)
           new->next = symbol_block;
           symbol_block = new;
           symbol_block_index = 0;
-          n_symbol_blocks++;
         }
       XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index]);
       symbol_block_index++;
@@ -3112,17 +3099,12 @@ static int marker_block_index;
 
 static union Lisp_Misc *marker_free_list;
 
-/* Total number of marker blocks now in use.  */
-
-static int n_marker_blocks;
-
 static void
 init_marker (void)
 {
   marker_block = NULL;
   marker_block_index = MARKER_BLOCK_SIZE;
   marker_free_list = 0;
-  n_marker_blocks = 0;
 }
 
 /* Return a newly allocated Lisp_Misc object, with no substructure.  */
@@ -3151,7 +3133,6 @@ allocate_misc (void)
           new->next = marker_block;
           marker_block = new;
           marker_block_index = 0;
-          n_marker_blocks++;
           total_free_markers += MARKER_BLOCK_SIZE;
         }
       XSETMISC (val, &marker_block->markers[marker_block_index]);
@@ -3184,7 +3165,7 @@ free_misc (Lisp_Object misc)
    The unwind function can get the C values back using XSAVE_VALUE.  */
 
 Lisp_Object
-make_save_value (void *pointer, int integer)
+make_save_value (void *pointer, ptrdiff_t integer)
 {
   register Lisp_Object val;
   register struct Lisp_Save_Value *p;
@@ -3929,11 +3910,11 @@ static Lisp_Object zombies[MAX_ZOMBIES];
 
 /* Number of zombie objects.  */
 
-static int nzombies;
+static EMACS_INT nzombies;
 
 /* Number of garbage collections.  */
 
-static int ngcs;
+static EMACS_INT ngcs;
 
 /* Average percentage of zombies per collection.  */
 
@@ -3941,7 +3922,7 @@ static double avg_zombies;
 
 /* Max. number of live and zombie objects.  */
 
-static int max_live, max_zombies;
+static EMACS_INT max_live, max_zombies;
 
 /* Average number of live objects per GC.  */
 
@@ -3952,7 +3933,7 @@ DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
   (void)
 {
   Lisp_Object args[8], zombie_list = Qnil;
-  int i;
+  EMACS_INT i;
   for (i = 0; i < nzombies; i++)
     zombie_list = Fcons (zombies[i], zombie_list);
   args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d\nzombies: %S");
@@ -4262,7 +4243,7 @@ static void
 check_gcpros (void)
 {
   struct gcpro *p;
-  size_t i;
+  ptrdiff_t i;
 
   for (p = gcprolist; p; p = p->next)
     for (i = 0; i < p->nvars; ++i)
@@ -4279,7 +4260,7 @@ dump_zombies (void)
 {
   int i;
 
-  fprintf (stderr, "\nZombies kept alive = %d:\n", nzombies);
+  fprintf (stderr, "\nZombies kept alive = %"pI":\n", nzombies);
   for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
     {
       fprintf (stderr, "  %d = ", i);
@@ -4851,9 +4832,8 @@ int
 inhibit_garbage_collection (void)
 {
   int count = SPECPDL_INDEX ();
-  int nbits = min (VALBITS, BITS_PER_INT);
 
-  specbind (Qgc_cons_threshold, make_number (((EMACS_INT) 1 << (nbits - 1)) - 1));
+  specbind (Qgc_cons_threshold, make_number (MOST_POSITIVE_FIXNUM));
   return count;
 }
 
@@ -4873,7 +4853,7 @@ returns nil, because real GC can't be done.  */)
 {
   register struct specbinding *bind;
   char stack_top_variable;
-  register size_t i;
+  ptrdiff_t i;
   int message_p;
   Lisp_Object total[8];
   int count = SPECPDL_INDEX ();
@@ -5103,9 +5083,10 @@ returns nil, because real GC can't be done.  */)
   if (gc_cons_threshold < 10000)
     gc_cons_threshold = 10000;
 
+  gc_relative_threshold = 0;
   if (FLOATP (Vgc_cons_percentage))
     { /* Set gc_cons_combined_threshold.  */
-      EMACS_INT tot = 0;
+      double tot = 0;
 
       tot += total_conses  * sizeof (struct Lisp_Cons);
       tot += total_symbols * sizeof (struct Lisp_Symbol);
@@ -5116,10 +5097,15 @@ returns nil, because real GC can't be done.  */)
       tot += total_intervals * sizeof (struct interval);
       tot += total_strings * sizeof (struct Lisp_String);
 
-      gc_relative_threshold = tot * XFLOAT_DATA (Vgc_cons_percentage);
+      tot *= XFLOAT_DATA (Vgc_cons_percentage);
+      if (0 < tot)
+        {
+          if (tot < TYPE_MAXIMUM (EMACS_INT))
+            gc_relative_threshold = tot;
+          else
+            gc_relative_threshold = TYPE_MAXIMUM (EMACS_INT);
+        }
     }
-  else
-    gc_relative_threshold = 0;
 
   if (garbage_collection_messages)
     {
@@ -5250,8 +5236,8 @@ static size_t mark_object_loop_halt;
 static void
 mark_vectorlike (struct Lisp_Vector *ptr)
 {
-  register EMACS_UINT size = ptr->header.size;
-  register EMACS_UINT i;
+  EMACS_INT size = ptr->header.size;
+  EMACS_INT i;
 
   eassert (!VECTOR_MARKED_P (ptr));
   VECTOR_MARK (ptr);            /* Else mark it */
@@ -5273,8 +5259,8 @@ mark_vectorlike (struct Lisp_Vector *ptr)
 static void
 mark_char_table (struct Lisp_Vector *ptr)
 {
-  register EMACS_UINT size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
-  register EMACS_UINT i;
+  int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+  int i;
 
   eassert (!VECTOR_MARKED_P (ptr));
   VECTOR_MARK (ptr);
@@ -5402,12 +5388,11 @@ mark_object (Lisp_Object arg)
            recursion there.  */
         {
           register struct Lisp_Vector *ptr = XVECTOR (obj);
-          register EMACS_UINT size = ptr->header.size;
-          register EMACS_UINT i;
+          int size = ptr->header.size & PSEUDOVECTOR_SIZE_MASK;
+          int i;
 
           CHECK_LIVE (live_vector_p);
           VECTOR_MARK (ptr);    /* Else mark it */
-          size &= PSEUDOVECTOR_SIZE_MASK;
           for (i = 0; i < size; i++) /* and then mark its elements */
             {
               if (i != COMPILED_CONSTANTS)
@@ -5534,7 +5519,7 @@ mark_object (Lisp_Object arg)
             if (ptr->dogc)
               {
                 Lisp_Object *p = (Lisp_Object *) ptr->pointer;
-                int nelt;
+                ptrdiff_t nelt;
                 for (nelt = ptr->integer; nelt > 0; nelt--, p++)
                   mark_maybe_object (*p);
               }
@@ -5734,7 +5719,7 @@ gc_sweep (void)
     register struct cons_block *cblk;
     struct cons_block **cprev = &cons_block;
     register int lim = cons_block_index;
-    register int num_free = 0, num_used = 0;
+    EMACS_INT num_free = 0, num_used = 0;
 
     cons_free_list = 0;
 
@@ -5795,7 +5780,6 @@ gc_sweep (void)
             /* Unhook from the free list.  */
             cons_free_list = cblk->conses[0].u.chain;
             lisp_align_free (cblk);
-            n_cons_blocks--;
           }
         else
           {
@@ -5812,7 +5796,7 @@ gc_sweep (void)
     register struct float_block *fblk;
     struct float_block **fprev = &float_block;
     register int lim = float_block_index;
-    register int num_free = 0, num_used = 0;
+    EMACS_INT num_free = 0, num_used = 0;
 
     float_free_list = 0;
 
@@ -5842,7 +5826,6 @@ gc_sweep (void)
             /* Unhook from the free list.  */
             float_free_list = fblk->floats[0].u.chain;
             lisp_align_free (fblk);
-            n_float_blocks--;
           }
         else
           {
@@ -5859,7 +5842,7 @@ gc_sweep (void)
     register struct interval_block *iblk;
     struct interval_block **iprev = &interval_block;
     register int lim = interval_block_index;
-    register int num_free = 0, num_used = 0;
+    EMACS_INT num_free = 0, num_used = 0;
 
     interval_free_list = 0;
 
@@ -5892,7 +5875,6 @@ gc_sweep (void)
             /* Unhook from the free list.  */
             interval_free_list = INTERVAL_PARENT (&iblk->intervals[0]);
             lisp_free (iblk);
-            n_interval_blocks--;
           }
         else
           {
@@ -5909,7 +5891,7 @@ gc_sweep (void)
     register struct symbol_block *sblk;
     struct symbol_block **sprev = &symbol_block;
     register int lim = symbol_block_index;
-    register int num_free = 0, num_used = 0;
+    EMACS_INT num_free = 0, num_used = 0;
 
     symbol_free_list = NULL;
 
@@ -5956,7 +5938,6 @@ gc_sweep (void)
             /* Unhook from the free list.  */
             symbol_free_list = sblk->symbols[0].next;
             lisp_free (sblk);
-            n_symbol_blocks--;
           }
         else
           {
@@ -5974,7 +5955,7 @@ gc_sweep (void)
     register struct marker_block *mblk;
     struct marker_block **mprev = &marker_block;
     register int lim = marker_block_index;
-    register int num_free = 0, num_used = 0;
+    EMACS_INT num_free = 0, num_used = 0;
 
     marker_free_list = 0;
 
@@ -6013,7 +5994,6 @@ gc_sweep (void)
             /* Unhook from the free list.  */
             marker_free_list = mblk->markers[0].u_free.chain;
             lisp_free (mblk);
-            n_marker_blocks--;
           }
         else
           {
@@ -6063,7 +6043,6 @@ gc_sweep (void)
             all_vectors = vector->header.next.vector;
           next = vector->header.next.vector;
           lisp_free (vector);
-          n_vectors--;
           vector = next;
 
         }