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
}
DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
-Return a new list of length LENGTH, with each element being INIT.
+Return a new list of length LENGTH, with each element being OBJECT.
*/
- (length, init))
+ (length, object))
{
CHECK_NATNUM (length);
size_t size = XINT (length);
while (size--)
- val = Fcons (init, val);
+ val = Fcons (object, val);
return val;
}
}
}
Lisp_Object
-make_vector (size_t length, Lisp_Object init)
+make_vector (size_t length, Lisp_Object object)
{
Lisp_Vector *vecp = make_vector_internal (length);
Lisp_Object *p = vector_data (vecp);
while (length--)
- *p++ = init;
+ *p++ = object;
{
Lisp_Object vector;
}
}
+#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.
+Return a new vector of length LENGTH, with each element being OBJECT.
See also the function `vector'.
*/
- (length, init))
+ (length, object))
{
CONCHECK_NATNUM (length);
- return make_vector (XINT (length), init);
+ return make_vector (XINT (length), object);
}
DEFUN ("vector", Fvector, 0, MANY, 0, /*
}
Lisp_Object
-make_bit_vector (size_t length, Lisp_Object init)
+make_bit_vector (size_t length, Lisp_Object bit)
{
Lisp_Bit_Vector *p = make_bit_vector_internal (length);
size_t num_longs = BIT_VECTOR_LONG_STORAGE (length);
- CHECK_BIT (init);
+ CHECK_BIT (bit);
- if (ZEROP (init))
+ if (ZEROP (bit))
memset (p->bits, 0, num_longs * sizeof (long));
else
{
}
DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
-Return a new bit vector of length LENGTH. with each bit being INIT.
-Each element is set to INIT. See also the function `bit-vector'.
+Return a new bit vector of length LENGTH. with each bit set to BIT.
+BIT must be one of the integers 0 or 1. See also the function `bit-vector'.
*/
- (length, init))
+ (length, bit))
{
CONCHECK_NATNUM (length);
- return make_bit_vector (XINT (length), init);
+ return make_bit_vector (XINT (length), bit);
}
DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
Return a newly created bit vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.
+Each argument must be one of the integers 0 or 1.
*/
(int nargs, Lisp_Object *args))
{
/* 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);
#endif /* MULE */
DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
-Return a new string of length LENGTH, with each character being INIT.
-LENGTH must be an integer and INIT must be a character.
+Return a new string consisting of LENGTH copies of CHARACTER.
+LENGTH must be a non-negative integer.
*/
- (length, init))
+ (length, character))
{
CHECK_NATNUM (length);
- CHECK_CHAR_COERCE_INT (init);
+ CHECK_CHAR_COERCE_INT (character);
{
Bufbyte init_str[MAX_EMCHAR_LEN];
- int len = set_charptr_emchar (init_str, XCHAR (init));
+ int len = set_charptr_emchar (init_str, XCHAR (character));
Lisp_Object val = make_uninit_string (len * XINT (length));
if (len == 1)
/* Optimize the single-byte case */
- memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val));
+ memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val));
else
{
size_t i;
{
Lisp_Object val;
- XSETOBJ (val, Lisp_Type_Record,
- alloc_lcrecord (list->size, list->implementation));
+ XSETOBJ (val, alloc_lcrecord (list->size, list->implementation));
return val;
}
}
Recursively copies contents of vectors and cons cells.
Does not copy symbols.
*/
- (obj))
+ (object))
{
- return obj;
+ return object;
}
\f
/* 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);
#define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
do { \
struct typename##_block *SFTB_current; \
- struct typename##_block **SFTB_prev; \
int SFTB_limit; \
int num_free = 0, num_used = 0; \
\
- for (SFTB_prev = ¤t_##typename##_block, \
- SFTB_current = current_##typename##_block, \
+ for (SFTB_current = current_##typename##_block, \
SFTB_limit = current_##typename##_block_index; \
SFTB_current; \
) \
UNMARK_##typename (SFTB_victim); \
} \
} \
- SFTB_prev = &(SFTB_current->prev); \
SFTB_current = SFTB_current->prev; \
SFTB_limit = countof (current_##typename##_block->block); \
} \
free_marker (Lisp_Marker *ptr)
{
/* Perhaps this will catch freeing an already-freed marker. */
- gc_checking_assert (ptr->lheader.type = lrecord_type_marker);
+ gc_checking_assert (ptr->lheader.type == lrecord_type_marker);
#ifndef ALLOC_NO_POOLS
FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr);
}
#if 0
-DEFUN ("memory-limit", Fmemory_limit, 0, 0, "", /*
+DEFUN ("memory-limit", Fmemory_limit, 0, 0, 0, /*
Return the address of the last byte Emacs has allocated, divided by 1024.
This may be helpful in debugging Emacs's memory usage.
The value is divided by 1024 to make sure it will fit in a lisp integer.
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