🚀 go-pugleaf

In an earlier message I complained that dumping is a pain if you put
stuff into site-init.el (as I do), because it is hard to predict what
PURESIZE should be.  Apparently the standard way to work around this
is to set PURESIZE to some large value, then see what is actually
necessary, and dump again.

Appended is a patch to Emacs 19.26 that will print the amount of pure
space needed for dumping (assuming sufficient space doesn't already
exist).

For instance, I just tried to dump Emacs, and I got this helpful message:

	Dumping under names emacs and emacs-19.26.11
	Pure Lisp storage exhausted.  PURESIZE = 208000, used = 602140

My changes do the following:

* 'pure' is now a pointer to an array, instead of an array itself.
  The array is now called 'pure_array'.
* All pure storage allocation is done via allocate_pure_storage.
* If allocate_pure_storage runs out of space in 'pure', it allocates a
  new storage area.  This has the side effect of turning off GC.
  (note: that isn't a problem because the dump is going to fail
  anyway)
* dump-emacs calls a new function 'check_pure_storage'.  This function
  errors out if 'pure' != 'pure_array' (ie if allocate_pure_storage
  allocated a new area).

I didn't touch the HAVE_SHM case because I didn't understand it.  Is
it actually used?  I couldn't find a system that defines HAVE_SHM.

The changes are to alloc.c and emacs.c.  I imagine they will work with
Emacs 19.27 as well, but I have not tried that.  The changes might be
bad if pure storage is allocated at a time when Emacs is not going to
be dumped.  But I don't think that ever happens.

Here is a ChangeLog entry:

Mon Sep 19 12:01:12 1994  Tom Tromey  <tromey@drip.colorado.edu>

	* alloc.c (allocate_pure_storage): Preserve misalignment.
	(Fgarbage_collect): Return nil if doing pure allocation and the
	pure space has been overrun.

Thu Sep 15 01:08:16 1994  Tom Tromey  (tromey@drip.colorado.edu)

	* emacs.c (Fdump_emacs): Call check_pure_storage.

	* alloc.c (allocate_pure_storage): New function.
	(pure_array): New variable.  "pure" now points to this by default.
	(pure_max): New variable.
	(check_pure_storage): New function.
	(make_pure_string): Allocate using allocate_pure_storage.
	(pure_cons): Ditto.
	(make_pure_float): Ditto.
	(make_pure_vector): Ditto.

Tom
---
tromey@busco.lanl.gov             Member, League for Programming Freedom

*** emacs.c.~1~	Sun Sep  4 21:14:55 1994
--- emacs.c	Mon Sep 19 10:12:48 1994
***************
*** 54,63 ****
--- 54,64 ----
  #endif
  
  extern void malloc_warning ();
  extern char *index ();
  extern char *strerror ();
+ extern void check_pure_storage ();
  
  /* Command line args from shell, as list of strings */
  Lisp_Object Vcommand_line_args;
  
  /* The name under which Emacs was invoked, with any leading directory
***************
*** 933,942 ****
--- 934,945 ----
      {
        CHECK_STRING (symname, 0);
        if (XSTRING (symname)->size)
  	symname = Fexpand_file_name (symname, Qnil);
      }
+ 
+   check_pure_storage ();
  
    tem = Vpurify_flag;
    Vpurify_flag = Qnil;
  
    fflush (stdout);


*** alloc.c.~1~	Tue May  3 20:29:50 1994
--- alloc.c	Mon Sep 19 12:02:33 1994
***************
*** 16,26 ****
  You should have received a copy of the GNU General Public License
  along with GNU Emacs; see the file COPYING.  If not, write to
  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  
  #include <signal.h>
! 
  #include <config.h>
  #include "lisp.h"
  #include "intervals.h"
  #include "puresize.h"
  #ifndef standalone
--- 16,26 ----
  You should have received a copy of the GNU General Public License
  along with GNU Emacs; see the file COPYING.  If not, write to
  the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  
  #include <signal.h>
! #include <assert.h>
  #include <config.h>
  #include "lisp.h"
  #include "intervals.h"
  #include "puresize.h"
  #ifndef standalone
***************
*** 75,97 ****
  
  /* Non-nil means defun should do purecopy on the function definition */
  Lisp_Object Vpurify_flag;
  
  #ifndef HAVE_SHM
! int pure[PURESIZE / sizeof (int)] = {0,};   /* Force it into data space! */
  #define PUREBEG (char *) pure
  #else
  #define pure PURE_SEG_BITS   /* Use shared memory segment */
  #define PUREBEG (char *)PURE_SEG_BITS
  
  /* This variable is used only by the XPNTR macro when HAVE_SHM is
     defined.  If we used the PURESIZE macro directly there, that would
     make most of emacs dependent on puresize.h, which we don't want -
     you should be able to change that without too much recompilation.
     So map_in_data initializes pure_size, and the dependencies work
     out.  */
  int pure_size;
  #endif /* not HAVE_SHM */
  
  /* Index in pure at which next pure object will be allocated. */
  int pureptr;
  
