[Message Prev][Message Next][Thread Prev][Thread Next][Message Index][Thread Index]

[MD:2830]Portable dumper



Keiichiro Nagano (永野圭一郎) <knagano@xxxxxxxxx> writes:

> この修正で、僕の手元でも garbage-collect が動くようになりました!!

さらに mmap で high address を返してきたときには malloc する
ようにしたので、ほとんどの人の環境で起動はするようになると思
います。

> ただ、また新たな bug を見つけました。-q -no-site-file で起動して
> *scratch* buffer で (category-table) を評価すると、100% SEGV が飛んで
> きます。-f category-table では落ちません。backtrace (bt1.txt) が示す通
> り、PVEC_CHAR_TABLE を print() しようとして死んでいます。

Bool vector の扱いに問題がありました。この patch で直ってい
るはずです。

> また、同じような症状で、立ち上げた Emacs 上で M-x garbage-collect を数
> 回繰り返すと落ちます (bt2.txt)。これは GC で落ちているのではなく、
> garbage-collect という symbol の oblookup に失敗しています。こちらは、
> 何回やれば落ちるのか、といったようなきちんとした再現性を、まだ見付けて
> いません。

たぶん、同じ原因だと思います。

> これだけではなんなので、emacs.dmp を探す code を (XEmacs から丸ごとぱ
> くってきて) でっちあげました。林さんの patch 3つのあとにあてて下さい。

ありがとうございます。手元でいじっていた Windows 用の code 
との conflict を resolve しなければならないのでちょっと待っ
てください。

この patch はふたたび configure.in を変更しますので、patch
をあてた後で autoconf と configure を実行しなおしてください。
書きかけの heap test 用 code があるのでちょっと長目ですが、
上の bug fix の code は diff の上の方にあります。
# 素の Emacs との diff は dump file search patch をあててか
# ら置きます。
# Subversion server が欲しい。;-) もう CVS には戻れないので
# sourceforge 等は使えないし。(^^;

あ、今思い出しましたが、known bug として、C-h h してから C-n
や C-f をしていると cursor 移動がおかしくなるというのがあり
ます。これはそのうちに修正します。
Index: ./configure.in
===================================================================
--- ./configure.in
+++ ./configure.in	Fri Jan 18 09:41:29 2002
@@ -1421,6 +1421,8 @@
   AC_DEFINE(DOUG_LEA_MALLOC)
 fi
 
+AC_CHECK_FUNCS(mmap)
+
 if test x"${REL_ALLOC}" = x; then
   REL_ALLOC=${GNU_MALLOC}
 fi
Index: ./src/config.in
===================================================================
--- ./src/config.in
+++ ./src/config.in	Fri Jan 18 09:42:10 2002
@@ -41,7 +41,10 @@
 /* Define REL_ALLOC if you want to use the relocating allocator for
    buffer space. */
 #undef REL_ALLOC
-  
+
+/* Define this if you have mmap. */
+#undef HAVE_MMAP
+
 /* Define HAVE_X_WINDOWS if you want to use the X window system.  */
 #undef HAVE_X_WINDOWS
 
Index: ./src/alloc.c
===================================================================
--- ./src/alloc.c
+++ ./src/alloc.c	Fri Jan 18 14:07:53 2002
@@ -2078,9 +2078,11 @@
  loop2:
   XUNMARK (obj);
 
+#ifndef PDUMP
   if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)
       && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
     return;
+#endif
 
   last_marked[last_marked_index++] = objptr;
   if (last_marked_index == LAST_MARKED_SIZE)
@@ -3043,6 +3045,7 @@
 							  Qnil)))))));
 }
 
+#ifdef PDUMP
 #include <stdio.h>
 #include <sys/types.h>
 #include <sys/stat.h>
@@ -3075,6 +3078,11 @@
   long cons_length, symbol_length, misc_length;
   long small_string_length, large_string_length;
   long float_length, vector_length;
+#ifdef PDUMP_DEBUG
+  long cons_size, symbol_size, misc_size;
+  long small_string_size, large_string_size;
+  long float_size, vector_size;
+#endif
 } pdump_header_t;
 
 typedef struct pdump_root_t
@@ -3089,7 +3097,7 @@
 #if 0
 #define PDUMP_OFFSET 12288
 #else
-#define PDUMP_OFFSET 10000
+#define PDUMP_OFFSET 0
 #endif
 static pdump_forward_t *pdump_hash[HASH_SIZE];
 
