Mercurial > hg > xemacs-beta
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++)