upstream

1 files changed, 110 insertions, 125 deletions

diff --git a/src/alloc.c b/src/alloc.c
index ac6cb861c4d..5b2553c69cc 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -29,11 +29,6 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include <pthread.h>
 #endif
 
-/* This file is part of the core Lisp implementation, and thus must
-   deal with the real data structures.  If the Lisp implementation is
-   replaced, this file likely will not be used.  */
-
-#undef HIDE_LISP_IMPLEMENTATION
 #include "lisp.h"
 #include "process.h"
 #include "intervals.h"
@@ -155,12 +150,6 @@ static pthread_mutex_t alloc_mutex;
 #define VECTOR_UNMARK(V)        ((V)->header.size &= ~ARRAY_MARK_FLAG)
 #define VECTOR_MARKED_P(V)      (((V)->header.size & ARRAY_MARK_FLAG) != 0)
 
-/* Value is the number of bytes of S, a pointer to a struct Lisp_String.
-   Be careful during GC, because S->size contains the mark bit for
-   strings.  */
-
-#define GC_STRING_BYTES(S)      (STRING_BYTES (S))
-
 /* Default value of gc_cons_threshold (see below).  */
 
 #define GC_DEFAULT_THRESHOLD (100000 * sizeof (Lisp_Object))
@@ -533,12 +522,7 @@ buffer_memory_full (ptrdiff_t nbytes)
    hold a size_t value and (2) the header size is a multiple of the
    alignment that Emacs needs for C types and for USE_LSB_TAG.  */
 #define XMALLOC_BASE_ALIGNMENT                          \
-  offsetof (                                            \
-    struct {                                            \
-      union { long double d; intmax_t i; void *p; } u;  \
-      char c;                                           \
-    },                                                  \
-    c)
+  alignof (union { long double d; intmax_t i; void *p; })
 
 #if USE_LSB_TAG
 # define XMALLOC_HEADER_ALIGNMENT \
@@ -1790,13 +1774,13 @@ static char const string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
    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_OVERHEAD                \
-         - GC_STRING_EXTRA                                        \
-         - offsetof (struct sblock, first_data)                   \
-         - SDATA_DATA_OFFSET)                                     \
-        & ~(sizeof (EMACS_INT) - 1)))
+static ptrdiff_t const STRING_BYTES_MAX =
+  min (STRING_BYTES_BOUND,
+       ((SIZE_MAX - XMALLOC_OVERRUN_CHECK_OVERHEAD
+         - GC_STRING_EXTRA
+         - offsetof (struct sblock, first_data)
+         - SDATA_DATA_OFFSET)
+        & ~(sizeof (EMACS_INT) - 1)));
 
 /* Initialize string allocation.  Called from init_alloc_once.  */
 
@@ -1812,10 +1796,8 @@ init_strings (void)
 
 static int check_string_bytes_count;
 
-#define CHECK_STRING_BYTES(S)   STRING_BYTES (S)
-
-
-/* Like GC_STRING_BYTES, but with debugging check.  */
+/* Like STRING_BYTES, but with debugging check.  Can be
+   called during GC, so pay attention to the mark bit.  */
 
 ptrdiff_t
 string_bytes (struct Lisp_String *s)
@@ -1847,15 +1829,8 @@ check_sblock (struct sblock *b)
 
       /* Check that the string size recorded in the string is the
          same as the one recorded in the sdata structure.  */
-      if (from->string)
-        CHECK_STRING_BYTES (from->string);
-
-      if (from->string)
-        nbytes = GC_STRING_BYTES (from->string);
-      else
-        nbytes = SDATA_NBYTES (from);
-
-      nbytes = SDATA_SIZE (nbytes);
+      nbytes = SDATA_SIZE (from->string ? string_bytes (from->string)
+                           : SDATA_NBYTES (from));
       from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
     }
 }
@@ -1876,7 +1851,7 @@ check_string_bytes (int all_p)
         {
           struct Lisp_String *s = b->first_data.string;
           if (s)
-            CHECK_STRING_BYTES (s);
+            string_bytes (s);
         }
 
       for (b = oldest_sblock; b; b = b->next)
@@ -1886,6 +1861,10 @@ check_string_bytes (int all_p)
     check_sblock (current_sblock);
 }
 
+#else /* not GC_CHECK_STRING_BYTES */
+
+#define check_string_bytes(all) ((void) 0)
+
 #endif /* GC_CHECK_STRING_BYTES */
 
 #ifdef GC_CHECK_STRING_FREE_LIST
