Mercurial > hg > xemacs-beta
diff src/alloc.c @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 56c54cf7c5b6 |
children | 1ce6082ce73f |
line wrap: on
line diff
--- a/src/alloc.c Mon Aug 13 09:00:04 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:02:59 2007 +0200 @@ -44,6 +44,7 @@ #include "backtrace.h" #include "buffer.h" #include "bytecode.h" +#include "chartab.h" #include "device.h" #include "elhash.h" #include "events.h" @@ -216,9 +217,7 @@ } else if (pureptr + size > PURESIZE) { - /* This can cause recursive bad behavior, we'll yell at the end */ - /* when we're done. */ - /* message ("\nERROR: Pure Lisp storage exhausted!\n"); */ + message ("\nERROR: Pure Lisp storage exhausted!\n"); pure_lossage = size; return (0); } @@ -1604,12 +1603,9 @@ b->annotated = Vload_file_name_internal_the_purecopy; else if (!NILP (Vload_file_name_internal)) { - struct gcpro gcpro1; - GCPRO1(val); /* don't let val or b get reaped */ Vload_file_name_internal_the_purecopy = Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal)); b->annotated = Vload_file_name_internal_the_purecopy; - UNGCPRO; } #endif @@ -2062,6 +2058,27 @@ #endif } +#ifdef MULE + +void +set_string_char (struct Lisp_String *s, Charcount i, Emchar c) +{ + Bytecount oldlen, newlen; + Bufbyte newstr[MAX_EMCHAR_LEN]; + Bytecount bytoff = charcount_to_bytecount (string_data (s), i); + + oldlen = charcount_to_bytecount (string_data (s) + bytoff, 1); + newlen = set_charptr_emchar (newstr, c); + + if (oldlen != newlen) + resize_string (s, bytoff, newlen - oldlen); + /* Remember, string_data (s) might have changed so we can't + cache it. */ + memcpy (string_data (s) + bytoff, newstr, newlen); +} + +#endif /* MULE */ + DEFUN ("make-string", Fmake_string, 2, 2, 0, /* Return a newly created string of length LENGTH, with each element being INIT. LENGTH must be an integer and INIT must be a character. @@ -2100,6 +2117,11 @@ make_string (CONST Bufbyte *contents, Bytecount length) { Lisp_Object val; + + /* Make sure we find out about bad make_string's when they happen */ +#if defined (ERROR_CHECK_BUFPOS) && defined (MULE) + bytecount_to_charcount (contents, length); /* Just for the assertions */ +#endif val = make_uninit_string (length); memcpy (XSTRING_DATA (val), contents, length); @@ -2206,7 +2228,7 @@ #ifdef ERROR_CHECK_GC CONST struct lrecord_implementation *implementation = lheader->implementation; - + /* There should be no other pointers to the free list. */ assert (!MARKED_RECORD_HEADER_P (lheader)); /* Only lcrecords should be here. */ @@ -2219,7 +2241,7 @@ assert (implementation->static_size == 0 || implementation->static_size == list->size); #endif /* ERROR_CHECK_GC */ - + MARK_RECORD_HEADER (lheader); chain = free_header->chain; } @@ -2552,14 +2574,12 @@ { struct Lisp_Compiled_Function *o = XCOMPILED_FUNCTION (obj); Lisp_Object new = make_compiled_function (1); - /* How on earth could this code have worked before? -sb */ - struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (new); + struct Lisp_Compiled_Function *n = XCOMPILED_FUNCTION (obj); 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 @@ -2575,45 +2595,24 @@ -static void -PURESIZE_h(long int puresize) -{ - int fd; - char *PURESIZE_h_file = "puresize_adjust.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|O_TRUNC, 0666)) < 0) { - report_file_error("Can't write PURESIZE_ADJUSTMENT", - Fcons(build_ext_string(PURESIZE_h_file, FORMAT_FILENAME), - Qnil)); - } - - write(fd, WARNING, strlen(WARNING)); - sprintf(define_PURESIZE, "# define PURESIZE_ADJUSTMENT %ld\n", - puresize - RAW_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" -"\tPurespace usage: %ld of %ld\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" "****", - PURESIZE+pure_lossage, PURESIZE); - if (die_if_pure_storage_exceeded) { - PURESIZE_h(PURESIZE + pure_lossage); - rc = -1; - } + (long) PURESIZE, + (((pure_lossage + report_round - 1) + / report_round) * report_round)); } else { @@ -2623,14 +2622,8 @@ 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); } @@ -2713,12 +2706,8 @@ } clear_message (); - if (rc < 0) { - (void)unlink("SATISFIED"); - fatal ("Pure size adjusted, will restart `make'"); - } else if (pure_lossage && die_if_pure_storage_exceeded) { + if (pure_lossage && die_if_pure_storage_exceeded) fatal ("Pure storage exhausted"); - } } @@ -3553,6 +3542,55 @@ #endif /* not standalone */ + +#if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) + +static void +verify_string_chars_integrity (void) +{ + struct string_chars_block *sb; + + /* Scan each existing string block sequentially, string by string. */ + for (sb = first_string_chars_block; sb; sb = sb->next) + { + int pos = 0; + /* POS is the index of the next string in the block. */ + while (pos < sb->pos) + { + struct string_chars *s_chars = + (struct string_chars *) &(sb->string_chars[pos]); + struct Lisp_String *string; + int size; + int fullsize; + + /* If the string_chars struct is marked as free (i.e. the STRING + pointer is 0xFFFFFFFF) then this is an unused chunk of string + storage. (See below.) */ + + if (FREE_STRUCT_P (s_chars)) + { + fullsize = ((struct unused_string_chars *) s_chars)->fullsize; + pos += fullsize; + continue; + } + + string = s_chars->string; + /* Must be 32-bit aligned. */ + assert ((((int) string) & 3) == 0); + + size = string_length (string); + fullsize = STRING_FULLSIZE (size); + + assert (!BIG_STRING_FULLSIZE_P (fullsize)); + assert (string_data (string) == s_chars->chars); + pos += fullsize; + } + assert (pos == sb->pos); + } +} + +#endif /* MULE && ERROR_CHECK_GC */ + /* Compactify string chars, relocating the reference to each -- free any empty string_chars_block we see. */ static void @@ -3826,7 +3864,6 @@ Vprocess_environment = Qnil; Vexec_directory = Qnil; Vdata_directory = Qnil; - Vsite_directory = Qnil; Vdoc_directory = Qnil; Vconfigure_info_directory = Qnil; Vexec_path = Qnil; @@ -4052,6 +4089,7 @@ prune_weak_hashtables (marked_p); prune_weak_lists (marked_p); prune_specifiers (marked_p); + prune_syntax_tables (marked_p); gc_sweep (); @@ -4153,11 +4191,6 @@ 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++)