--- 75,106 ----
  
  /* Non-nil means defun should do purecopy on the function definition */
  Lisp_Object Vpurify_flag;
  
  #ifndef HAVE_SHM
! 
! int pure_array[PURESIZE / sizeof (int)] = {0,};	/* Force it into data space! */
! int *pure = pure_array;
! 
! /* Total number of pure bytes allocated. */
! int pure_max;
! 
  #define PUREBEG (char *) pure
+ 
  #else
+ 
  #define pure PURE_SEG_BITS   /* Use shared memory segment */
  #define PUREBEG (char *)PURE_SEG_BITS
  
  /* This variable is used only by the XPNTR macro when HAVE_SHM is
     defined.  If we used the PURESIZE macro directly there, that would
     make most of emacs dependent on puresize.h, which we don't want -
     you should be able to change that without too much recompilation.
     So map_in_data initializes pure_size, and the dependencies work
     out.  */
  int pure_size;
+ 
  #endif /* not HAVE_SHM */
  
  /* Index in pure at which next pure object will be allocated. */
  int pureptr;
  
***************
*** 997,1046 ****
    }
  }
  
  /* Pure storage management.  */
  
  /* Must get an error if pure storage is full,
!  since if it cannot hold a large string
!  it may be able to hold conses that point to that string;
!  then the string is not protected from gc. */
  
  Lisp_Object
  make_pure_string (data, length)
       char *data;
       int length;
  {
    register Lisp_Object new;
    register int size = sizeof (int) + INTERVAL_PTR_SIZE + length + 1;
  
!   if (pureptr + size > PURESIZE)
!     error ("Pure Lisp storage exhausted");
!   XSET (new, Lisp_String, PUREBEG + pureptr);
    XSTRING (new)->size = length;
    bcopy (data, XSTRING (new)->data, length);
    XSTRING (new)->data[length] = 0;
  
    /* We must give strings in pure storage some kind of interval.  So we
       give them a null one.  */
  #if defined (USE_TEXT_PROPERTIES)
    XSTRING (new)->intervals = NULL_INTERVAL;
  #endif
!   pureptr += (size + sizeof (int) - 1)
! 	     / sizeof (int) * sizeof (int);
    return new;
  }
  
  Lisp_Object
  pure_cons (car, cdr)
       Lisp_Object car, cdr;
  {
    register Lisp_Object new;
  
!   if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE)
!     error ("Pure Lisp storage exhausted");
!   XSET (new, Lisp_Cons, PUREBEG + pureptr);
!   pureptr += sizeof (struct Lisp_Cons);
    XCONS (new)->car = Fpurecopy (car);
    XCONS (new)->cdr = Fpurecopy (cdr);
    return new;
  }
  
--- 1006,1114 ----
    }
  }
  
  /* Pure storage management.  */
  
+ /* Largest alignment we think we will ever encounter.  FIXME. */
+ #define MAX_ALIGN 16
+ 
+ /* Allocate some pure space.  If we grow above PURESIZE, then malloc
+    some space.  This lets us determine how much pure space we actually
+    need. */
+ static char *
+ allocate_pure_storage (size, alignment)
+      int size, alignment;
+ {
+   char *save;
+ 
+ #ifndef HAVE_SHM
+   if (pureptr + size > PURESIZE)
+     {
+       /* Ran out of memory in last block.  Allocate a new one.
+ 	 Fails if object to be allocated is bigger than
+ 	 PURESIZE, so we assert that that can't happen. */
+       save = (char *) pure;
+       assert (size < PURESIZE);
+       pure = (int *) xmalloc (PURESIZE);
+       pure_max += pureptr;
+ 
+       /* We need to preserve our old alignment, because otherwise some
+ 	 future allocation could be aligned differently, resulting in
+ 	 a different value for PURE_MAX.  This has actually happened.
+ 	 So we make pureptr a little bigger than 0, to make the
+ 	 alignment come out the same.  And simultaneously we decrement
+ 	 pure_max, to make the total size come out right. */
+       pureptr = ((unsigned long) save + pureptr) & (MAX_ALIGN - 1);
+       pure_max -= pureptr;
+     }
+ #else
+   if (pureptr + size > PURESIZE)
+     error ("Pure Lisp storage exhausted");
+ #endif /* not HAVE_SHM */
+ 
+   save = PUREBEG + pureptr;
+   save = (char *) (((unsigned long) save + alignment - 1) & - alignment);
+   pureptr = save - PUREBEG + size;
+   return (save);
+ }
+ 
+ /* Throw an error if we've overrun our pure storage. */
+ void
+ check_pure_storage ()
+ {
+ #ifndef HAVE_SHM
+   if (pure != pure_array)
+     {
+       error ("Pure Lisp storage exhausted.  PURESIZE = %d, used = %d",
+ 	     PURESIZE, pure_max + pureptr);
+     }
+ #endif /* not HAVE_SHM */
+ }
+ 
  /* Must get an error if pure storage is full,
!    since if it cannot hold a large string
!    it may be able to hold conses that point to that string;
!    then the string is not protected from gc.
! 
!    But this only holds in the HAVE_SHM case.  Ordinarily we reallocate
!    our pure storage and then print a useful message when dumping
!    fails. */
  
  Lisp_Object
  make_pure_string (data, length)
       char *data;
       int length;
  {
    register Lisp_Object new;
    register int size = sizeof (int) + INTERVAL_PTR_SIZE + length + 1;
+   register char *space;
  
!   space = allocate_pure_storage ((size + sizeof (int) - 1)
! 				 / sizeof (int) * sizeof (int), 1);
!   XSET (new, Lisp_String, space);
    XSTRING (new)->size = length;
    bcopy (data, XSTRING (new)->data, length);
    XSTRING (new)->data[length] = 0;
  
    /* We must give strings in pure storage some kind of interval.  So we
       give them a null one.  */
  #if defined (USE_TEXT_PROPERTIES)
    XSTRING (new)->intervals = NULL_INTERVAL;
  #endif
! 
    return new;
  }
  
  Lisp_Object
  pure_cons (car, cdr)
       Lisp_Object car, cdr;
  {
    register Lisp_Object new;
+   register char *space;
  
!   space = allocate_pure_storage (sizeof (struct Lisp_Cons), 1);
!   XSET (new, Lisp_Cons, space);
    XCONS (new)->car = Fpurecopy (car);
    XCONS (new)->cdr = Fpurecopy (cdr);
    return new;
  }
  
***************
*** 1049,1084 ****
  Lisp_Object
  make_pure_float (num)
       double num;
  {
    register Lisp_Object new;
  
    /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof
       (double) boundary.  Some architectures (like the sparc) require
       this, and I suspect that floats are rare enough that it's no
       tragedy for those that do.  */
    {
      int alignment;
-     char *p = PUREBEG + pureptr;
  
  #ifdef __GNUC__
  #if __GNUC__ >= 2
      alignment = __alignof (struct Lisp_Float);
  #else
      alignment = sizeof (struct Lisp_Float);
  #endif
  #else
      alignment = sizeof (struct Lisp_Float);
  #endif  
!     p = (char *) (((unsigned long) p + alignment - 1) & - alignment);
!     pureptr = p - PUREBEG;
    }
  
!   if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
!     error ("Pure Lisp storage exhausted");
!   XSET (new, Lisp_Float, PUREBEG + pureptr);
!   pureptr += sizeof (struct Lisp_Float);
    XFLOAT (new)->data = num;
    XFLOAT (new)->type = 0;	/* bug chasing -wsr */
    return new;
  }
  
--- 1117,1149 ----
  Lisp_Object
  make_pure_float (num)
       double num;
  {
    register Lisp_Object new;
+   register char *space;
  
    /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof
       (double) boundary.  Some architectures (like the sparc) require
       this, and I suspect that floats are rare enough that it's no
       tragedy for those that do.  */
    {
      int alignment;
  
  #ifdef __GNUC__
  #if __GNUC__ >= 2
      alignment = __alignof (struct Lisp_Float);
  #else
      alignment = sizeof (struct Lisp_Float);
  #endif
  #else
      alignment = sizeof (struct Lisp_Float);
  #endif  
! 
!     space = allocate_pure_storage (sizeof (struct Lisp_Float), alignment);
    }
  
!   XSET (new, Lisp_Float, space);
    XFLOAT (new)->data = num;
    XFLOAT (new)->type = 0;	/* bug chasing -wsr */
    return new;
  }
  
***************
*** 1088,1103 ****
  make_pure_vector (len)
       int len;
  {
    register Lisp_Object new;
    register int size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object);
  
!   if (pureptr + size > PURESIZE)
!     error ("Pure Lisp storage exhausted");
  
!   XSET (new, Lisp_Vector, PUREBEG + pureptr);
!   pureptr += size;
    XVECTOR (new)->size = len;
    return new;
  }
  
  DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
--- 1153,1167 ----
  make_pure_vector (len)
       int len;
  {
    register Lisp_Object new;
    register int size = sizeof (struct Lisp_Vector) + (len - 1) * sizeof (Lisp_Object);
+   register char *space;
  
!   space = allocate_pure_storage (size, 1);
  
!   XSET (new, Lisp_Vector, space);
    XVECTOR (new)->size = len;
    return new;
  }
  
  DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
***************
*** 1218,1227 ****
--- 1282,1299 ----
    register Lisp_Object tem;
    char *omessage = echo_area_glyphs;
    int omessage_length = echo_area_glyphs_length;
    char stack_top_variable;
    register int i;
+ 
+ #ifndef HAVE_SHM
+   /* If we're doing pure allocation, and we've allocated a new pure
+      storage array, then we don't GC.  (We are just going to exit in
+      this case anyway). */
+   if (!NILP (Vpurify_flag) && pure != pure_array)
+     return (Qnil);
+ #endif
  
    /* Save a copy of the contents of the stack, for debugging.  */
  #if MAX_SAVE_STACK > 0
    if (NILP (Vpurify_flag))
      {