@@ -1997,7 +1976,7 @@ allocate_string_data (struct Lisp_String *s,
   if (s->data)
     {
       old_data = SDATA_OF_STRING (s);
-      old_nbytes = GC_STRING_BYTES (s);
+      old_nbytes = STRING_BYTES (s);
     }
   else
     old_data = NULL;
@@ -2131,10 +2110,10 @@ sweep_strings (void)
                      how large that is.  Reset the sdata's string
                      back-pointer so that we know it's free.  */
 #ifdef GC_CHECK_STRING_BYTES
-                  if (GC_STRING_BYTES (s) != SDATA_NBYTES (data))
+                  if (string_bytes (s) != SDATA_NBYTES (data))
                     abort ();
 #else
-                  data->u.nbytes = GC_STRING_BYTES (s);
+                  data->u.nbytes = STRING_BYTES (s);
 #endif
                   data->string = NULL;
 
@@ -2237,22 +2216,17 @@ compact_small_strings (void)
           /* Compute the next FROM here because copying below may
              overwrite data we need to compute it.  */
           ptrdiff_t nbytes;
+          struct Lisp_String *s = from->string;
 
 #ifdef GC_CHECK_STRING_BYTES
           /* Check that the string size recorded in the string is the
              same as the one recorded in the sdata structure. */
-          if (from->string
-              && GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
+          if (s && string_bytes (s) != SDATA_NBYTES (from))
             abort ();
 #endif /* GC_CHECK_STRING_BYTES */
 
-          if (from->string)
-            nbytes = GC_STRING_BYTES (from->string);
-          else
-            nbytes = SDATA_NBYTES (from);
-
-          if (nbytes > LARGE_STRING_BYTES)
-            abort ();
+          nbytes = s ? STRING_BYTES (s) : SDATA_NBYTES (from);
+          eassert (nbytes <= LARGE_STRING_BYTES);
 
           nbytes = SDATA_SIZE (nbytes);
           from_end = (struct sdata *) ((char *) from + nbytes + GC_STRING_EXTRA);
@@ -2264,8 +2238,8 @@ compact_small_strings (void)
             abort ();
 #endif
 
-          /* FROM->string non-null means it's alive.  Copy its data.  */
-          if (from->string)
+          /* Non-NULL S means it's alive.  Copy its data.  */
+          if (s)
             {
               /* If TB is full, proceed with the next sblock.  */
               to_end = (struct sdata *) ((char *) to + nbytes + GC_STRING_EXTRA);
@@ -2811,6 +2785,38 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, L
                                                        Fcons (arg5, Qnil)))));
 }
 
