Re: Aligned blocks management: obsolete?

[Dmitry Antipov <dmantipov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 1183 bytes --]

[some stuff from old discussion below]

On 12/12/2011 10:27 PM, Paul Eggert wrote:

> On 12/12/11 06:07, Dmitry Antipov wrote:
>> I suppose that any non-ancient glibc malloc
>> doesn't require such a glitch in lisp_align_malloc any more
>
> This sounds correct to me as well, though I can't cite
> chapter and verse offhand.  Certainly the posix_memalign
> implementation has mutated significantly since glibc 2.3.2
> came out in 2003, and any performance measurements
> based on 2.3.2 are suspect now.
>
> More generally, if some cruft was put into alloc.c long ago
> for performance reasons, and if we can no longer demonstrate
> that the cruft improves performance significantly
> on currently-used platforms, then surely it's OK to remove it
> after the feature freeze is over.  Cruft like that has a real
> maintenance cost, and there's no point keeping it
> if it doesn't actually have a performance benefit.

I believe this becomes more and more actual because more and more
of ancient systems with poor malloc implementations falls into their
graves; this cleanup assumes that every malloc implementation
has reasonably efficient posix_memalign or memalign at least.

Dmitry

[-- Attachment #2: lisp_align_malloc_cleanup.patch --]
[-- Type: text/plain, Size: 12530 bytes --]

=== modified file 'src/alloc.c'
--- src/alloc.c	2012-06-16 12:24:15 +0000
+++ src/alloc.c	2012-06-19 16:46:26 +0000
@@ -309,9 +309,6 @@
   MEM_TYPE_VECTOR_BLOCK
 };
 
-static void *lisp_malloc (size_t, enum mem_type);
-
-
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
 
 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
@@ -888,19 +885,37 @@
   return Qnil;
 }
 
+#if ! USE_LSB_TAG
+
+/* Used to catch invalid address when debugging.  */
+
+void *lisp_malloc_loser EXTERNALLY_VISIBLE;
+
+/* Nonzero if the memory at ADDR can be
+   addressed thru a Lisp object's pointer.  */
+
+static inline void
+verify_address (char *addr)
+{
+  Lisp_Object obj;
+
+  XSETCONS (obj, addr);
+  if ((char *) XCONS (obj) == addr)
+    return 1;
+  lisp_malloc_loser = addr;
+  return 0;
+}
+
+#endif /* not USE_LSB_TAG */
 
 /* Like malloc but used for allocating Lisp data.  NBYTES is the
    number of bytes to allocate, TYPE describes the intended use of the
    allocated memory block (for strings, for conses, ...).  */
 
-#if ! USE_LSB_TAG
-void *lisp_malloc_loser EXTERNALLY_VISIBLE;
-#endif
-
 static void *
 lisp_malloc (size_t nbytes, enum mem_type type)
 {
-  register void *val;
+  void *val;
 
   MALLOC_BLOCK_INPUT;
 
@@ -908,24 +923,33 @@
   allocated_mem_type = type;
 #endif
 
+#ifdef DOUG_LEA_MALLOC
+  /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
+     because mapped region contents are not preserved in
+     a dumped Emacs.  */
+  mallopt (M_MMAP_MAX, 0);
+#endif
   val = (void *) malloc (nbytes);
+#ifdef DOUG_LEA_MALLOC
+  /* Back to a reasonable maximum of mmap'ed areas.  */
+  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+
+  if (!val && nbytes)
+    {
+      MALLOC_UNBLOCK_INPUT;
+      memory_full (nbytes);
+    }
 
 #if ! USE_LSB_TAG
-  /* If the memory just allocated cannot be addressed thru a Lisp
-     object's pointer, and it needs to be,
-     that's equivalent to running out of memory.  */
-  if (val && type != MEM_TYPE_NON_LISP)
+  if (val && type != MEM_TYPE_NON_LISP
+      && !verify_address ((char *) val + nbytes - 1))
     {
-      Lisp_Object tem;
-      XSETCONS (tem, (char *) val + nbytes - 1);
-      if ((char *) XCONS (tem) != (char *) val + nbytes - 1)
-	{
-	  lisp_malloc_loser = val;
-	  free (val);
-	  val = 0;
-	}
+      free (val);
+      MALLOC_UNBLOCK_INPUT;
+      memory_full (SIZE_MAX);
     }
-#endif
+#endif /* not USE_LSB_TAG */
 
 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
   if (val && type != MEM_TYPE_NON_LISP)
@@ -933,116 +957,33 @@
 #endif
 
   MALLOC_UNBLOCK_INPUT;
-  if (!val && nbytes)
-    memory_full (nbytes);
   return val;
 }
 
