#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 */
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)
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.
!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
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! */
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);
}
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;
}
}
-#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'.
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);
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++)
/* 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))
-#ifdef UTF2000
- && (!OLDER_RECORD_HEADER_P (lheader))
-#endif
- )
+ if (! MARKED_RECORD_HEADER_P (lheader))
{
MARK_RECORD_HEADER (lheader);
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)
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));
/* 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);
+ }
+}
+
\f
void
garbage_collect_1 (void)
gc_in_progress = 0;
+ run_post_gc_actions ();
+
/******* End of garbage collection ********/
run_hook_trapping_errors ("Error in post-gc-hook", Qpost_gc_hook);
())
{
Lisp_Object pl = Qnil;
- int i;
+ unsigned int i;
int gc_count_vector_total_size = 0;
garbage_collect_1 ();
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;
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 */
projects / chise / xemacs-chise.git- / blobdiff