+/* Make a list of COUNT Lisp_Objects, where ARG is the
+   first one.  Allocate conses from pure space if TYPE
+   is CONSTYPE_PURE, or allocate as usual if type is CONSTYPE_HEAP.  */
+
+Lisp_Object
+listn (enum constype type, ptrdiff_t count, Lisp_Object arg, ...)
+{
+  va_list ap;
+  ptrdiff_t i;
+  Lisp_Object val, *objp;
+
+  /* Change to SAFE_ALLOCA if you hit this eassert.  */
+  eassert (count <= MAX_ALLOCA / sizeof (Lisp_Object));
+
+  objp = alloca (count * sizeof (Lisp_Object));
+  objp[0] = arg;
+  va_start (ap, arg);
+  for (i = 1; i < count; i++)
+    objp[i] = va_arg (ap, Lisp_Object);
+  va_end (ap);
+
+  for (val = Qnil, i = count - 1; i >= 0; i--)
+    {
+      if (type == CONSTYPE_PURE)
+        val = pure_cons (objp[i], val);
+      else if (type == CONSTYPE_HEAP)
+        val = Fcons (objp[i], val);
+      else
+        abort ();
+    }
+  return val;
+}
 
 DEFUN ("list", Flist, Slist, 0, MANY, 0,
        doc: /* Return a newly created list with specified arguments as elements.
@@ -4620,10 +4626,10 @@ mark_maybe_pointer (void *p)
 }
 
 
-/* Alignment of pointer values.  Use offsetof, as it sometimes returns
+/* Alignment of pointer values.  Use alignof, as it sometimes returns
    a smaller alignment than GCC's __alignof__ and mark_memory might
    miss objects if __alignof__ were used.  */
-#define GC_POINTER_ALIGNMENT offsetof (struct {char a; void *b;}, b)
+#define GC_POINTER_ALIGNMENT alignof (void *)
 
 /* Define POINTERS_MIGHT_HIDE_IN_OBJECTS to 1 if marking via C pointers does
    not suffice, which is the typical case.  A host where a Lisp_Object is
@@ -5071,17 +5077,11 @@ pure_alloc (size_t size, int type)
 #if USE_LSB_TAG
   size_t alignment = (1 << GCTYPEBITS);
 #else
-  size_t alignment = sizeof (EMACS_INT);
+  size_t alignment = alignof (EMACS_INT);
 
   /* Give Lisp_Floats an extra alignment.  */
   if (type == Lisp_Float)
-    {
-#if defined __GNUC__ && __GNUC__ >= 2
-      alignment = __alignof (struct Lisp_Float);
-#else
-      alignment = sizeof (struct Lisp_Float);
-#endif
-    }
+    alignment = alignof (struct Lisp_Float);
 #endif
 
  again:
@@ -5416,7 +5416,7 @@ See Info node `(elisp)Garbage Collection'.  */)
   int message_p;
   Lisp_Object total[11];
   ptrdiff_t count = SPECPDL_INDEX ();
-  EMACS_TIME t1;
+  EMACS_TIME start;
 
   if (abort_on_gc)
     abort ();
@@ -5426,14 +5426,14 @@ See Info node `(elisp)Garbage Collection'.  */)
   if (pure_bytes_used_before_overflow)
     return Qnil;
 
-  CHECK_CONS_LIST ();
+  check_cons_list ();
 
   /* Don't keep undo information around forever.
      Do this early on, so it is no problem if the user quits.  */
   FOR_EACH_BUFFER (nextb)
     compact_buffer (nextb);
 
-  t1 = current_emacs_time ();
+  start = current_emacs_time ();
 
   /* In case user calls debug_print during GC,
      don't let that cause a recursive GC.  */
@@ -5594,7 +5594,7 @@ See Info node `(elisp)Garbage Collection'.  */)
 
   UNBLOCK_INPUT;
 
-  CHECK_CONS_LIST ();
+  check_cons_list ();
 
   gc_in_progress = 0;
 
@@ -5685,18 +5685,16 @@ See Info node `(elisp)Garbage Collection'.  */)
 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
   {
     /* Compute average percentage of zombies.  */
-    double nlive = 0;
-
-    for (i = 0; i < 7; ++i)
-      if (CONSP (total[i]))
-        nlive += XFASTINT (XCAR (total[i]));
+    double nlive =
+      (total_conses + total_symbols + total_markers + total_strings
+       + total_vectors + total_floats + total_intervals + total_buffers);
 
     avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
     max_live = max (nlive, max_live);
     avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
     max_zombies = max (nzombies, max_zombies);
     ++ngcs;
-    }
+  }
 #endif
 
   if (!NILP (Vpost_gc_hook))