-/* Free BLOCK.  This must be called to free memory allocated with a
-   call to lisp_malloc.  */
-
-static void
-lisp_free (void *block)
-{
-  MALLOC_BLOCK_INPUT;
-  free (block);
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
-  mem_delete (mem_find (block));
-#endif
-  MALLOC_UNBLOCK_INPUT;
-}
-
-/*****  Allocation of aligned blocks of memory to store Lisp data.  *****/
-
-/* The entry point is lisp_align_malloc which returns blocks of at most
-   BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary.  */
-
-#if defined (HAVE_POSIX_MEMALIGN) && defined (SYSTEM_MALLOC)
-#define USE_POSIX_MEMALIGN 1
-#endif
+/* Allocation of aligned blocks.  We assume that malloc implementation
+   provides posix_memalign or (obsolete) memalign at least.  */
 
 /* BLOCK_ALIGN has to be a power of 2.  */
+
 #define BLOCK_ALIGN (1 << 10)
 
-/* Padding to leave at the end of a malloc'd block.  This is to give
-   malloc a chance to minimize the amount of memory wasted to alignment.
-   It should be tuned to the particular malloc library used.
-   On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
-   posix_memalign on the other hand would ideally prefer a value of 4
-   because otherwise, there's 1020 bytes wasted between each ablocks.
-   In Emacs, testing shows that those 1020 can most of the time be
-   efficiently used by malloc to place other objects, so a value of 0 can
-   still preferable unless you have a lot of aligned blocks and virtually
-   nothing else.  */
-#define BLOCK_PADDING 0
-#define BLOCK_BYTES \
-  (BLOCK_ALIGN - sizeof (struct ablocks *) - BLOCK_PADDING)
-
-/* Internal data structures and constants.  */
-
-#define ABLOCKS_SIZE 16
-
-/* An aligned block of memory.  */
-struct ablock
-{
-  union
-  {
-    char payload[BLOCK_BYTES];
-    struct ablock *next_free;
-  } x;
-  /* `abase' is the aligned base of the ablocks.  */
-  /* It is overloaded to hold the virtual `busy' field that counts
-     the number of used ablock in the parent ablocks.
-     The first ablock has the `busy' field, the others have the `abase'
-     field.  To tell the difference, we assume that pointers will have
-     integer values larger than 2 * ABLOCKS_SIZE.  The lowest bit of `busy'
-     is used to tell whether the real base of the parent ablocks is `abase'
-     (if not, the word before the first ablock holds a pointer to the
-     real base).  */
-  struct ablocks *abase;
-  /* The padding of all but the last ablock is unused.  The padding of
-     the last ablock in an ablocks is not allocated.  */
-#if BLOCK_PADDING
-  char padding[BLOCK_PADDING];
-#endif
-};
-
-/* A bunch of consecutive aligned blocks.  */
-struct ablocks
-{
-  struct ablock blocks[ABLOCKS_SIZE];
-};
-
-/* Size of the block requested from malloc or posix_memalign.  */
-#define ABLOCKS_BYTES (sizeof (struct ablocks) - BLOCK_PADDING)
-
-#define ABLOCK_ABASE(block) \
-  (((uintptr_t) (block)->abase) <= (1 + 2 * ABLOCKS_SIZE)	\
-   ? (struct ablocks *)(block)					\
-   : (block)->abase)
-
-/* Virtual `busy' field.  */
-#define ABLOCKS_BUSY(abase) ((abase)->blocks[0].abase)
-
-/* Pointer to the (not necessarily aligned) malloc block.  */
-#ifdef USE_POSIX_MEMALIGN
-#define ABLOCKS_BASE(abase) (abase)
-#else
-#define ABLOCKS_BASE(abase) \
-  (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void**)abase)[-1])
-#endif
-
-/* The list of free ablock.   */
-static struct ablock *free_ablock;
-
-/* Allocate an aligned block of nbytes.
-   Alignment is on a multiple of BLOCK_ALIGN and `nbytes' has to be
-   smaller or equal to BLOCK_BYTES.  */
+/* Padding to leave at the end of a malloc'd block.  This should help
+   the malloc implementation to allocate aligned blocks consecutively.
+   FIXME: tuned to fit glibc malloc, may be suboptimal for others.  */
+
+#define BLOCK_PADDING sizeof (long)
+
+/* Maximum amount of memory in aligned block.  */
+
+#define BLOCK_BYTES (BLOCK_ALIGN - BLOCK_PADDING)
+
+/* Like lisp_malloc, but allocates aligned block of at
+   most BLOCK_BYTES aligned on a BLOCK_ALIGN boundary.  */
+
 static void *
 lisp_align_malloc (size_t nbytes, enum mem_type type)
 {
-  void *base, *val;
-  struct ablocks *abase;
+  void *val;
 
   eassert (nbytes <= BLOCK_BYTES);
 
@@ -1052,86 +993,40 @@
   allocated_mem_type = type;
 #endif
 
-  if (!free_ablock)
-    {
-      int i;
-      intptr_t aligned; /* int gets warning casting to 64-bit pointer.  */
-
 #ifdef DOUG_LEA_MALLOC
-      /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
-	 because mapped region contents are not preserved in
-	 a dumped Emacs.  */
-      mallopt (M_MMAP_MAX, 0);
+  /* Prevent mmap'ing the chunk.  Lisp data may not be mmap'ed
+     because mapped region contents are not preserved in
+     a dumped Emacs.  */
+  mallopt (M_MMAP_MAX, 0);
 #endif
 
-#ifdef USE_POSIX_MEMALIGN
-      {
-	int err = posix_memalign (&base, BLOCK_ALIGN, ABLOCKS_BYTES);
-	if (err)
-	  base = NULL;
-	abase = base;
-      }
+#ifdef HAVE_POSIX_MEMALIGN
+  if (posix_memalign (&val, BLOCK_ALIGN, nbytes))
+    val = NULL;
 #else
-      base = malloc (ABLOCKS_BYTES);
-      abase = ALIGN (base, BLOCK_ALIGN);
+  val = memalign (BLOCK_ALIGN, nbytes);
 #endif
 
-      if (base == 0)
-	{
-	  MALLOC_UNBLOCK_INPUT;
-	  memory_full (ABLOCKS_BYTES);
-	}
-
-      aligned = (base == abase);
-      if (!aligned)
-	((void**)abase)[-1] = base;
-
 #ifdef DOUG_LEA_MALLOC
-      /* Back to a reasonable maximum of mmap'ed areas.  */
-      mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+  /* Back to a reasonable maximum of mmap'ed areas.  */
+  mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
 #endif
 
+  if (!val && nbytes)
+    {
+      MALLOC_UNBLOCK_INPUT;
+      memory_full (nbytes);
+    }
+
 #if ! USE_LSB_TAG
-      /* If the memory just allocated cannot be addressed thru a Lisp
-	 object's pointer, and it needs to be, that's equivalent to
-	 running out of memory.  */
-      if (type != MEM_TYPE_NON_LISP)
-	{
-	  Lisp_Object tem;
-	  char *end = (char *) base + ABLOCKS_BYTES - 1;
-	  XSETCONS (tem, end);
-	  if ((char *) XCONS (tem) != end)
-	    {
-	      lisp_malloc_loser = base;
-	      free (base);
-	      MALLOC_UNBLOCK_INPUT;
-	      memory_full (SIZE_MAX);
-	    }
-	}
-#endif
-
-      /* Initialize the blocks and put them on the free list.
-	 If `base' was not properly aligned, we can't use the last block.  */
-      for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++)
-	{
-	  abase->blocks[i].abase = abase;
-	  abase->blocks[i].x.next_free = free_ablock;
-	  free_ablock = &abase->blocks[i];
-	}
-      ABLOCKS_BUSY (abase) = (struct ablocks *) aligned;
-
-      eassert (0 == ((uintptr_t) abase) % BLOCK_ALIGN);
-      eassert (ABLOCK_ABASE (&abase->blocks[3]) == abase); /* 3 is arbitrary */
-      eassert (ABLOCK_ABASE (&abase->blocks[0]) == abase);
-      eassert (ABLOCKS_BASE (abase) == base);
-      eassert (aligned == (intptr_t) ABLOCKS_BUSY (abase));
+  if (type != MEM_TYPE_NON_LISP 
+      && !verify_address ((char *) val + nbytes - 1))
+    {
+      free (val);
+      MALLOC_UNBLOCK_INPUT;
+      memory_full (SIZE_MAX);
     }
-
-  abase = ABLOCK_ABASE (free_ablock);
-  ABLOCKS_BUSY (abase) =
-    (struct ablocks *) (2 + (intptr_t) ABLOCKS_BUSY (abase));
-  val = free_ablock;
-  free_ablock = free_ablock->x.next_free;
+#endif /* not USE_LSB_TAG */
 
 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
   if (type != MEM_TYPE_NON_LISP)
@@ -1139,51 +1034,21 @@
 #endif
 
   MALLOC_UNBLOCK_INPUT;
-
   eassert (0 == ((uintptr_t) val) % BLOCK_ALIGN);
   return val;
 }
 
