(MAX_LEADING_BYTE_PRIVATE): Fixed.

[chise/xemacs-chise.git] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index b069424..6cb81ee 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -358,6 +358,9 @@ allocate_lisp_storage (size_t size)
    After doing the mark phase, GC will walk this linked list
    and free any lcrecord which hasn't been marked. */
 static struct lcrecord_header *all_lcrecords;
+#ifdef UTF2000
+static struct lcrecord_header *all_older_lcrecords;
+#endif
 
 void *
 alloc_lcrecord (size_t size, const struct lrecord_implementation *implementation)
@@ -387,6 +390,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.
@@ -437,6 +471,14 @@ disksave_object_finalization_1 (void)
          !header->free)
        LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1);
     }
+#ifdef UTF2000
+  for (header = all_older_lcrecords; header; header = header->next)
+    {
+      if (LHEADER_IMPLEMENTATION (&header->lheader)->finalizer &&
+         !header->free)
+       LHEADER_IMPLEMENTATION (&header->lheader)->finalizer (header, 1);
+    }
+#endif
 }
 
 \f
@@ -1143,6 +1185,74 @@ make_vector (size_t length, Lisp_Object object)
   }
 }
 
+#ifdef HAVE_GGC
+Lisp_Object
+make_older_vector (size_t length, Lisp_Object init)
+{
+  struct lcrecord_header* orig_all_lcrecords = all_lcrecords;
+  Lisp_Object obj;
+
+  all_lcrecords = all_older_lcrecords;
+  obj = make_vector (length, init);
+  all_older_lcrecords = all_lcrecords;
+  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, /*
 Return a new vector of length LENGTH, with each element being OBJECT.
 See also the function `vector'.
@@ -2061,6 +2171,10 @@ LENGTH must be a non-negative integer.
            Bufbyte *init_ptr = init_str;
            switch (len)
              {
+#ifdef UTF2000
+             case 6: *ptr++ = *init_ptr++;
+             case 5: *ptr++ = *init_ptr++;
+#endif
              case 4: *ptr++ = *init_ptr++;
              case 3: *ptr++ = *init_ptr++;
              case 2: *ptr++ = *init_ptr++;
@@ -2479,7 +2593,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);
 
@@ -3875,6 +3993,9 @@ reinit_alloc_once_early (void)
   XSETINT (all_bit_vectors, 0); /* Qzero may not be set yet. */
   XSETINT (Vgc_message, 0);
   all_lcrecords = 0;
+#ifdef UTF2000
+  all_older_lcrecords = 0;
+#endif
   ignore_malloc_warnings = 1;
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */