2183 |
void |
void |
2184 |
init_float () |
init_float () |
2185 |
{ |
{ |
2186 |
float_block = (struct float_block *) lisp_align_malloc (sizeof *float_block, |
float_block = NULL; |
2187 |
MEM_TYPE_FLOAT); |
float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block. */ |
|
float_block->next = 0; |
|
|
bzero ((char *) float_block->floats, sizeof float_block->floats); |
|
|
bzero ((char *) float_block->gcmarkbits, sizeof float_block->gcmarkbits); |
|
|
float_block_index = 0; |
|
2188 |
float_free_list = 0; |
float_free_list = 0; |
2189 |
n_float_blocks = 1; |
n_float_blocks = 0; |
2190 |
} |
} |
2191 |
|
|
2192 |
|
|
2248 |
/* We store cons cells inside of cons_blocks, allocating a new |
/* We store cons cells inside of cons_blocks, allocating a new |
2249 |
cons_block with malloc whenever necessary. Cons cells reclaimed by |
cons_block with malloc whenever necessary. Cons cells reclaimed by |
2250 |
GC are put on a free list to be reallocated before allocating |
GC are put on a free list to be reallocated before allocating |
2251 |
any new cons cells from the latest cons_block. |
any new cons cells from the latest cons_block. */ |
|
|
|
|
Each cons_block is just under 1020 bytes long, |
|
|
since malloc really allocates in units of powers of two |
|
|
and uses 4 bytes for its own overhead. */ |
|
2252 |
|
|
2253 |
#define CONS_BLOCK_SIZE \ |
#define CONS_BLOCK_SIZE \ |
2254 |
((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons)) |
(((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \ |
2255 |
|
/ (sizeof (struct Lisp_Cons) * CHAR_BIT + 1)) |
2256 |
|
|
2257 |
|
#define CONS_BLOCK(fptr) \ |
2258 |
|
((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1))) |
2259 |
|
|
2260 |
|
#define CONS_INDEX(fptr) \ |
2261 |
|
((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons)) |
2262 |
|
|
2263 |
struct cons_block |
struct cons_block |
2264 |
{ |
{ |
2265 |
struct cons_block *next; |
/* Place `conses' at the beginning, to ease up CONS_INDEX's job. */ |
2266 |
struct Lisp_Cons conses[CONS_BLOCK_SIZE]; |
struct Lisp_Cons conses[CONS_BLOCK_SIZE]; |
2267 |
|
int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)]; |
2268 |
|
struct cons_block *next; |
2269 |
}; |
}; |
2270 |
|
|
2271 |
|
#define CONS_MARKED_P(fptr) \ |
2272 |
|
GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) |
2273 |
|
|
2274 |
|
#define CONS_MARK(fptr) \ |
2275 |
|
SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) |
2276 |
|
|
2277 |
|
#define CONS_UNMARK(fptr) \ |
2278 |
|
UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr))) |
2279 |
|
|
2280 |
/* Current cons_block. */ |
/* Current cons_block. */ |
2281 |
|
|
2282 |
struct cons_block *cons_block; |
struct cons_block *cons_block; |
2299 |
void |
void |
2300 |
init_cons () |
init_cons () |
2301 |
{ |
{ |
2302 |
cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block, |
cons_block = NULL; |
2303 |
MEM_TYPE_CONS); |
cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block. */ |
|
cons_block->next = 0; |
|
|
bzero ((char *) cons_block->conses, sizeof cons_block->conses); |
|
|
cons_block_index = 0; |
|
2304 |
cons_free_list = 0; |
cons_free_list = 0; |
2305 |
n_cons_blocks = 1; |
n_cons_blocks = 0; |
2306 |
} |
} |
2307 |
|
|
2308 |
|
|
2339 |
if (cons_block_index == CONS_BLOCK_SIZE) |
if (cons_block_index == CONS_BLOCK_SIZE) |
2340 |
{ |
{ |
2341 |
register struct cons_block *new; |
register struct cons_block *new; |
2342 |
new = (struct cons_block *) lisp_malloc (sizeof *new, |
new = (struct cons_block *) lisp_align_malloc (sizeof *new, |
2343 |
MEM_TYPE_CONS); |
MEM_TYPE_CONS); |
2344 |
new->next = cons_block; |
new->next = cons_block; |
2345 |
cons_block = new; |
cons_block = new; |
2346 |
cons_block_index = 0; |
cons_block_index = 0; |
2351 |
|
|
2352 |
XSETCAR (val, car); |
XSETCAR (val, car); |
2353 |
XSETCDR (val, cdr); |
XSETCDR (val, cdr); |
2354 |
|
CONS_UNMARK (XCONS (val)); |
2355 |
consing_since_gc += sizeof (struct Lisp_Cons); |
consing_since_gc += sizeof (struct Lisp_Cons); |
2356 |
cons_cells_consed++; |
cons_cells_consed++; |
2357 |
return val; |
return val; |
3443 |
one of the unused cells in the current cons block, |
one of the unused cells in the current cons block, |
3444 |
and not be on the free-list. */ |
and not be on the free-list. */ |
3445 |
return (offset >= 0 |
return (offset >= 0 |
3446 |
|
&& offset < (CONS_BLOCK_SIZE * sizeof b->conses[0]) |
3447 |
&& offset % sizeof b->conses[0] == 0 |
&& offset % sizeof b->conses[0] == 0 |
3448 |
&& (b != cons_block |
&& (b != cons_block |
3449 |
|| offset / sizeof b->conses[0] < cons_block_index) |
|| offset / sizeof b->conses[0] < cons_block_index) |
3638 |
break; |
break; |
3639 |
|
|
3640 |
case Lisp_Cons: |
case Lisp_Cons: |
3641 |
mark_p = (live_cons_p (m, po) |
mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj))); |
|
&& !XMARKBIT (XCONS (obj)->car)); |
|
3642 |
break; |
break; |
3643 |
|
|
3644 |
case Lisp_Symbol: |
case Lisp_Symbol: |
3712 |
break; |
break; |
3713 |
|
|
3714 |
case MEM_TYPE_CONS: |
case MEM_TYPE_CONS: |
3715 |
if (live_cons_p (m, p) |
if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p)) |
|
&& !XMARKBIT (((struct Lisp_Cons *) p)->car)) |
|
3716 |
XSETCONS (obj, p); |
XSETCONS (obj, p); |
3717 |
break; |
break; |
3718 |
|
|
4412 |
for (i = 0; i < tail->nvars; i++) |
for (i = 0; i < tail->nvars; i++) |
4413 |
if (!XMARKBIT (tail->var[i])) |
if (!XMARKBIT (tail->var[i])) |
4414 |
{ |
{ |
|
/* Explicit casting prevents compiler warning about |
|
|
discarding the `volatile' qualifier. */ |
|
4415 |
mark_object (tail->var[i]); |
mark_object (tail->var[i]); |
4416 |
XMARK (tail->var[i]); |
XMARK (tail->var[i]); |
4417 |
} |
} |
4421 |
mark_byte_stack (); |
mark_byte_stack (); |
4422 |
for (bind = specpdl; bind != specpdl_ptr; bind++) |
for (bind = specpdl; bind != specpdl_ptr; bind++) |
4423 |
{ |
{ |
|
/* These casts avoid a warning for discarding `volatile'. */ |
|
4424 |
mark_object (bind->symbol); |
mark_object (bind->symbol); |
4425 |
mark_object (bind->old_value); |
mark_object (bind->old_value); |
4426 |
} |
} |
5048 |
case Lisp_Cons: |
case Lisp_Cons: |
5049 |
{ |
{ |
5050 |
register struct Lisp_Cons *ptr = XCONS (obj); |
register struct Lisp_Cons *ptr = XCONS (obj); |
5051 |
if (XMARKBIT (ptr->car)) break; |
if (CONS_MARKED_P (ptr)) break; |
5052 |
CHECK_ALLOCATED_AND_LIVE (live_cons_p); |
CHECK_ALLOCATED_AND_LIVE (live_cons_p); |
5053 |
XMARK (ptr->car); |
CONS_MARK (ptr); |
5054 |
/* If the cdr is nil, avoid recursion for the car. */ |
/* If the cdr is nil, avoid recursion for the car. */ |
5055 |
if (EQ (ptr->cdr, Qnil)) |
if (EQ (ptr->cdr, Qnil)) |
5056 |
{ |
{ |
5109 |
{ |
{ |
5110 |
register struct Lisp_Cons *ptr = XCONS (tail); |
register struct Lisp_Cons *ptr = XCONS (tail); |
5111 |
|
|
5112 |
if (XMARKBIT (ptr->car)) |
if (CONS_MARKED_P (ptr)) |
5113 |
break; |
break; |
5114 |
XMARK (ptr->car); |
CONS_MARK (ptr); |
5115 |
if (GC_CONSP (ptr->car) |
if (GC_CONSP (ptr->car) |
5116 |
&& ! XMARKBIT (XCAR (ptr->car)) |
&& !CONS_MARKED_P (XCONS (ptr->car)) |
5117 |
&& GC_MARKERP (XCAR (ptr->car))) |
&& GC_MARKERP (XCAR (ptr->car))) |
5118 |
{ |
{ |
5119 |
XMARK (XCAR_AS_LVALUE (ptr->car)); |
CONS_MARK (XCONS (ptr->car)); |
5120 |
mark_object (XCDR (ptr->car)); |
mark_object (XCDR (ptr->car)); |
5121 |
} |
} |
5122 |
else |
else |
5182 |
break; |
break; |
5183 |
|
|
5184 |
case Lisp_String: |
case Lisp_String: |
5185 |
{ |
survives_p = STRING_MARKED_P (XSTRING (obj)); |
|
struct Lisp_String *s = XSTRING (obj); |
|
|
survives_p = STRING_MARKED_P (s); |
|
|
} |
|
5186 |
break; |
break; |
5187 |
|
|
5188 |
case Lisp_Vectorlike: |
case Lisp_Vectorlike: |
5189 |
if (GC_BUFFERP (obj)) |
survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj)); |
|
survives_p = VECTOR_MARKED_P (XBUFFER (obj)); |
|
|
else if (GC_SUBRP (obj)) |
|
|
survives_p = 1; |
|
|
else |
|
|
survives_p = VECTOR_MARKED_P (XVECTOR (obj)); |
|
5190 |
break; |
break; |
5191 |
|
|
5192 |
case Lisp_Cons: |
case Lisp_Cons: |
5193 |
survives_p = XMARKBIT (XCAR (obj)); |
survives_p = CONS_MARKED_P (XCONS (obj)); |
5194 |
break; |
break; |
5195 |
|
|
5196 |
case Lisp_Float: |
case Lisp_Float: |
5235 |
register int i; |
register int i; |
5236 |
int this_free = 0; |
int this_free = 0; |
5237 |
for (i = 0; i < lim; i++) |
for (i = 0; i < lim; i++) |
5238 |
if (!XMARKBIT (cblk->conses[i].car)) |
if (!CONS_MARKED_P (&cblk->conses[i])) |
5239 |
{ |
{ |
5240 |
this_free++; |
this_free++; |
5241 |
*(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; |
*(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list; |
5247 |
else |
else |
5248 |
{ |
{ |
5249 |
num_used++; |
num_used++; |
5250 |
XUNMARK (cblk->conses[i].car); |
CONS_UNMARK (&cblk->conses[i]); |
5251 |
} |
} |
5252 |
lim = CONS_BLOCK_SIZE; |
lim = CONS_BLOCK_SIZE; |
5253 |
/* If this block contains only free conses and we have already |
/* If this block contains only free conses and we have already |
5258 |
*cprev = cblk->next; |
*cprev = cblk->next; |
5259 |
/* Unhook from the free list. */ |
/* Unhook from the free list. */ |
5260 |
cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; |
cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr; |
5261 |
lisp_free (cblk); |
lisp_align_free (cblk); |
5262 |
n_cons_blocks--; |
n_cons_blocks--; |
5263 |
} |
} |
5264 |
else |
else |