]> code.delx.au - gnu-emacs/blobdiff - src/alloc.c
Merge from origin/emacs-25
[gnu-emacs] / src / alloc.c
index 668bbc759471afc5c27e2d93dede7f3e2ae61569..56a535411c8318a77ae67bbee7cd9dd483e8dd32 100644 (file)
@@ -7,8 +7,8 @@ This file is part of GNU Emacs.
 
 GNU Emacs is free software: you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,10 +22,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 
 #include <stdio.h>
 #include <limits.h>            /* For CHAR_BIT.  */
-
-#ifdef ENABLE_CHECKING
-#include <signal.h>            /* For SIGABRT.  */
-#endif
+#include <signal.h>            /* For SIGABRT, SIGDANGER.  */
 
 #ifdef HAVE_PTHREAD
 #include <pthread.h>
@@ -35,6 +32,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "dispextern.h"
 #include "intervals.h"
 #include "puresize.h"
+#include "sheap.h"
 #include "systime.h"
 #include "character.h"
 #include "buffer.h"
@@ -58,6 +56,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #include "dosfns.h"            /* For dos_memory_info.  */
 #endif
 
+#ifdef HAVE_MALLOC_H
+# include <malloc.h>
+#endif
+
 #if (defined ENABLE_CHECKING                   \
      && defined HAVE_VALGRIND_VALGRIND_H       \
      && !defined USE_VALGRIND)
@@ -106,8 +108,6 @@ my_heap_start (void)
 
 #ifdef DOUG_LEA_MALLOC
 
-#include <malloc.h>
-
 /* Specify maximum number of areas to mmap.  It would be nice to use a
    value that explicitly means "no limit".  */
 
@@ -117,18 +117,6 @@ my_heap_start (void)
    inside glibc's malloc.  */
 static void *malloc_state_ptr;
 
-/* Get and free this pointer; useful around unexec.  */
-void
-alloc_unexec_pre (void)
-{
-  malloc_state_ptr = malloc_get_state ();
-}
-void
-alloc_unexec_post (void)
-{
-  free (malloc_state_ptr);
-}
-
 /* Restore the dumped malloc state.  Because malloc can be invoked
    even before main (e.g. by the dynamic linker), the dumped malloc
    state must be restored as early as possible using this special hook.  */
@@ -169,14 +157,40 @@ malloc_initialize_hook (void)
     }
 }
 
+/* Declare the malloc initialization hook, which runs before 'main' starts.
+   EXTERNALLY_VISIBLE works around Bug#22522.  */
 # ifndef __MALLOC_HOOK_VOLATILE
 #  define __MALLOC_HOOK_VOLATILE
 # endif
-voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook
+voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE
   = malloc_initialize_hook;
 
 #endif
 
+/* Allocator-related actions to do just before and after unexec.  */
+
+void
+alloc_unexec_pre (void)
+{
+#ifdef DOUG_LEA_MALLOC
+  malloc_state_ptr = malloc_get_state ();
+#endif
+#ifdef HYBRID_MALLOC
+  bss_sbrk_did_unexec = true;
+#endif
+}
+
+void
+alloc_unexec_post (void)
+{
+#ifdef DOUG_LEA_MALLOC
+  free (malloc_state_ptr);
+#endif
+#ifdef HYBRID_MALLOC
+  bss_sbrk_did_unexec = false;
+#endif
+}
+
 /* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
    to a struct Lisp_String.  */
 
@@ -550,6 +564,8 @@ static struct Lisp_Finalizer doomed_finalizers;
                                Malloc
  ************************************************************************/
 
+#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC)
+
 /* Function malloc calls this if it finds we are near exhausting storage.  */
 
 void
@@ -558,6 +574,7 @@ malloc_warning (const char *str)
   pending_malloc_warning = str;
 }
 
+#endif
 
 /* Display an already-pending malloc warning.  */
 
@@ -1111,23 +1128,14 @@ lisp_free (void *block)
    unexmacosx.c, so don't use it on Darwin.  */
 
 #if ! ADDRESS_SANITIZER && !defined DARWIN_OS
-# if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
-#  define USE_ALIGNED_ALLOC 1
-#  ifndef HAVE_ALIGNED_ALLOC
-/* Defined in gmalloc.c.  */
-void *aligned_alloc (size_t, size_t);
-#  endif
-# elif defined HYBRID_MALLOC
-#  if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
-#   define USE_ALIGNED_ALLOC 1
-#   define aligned_alloc hybrid_aligned_alloc
-/* Defined in gmalloc.c.  */
-void *aligned_alloc (size_t, size_t);
-#  endif
-# elif defined HAVE_ALIGNED_ALLOC
+# if (defined HAVE_ALIGNED_ALLOC                                       \
+      || (defined HYBRID_MALLOC                                                \
+         ? defined HAVE_POSIX_MEMALIGN                                 \
+         : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC))
 #  define USE_ALIGNED_ALLOC 1
-# elif defined HAVE_POSIX_MEMALIGN
+# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN
 #  define USE_ALIGNED_ALLOC 1
