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 The table is sorted by the address of the data itself. This makes
32 for easy lookups. This is not portable: according to ANSI C,
33 pointers can only be compared within the same object (i.e. the same
34 block of malloced memory.). For machines with weird architectures,
35 this should be revised.
37 (Apparently, for this reason 1.6 and earlier had macros for pointer
40 perhaps it is worthwhile to remove the 2nd level of indirection in
41 the table, but this certainly makes for cleaner code.
43 scm_t_heap_segment
**scm_i_heap_segment_table
;
44 size_t scm_i_heap_segment_table_size
;
45 static scm_t_cell
*lowest_cell
;
46 static scm_t_cell
*highest_cell
;
50 RETURN: index of inserted segment.
53 scm_i_insert_segment (scm_t_heap_segment
*seg
)
55 size_t size
= (scm_i_heap_segment_table_size
+ 1) * sizeof (scm_t_heap_segment
*);
56 SCM_SYSCALL(scm_i_heap_segment_table
57 = ((scm_t_heap_segment
**)
58 realloc ((char *)scm_i_heap_segment_table
, size
)));
61 We can't alloc 4 more bytes. This is hopeless.
63 if (!scm_i_heap_segment_table
)
65 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
71 lowest_cell
= seg
->bounds
[0];
72 highest_cell
= seg
->bounds
[1];
76 lowest_cell
= SCM_MIN (lowest_cell
, seg
->bounds
[0]);
77 highest_cell
= SCM_MAX (highest_cell
, seg
->bounds
[1]);
85 while (i
< scm_i_heap_segment_table_size
86 && scm_i_heap_segment_table
[i
]->bounds
[0] <= seg
->bounds
[0])
90 We insert a new entry; if that happens to be before the
91 "current" segment of a freelist, we must move the freelist index
94 if (scm_i_master_freelist
.heap_segment_idx
>= i
)
95 scm_i_master_freelist
.heap_segment_idx
++;
96 if (scm_i_master_freelist2
.heap_segment_idx
>= i
)
97 scm_i_master_freelist2
.heap_segment_idx
++;
99 for (j
= scm_i_heap_segment_table_size
; j
> i
; --j
)
100 scm_i_heap_segment_table
[j
] = scm_i_heap_segment_table
[j
- 1];
102 scm_i_heap_segment_table
[i
] = seg
;
103 scm_i_heap_segment_table_size
++;
111 Determine whether the given value does actually represent a cell in
112 some heap segment. If this is the case, the number of the heap
113 segment is returned. Otherwise, -1 is returned. Binary search is
114 used to determine the heap segment that contains the cell.
116 I think this function is too long to be inlined. --hwn
119 scm_i_find_heap_segment_containing_object (SCM obj
)
124 if ((scm_t_cell
*) obj
< lowest_cell
|| (scm_t_cell
*) obj
>= highest_cell
)
128 scm_t_cell
*ptr
= SCM2PTR (obj
);
130 unsigned int j
= scm_i_heap_segment_table_size
- 1;
132 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
134 else if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
140 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[1])
144 else if (scm_i_heap_segment_table
[j
]->bounds
[0] <= ptr
)
151 unsigned long int k
= (i
+ j
) / 2;
155 else if (ptr
< scm_i_heap_segment_table
[k
]->bounds
[1])
159 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
162 else if (scm_i_heap_segment_table
[k
]->bounds
[0] <= ptr
)
166 if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
172 if (!SCM_DOUBLECELL_ALIGNED_P (obj
) && scm_i_heap_segment_table
[i
]->span
== 2)
174 else if (SCM_GC_IN_CARD_HEADERP (ptr
))
184 scm_i_marked_count (void)
188 for (; i
< scm_i_heap_segment_table_size
; i
++)
190 c
+= scm_i_heap_segment_marked_count (scm_i_heap_segment_table
[i
]);
197 scm_i_sweep_some_segments (scm_t_cell_type_statistics
*freelist
,
198 scm_t_sweep_statistics
*sweep_stats
)
200 int i
= freelist
->heap_segment_idx
;
201 SCM collected
= SCM_EOL
;
203 if (i
== -1) /* huh? --hwn */
207 i
< scm_i_heap_segment_table_size
; i
++)
209 if (scm_i_heap_segment_table
[i
]->freelist
!= freelist
)
212 collected
= scm_i_sweep_some_cards (scm_i_heap_segment_table
[i
],
214 DEFAULT_SWEEP_AMOUNT
);
216 if (collected
!= SCM_EOL
) /* Don't increment i */
220 freelist
->heap_segment_idx
= i
;
226 scm_i_reset_segments (void)
229 for (; i
< scm_i_heap_segment_table_size
; i
++)
231 scm_t_heap_segment
*seg
= scm_i_heap_segment_table
[i
];
232 seg
->next_free_card
= seg
->bounds
[0];
240 Return a hashtab with counts of live objects, with tags as keys.
243 scm_i_all_segments_statistics (SCM tab
)
246 for (; i
< scm_i_heap_segment_table_size
; i
++)
248 scm_t_heap_segment
*seg
= scm_i_heap_segment_table
[i
];
249 scm_i_heap_segment_statistics (seg
, tab
);
257 scm_i_segment_table_info(int* size
)
259 *size
= scm_i_heap_segment_table_size
;
260 unsigned long *bounds
= malloc (sizeof (unsigned long) * *size
* 2);
264 for (i
= *size
; i
-- > 0; )
266 bounds
[2*i
] = (unsigned long)scm_i_heap_segment_table
[i
]->bounds
[0];
267 bounds
[2*i
+1] = (unsigned long)scm_i_heap_segment_table
[i
]->bounds
[1];
274 scm_i_sweep_all_segments (char const *reason
,
275 scm_t_sweep_statistics
*sweep_stats
)
278 for (i
= 0; i
< scm_i_heap_segment_table_size
; i
++)
280 scm_i_sweep_segment (scm_i_heap_segment_table
[i
], sweep_stats
);
286 scm_i_clear_mark_space (void)
289 for (; i
< scm_i_heap_segment_table_size
; i
++)
291 scm_i_clear_segment_mark_space (scm_i_heap_segment_table
[i
]);