183 |
if (type == 0) |
if (type == 0) |
184 |
{ |
{ |
185 |
fprintf (stderr, |
fprintf (stderr, |
186 |
"scm_must_free called on object not allocated with scm_must_malloc\n"); |
"scm_gc_free called on object not allocated with scm_gc_malloc\n"); |
187 |
abort (); |
abort (); |
188 |
} |
} |
189 |
type->data = (void *) ((int) type->data - 1); |
type->data = (void *) ((int) type->data - 1); |
194 |
scm_malloc_reregister (void *old, void *new, const char *newwhat) |
scm_malloc_reregister (void *old, void *new, const char *newwhat) |
195 |
{ |
{ |
196 |
hash_entry_t *object, *type; |
hash_entry_t *object, *type; |
197 |
GET_CREATE_HASH_ENTRY (object, object, old, l1); |
|
198 |
type = (hash_entry_t *) object->data; |
if (old == NULL) |
199 |
if (type == 0) |
scm_malloc_register (new, newwhat); |
200 |
{ |
else |
|
fprintf (stderr, |
|
|
"scm_must_realloc called on object not allocated with scm_must_malloc\n"); |
|
|
abort (); |
|
|
} |
|
|
if (strcmp ((char *) type->key, newwhat) != 0) |
|
201 |
{ |
{ |
202 |
if (strcmp (newwhat, "vector-set-length!") != 0) |
GET_CREATE_HASH_ENTRY (object, object, old, l1); |
203 |
|
type = (hash_entry_t *) object->data; |
204 |
|
if (type == 0) |
205 |
{ |
{ |
206 |
fprintf (stderr, |
fprintf (stderr, |
207 |
"scm_must_realloc called with arg %s, was %s\n", |
"scm_gc_realloc called on object not allocated " |
208 |
newwhat, |
"with scm_gc_malloc\n"); |
|
(char *) type->key); |
|
209 |
abort (); |
abort (); |
210 |
} |
} |
211 |
} |
if (strcmp ((char *) type->key, newwhat) != 0) |
212 |
if (new != old) |
{ |
213 |
{ |
if (strcmp (newwhat, "vector-set-length!") != 0) |
214 |
object->key = 0; |
{ |
215 |
CREATE_HASH_ENTRY (object, new, type, l2); |
fprintf (stderr, |
216 |
|
"scm_gc_realloc called with arg %s, was %s\n", |
217 |
|
newwhat, |
218 |
|
(char *) type->key); |
219 |
|
abort (); |
220 |
|
} |
221 |
|
} |
222 |
|
if (new != old) |
223 |
|
{ |
224 |
|
object->key = 0; |
225 |
|
CREATE_HASH_ENTRY (object, new, type, l2); |
226 |
|
} |
227 |
} |
} |
228 |
} |
} |
229 |
|
|
231 |
(), |
(), |
232 |
"Return an alist ((@var{what} . @var{n}) ...) describing number\n" |
"Return an alist ((@var{what} . @var{n}) ...) describing number\n" |
233 |
"of malloced objects.\n" |
"of malloced objects.\n" |
234 |
"@var{what} is the second argument to @code{scm_must_malloc},\n" |
"@var{what} is the second argument to @code{scm_gc_malloc},\n" |
235 |
"@var{n} is the number of objects of that type currently\n" |
"@var{n} is the number of objects of that type currently\n" |
236 |
"allocated.") |
"allocated.") |
237 |
#define FUNC_NAME s_scm_malloc_stats |
#define FUNC_NAME s_scm_malloc_stats |