@@ -5709,10 +5707,9 @@ See Info node `(elisp)Garbage Collection'.  */)
   /* Accumulate statistics.  */
   if (FLOATP (Vgc_elapsed))
     {
-      EMACS_TIME t2 = current_emacs_time ();
-      EMACS_TIME t3 = sub_emacs_time (t2, t1);
+      EMACS_TIME since_start = sub_emacs_time (current_emacs_time (), start);
       Vgc_elapsed = make_float (XFLOAT_DATA (Vgc_elapsed)
-                                + EMACS_TIME_TO_DOUBLE (t3));
+                                + EMACS_TIME_TO_DOUBLE (since_start));
     }
 
   gcs_done++;
@@ -5929,7 +5926,7 @@ mark_object (Lisp_Object arg)
 
 #endif /* not GC_CHECK_MARKED_OBJECTS */
 
-  switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+  switch (XTYPE (obj))
     {
     case Lisp_String:
       {
@@ -5942,7 +5939,7 @@ mark_object (Lisp_Object arg)
 #ifdef GC_CHECK_STRING_BYTES
         /* Check that the string size recorded in the string is the
            same as the one recorded in the sdata structure.  */
-        CHECK_STRING_BYTES (ptr);
+        string_bytes (ptr);
 #endif /* GC_CHECK_STRING_BYTES */
       }
       break;
@@ -6281,10 +6278,7 @@ gc_sweep (void)
   sweep_weak_hash_tables ();
 
   sweep_strings ();
-#ifdef GC_CHECK_STRING_BYTES
-  if (!noninteractive)
-    check_string_bytes (1);
-#endif
+  check_string_bytes (!noninteractive);
 
   /* Put all unmarked conses on free list */
   {
@@ -6604,11 +6598,7 @@ gc_sweep (void)
   }
 
   sweep_vectors ();
-
-#ifdef GC_CHECK_STRING_BYTES
-  if (!noninteractive)
-    check_string_bytes (1);
-#endif
+  check_string_bytes (!noninteractive);
 }
 
 
@@ -6644,18 +6634,15 @@ Frames, windows, buffers, and subprocesses count as vectors
   (but the contents of a buffer's text do not count here).  */)
   (void)
 {
-  Lisp_Object consed[8];
-
-  consed[0] = bounded_number (cons_cells_consed);
-  consed[1] = bounded_number (floats_consed);
-  consed[2] = bounded_number (vector_cells_consed);
-  consed[3] = bounded_number (symbols_consed);
-  consed[4] = bounded_number (string_chars_consed);
-  consed[5] = bounded_number (misc_objects_consed);
-  consed[6] = bounded_number (intervals_consed);
-  consed[7] = bounded_number (strings_consed);
-
-  return Flist (8, consed);
+  return listn (CONSTYPE_HEAP, 8,
+                bounded_number (cons_cells_consed),
+                bounded_number (floats_consed),
+                bounded_number (vector_cells_consed),
+                bounded_number (symbols_consed),
+                bounded_number (string_chars_consed),
+                bounded_number (misc_objects_consed),
+                bounded_number (intervals_consed),
+                bounded_number (strings_consed));
 }
 
 /* Find at most FIND_MAX symbols which have OBJ as their value or
@@ -6836,8 +6823,8 @@ do hash-consing of the objects allocated to pure space.  */);
   /* We build this in advance because if we wait until we need it, we might
      not be able to allocate the memory to hold it.  */
   Vmemory_signal_data
-    = pure_cons (Qerror,
-                 pure_cons (build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"), Qnil));
+    = listn (CONSTYPE_PURE, 2, Qerror,
+             build_pure_c_string ("Memory exhausted--use M-x save-some-buffers then exit and restart Emacs"));
 
   DEFVAR_LISP ("memory-full", Vmemory_full,
                doc: /* Non-nil means Emacs cannot get much more Lisp memory.  */);
@@ -6876,28 +6863,26 @@ The time is in seconds as a floating point value.  */);
 #endif
 }
 
-/* Make some symbols visible to GDB.  These cannot be done as enums, like
-   GCTYPEBITS or USE_LSB_TAG, since values might not be in 'int' range.
-   Each symbol X has a corresponding X_VAL symbol, verified to have
-   the correct value.
-
-   This is last, so that the #undef lines don't mess up later code.  */
-
-#define ARRAY_MARK_FLAG_VAL PTRDIFF_MIN
-#define PSEUDOVECTOR_FLAG_VAL (PTRDIFF_MAX - PTRDIFF_MAX / 2)
-#define VALMASK_VAL (USE_LSB_TAG ? -1 << GCTYPEBITS : VAL_MAX)
-
-verify (ARRAY_MARK_FLAG_VAL == ARRAY_MARK_FLAG);
-verify (PSEUDOVECTOR_FLAG_VAL == PSEUDOVECTOR_FLAG);
-verify (VALMASK_VAL == VALMASK);
-
-#undef ARRAY_MARK_FLAG
-#undef PSEUDOVECTOR_FLAG
-#undef VALMASK
-
-ptrdiff_t const EXTERNALLY_VISIBLE
-  ARRAY_MARK_FLAG = ARRAY_MARK_FLAG_VAL,
-  PSEUDOVECTOR_FLAG = PSEUDOVECTOR_FLAG_VAL;
-
-EMACS_INT const EXTERNALLY_VISIBLE
-  VALMASK = VALMASK_VAL;
+/* When compiled with GCC, GDB might say "No enum type named
+   pvec_type" if we don't have at least one symbol with that type, and
+   then xbacktrace could fail.  Similarly for the other enums and
+   their values.  */
+union
+{
+  enum CHARTAB_SIZE_BITS CHARTAB_SIZE_BITS;
+  enum CHAR_TABLE_STANDARD_SLOTS CHAR_TABLE_STANDARD_SLOTS;
+  enum char_bits char_bits;
+  enum CHECK_LISP_OBJECT_TYPE CHECK_LISP_OBJECT_TYPE;
+  enum DEFAULT_HASH_SIZE DEFAULT_HASH_SIZE;
+  enum enum_USE_LSB_TAG enum_USE_LSB_TAG;
+  enum FLOAT_TO_STRING_BUFSIZE FLOAT_TO_STRING_BUFSIZE;
+  enum Lisp_Bits Lisp_Bits;
+  enum Lisp_Compiled Lisp_Compiled;
+  enum maxargs maxargs;
+  enum MAX_ALLOCA MAX_ALLOCA;
+  enum More_Lisp_Bits More_Lisp_Bits;
+  enum pvec_type pvec_type;
+#if USE_LSB_TAG
+  enum lsb_bits lsb_bits;
+#endif
+} const EXTERNALLY_VISIBLE gdb_make_enums_visible = {0};