X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Falloc.c;h=54f3c38f0965c6ab645dfdbedda435bfb4b42c42;hb=14ac73276fa152e8f0b74602792afc0b9c3236c9;hp=ddd884a182244eb5ef7f73b86d1574354192b260;hpb=571a24e2bfea15d37c3503414674f59e89ec9652;p=chise%2Fxemacs-chise.git.1

diff --git a/src/alloc.c b/src/alloc.c
index ddd884a..54f3c38 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -85,8 +85,8 @@ EXFUN (Fgarbage_collect, 0);
 #endif
 
 #ifdef DEBUG_XEMACS
-static int debug_allocation;
-static int debug_allocation_backtrace_length;
+static Fixnum debug_allocation;
+static Fixnum debug_allocation_backtrace_length;
 #endif
 
 /* Number of bytes of consing done since the last gc */
@@ -412,7 +412,7 @@ free_lcrecord (struct lcrecord_header *lcrecord)
 	      break;
 	    }
 	  else if (next == 0)
-	    abort ();
+	    ABORT ();
 	  else
 	    header = next;
 	}
@@ -447,17 +447,31 @@ disksave_object_finalization_1 (void)
    about expressions in src/.gdbinit.  See src/.gdbinit or src/.dbxrc
    to see how this is used.  */
 
-const EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
-const EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
+EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
+EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
 
 #ifdef USE_UNION_TYPE
-const unsigned char dbg_USE_UNION_TYPE = 1;
+unsigned char dbg_USE_UNION_TYPE = 1;
 #else
-const unsigned char dbg_USE_UNION_TYPE = 0;
+unsigned char dbg_USE_UNION_TYPE = 0;
 #endif
 
-const unsigned char dbg_valbits = VALBITS;
-const unsigned char dbg_gctypebits = GCTYPEBITS;
+unsigned char dbg_valbits = VALBITS;
+unsigned char dbg_gctypebits = GCTYPEBITS;
+
+/* On some systems, the above definitions will be optimized away by
+   the compiler or linker unless they are referenced in some function. */
+long dbg_inhibit_dbg_symbol_deletion (void);
+long
+dbg_inhibit_dbg_symbol_deletion (void)
+{
+  return
+    (dbg_valmask +
+     dbg_typemask +
+     dbg_USE_UNION_TYPE +
+     dbg_valbits +
+     dbg_gctypebits);
+}
 
 /* Macros turned into functions for ease of debugging.
    Debuggers don't know about macros! */
@@ -1043,7 +1057,7 @@ mark_vector (Lisp_Object obj)
 static size_t
 size_vector (const void *lheader)
 {
-  return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, contents,
+  return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object, contents,
 				       ((Lisp_Vector *) lheader)->size);
 }
 
@@ -1091,7 +1105,8 @@ static Lisp_Vector *
 make_vector_internal (size_t sizei)
 {
   /* no vector_next */
-  size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, contents, sizei);
+  size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, Lisp_Object,
+					       contents, sizei);
   Lisp_Vector *p = (Lisp_Vector *) alloc_lcrecord (sizem, &lrecord_vector);
 
   p->size = sizei;
@@ -1254,7 +1269,8 @@ static Lisp_Bit_Vector *
 make_bit_vector_internal (size_t sizei)
 {
   size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
-  size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs);
+  size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long,
+					       bits, num_longs);
   Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem);
   set_lheader_implementation (&p->lheader, &lrecord_bit_vector);
 
@@ -1299,7 +1315,7 @@ make_bit_vector (size_t length, Lisp_Object bit)
 Lisp_Object
 make_bit_vector_from_byte_vector (unsigned char *bytevec, size_t length)
 {
-  int i;
+  size_t i;
   Lisp_Bit_Vector *p = make_bit_vector_internal (length);
 
   for (i = 0; i < length; i++)
@@ -2035,6 +2051,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++;
@@ -2457,7 +2477,8 @@ static struct
   int instances_freed;
   int bytes_freed;
   int instances_on_free_list;
-} lcrecord_stats [countof (lrecord_implementations_table)];
+} lcrecord_stats [countof (lrecord_implementations_table)
+		  + MODULE_DEFINABLE_TYPE_COUNT];
 
 static void
 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
