X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Falloc.c;h=f10c14b28c4eaa2f1c4eb8b7875cf2db999028ef;hb=3aca7317dd930beecbddba646284279744087e69;hp=f695a712cc460f49237a6016d9ce614282be5a2a;hpb=f90d030e9d6e2be08166ad7451a16eb467cfef0f;p=chise%2Fxemacs-chise.git-

diff --git a/src/alloc.c b/src/alloc.c
index f695a71..f10c14b 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -400,6 +400,37 @@ alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation
   return lcheader;
 }
 
+#ifdef UTF2000
+void *
+alloc_older_lcrecord (size_t size,
+		      const struct lrecord_implementation *implementation)
+{
+  struct lcrecord_header *lcheader;
+
+  type_checking_assert
+    ((implementation->static_size == 0 ?
+      implementation->size_in_bytes_method != NULL :
+      implementation->static_size == size)
+     &&
+     (! implementation->basic_p)
+     &&
+     (! (implementation->hash == NULL && implementation->equal != NULL)));
+
+  lcheader = (struct lcrecord_header *) allocate_lisp_storage (size);
+  set_lheader_older_implementation (&lcheader->lheader, implementation);
+  lcheader->next = all_older_lcrecords;
+#if 1                           /* mly prefers to see small ID numbers */
+  lcheader->uid = lrecord_uid_counter++;
+#else				/* jwz prefers to see real addrs */
+  lcheader->uid = (int) &lcheader;
+#endif
+  lcheader->free = 0;
+  all_older_lcrecords = lcheader;
+  INCREMENT_CONS_COUNTER (size, implementation->name);
+  return lcheader;
+}
+#endif
+
 #if 0 /* Presently unused */
 /* Very, very poor man's EGC?
  * This may be slow and thrash pages all over the place.
@@ -1164,7 +1195,7 @@ make_vector (size_t length, Lisp_Object init)
   }
 }
 
-#ifdef UTF2000
+#ifdef HAVE_GGC
 Lisp_Object
 make_older_vector (size_t length, Lisp_Object init)
 {
@@ -1177,6 +1208,59 @@ make_older_vector (size_t length, Lisp_Object init)
   all_lcrecords = orig_all_lcrecords;
   return obj;
 }
+
+void make_vector_newer_1 (Lisp_Object v);
+void
+make_vector_newer_1 (Lisp_Object v)
+{
+  struct lcrecord_header* lcrecords = all_older_lcrecords;
+
+  if (lcrecords != NULL)
+    {
+      if (lcrecords == XPNTR (v))
+	{
+	  lcrecords->lheader.older = 0;
+	  all_older_lcrecords = all_older_lcrecords->next;
+	  lcrecords->next = all_lcrecords;
+	  all_lcrecords = lcrecords;
+	  return;
+	}
+      else
+	{
+	  struct lcrecord_header* plcrecords = lcrecords;
+
+	  lcrecords = lcrecords->next;
+	  while (lcrecords != NULL)
+	    {
+	      if (lcrecords == XPNTR (v))
+		{
+		  lcrecords->lheader.older = 0;
+		  plcrecords->next = lcrecords->next;
+		  lcrecords->next = all_lcrecords;
+		  all_lcrecords = lcrecords;
+		  return;
+		}
+	      plcrecords = lcrecords;
+	      lcrecords = lcrecords->next;
+	    }
+	}
+    }
+}
+
+void
+make_vector_newer (Lisp_Object v)
+{
+  int i;
+
+  for (i = 0; i < XVECTOR_LENGTH (v); i++)
+    {
+      Lisp_Object obj = XVECTOR_DATA (v)[i];
+
+      if (VECTORP (obj) && !EQ (obj, v))
+	make_vector_newer (obj);
+    }
+  make_vector_newer_1 (v);
+}
 #endif
 
 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
@@ -2521,7 +2605,11 @@ mark_object (Lisp_Object obj)
 
       /* All c_readonly objects have their mark bit set,
 	 so that we only need to check the mark bit here. */
-      if (! MARKED_RECORD_HEADER_P (lheader))
+      if ( (!MARKED_RECORD_HEADER_P (lheader))
+#ifdef UTF2000
+	   && (!OLDER_RECORD_HEADER_P (lheader))
+#endif
+	   )
 	{
 	  MARK_RECORD_HEADER (lheader);