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++)