+#  define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h.  */
 static void *
 aligned_alloc (size_t alignment, size_t size)
 {
@@ -1375,8 +1383,8 @@ lisp_align_free (void *block)
 static bool
 laligned (void *p, size_t size)
 {
-  return (MALLOC_IS_GC_ALIGNED || size % GCALIGNMENT != 0
-         || (intptr_t) p % GCALIGNMENT == 0);
+  return (MALLOC_IS_GC_ALIGNED || (intptr_t) p % GCALIGNMENT == 0
+         || size % GCALIGNMENT != 0);
 }
 
 /* Like malloc and realloc except that if SIZE is Lisp-aligned, make
@@ -1385,7 +1393,15 @@ laligned (void *p, size_t size)
    Lisp-aligned pointer.  Code that needs to allocate C heap memory
    for a Lisp object should use one of these functions to obtain a
    pointer P; that way, if T is an enum Lisp_Type value and L ==
-   make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T.  */
+   make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T.
+
+   On typical modern platforms these functions' loops do not iterate.
+   On now-rare (and perhaps nonexistent) platforms, the loops in
+   theory could repeat forever.  If an infinite loop is possible on a
+   platform, a build would surely loop and the builder can then send
+   us a bug report.  Adding a counter to try to detect any such loop
+   would complicate the code (and possibly introduce bugs, in code
+   that's never really exercised) for little benefit.  */
 
 static void *
 lmalloc (size_t size)
@@ -3383,22 +3399,13 @@ allocate_buffer (void)
 DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
        doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
 See also the function `vector'.  */)
-  (register Lisp_Object length, Lisp_Object init)
+  (Lisp_Object length, Lisp_Object init)
 {
-  Lisp_Object vector;
-  register ptrdiff_t sizei;
-  register ptrdiff_t i;
-  register struct Lisp_Vector *p;
-
   CHECK_NATNUM (length);
-
-  p = allocate_vector (XFASTINT (length));
-  sizei = XFASTINT (length);
-  for (i = 0; i < sizei; i++)
+  struct Lisp_Vector *p = allocate_vector (XFASTINT (length));
+  for (ptrdiff_t i = 0; i < XFASTINT (length); i++)
     p->contents[i] = init;
-
-  XSETVECTOR (vector, p);
-  return vector;
+  return make_lisp_ptr (p, Lisp_Vectorlike);
 }
 
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
@@ -3407,12 +3414,9 @@ Any number of arguments, even zero arguments, are allowed.
 usage: (vector &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
-  ptrdiff_t i;
-  register Lisp_Object val = make_uninit_vector (nargs);
-  register struct Lisp_Vector *p = XVECTOR (val);
-
-  for (i = 0; i < nargs; i++)
-    p->contents[i] = args[i];
+  Lisp_Object val = make_uninit_vector (nargs);
+  struct Lisp_Vector *p = XVECTOR (val);
+  memcpy (p->contents, args, nargs * sizeof *args);
   return val;
 }
 
@@ -3451,9 +3455,8 @@ 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)
 {
-  ptrdiff_t i;
-  register Lisp_Object val = make_uninit_vector (nargs);
-  register struct Lisp_Vector *p = XVECTOR (val);
+  Lisp_Object val = make_uninit_vector (nargs);
+  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
@@ -3463,8 +3466,7 @@ 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).  */
 
-  for (i = 0; i < nargs; i++)
-    p->contents[i] = args[i];
+  memcpy (p->contents, args, nargs * sizeof *args);
   make_byte_code (p);
   XSETCOMPILED (val, p);
   return val;
@@ -3722,7 +3724,6 @@ make_save_ptr_int (void *a, ptrdiff_t b)
   return val;
 }
 
-#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
 Lisp_Object
 make_save_ptr_ptr (void *a, void *b)
 {
@@ -3733,7 +3734,6 @@ make_save_ptr_ptr (void *a, void *b)
   p->data[1].pointer = b;
   return val;
 }
-#endif
 
 Lisp_Object
 make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
@@ -5425,7 +5425,7 @@ purecopy (Lisp_Object obj)
     }
   else
     {
-      Lisp_Object fmt = build_pure_c_string ("Don't know how to purify: %S");
+      AUTO_STRING (fmt, "Don't know how to purify: %S");
       Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
     }
 
@@ -5656,7 +5656,7 @@ garbage_collect_1 (void *end)
     return Qnil;
 
   /* Record this function, so it appears on the profiler's backtraces.  */
-  record_in_backtrace (Qautomatic_gc, 0, 0);
+  record_in_backtrace (QAutomatic_GC, 0, 0);
 
   check_cons_list ();
 
@@ -7386,7 +7386,7 @@ do hash-consing of the objects allocated to pure space.  */);
   DEFSYM (Qstring_bytes, "string-bytes");
   DEFSYM (Qvector_slots, "vector-slots");
   DEFSYM (Qheap, "heap");
-  DEFSYM (Qautomatic_gc, "Automatic GC");
+  DEFSYM (QAutomatic_GC, "Automatic GC");
 
   DEFSYM (Qgc_cons_threshold, "gc-cons-threshold");
   DEFSYM (Qchar_table_extra_slots, "char-table-extra-slots");