diff src/alloc.c @ 26:441bb1e64a06 r19-15b96

Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 859a2309aef8
children 1917ad0d78d7
line wrap: on
line diff
--- a/src/alloc.c	Mon Aug 13 08:51:05 2007 +0200
+++ b/src/alloc.c	Mon Aug 13 08:51:32 2007 +0200
@@ -216,7 +216,9 @@
     }
   else if (pureptr + size > PURESIZE)
     {
-      message ("\nERROR:  Pure Lisp storage exhausted!\n");
+      /* This can cause recursive bad behavior, we'll yell at the end */
+      /* when we're done. */
+      /* message ("\nERROR:  Pure Lisp storage exhausted!\n"); */
       pure_lossage = size;
       return (0);
     }
@@ -2547,12 +2549,14 @@
           {
             struct Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj);
             Lisp_Object new = make_compiled_function (1);
-            struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (obj);
+	    /* How on earth could this code have worked before?  -sb */
+            struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (new);
             n->flags = o->flags;
             n->bytecodes = Fpurecopy (o->bytecodes);
             n->constants = Fpurecopy (o->constants);
             n->arglist = Fpurecopy (o->arglist);
             n->doc_and_interactive = Fpurecopy (o->doc_and_interactive);
+	    n->maxdepth = o->maxdepth;
             return (new);
           }
 #ifdef LISP_FLOAT_TYPE
@@ -2568,24 +2572,46 @@
 
 
 
+static void
+PURESIZE_h(long int puresize)
+{
+  int fd;
+  char *PURESIZE_h_file = "PURESIZE.h";
+  char *WARNING = "/* This file is generated by XEmacs, DO NOT MODIFY!!! */\n";
+  char define_PURESIZE[256];
+
+  if ((fd = open(PURESIZE_h_file, O_WRONLY|O_CREAT)) < 0) {
+    report_file_error("Can't write PURESIZE",
+		      Fcons(build_ext_string(PURESIZE_h_file, FORMAT_FILENAME),
+			    Qnil));
+  }
+
+  write(fd, WARNING, strlen(WARNING));
+  sprintf(define_PURESIZE, "# define PURESIZE %ld\n", puresize);
+  write(fd, define_PURESIZE, strlen(define_PURESIZE));
+  close(fd);
+}
+
 void
 report_pure_usage (int report_impurities,
                    int die_if_pure_storage_exceeded)
 {
+  int rc = 0;
+
   if (pure_lossage)
     {
       CONST long report_round = 5000;
 
       message ("\n****\tPure Lisp storage exhausted!\n"
- "\tCheck whether you are loading .el files when .elc files were intended.\n"
- "\tOtherwise, increase PURESIZE in puresize.h and relink.\n\n"
- "\tPURESIZE is presently %ld.\n"
  "\tAn additional %ld bytes will guarantee enough pure space;\n"
  "\ta smaller increment may work (due to structure-sharing).\n"
  "****",
-	       (long) PURESIZE,
                (((pure_lossage + report_round - 1)
                  / report_round) * report_round));
+      if (die_if_pure_storage_exceeded) {
+	PURESIZE_h(PURESIZE + pure_lossage);
+	rc = -1;
+      }
     }
   else
     {
@@ -2595,8 +2621,14 @@
       sprintf (buf, "Purespace usage: %ld of %ld (%d%%",
                pureptr, (long) PURESIZE,
                (int) (pureptr / (PURESIZE / 100.0) + 0.5));
-      if (lost > 2)
+      if (lost > 2) {
         sprintf (buf + strlen (buf), " -- %dk wasted", lost);
+	if (die_if_pure_storage_exceeded) {
+	  PURESIZE_h(pureptr + 16);
+	  rc = -1;
+	}
+      }
+
       strcat (buf, ").");
       message ("%s", buf);
     }
@@ -2679,8 +2711,12 @@
     }
   clear_message ();
 
-  if (pure_lossage && die_if_pure_storage_exceeded)
+  if (rc < 0) {
+    fatal ("Pure size adjusted, will restart `make'");
+  } else if (pure_lossage && die_if_pure_storage_exceeded) {
     fatal ("Pure storage exhausted");
+  }
+  (void)sys_unlink("SATISFIED");
 }
 
 
@@ -4114,6 +4150,11 @@
   Lisp_Object ret[6];
   int i;
 
+  if (purify_flag && pure_lossage)
+    {
+      return Qnil;
+    }
+
   garbage_collect_1 ();
 
   for (i = 0; i < last_lrecord_type_index_assigned; i++)