@@ -2575,8 +2596,8 @@ sweep_bit_vectors_1 (Lisp_Object *prev,
 	  total_size += len;
           total_storage +=
 	    MALLOC_OVERHEAD +
-	    FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
-					  BIT_VECTOR_LONG_STORAGE (len));
+	    FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long,
+					  bits, BIT_VECTOR_LONG_STORAGE (len));
 	  num_used++;
 	  /* #### May modify next on a C_READONLY bitvector */
 	  prev = &(bit_vector_next (v));
@@ -3226,6 +3247,61 @@ restore_gc_inhibit (Lisp_Object val)
 /* Maybe we want to use this when doing a "panic" gc after memory_full()? */
 static int gc_hooks_inhibited;
 
+struct post_gc_action
+{
+  void (*fun) (void *);
+  void *arg;
+};
+
+typedef struct post_gc_action post_gc_action;
+
+typedef struct
+{
+  Dynarr_declare (post_gc_action);
+} post_gc_action_dynarr;
+
+static post_gc_action_dynarr *post_gc_actions;
+
+/* Register an action to be called at the end of GC.
+   gc_in_progress is 0 when this is called.
+   This is used when it is discovered that an action needs to be taken,
+   but it's during GC, so it's not safe. (e.g. in a finalize method.)
+
+   As a general rule, do not use Lisp objects here.
+   And NEVER signal an error.
+*/
+
+void
+register_post_gc_action (void (*fun) (void *), void *arg)
+{
+  post_gc_action action;
+
+  if (!post_gc_actions)
+    post_gc_actions = Dynarr_new (post_gc_action);
+
+  action.fun = fun;
+  action.arg = arg;
+
+  Dynarr_add (post_gc_actions, action);
+}
+
+static void
+run_post_gc_actions (void)
+{
+  int i;
+
+  if (post_gc_actions)
+    {
+      for (i = 0; i < Dynarr_length (post_gc_actions); i++)
+	{
+	  post_gc_action action = Dynarr_at (post_gc_actions, i);
+	  (action.fun) (action.arg);
+	}
+
+      Dynarr_reset (post_gc_actions);
+    }
+}
+
 
 void
 garbage_collect_1 (void)
@@ -3315,6 +3391,7 @@ garbage_collect_1 (void)
   /***** Now we actually start the garbage collection. */
 
   gc_in_progress = 1;
+  inhibit_non_essential_printing_operations = 1;
 
   gc_generation_number[0]++;
 
@@ -3439,8 +3516,11 @@ garbage_collect_1 (void)
     gc_cons_threshold = 10000;
 #endif
 
+  inhibit_non_essential_printing_operations = 0;
   gc_in_progress = 0;
 
+  run_post_gc_actions ();
+
   /******* End of garbage collection ********/
 
   run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook);
@@ -3517,7 +3597,7 @@ Garbage collection happens automatically if you cons more than
        ())
 {
   Lisp_Object pl = Qnil;
-  int i;
+  unsigned int i;
   int gc_count_vector_total_size = 0;
 
   garbage_collect_1 ();
@@ -3532,7 +3612,7 @@ Garbage collection happens automatically if you cons more than
           const char *name = lrecord_implementations_table[i]->name;
 	  int len = strlen (name);
 	  /* save this for the FSFmacs-compatible part of the summary */
-	  if (i == lrecord_vector.lrecord_type_index)
+	  if (i == lrecord_type_vector)
 	    gc_count_vector_total_size =
 	      lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed;
 
@@ -3808,8 +3888,8 @@ reinit_alloc_once_early (void)
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128*1024); /* trim threshold */
   mallopt (M_MMAP_THRESHOLD, 64*1024); /* mmap threshold */
-#if 0 /* Moved to emacs.c */
-  mallopt (M_MMAP_MAX, 64); /* max. number of mmap'ed areas */
+#if 1 /* Moved to emacs.c */
+  mallopt (M_MMAP_MAX, 0); /* max. number of mmap'ed areas */
 #endif
 #endif
   init_string_alloc ();