@@ -3236,12 +3244,11 @@
 	}
       else if (BOOL_VECTOR_P (obj))
 	{
-	  struct Lisp_Vector *ptr = XVECTOR (obj);
-	  EMACS_INT size = ptr->size;
-	  if (size & PSEUDOVECTOR_FLAG)
-	    size &= PSEUDOVECTOR_SIZE_MASK;
-	  pdump_register_object (obj, (sizeof (struct Lisp_Vector)
-				       + (size - 1) * sizeof (Lisp_Object)),
+	  struct Lisp_Bool_Vector *ptr = XBOOL_VECTOR (obj);
+	  pdump_register_object (obj,
+				 (sizeof (struct Lisp_Vector)
+				  + ptr->size * sizeof (unsigned char)
+				  - sizeof (Lisp_Object)),
 				 PDUMP_VECTOR);
 	  break;
 	}
@@ -3550,13 +3557,11 @@
 	}
       else if (BOOL_VECTOR_P (obj))
 	{
-	  struct Lisp_Vector *ptr = XVECTOR (obj);
+	  struct Lisp_Bool_Vector *ptr = XBOOL_VECTOR (obj);
 	  long total_size = pdump_size (obj);
-	  struct Lisp_Vector *new = (struct Lisp_Vector *) xmalloc (total_size);
-	  EMACS_INT size = ptr->size;
+	  struct Lisp_Bool_Vector *new
+	    = (struct Lisp_Bool_Vector *) xmalloc (total_size);
 
-	  if (size & PSEUDOVECTOR_FLAG)
-	    size &= PSEUDOVECTOR_SIZE_MASK;
 	  memcpy (new, ptr, total_size);
 	  fwrite (new, total_size, 1, pdump_stream);
 	  xfree (new);
@@ -3651,6 +3656,15 @@
   header.large_string_length = pdump_lisp_object[PDUMP_LARGE_STRING].index;
   header.float_length = pdump_lisp_object[PDUMP_FLOAT].index; 
   header.vector_length = pdump_lisp_object[PDUMP_VECTOR].index;
+#ifdef PDUMP_DEBUG
+  header.cons_size = pdump_lisp_object[PDUMP_CONS].size;
+  header.symbol_size = pdump_lisp_object[PDUMP_SYMBOL].size;
+  header.misc_size = pdump_lisp_object[PDUMP_MISC].size;
+  header.small_string_size = pdump_lisp_object[PDUMP_SMALL_STRING].size;
+  header.large_string_size = pdump_lisp_object[PDUMP_LARGE_STRING].size;
+  header.float_size = pdump_lisp_object[PDUMP_FLOAT].size; 
+  header.vector_size = pdump_lisp_object[PDUMP_VECTOR].size;
+#endif
   fwrite (&header, sizeof (header), 1, pdump_stream);
 
   pdump_write_objects (pdump_stream);
@@ -3686,16 +3700,37 @@
   point_marker = saved_point_marker;
 }
 
+#ifdef PDUMP_DEBUG
+#define PDUMP_RELOCATE(obj, offset) pdump_relocate_1(&obj, offset)
+static void
+pdump_relocate_1 (Lisp_Object *obj, unsigned long offset)
+{
+  char *p_r_ptr = (char *) ((unsigned long) XPNTR (*obj) + offset);
+  if (! INTEGERP (*obj)
+      && pdump_objects_start <= p_r_ptr
+      && p_r_ptr < pdump_objects_start + pdump_header.objects_size)
+    {
+      if (VECTORLIKEP (*obj))
+	XSETVECTOR (*obj, p_r_ptr);
+      else
+	XSET ((*obj), XTYPE (*obj), p_r_ptr);
+      assert (XPNTR (*obj) == p_r_ptr);
+    }
+  else
+    assert (INTEGERP (*obj) || SUBRP (*obj));
+}
+#else
 #define PDUMP_RELOCATE(obj, offset)					\
 do									\
 {									\
-  char *p_r_ptr = (char *) ((long) XPNTR (obj) + offset);		\
+  char *p_r_ptr = (char *) ((unsigned long) XPNTR (obj) + offset);	\
   if (! INTEGERP (obj)							\
       && pdump_objects_start <= p_r_ptr					\
       && p_r_ptr < pdump_objects_start + pdump_header.objects_size)	\
-    XSET ((obj), XTYPE (obj), (char *) XPNTR (obj) + offset);		\
+    XSET ((obj), XTYPE (obj), p_r_ptr);					\
 }									\
 while (0)
+#endif
 
 static void pdump_relocate_objects (long offset);
 int
@@ -3708,12 +3743,33 @@
 
   read (fd, &pdump_header, sizeof (pdump_header));
   lseek (fd, 0, SEEK_SET);
+#ifdef HAVE_MMAP
   ret = (char *)mmap (pdump_header.offset, pdump_header.objects_size
 		      + sizeof (pdump_header_t),
 		      PROT_READ|PROT_WRITE, MAP_PRIVATE,
 		      fd, 0);
   if ((long) ret == -1)
     return 1;
