1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 Free Software Foundation, Inc.
3 * This library is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU Lesser General Public
5 * License as published by the Free Software Foundation; either
6 * version 2.1 of the License, or (at your option) any later version.
8 * This library is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
11 * Lesser General Public License for more details.
13 * You should have received a copy of the GNU Lesser General Public
14 * License along with this library; if not, write to the Free Software
15 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 #include "libguile/_scm.h"
23 #include "libguile/pairs.h"
24 #include "libguile/gc.h"
25 #include "libguile/private-gc.h"
31 size_t scm_max_segment_size
;
34 scm_i_make_empty_heap_segment (scm_t_cell_type_statistics
*fl
)
36 scm_t_heap_segment
* shs
= malloc (sizeof (scm_t_heap_segment
));
40 fprintf (stderr
, "scm_i_get_new_heap_segment: out of memory.\n");
44 shs
->bounds
[0] = NULL
;
45 shs
->bounds
[1] = NULL
;
49 shs
->next_free_card
= NULL
;
56 scm_i_heap_segment_statistics (scm_t_heap_segment
*seg
, SCM tab
)
58 scm_t_cell
*p
= seg
->bounds
[0];
59 while (p
< seg
->bounds
[1])
61 scm_i_card_statistics (p
, tab
, seg
);
62 p
+= SCM_GC_CARD_N_CELLS
;
69 Fill SEGMENT with memory both for data and mark bits.
71 RETURN: 1 on success, 0 failure
74 scm_i_initialize_heap_segment_data (scm_t_heap_segment
* segment
, size_t requested
)
79 int card_data_cell_count
= (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
);
80 int card_count
=1 + (requested
/ sizeof (scm_t_cell
)) / card_data_cell_count
;
83 one card extra due to alignment
85 size_t mem_needed
= (1+card_count
) * SCM_GC_SIZEOF_CARD
86 + SCM_GC_CARD_BVEC_SIZE_IN_LONGS
* card_count
* SCM_SIZEOF_LONG
88 scm_t_c_bvec_long
* bvec_ptr
= 0;
89 scm_t_cell
* memory
= 0;
92 We use calloc to alloc the heap. On GNU libc this is
93 equivalent to mmapping /dev/zero
95 SCM_SYSCALL (memory
= (scm_t_cell
* ) calloc (1, mem_needed
));
100 segment
->malloced
= memory
;
101 segment
->bounds
[0] = SCM_GC_CARD_UP (memory
);
102 segment
->bounds
[1] = segment
->bounds
[0] + card_count
* SCM_GC_CARD_N_CELLS
;
104 segment
->freelist
->heap_size
+= scm_i_segment_cell_count (segment
);
106 bvec_ptr
= (scm_t_c_bvec_long
*) segment
->bounds
[1];
109 Don't init the mem or the bitvector. This is handled by lazy
113 segment
->next_free_card
= segment
->bounds
[0];
114 segment
->first_time
= 1;
119 scm_i_segment_card_count (scm_t_heap_segment
* seg
)
121 return (seg
->bounds
[1] - seg
->bounds
[0]) / SCM_GC_CARD_N_CELLS
;
125 Return the number of available single-cell data cells.
128 scm_i_segment_cell_count (scm_t_heap_segment
* seg
)
130 return scm_i_segment_card_count (seg
) * (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
)
131 + ((seg
->span
== 2) ? -1 : 0);
135 scm_i_clear_segment_mark_space (scm_t_heap_segment
*seg
)
137 scm_t_cell
* markspace
= seg
->bounds
[1];
139 memset (markspace
, 0x00,
140 scm_i_segment_card_count (seg
) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS
* SCM_SIZEOF_LONG
);
144 Sweep cards from SEG until we've gathered THRESHOLD cells
151 scm_i_sweep_some_cards (scm_t_heap_segment
*seg
)
156 int (*sweeper
) (scm_t_cell
*, SCM
*, scm_t_heap_segment
* )
157 = (seg
->first_time
) ? &scm_i_init_card_freelist
: &scm_i_sweep_card
;
159 scm_t_cell
* next_free
= seg
->next_free_card
;
162 while (collected
< threshold
&& next_free
< seg
->bounds
[1])
164 collected
+= (*sweeper
) (next_free
, &cells
, seg
);
165 next_free
+= SCM_GC_CARD_N_CELLS
;
169 scm_gc_cells_swept
+= cards_swept
* (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
);
170 scm_gc_cells_collected
+= collected
* seg
->span
;
172 if (!seg
->first_time
)
173 scm_cells_allocated
-= collected
* seg
->span
;
175 seg
->freelist
->collected
+= collected
* seg
->span
;
178 if(next_free
== seg
->bounds
[1])
183 seg
->next_free_card
= next_free
;
189 Force a sweep of this entire segment. This doesn't modify sweep
190 statistics, it just frees the memory pointed to by to-be-swept
193 Implementation is slightly ugh.
195 FIXME: if you do scm_i_sweep_segment(), and then allocate from this
196 segment again, the statistics are off.
199 scm_i_sweep_segment (scm_t_heap_segment
* seg
)
201 scm_t_cell
* p
= seg
->next_free_card
;
202 int yield
= scm_gc_cells_collected
;
203 int coll
= seg
->freelist
->collected
;
204 unsigned long alloc
= scm_cells_allocated
;
206 while (scm_i_sweep_some_cards (seg
) != SCM_EOL
)
209 scm_gc_cells_collected
= yield
;
210 scm_cells_allocated
= alloc
;
211 seg
->freelist
->collected
= coll
;
213 seg
->next_free_card
=p
;
217 scm_i_sweep_all_segments (char const *reason
)
221 for (i
= 0; i
< scm_i_heap_segment_table_size
; i
++)
223 scm_i_sweep_segment (scm_i_heap_segment_table
[i
]);
231 The table is sorted by the address of the data itself. This makes
232 for easy lookups. This is not portable: according to ANSI C,
233 pointers can only be compared within the same object (i.e. the same
234 block of malloced memory.). For machines with weird architectures,
235 this should be revised.
237 (Apparently, for this reason 1.6 and earlier had macros for pointer
240 perhaps it is worthwhile to remove the 2nd level of indirection in
241 the table, but this certainly makes for cleaner code.
243 scm_t_heap_segment
** scm_i_heap_segment_table
;
244 size_t scm_i_heap_segment_table_size
;
245 scm_t_cell
*lowest_cell
;
246 scm_t_cell
*highest_cell
;
250 scm_i_clear_mark_space (void)
253 for (; i
< scm_i_heap_segment_table_size
; i
++)
255 scm_i_clear_segment_mark_space (scm_i_heap_segment_table
[i
]);
261 RETURN: index of inserted segment.
264 scm_i_insert_segment (scm_t_heap_segment
* seg
)
266 size_t size
= (scm_i_heap_segment_table_size
+ 1) * sizeof (scm_t_heap_segment
*);
267 SCM_SYSCALL(scm_i_heap_segment_table
= ((scm_t_heap_segment
**)
268 realloc ((char *)scm_i_heap_segment_table
, size
)));
271 We can't alloc 4 more bytes. This is hopeless.
273 if (!scm_i_heap_segment_table
)
275 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
281 lowest_cell
= seg
->bounds
[0];
282 highest_cell
= seg
->bounds
[1];
286 lowest_cell
= SCM_MIN (lowest_cell
, seg
->bounds
[0]);
287 highest_cell
= SCM_MAX (highest_cell
, seg
->bounds
[1]);
295 while (i
< scm_i_heap_segment_table_size
296 && scm_i_heap_segment_table
[i
]->bounds
[0] <= seg
->bounds
[0])
300 We insert a new entry; if that happens to be before the
301 "current" segment of a freelist, we must move the freelist index
304 if (scm_i_master_freelist
.heap_segment_idx
>= i
)
305 scm_i_master_freelist
.heap_segment_idx
++;
306 if (scm_i_master_freelist2
.heap_segment_idx
>= i
)
307 scm_i_master_freelist2
.heap_segment_idx
++;
309 for (j
= scm_i_heap_segment_table_size
; j
> i
; --j
)
310 scm_i_heap_segment_table
[j
] = scm_i_heap_segment_table
[j
- 1];
312 scm_i_heap_segment_table
[i
] = seg
;
313 scm_i_heap_segment_table_size
++;
320 scm_i_sweep_some_segments (scm_t_cell_type_statistics
* fl
)
322 int i
= fl
->heap_segment_idx
;
323 SCM collected
= SCM_EOL
;
329 i
< scm_i_heap_segment_table_size
; i
++)
331 if (scm_i_heap_segment_table
[i
]->freelist
!= fl
)
334 collected
= scm_i_sweep_some_cards (scm_i_heap_segment_table
[i
]);
337 if (collected
!= SCM_EOL
) /* Don't increment i */
341 fl
->heap_segment_idx
= i
;
348 scm_i_reset_segments (void)
351 for (; i
< scm_i_heap_segment_table_size
; i
++)
353 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
354 seg
->next_free_card
= seg
->bounds
[0];
359 Return a hashtab with counts of live objects, with tags as keys.
364 scm_i_all_segments_statistics (SCM tab
)
367 for (; i
< scm_i_heap_segment_table_size
; i
++)
369 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
370 scm_i_heap_segment_statistics (seg
, tab
);
380 Determine whether the given value does actually represent a cell in
381 some heap segment. If this is the case, the number of the heap
382 segment is returned. Otherwise, -1 is returned. Binary search is
383 used to determine the heap segment that contains the cell.
386 I think this function is too long to be inlined. --hwn
389 scm_i_find_heap_segment_containing_object (SCM obj
)
394 if ((scm_t_cell
* ) obj
< lowest_cell
|| (scm_t_cell
*) obj
>= highest_cell
)
399 scm_t_cell
* ptr
= SCM2PTR (obj
);
400 unsigned long int i
= 0;
401 unsigned long int j
= scm_i_heap_segment_table_size
- 1;
403 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
405 else if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
411 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[1])
415 else if (scm_i_heap_segment_table
[j
]->bounds
[0] <= ptr
)
422 unsigned long int k
= (i
+ j
) / 2;
426 else if (ptr
< scm_i_heap_segment_table
[k
]->bounds
[1])
430 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
433 else if (scm_i_heap_segment_table
[k
]->bounds
[0] <= ptr
)
437 if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
443 if (!SCM_DOUBLECELL_ALIGNED_P (obj
) && scm_i_heap_segment_table
[i
]->span
== 2)
445 else if (SCM_GC_IN_CARD_HEADERP (ptr
))
455 Important entry point: try to grab some memory, and make it into a
458 RETURN: the index of the segment.
461 scm_i_get_new_heap_segment (scm_t_cell_type_statistics
*freelist
,
462 policy_on_error error_policy
)
467 /* Assure that the new segment is predicted to be large enough.
469 * New yield should at least equal GC fraction of new heap size, i.e.
471 * y + dh > f * (h + dh)
474 * f : min yield fraction
476 * dh : size of new heap segment
478 * This gives dh > (f * h - y) / (1 - f)
480 float f
= freelist
->min_yield_fraction
/ 100.0;
481 float h
= SCM_HEAP_SIZE
;
483 = (f
* h
- scm_gc_cells_collected
) / (1.0 - f
);
485 /* Make heap grow with factor 1.5 */
486 len
= freelist
->heap_size
/ 2;
488 fprintf (stderr
, "(%ld < %ld)", (long) len
, (long) min_cells
);
492 len
= (unsigned long) min_cells
;
493 len
*= sizeof (scm_t_cell
);
494 /* force new sampling */
495 freelist
->collected
= LONG_MAX
;
498 if (len
> scm_max_segment_size
)
499 len
= scm_max_segment_size
;
500 if (len
< SCM_MIN_HEAP_SEG_SIZE
)
501 len
= SCM_MIN_HEAP_SEG_SIZE
;
504 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
506 /* Allocate with decaying ambition. */
507 while (len
>= SCM_MIN_HEAP_SEG_SIZE
)
509 if (scm_i_initialize_heap_segment_data (seg
, len
))
511 return scm_i_insert_segment (seg
);
518 if (error_policy
== abort_on_error
)
520 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap.\n");
527 scm_i_make_initial_segment (int init_heap_size
, scm_t_cell_type_statistics
*freelist
)
529 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
531 if (init_heap_size
< 1)
533 init_heap_size
= SCM_DEFAULT_INIT_HEAP_SIZE_1
;
536 if (scm_i_initialize_heap_segment_data (seg
, init_heap_size
))
538 freelist
->heap_segment_idx
= scm_i_insert_segment (seg
);
542 Why the fuck try twice? --hwn
546 scm_i_initialize_heap_segment_data (seg
, SCM_HEAP_SEG_SIZE
);
549 if (freelist
->min_yield_fraction
)
550 freelist
->min_yield
= (freelist
->heap_size
* freelist
->min_yield_fraction