extern int __malloc_extra_blocks;
#endif /* !defined(DOUG_LEA_MALLOC) */
-extern Lisp_Object Vhistory_length;
-
#define max(A,B) ((A) > (B) ? (A) : (B))
#define min(A,B) ((A) < (B) ? (A) : (B))
}
/* Explicitly free a float cell. */
+void
free_float (ptr)
struct Lisp_Float *ptr;
{
bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
- length_in_chars = length_in_elts * sizeof (EMACS_INT);
+ length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR);
/* We must allocate one more elements than LENGTH_IN_ELTS for the
slot `size' of the struct Lisp_Bool_Vector. */
real_init = (NILP (init) ? 0 : -1);
for (i = 0; i < length_in_chars ; i++)
p->data[i] = real_init;
+ /* Clear the extraneous bits in the last byte. */
+ if (XINT (length) != length_in_chars * BITS_PER_CHAR)
+ XBOOL_VECTOR (val)->data[length_in_chars - 1]
+ &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;
return val;
}
if (garbage_collection_messages)
message1_nolog ("Garbage collecting...");
- /* Don't keep command history around forever. */
- if (NUMBERP (Vhistory_length) && XINT (Vhistory_length) > 0)
- {
- tem = Fnthcdr (Vhistory_length, Vcommand_history);
- if (CONSP (tem))
- XCONS (tem)->cdr = Qnil;
- }
+ shrink_regexp_cache ();
- /* Likewise for undo information. */
+ /* Don't keep undo information around forever. */
{
register struct buffer *nextb = all_buffers;
}
mark_kboards ();
+ /* Look thru every buffer's undo list
+ for elements that update markers that were not marked,
+ and delete them. */
+ {
+ register struct buffer *nextb = all_buffers;
+
+ while (nextb)
+ {
+ /* If a buffer's undo list is Qt, that means that undo is
+ turned off in that buffer. Calling truncate_undo_list on
+ Qt tends to return NULL, which effectively turns undo back on.
+ So don't call truncate_undo_list if undo_list is Qt. */
+ if (! EQ (nextb->undo_list, Qt))
+ {
+ Lisp_Object tail, prev;
+ tail = nextb->undo_list;
+ prev = Qnil;
+ while (CONSP (tail))
+ {
+ if (GC_CONSP (XCONS (tail)->car)
+ && GC_MARKERP (XCONS (XCONS (tail)->car)->car)
+ && ! XMARKBIT (XMARKER (XCONS (XCONS (tail)->car)->car)->chain))
+ {
+ if (NILP (prev))
+ nextb->undo_list = tail = XCONS (tail)->cdr;
+ else
+ tail = XCONS (prev)->cdr = XCONS (tail)->cdr;
+ }
+ else
+ {
+ prev = tail;
+ tail = XCONS (tail)->cdr;
+ }
+ }
+ }
+
+ nextb = nextb->next;
+ }
+ }
+
gc_sweep ();
/* Clear the mark bits that we set in certain root slots. */
MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));
+ if (CONSP (buffer->undo_list))
+ {
+ Lisp_Object tail;
+ tail = buffer->undo_list;
+
+ while (CONSP (tail))
+ {
+ register struct Lisp_Cons *ptr = XCONS (tail);
+
+ if (XMARKBIT (ptr->car))
+ break;
+ XMARK (ptr->car);
+ if (GC_CONSP (ptr->car)
+ && ! XMARKBIT (XCONS (ptr->car)->car)
+ && GC_MARKERP (XCONS (ptr->car)->car))
+ {
+ XMARK (XCONS (ptr->car)->car);
+ mark_object (&XCONS (ptr->car)->cdr);
+ }
+ else
+ mark_object (&ptr->car);
+
+ if (CONSP (ptr->cdr))
+ tail = ptr->cdr;
+ else
+ break;
+ }
+
+ mark_object (&XCONS (tail)->cdr);
+ }
+ else
+ mark_object (&buffer->undo_list);
+
#if 0
mark_object (buffer->syntax_table);
if (kb->kbd_macro_buffer)
for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++)
mark_object (p);
+ mark_object (&kb->Voverriding_terminal_local_map);
+ mark_object (&kb->Vlast_command);
+ mark_object (&kb->Vreal_last_command);
mark_object (&kb->Vprefix_arg);
+ mark_object (&kb->Vlast_prefix_arg);
mark_object (&kb->kbd_queue);
+ mark_object (&kb->defining_kbd_macro);
mark_object (&kb->Vlast_kbd_macro);
mark_object (&kb->Vsystem_key_alist);
mark_object (&kb->system_key_syms);
+ mark_object (&kb->Vdefault_minibuffer_frame);
}
}
\f
for (i = 0; i < lim; i++)
if (!XMARKBIT (cblk->conses[i].car))
{
- num_free++;
this_free++;
*(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
cons_free_list = &cblk->conses[i];
/* If this block contains only free conses and we have already
seen more than two blocks worth of free conses then deallocate
this block. */
- if (this_free == CONS_BLOCK_SIZE && num_free > 2*CONS_BLOCK_SIZE)
+ if (this_free == CONS_BLOCK_SIZE && num_free > CONS_BLOCK_SIZE)
{
- num_free -= CONS_BLOCK_SIZE;
*cprev = cblk->next;
/* Unhook from the free list. */
cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
xfree (cblk);
}
else
- cprev = &cblk->next;
+ {
+ num_free += this_free;
+ cprev = &cblk->next;
+ }
}
total_conses = num_used;
total_free_conses = num_free;
for (i = 0; i < lim; i++)
if (!XMARKBIT (fblk->floats[i].type))
{
- num_free++;
this_free++;
*(struct Lisp_Float **)&fblk->floats[i].data = float_free_list;
float_free_list = &fblk->floats[i];
/* If this block contains only free floats and we have already
seen more than two blocks worth of free floats then deallocate
this block. */
- if (this_free == FLOAT_BLOCK_SIZE && num_free > 2*FLOAT_BLOCK_SIZE)
+ if (this_free == FLOAT_BLOCK_SIZE && num_free > FLOAT_BLOCK_SIZE)
{
- num_free -= FLOAT_BLOCK_SIZE;
*fprev = fblk->next;
/* Unhook from the free list. */
float_free_list = *(struct Lisp_Float **) &fblk->floats[0].data;
xfree (fblk);
}
else
- fprev = &fblk->next;
+ {
+ num_free += this_free;
+ fprev = &fblk->next;
+ }
}
total_floats = num_used;
total_free_floats = num_free;
{
iblk->intervals[i].parent = interval_free_list;
interval_free_list = &iblk->intervals[i];
- num_free++;
this_free++;
}
else
/* If this block contains only free intervals and we have already
seen more than two blocks worth of free intervals then
deallocate this block. */
- if (this_free == INTERVAL_BLOCK_SIZE
- && num_free > 2*INTERVAL_BLOCK_SIZE)
+ if (this_free == INTERVAL_BLOCK_SIZE && num_free > INTERVAL_BLOCK_SIZE)
{
- num_free -= INTERVAL_BLOCK_SIZE;
*iprev = iblk->next;
/* Unhook from the free list. */
interval_free_list = iblk->intervals[0].parent;
xfree (iblk);
}
else
- iprev = &iblk->next;
+ {
+ num_free += this_free;
+ iprev = &iblk->next;
+ }
}
total_intervals = num_used;
total_free_intervals = num_free;
{
*(struct Lisp_Symbol **)&sblk->symbols[i].value = symbol_free_list;
symbol_free_list = &sblk->symbols[i];
- num_free++;
this_free++;
}
else
/* If this block contains only free symbols and we have already
seen more than two blocks worth of free symbols then deallocate
this block. */
- if (this_free == SYMBOL_BLOCK_SIZE && num_free > 2*SYMBOL_BLOCK_SIZE)
+ if (this_free == SYMBOL_BLOCK_SIZE && num_free > SYMBOL_BLOCK_SIZE)
{
- num_free -= SYMBOL_BLOCK_SIZE;
*sprev = sblk->next;
/* Unhook from the free list. */
symbol_free_list = *(struct Lisp_Symbol **)&sblk->symbols[0].value;
xfree (sblk);
}
else
- sprev = &sblk->next;
+ {
+ num_free += this_free;
+ sprev = &sblk->next;
+ }
}
total_symbols = num_used;
total_free_symbols = num_free;
mblk->markers[i].u_marker.type = Lisp_Misc_Free;
mblk->markers[i].u_free.chain = marker_free_list;
marker_free_list = &mblk->markers[i];
- num_free++;
this_free++;
}
else
/* If this block contains only free markers and we have already
seen more than two blocks worth of free markers then deallocate
this block. */
- if (this_free == MARKER_BLOCK_SIZE && num_free > 2*MARKER_BLOCK_SIZE)
+ if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
{
- num_free -= MARKER_BLOCK_SIZE;
*mprev = mblk->next;
/* Unhook from the free list. */
marker_free_list = mblk->markers[0].u_free.chain;
xfree (mblk);
}
else
- mprev = &mblk->next;
+ {
+ num_free += this_free;
+ mprev = &mblk->next;
+ }
}
total_markers = num_used;
\f
/* Initialization */
+void
init_alloc_once ()
{
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
#endif /* VIRT_ADDR_VARIES */
}
+void
init_alloc ()
{
gcprolist = 0;
HCoop / bpt / emacs.git / blobdiff