Resorted; add missing Morohashi's Daikanwa characters; add missing
[chise/xemacs-chise.git] / src / alloc.c
index f695a71..9287177 100644 (file)
@@ -159,16 +159,6 @@ Lisp_Object Vgc_pointer_glyph;
 static const char gc_default_message[] = "Garbage collecting";
 Lisp_Object Qgarbage_collecting;
 
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
- EMACS_INT malloc_sbrk_used;
-
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
- EMACS_INT malloc_sbrk_unused;
-
 /* Non-zero means we're in the process of doing the dump */
 int purify_flag;
 
@@ -400,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.
@@ -1164,7 +1185,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 +1198,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, /*
@@ -1477,7 +1551,6 @@ This is terrible behavior which is retained for compatibility with old
   /* Check for valid formal parameter list now, to allow us to use
      SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
   {
-    Lisp_Object symbol, tail;
     EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail)
       {
        CHECK_SYMBOL (symbol);
@@ -2326,8 +2399,7 @@ allocate_managed_lcrecord (Lisp_Object lcrecord_list)
     {
       Lisp_Object val;
 
-      XSETOBJ (val, Lisp_Type_Record,
-              alloc_lcrecord (list->size, list->implementation));
+      XSETOBJ (val, alloc_lcrecord (list->size, list->implementation));
       return val;
     }
 }
@@ -2379,9 +2451,8 @@ Does not copy symbols.
 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
    Additional ones may be defined by a module (none yet).  We leave some
    room in `lrecord_implementations_table' for such new lisp object types. */
-#define MODULE_DEFINABLE_TYPE_COUNT 32
-const struct lrecord_implementation *lrecord_implementations_table[lrecord_type_count + MODULE_DEFINABLE_TYPE_COUNT];
-
+const struct lrecord_implementation *lrecord_implementations_table[(unsigned int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
+unsigned int lrecord_type_count = (unsigned int)lrecord_type_last_built_in_type;
 /* Object marker functions are in the lrecord_implementation structure.
    But copying them to a parallel array is much more cache-friendly.
    This hack speeds up (garbage-collect) by about 5%. */
@@ -2521,7 +2592,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);
 
@@ -3955,10 +4030,6 @@ reinit_alloc_once_early (void)
 #else
   gc_cons_threshold = 15000; /* debugging */
 #endif
-#ifdef VIRT_ADDR_VARIES
-  malloc_sbrk_unused = 1<<22;  /* A large number */
-  malloc_sbrk_used = 100000;   /* as reasonable as any number */
-#endif /* VIRT_ADDR_VARIES */
   lrecord_uid_counter = 259;
   debug_string_purity = 0;
   gcprolist = 0;
@@ -4007,9 +4078,9 @@ reinit_alloc (void)
 void
 syms_of_alloc (void)
 {
-  defsymbol (&Qpre_gc_hook, "pre-gc-hook");
-  defsymbol (&Qpost_gc_hook, "post-gc-hook");
-  defsymbol (&Qgarbage_collecting, "garbage-collecting");
+  DEFSYMBOL (Qpre_gc_hook);
+  DEFSYMBOL (Qpost_gc_hook);
+  DEFSYMBOL (Qgarbage_collecting);
 
   DEFSUBR (Fcons);
   DEFSUBR (Flist);
@@ -4053,16 +4124,6 @@ See also `consing-since-gc'.
 Number of bytes of sharable Lisp data allocated so far.
 */ );
 
-#if 0
-  DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used /*
-Number of bytes of unshared memory allocated in this session.
-*/ );
-
-  DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused /*
-Number of bytes of unshared memory remaining available in this session.
-*/ );
-#endif
-
 #ifdef DEBUG_XEMACS
   DEFVAR_INT ("debug-allocation", &debug_allocation /*
 If non-zero, print out information to stderr about all objects allocated.