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
malloc_probe (size); \
} while (0)
+static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+static void *lrealloc (void *, size_t);
-/* Like malloc but check for no memory and block interrupt input.. */
+/* Like malloc but check for no memory and block interrupt input. */
void *
xmalloc (size_t size)
void *val;
MALLOC_BLOCK_INPUT;
- val = malloc (size);
+ val = lmalloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
void *val;
MALLOC_BLOCK_INPUT;
- val = malloc (size);
+ val = lmalloc (size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
- val = malloc (size);
+ val = lmalloc (size);
else
- val = realloc (block, size);
+ val = lrealloc (block, size);
MALLOC_UNBLOCK_INPUT;
if (!val && size)
allocated_mem_type = type;
#endif
- val = malloc (nbytes);
+ val = lmalloc (nbytes);
#if ! USE_LSB_TAG
/* If the memory just allocated cannot be addressed thru a Lisp
/* Use aligned_alloc if it or a simple substitute is available.
Address sanitization breaks aligned allocation, as of gcc 4.8.2 and
- clang 3.3 anyway. */
-
-#if ! ADDRESS_SANITIZER
-# if defined HYBRID_MALLOC
-# if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
-# define USE_ALIGNED_ALLOC 1
-# endif
-# elif !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC
+ clang 3.3 anyway. Aligned allocation is incompatible with
+ unexmacosx.c, so don't use it on Darwin. */
+
+#if ! ADDRESS_SANITIZER && !defined DARWIN_OS
+# 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_ALIGNED_ALLOC
-# 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)
{
MALLOC_UNBLOCK_INPUT;
}
+#if !defined __GNUC__ && !defined __alignof__
+# define __alignof__(type) alignof (type)
+#endif
+
+/* True if malloc returns a multiple of GCALIGNMENT. In practice this
+ holds if __alignof__ (max_align_t) is a multiple. Use __alignof__
+ if available, as otherwise this check would fail with GCC x86.
+ This is a macro, not an enum constant, for portability to HP-UX
+ 10.20 cc and AIX 3.2.5 xlc. */
+#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0)
+
+/* True if P is suitably aligned for SIZE, where Lisp alignment may be
+ needed if SIZE is Lisp-aligned. */
+
+static bool
+laligned (void *p, size_t size)
+{
+ 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
+ sure the result is too, if necessary by reallocating (typically
+ with larger and larger sizes) until the allocator returns a
+ 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.
+
+ 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)
+{
+#if USE_ALIGNED_ALLOC
+ if (! MALLOC_IS_GC_ALIGNED)
+ return aligned_alloc (GCALIGNMENT, size);
+#endif
+
+ void *p;
+ while (true)
+ {
+ p = malloc (size);
+ if (laligned (p, size))
+ break;
+ free (p);
+ size_t bigger;
+ if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ size = bigger;
+ }
+
+ eassert ((intptr_t) p % GCALIGNMENT == 0);
+ return p;
+}
+
+static void *
+lrealloc (void *p, size_t size)
+{
+ while (true)
+ {
+ p = realloc (p, size);
+ if (laligned (p, size))
+ break;
+ size_t bigger;
+ if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+ size = bigger;
+ }
+
+ eassert ((intptr_t) p % GCALIGNMENT == 0);
+ return p;
+}
+
\f
/***********************************************************************
Interval Allocation
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,
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;
}
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
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;
return val;
}
-#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
Lisp_Object
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)
}
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)));
}
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 ();
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");