1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 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
);
143 /* Sweep cards from SEG until we've gathered THRESHOLD cells. On return,
144 *CELLS_SWEPT contains the number of cells that have been visited and
145 *CELLS_COLLECTED contains the number of cells actually collected. A
146 freelist is returned, potentially empty. */
148 scm_i_sweep_some_cards (scm_t_heap_segment
*seg
,
149 scm_t_sweep_statistics
*sweep_stats
)
154 int (*sweeper
) (scm_t_cell
*, SCM
*, scm_t_heap_segment
* )
155 = (seg
->first_time
) ? &scm_i_init_card_freelist
: &scm_i_sweep_card
;
157 scm_t_cell
* next_free
= seg
->next_free_card
;
160 while (collected
< threshold
&& next_free
< seg
->bounds
[1])
162 collected
+= (*sweeper
) (next_free
, &cells
, seg
);
163 next_free
+= SCM_GC_CARD_N_CELLS
;
167 sweep_stats
->swept
= cards_swept
* seg
->span
168 * (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
);
170 if (!seg
->first_time
)
172 /* scm_cells_allocated -= collected * seg->span; */
173 sweep_stats
->collected
= collected
* seg
->span
;
176 sweep_stats
->collected
= 0;
178 seg
->freelist
->collected
+= collected
* seg
->span
;
180 if(next_free
== seg
->bounds
[1])
185 seg
->next_free_card
= next_free
;
191 Force a sweep of this entire segment. This doesn't modify sweep
192 statistics, it just frees the memory pointed to by to-be-swept
195 Implementation is slightly ugh.
197 FIXME: if you do scm_i_sweep_segment(), and then allocate from this
198 segment again, the statistics are off.
201 scm_i_sweep_segment (scm_t_heap_segment
*seg
,
202 scm_t_sweep_statistics
*sweep_stats
)
204 scm_t_sweep_statistics sweep
;
205 scm_t_cell
* p
= seg
->next_free_card
;
207 scm_i_sweep_statistics_init (sweep_stats
);
209 while (scm_i_sweep_some_cards (seg
, &sweep
) != SCM_EOL
)
210 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
212 seg
->next_free_card
=p
;
216 scm_i_sweep_all_segments (char const *reason
,
217 scm_t_sweep_statistics
*sweep_stats
)
221 scm_i_sweep_statistics_init (sweep_stats
);
222 for (i
= 0; i
< scm_i_heap_segment_table_size
; i
++)
224 scm_t_sweep_statistics sweep
;
226 scm_i_sweep_segment (scm_i_heap_segment_table
[i
], &sweep
);
227 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
235 The table is sorted by the address of the data itself. This makes
236 for easy lookups. This is not portable: according to ANSI C,
237 pointers can only be compared within the same object (i.e. the same
238 block of malloced memory.). For machines with weird architectures,
239 this should be revised.
241 (Apparently, for this reason 1.6 and earlier had macros for pointer
244 perhaps it is worthwhile to remove the 2nd level of indirection in
245 the table, but this certainly makes for cleaner code.
247 scm_t_heap_segment
** scm_i_heap_segment_table
;
248 size_t scm_i_heap_segment_table_size
;
249 scm_t_cell
*lowest_cell
;
250 scm_t_cell
*highest_cell
;
254 scm_i_clear_mark_space (void)
257 for (; i
< scm_i_heap_segment_table_size
; i
++)
259 scm_i_clear_segment_mark_space (scm_i_heap_segment_table
[i
]);
265 RETURN: index of inserted segment.
268 scm_i_insert_segment (scm_t_heap_segment
* seg
)
270 size_t size
= (scm_i_heap_segment_table_size
+ 1) * sizeof (scm_t_heap_segment
*);
271 SCM_SYSCALL(scm_i_heap_segment_table
= ((scm_t_heap_segment
**)
272 realloc ((char *)scm_i_heap_segment_table
, size
)));
275 We can't alloc 4 more bytes. This is hopeless.
277 if (!scm_i_heap_segment_table
)
279 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
285 lowest_cell
= seg
->bounds
[0];
286 highest_cell
= seg
->bounds
[1];
290 lowest_cell
= SCM_MIN (lowest_cell
, seg
->bounds
[0]);
291 highest_cell
= SCM_MAX (highest_cell
, seg
->bounds
[1]);
299 while (i
< scm_i_heap_segment_table_size
300 && scm_i_heap_segment_table
[i
]->bounds
[0] <= seg
->bounds
[0])
304 We insert a new entry; if that happens to be before the
305 "current" segment of a freelist, we must move the freelist index
308 if (scm_i_master_freelist
.heap_segment_idx
>= i
)
309 scm_i_master_freelist
.heap_segment_idx
++;
310 if (scm_i_master_freelist2
.heap_segment_idx
>= i
)
311 scm_i_master_freelist2
.heap_segment_idx
++;
313 for (j
= scm_i_heap_segment_table_size
; j
> i
; --j
)
314 scm_i_heap_segment_table
[j
] = scm_i_heap_segment_table
[j
- 1];
316 scm_i_heap_segment_table
[i
] = seg
;
317 scm_i_heap_segment_table_size
++;
324 scm_i_sweep_some_segments (scm_t_cell_type_statistics
*fl
,
325 scm_t_sweep_statistics
*sweep_stats
)
327 int i
= fl
->heap_segment_idx
;
328 SCM collected
= SCM_EOL
;
330 scm_i_sweep_statistics_init (sweep_stats
);
335 i
< scm_i_heap_segment_table_size
; i
++)
337 scm_t_sweep_statistics sweep
;
339 if (scm_i_heap_segment_table
[i
]->freelist
!= fl
)
342 collected
= scm_i_sweep_some_cards (scm_i_heap_segment_table
[i
],
345 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
347 if (collected
!= SCM_EOL
) /* Don't increment i */
351 fl
->heap_segment_idx
= i
;
358 scm_i_reset_segments (void)
361 for (; i
< scm_i_heap_segment_table_size
; i
++)
363 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
364 seg
->next_free_card
= seg
->bounds
[0];
369 Return a hashtab with counts of live objects, with tags as keys.
374 scm_i_all_segments_statistics (SCM tab
)
377 for (; i
< scm_i_heap_segment_table_size
; i
++)
379 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
380 scm_i_heap_segment_statistics (seg
, tab
);
390 Determine whether the given value does actually represent a cell in
391 some heap segment. If this is the case, the number of the heap
392 segment is returned. Otherwise, -1 is returned. Binary search is
393 used to determine the heap segment that contains the cell.
396 I think this function is too long to be inlined. --hwn
399 scm_i_find_heap_segment_containing_object (SCM obj
)
404 if ((scm_t_cell
* ) obj
< lowest_cell
|| (scm_t_cell
*) obj
>= highest_cell
)
409 scm_t_cell
* ptr
= SCM2PTR (obj
);
410 unsigned long int i
= 0;
411 unsigned long int j
= scm_i_heap_segment_table_size
- 1;
413 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
415 else if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
421 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[1])
425 else if (scm_i_heap_segment_table
[j
]->bounds
[0] <= ptr
)
432 unsigned long int k
= (i
+ j
) / 2;
436 else if (ptr
< scm_i_heap_segment_table
[k
]->bounds
[1])
440 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
443 else if (scm_i_heap_segment_table
[k
]->bounds
[0] <= ptr
)
447 if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
453 if (!SCM_DOUBLECELL_ALIGNED_P (obj
) && scm_i_heap_segment_table
[i
]->span
== 2)
455 else if (SCM_GC_IN_CARD_HEADERP (ptr
))
465 Important entry point: try to grab some memory, and make it into a
468 RETURN: the index of the segment.
471 scm_i_get_new_heap_segment (scm_t_cell_type_statistics
*freelist
,
472 policy_on_error error_policy
)
477 /* Assure that the new segment is predicted to be large enough.
479 * New yield should at least equal GC fraction of new heap size, i.e.
481 * y + dh > f * (h + dh)
484 * f : min yield fraction
486 * dh : size of new heap segment
488 * This gives dh > (f * h - y) / (1 - f)
490 float f
= freelist
->min_yield_fraction
/ 100.0;
491 float h
= SCM_HEAP_SIZE
;
492 float min_cells
= (f
* h
- scm_gc_cells_collected
) / (1.0 - f
);
494 /* Make heap grow with factor 1.5 */
495 len
= freelist
->heap_size
/ 2;
497 fprintf (stderr
, "(%ld < %ld)", (long) len
, (long) min_cells
);
501 len
= (unsigned long) min_cells
;
502 len
*= sizeof (scm_t_cell
);
503 /* force new sampling */
504 freelist
->collected
= LONG_MAX
;
507 if (len
> scm_max_segment_size
)
508 len
= scm_max_segment_size
;
509 if (len
< SCM_MIN_HEAP_SEG_SIZE
)
510 len
= SCM_MIN_HEAP_SEG_SIZE
;
513 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
515 /* Allocate with decaying ambition. */
516 while (len
>= SCM_MIN_HEAP_SEG_SIZE
)
518 if (scm_i_initialize_heap_segment_data (seg
, len
))
520 return scm_i_insert_segment (seg
);
527 if (error_policy
== abort_on_error
)
529 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap.\n");
536 scm_i_make_initial_segment (int init_heap_size
, scm_t_cell_type_statistics
*freelist
)
538 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
540 if (init_heap_size
< 1)
542 init_heap_size
= SCM_DEFAULT_INIT_HEAP_SIZE_1
;
545 if (scm_i_initialize_heap_segment_data (seg
, init_heap_size
))
547 freelist
->heap_segment_idx
= scm_i_insert_segment (seg
);
551 Why the fuck try twice? --hwn
555 scm_i_initialize_heap_segment_data (seg
, SCM_HEAP_SEG_SIZE
);
558 if (freelist
->min_yield_fraction
)
559 freelist
->min_yield
= (freelist
->heap_size
* freelist
->min_yield_fraction