+  else if ((unsigned long)ret & ~VALMASK)
+#endif /* HAVE_MMAP */
+    {
+      munmap (ret, pdump_header.objects_size + sizeof (pdump_header_t));
+#ifdef DOUG_LEA_MALLOC
+      /* Prevent mmap'ing the chunk.  */
+      mallopt (M_MMAP_MAX, 0);
+#endif
+      ret = (char *) xmalloc (pdump_header.objects_size + sizeof (pdump_header_t));
+#ifdef DOUG_LEA_MALLOC
+      /* Back to a reasonable maximum of mmap'ed areas. */
+      mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+      if ((unsigned long)ret & ~VALMASK)
+	{
+	  fprintf (stderr, "emacs: malloc returned high address\n");
+	  return 1;
+	}
+      read (fd, ret, pdump_header.objects_size + sizeof (pdump_header_t));
+    }
   pdump_objects_start = ret + sizeof (pdump_header_t);
   offset = ret - pdump_header.offset;
   lseek (fd, pdump_header.objects_size + sizeof (pdump_header_t), SEEK_SET);
@@ -3927,8 +3983,18 @@
       size = ptr->size;
       if (size & PSEUDOVECTOR_FLAG)
 	size &= PSEUDOVECTOR_SIZE_MASK;
-      obj_ptr += (sizeof (struct Lisp_Vector)
-		  + (size - 1) * sizeof (Lisp_Object));
+      if ((((struct Lisp_Vector *)obj_ptr)->size
+	   & (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+	  == (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
+	{
+	  struct Lisp_Bool_Vector *ptr = (struct Lisp_Bool_Vector *) obj_ptr;
+	  obj_ptr += (sizeof (struct Lisp_Vector)
+		      + ptr->size * sizeof (unsigned char)
+		      - sizeof (Lisp_Object));
+	}
+      else
+	obj_ptr += (sizeof (struct Lisp_Vector)
+		    + (size - 1) * sizeof (Lisp_Object));
     }
 }
 
@@ -4035,12 +4101,10 @@
 	   & (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
 	  == (PSEUDOVECTOR_FLAG | PVEC_BOOL_VECTOR))
 	{
-	  struct Lisp_Vector *ptr = (struct Lisp_Vector *) obj_ptr;
-	  EMACS_INT size = ptr->size;
-	  if (size & PSEUDOVECTOR_FLAG)
-	    size &= PSEUDOVECTOR_SIZE_MASK;
+	  struct Lisp_Bool_Vector *ptr = (struct Lisp_Bool_Vector *) obj_ptr;
 	  obj_ptr += (sizeof (struct Lisp_Vector)
-		      + (size - 1) * sizeof (Lisp_Object));
+		      + ptr->size * sizeof (unsigned char)
+		      - sizeof (Lisp_Object));
 	}
       else
 	{
@@ -4058,6 +4122,231 @@
     }
 }
 