+/* Free BLOCK.  This must be called to free memory allocated
+   with a call to lisp_malloc or lisp_align_malloc.  */
+
 static void
-lisp_align_free (void *block)
+lisp_free (void *block)
 {
-  struct ablock *ablock = block;
-  struct ablocks *abase = ABLOCK_ABASE (ablock);
-
   MALLOC_BLOCK_INPUT;
+  free (block);
 #if GC_MARK_STACK && !defined GC_MALLOC_CHECK
   mem_delete (mem_find (block));
 #endif
-  /* Put on free list.  */
-  ablock->x.next_free = free_ablock;
-  free_ablock = ablock;
-  /* Update busy count.  */
-  ABLOCKS_BUSY (abase)
-    = (struct ablocks *) (-2 + (intptr_t) ABLOCKS_BUSY (abase));
-
-  if (2 > (intptr_t) ABLOCKS_BUSY (abase))
-    { /* All the blocks are free.  */
-      int i = 0, aligned = (intptr_t) ABLOCKS_BUSY (abase);
-      struct ablock **tem = &free_ablock;
-      struct ablock *atop = &abase->blocks[aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1];
-
-      while (*tem)
-	{
-	  if (*tem >= (struct ablock *) abase && *tem < atop)
-	    {
-	      i++;
-	      *tem = (*tem)->x.next_free;
-	    }
-	  else
-	    tem = &(*tem)->x.next_free;
-	}
-      eassert ((aligned & 1) == aligned);
-      eassert (i == (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1));
-#ifdef USE_POSIX_MEMALIGN
-      eassert ((uintptr_t) ABLOCKS_BASE (abase) % BLOCK_ALIGN == 0);
-#endif
-      free (ABLOCKS_BASE (abase));
-    }
   MALLOC_UNBLOCK_INPUT;
 }
 
@@ -3757,7 +3622,7 @@
 	    if (i == 0)
 	      free (spare_memory[i]);
 	    else if (i >= 1 && i <= 4)
-	      lisp_align_free (spare_memory[i]);
+	      lisp_free (spare_memory[i]);
 	    else
 	      lisp_free (spare_memory[i]);
 	    spare_memory[i] = 0;
@@ -6292,7 +6157,7 @@
 	    *cprev = cblk->next;
 	    /* Unhook from the free list.  */
 	    cons_free_list = cblk->conses[0].u.chain;
-	    lisp_align_free (cblk);
+	    lisp_free (cblk);
 	  }
 	else
 	  {
@@ -6338,7 +6203,7 @@
 	    *fprev = fblk->next;
 	    /* Unhook from the free list.  */
 	    float_free_list = fblk->floats[0].u.chain;
-	    lisp_align_free (fblk);
+	    lisp_free (fblk);
 	  }
 	else
 	  {
@@ -6671,9 +6536,6 @@
   pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
   pure_bytes_used_before_overflow = 0;
 
-  /* Initialize the list of free aligned blocks.  */
-  free_ablock = NULL;
-
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);