xemacs-beta: src/alloc.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:383a494979f8
+:441bb1e64a06
 pure_lossage += size;
 return (0);
 }
 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);
 }
 else
 return (1);
 {
 if (COMPILED_FUNCTIONP (obj))
 {
 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
 else if (FLOATP (obj))
 return make_pure_float (float_data (XFLOAT (obj)));
 return (obj);
 }
+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
 {
 int lost = (PURESIZE - pureptr) / 1024;
 char buf[200];
 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);
 }
 #ifdef PURESTAT
 UNGCPRO;
 garbage_collect_1 ();         /* GC garbage_collect's garbage */
 }
 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");
 }
 /**********************************************************************/
 /*                            staticpro                               */
 {
 Lisp_Object pl = Qnil;
 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++)
 {
 if (lcrecord_stats[i].bytes_in_use != 0

Mercurial > hg > xemacs-beta

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