+static int
+dumped_p (char * ptr)
+{
+  return (pdump_objects_start <= ptr
+	  && ptr < pdump_objects_start + pdump_header.objects_size);
+}
+
+#ifdef PDUMP_DEBUG
+static void
+pdump_check_object_validity (Lisp_Object obj)
+{
+  char *ptr = (char *)XPNTR (obj);
+  switch (SWITCH_ENUM_CAST (XTYPE (obj)))
+    {
+#if 0
+    case Lisp_String:
+      {
+	break;
+      }
+    case Lisp_Vectorlike:
+      if (BUFFERP (obj))
+	break;
+      else if (SUBRP (obj))
+	break;
+      else
+	{
+	  EMACS_INT size = ptr->size;
+	  if (size & PSEUDOVECTOR_FLAG)
+	    size &= PSEUDOVECTOR_SIZE_MASK;
+	  break;
+	}
+#endif
+    case Lisp_Symbol:
+      {
+	if (dumped_p (ptr))
+	  {
+	    char *symbol_start = pdump_objects_start + pdump_header.cons_size
+	      + pdump_header.misc_size + pdump_header.small_string_size
+	      + pdump_header.large_string_size;
+	    assert (symbol_start <= ptr
+		    && ptr <= symbol_start + pdump_header.symbol_size
+		    && ((ptr - symbol_start) % (sizeof (struct Lisp_Symbol))
+			== 0));
+	  }
+	else
+	  {
+	    struct symbol_block *sblk;
+	    struct symbol_block **sprev = &symbol_block;
+	    int limit = symbol_block_index;
+	    int found = 0;
+	    for (sblk = symbol_block; sblk; sblk = *sprev)
+	      {
+		if (sblk->symbols <= ptr && ptr < sblk->symbols + limit)
+		  {
+		    assert ((ptr - (char *) sblk->symbols) % sizeof (struct Lisp_Symbol)
+			    == 0);
+		    found = 1;
+		    break;
+		  }
+		limit = SYMBOL_BLOCK_SIZE;
+		sprev = &sblk->next;
+	      }
+	    assert (found);
+	  }
+	
+	break;
+      }
+    case Lisp_Misc:
+      {
+	int found = 0;
+	if (dumped_p (ptr))
+	  {
+	    char *misc_ptr;
+	    assert (ptr < (pdump_objects_start + pdump_header.cons_size
+			   + pdump_header.misc_size));
+	    for (misc_ptr = pdump_objects_start + pdump_header.cons_size;
+		 misc_ptr <= ptr;
+		 )
+	      {
+		if (misc_ptr == ptr)
+		  {
+		    found = 1;
+		    break;
+		  }
+		switch (((union Lisp_Misc *)misc_ptr)->u_marker.type)
+		  {
+		  case Lisp_Misc_Marker:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Marker);
+		      break;
+		    }
+		  case Lisp_Misc_Buffer_Local_Value:
+		  case Lisp_Misc_Some_Buffer_Local_Value:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Buffer_Local_Value);
+		      break;
+		    }
+		  case Lisp_Misc_Intfwd:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Intfwd);
+		      break;
+		    }
+		  case Lisp_Misc_Boolfwd:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Boolfwd);
+		      break;
+		    }
+		  case Lisp_Misc_Objfwd:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Objfwd);
+		      break;
+		    }
+		  case Lisp_Misc_Buffer_Objfwd:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Buffer_Objfwd);
+		      break;
+		    }
+		  case Lisp_Misc_Kboard_Objfwd:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Kboard_Objfwd);
+		      break;
+		    }
+		  case Lisp_Misc_Overlay:
+		    {
+		      misc_ptr += sizeof (struct Lisp_Overlay);
+		      break;
+		    }
+		  default:
+		    abort ();
+		  }
+	      }
+	  }
+	else
+	  {
+	    struct marker_block *mblk;
+	    struct marker_block **mprev = &marker_block;
+	    int limit = marker_block_index;
+	    for (mblk = marker_block; mblk; mblk = *mprev)
+	      {
+		if (mblk->markers <= ptr && ptr < mblk->markers + limit)
+		  {
+		    assert ((ptr - (char *) mblk->markers) % sizeof (union Lisp_Misc)
+			    == 0);
+		    found = 1;
+		    break;
+		  }
+		limit = MARKER_BLOCK_SIZE;
+		mprev = &mblk->next;
+	      }
+	  }
+	assert (found);
+	break;
+      }
+    case Lisp_Cons:
+      {
+	if (dumped_p (ptr))
+	  assert (ptr < pdump_objects_start + pdump_header.cons_size
+		  && ((ptr - pdump_objects_start) % sizeof (struct Lisp_Cons)
+		      == 0));
+
+	else
+	  {
+	    struct cons_block *cblk;
+	    struct cons_block **cprev = &cons_block;
+	    int limit = cons_block_index;
+	    int found = 0;
+	    for (cblk = cons_block; cblk; cblk = *cprev)
+	      {
+		if (cblk->conses <= ptr && ptr < cblk->conses + limit)
+		  {
+		    assert ((ptr - (char *) cblk->conses) % sizeof (struct Lisp_Cons)
+			    == 0);
+		    found = 1;
+		    break;
+		  }
+		limit = CONS_BLOCK_SIZE;
+		cprev = &cblk->next;
+	      }
+	    assert (found);
+	  }
+	break;
+      }
+    case Lisp_Float:
+      {
+	if (dumped_p (ptr))
+	  {
+	    char *float_start = pdump_objects_start + pdump_header.cons_size
+	      + pdump_header.misc_size + pdump_header.small_string_size
+	      + pdump_header.large_string_size + pdump_header.symbol_size;
+	    assert (float_start <= ptr
+		    && ptr <= float_start + pdump_header.float_size
+		    && ((ptr - float_start) % (sizeof (struct Lisp_Float))
+			== 0));
+	  }
+	else
+	  {
+	    struct float_block *fblk;
+	    struct float_block **fprev = &float_block;
+	    int limit = float_block_index;
+	    int found = 0;
+	    for (fblk = float_block; fblk; fblk = *fprev)
+	      {
+		if (fblk->floats <= ptr && ptr < fblk->floats + limit)
+		  {
+		    assert ((ptr - (char *) fblk->floats) % sizeof (struct Lisp_Float)
+			    == 0);
+		    found = 1;
+		    break;
+		  }
+		limit = FLOAT_BLOCK_SIZE;
+		fprev = &fblk->next;
+	      }
+	    assert (found);
+	  }
+	break;
+      }
+    case Lisp_Int:
+      break;
+    default:
+      break;
+    }
+}
+#endif
+
+#endif /* PDUMP */
 
 /* Initialization */
 
-- 
Yoshiki Hayashi