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;
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
static size_t
size_vector (const void *lheader)
{
- return offsetof (Lisp_Vector, contents[((Lisp_Vector *) lheader)->size]);
+ return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, contents,
+ ((Lisp_Vector *) lheader)->size);
}
static int
make_vector_internal (size_t sizei)
{
/* no vector_next */
- size_t sizem = offsetof (Lisp_Vector, contents[sizei]);
+ size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Vector, 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 INIT.
See also the function `vector'.
make_bit_vector_internal (size_t sizei)
{
size_t num_longs = BIT_VECTOR_LONG_STORAGE (sizei);
- size_t sizem = offsetof (Lisp_Bit_Vector, bits[num_longs]);
+ size_t sizem = FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits, num_longs);
Lisp_Bit_Vector *p = (Lisp_Bit_Vector *) allocate_lisp_storage (sizem);
set_lheader_implementation (&p->lheader, &lrecord_bit_vector);
/* 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);
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++;
{
Lisp_Object val;
- XSETOBJ (val, Lisp_Type_Record,
- alloc_lcrecord (list->size, list->implementation));
+ XSETOBJ (val, alloc_lcrecord (list->size, list->implementation));
return val;
}
}
/* 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%. */
/* 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);
total_size += len;
total_storage +=
MALLOC_OVERHEAD +
- offsetof (Lisp_Bit_Vector, bits[BIT_VECTOR_LONG_STORAGE (len)]);
+ FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, bits,
+ BIT_VECTOR_LONG_STORAGE (len));
num_used++;
/* #### May modify next on a C_READONLY bitvector */
prev = &(bit_vector_next (v));
UNMARK_RECORD_HEADER (&(p->lheader)); \
num_bytes += size; \
if (!BIG_STRING_SIZE_P (size)) \
- { num_small_bytes += size; \
- num_small_used++; \
+ { \
+ num_small_bytes += size; \
+ num_small_used++; \
} \
if (debug) \
debug_string_purity_print (p); \
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 */
#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;
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);
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.
projects / chise / xemacs-chise.git / blobdiff