]>
Commit | Line | Data |
---|---|---|
2f5f7a08 TT |
1 | /* |
2 | * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers | |
3 | * Copyright (c) 1991-1994 by Xerox Corporation. All rights reserved. | |
79f777fd | 4 | * Copyright (c) 1999-2001 by Hewlett-Packard Company. All rights reserved. |
2f5f7a08 TT |
5 | * |
6 | * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED | |
7 | * OR IMPLIED. ANY USE IS AT YOUR OWN RISK. | |
8 | * | |
9 | * Permission is hereby granted to use or copy this program | |
10 | * for any purpose, provided the above notices are retained on all copies. | |
11 | * Permission to modify the code and to distribute modified code is granted, | |
12 | * provided the above notices are retained, and a notice that the code was | |
13 | * modified is included with the above copyright notice. | |
14 | */ | |
15 | /* Boehm, July 31, 1995 5:02 pm PDT */ | |
16 | ||
17 | ||
18 | #include <stdio.h> | |
787bf7e3 | 19 | #include <limits.h> |
9110a741 | 20 | #ifndef _WIN32_WCE |
2f5f7a08 | 21 | #include <signal.h> |
9110a741 | 22 | #endif |
2f5f7a08 TT |
23 | |
24 | #define I_HIDE_POINTERS /* To make GC_call_with_alloc_lock visible */ | |
9110a741 | 25 | #include "private/gc_pmark.h" |
2f5f7a08 | 26 | |
4c7726b1 | 27 | #ifdef GC_SOLARIS_THREADS |
2f5f7a08 TT |
28 | # include <sys/syscall.h> |
29 | #endif | |
9110a741 BM |
30 | #if defined(MSWIN32) || defined(MSWINCE) |
31 | # define WIN32_LEAN_AND_MEAN | |
32 | # define NOSERVICE | |
2f5f7a08 | 33 | # include <windows.h> |
9110a741 | 34 | # include <tchar.h> |
2f5f7a08 TT |
35 | #endif |
36 | ||
37 | # ifdef THREADS | |
38 | # ifdef PCR | |
39 | # include "il/PCR_IL.h" | |
40 | PCR_Th_ML GC_allocate_ml; | |
41 | # else | |
42 | # ifdef SRC_M3 | |
43 | /* Critical section counter is defined in the M3 runtime */ | |
44 | /* That's all we use. */ | |
45 | # else | |
4c7726b1 | 46 | # ifdef GC_SOLARIS_THREADS |
2f5f7a08 TT |
47 | mutex_t GC_allocate_ml; /* Implicitly initialized. */ |
48 | # else | |
30c3de1f JS |
49 | # if defined(GC_WIN32_THREADS) |
50 | # if defined(GC_PTHREADS) | |
51 | pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER; | |
52 | # elif defined(GC_DLL) | |
9110a741 BM |
53 | __declspec(dllexport) CRITICAL_SECTION GC_allocate_ml; |
54 | # else | |
55 | CRITICAL_SECTION GC_allocate_ml; | |
56 | # endif | |
2f5f7a08 | 57 | # else |
4c7726b1 BM |
58 | # if defined(GC_PTHREADS) && !defined(GC_SOLARIS_THREADS) |
59 | # if defined(USE_SPIN_LOCK) | |
60 | pthread_t GC_lock_holder = NO_THREAD; | |
61 | # else | |
20bbd3cd | 62 | pthread_mutex_t GC_allocate_ml = PTHREAD_MUTEX_INITIALIZER; |
9110a741 BM |
63 | pthread_t GC_lock_holder = NO_THREAD; |
64 | /* Used only for assertions, and to prevent */ | |
65 | /* recursive reentry in the system call wrapper. */ | |
4c7726b1 BM |
66 | # endif |
67 | # else | |
20bbd3cd | 68 | --> declare allocator lock here |
2f5f7a08 TT |
69 | # endif |
70 | # endif | |
71 | # endif | |
72 | # endif | |
73 | # endif | |
74 | # endif | |
75 | ||
b6459d9a | 76 | #if defined(NOSYS) || defined(ECOS) |
1530be84 TT |
77 | #undef STACKBASE |
78 | #endif | |
79 | ||
30c3de1f JS |
80 | /* Dont unnecessarily call GC_register_main_static_data() in case */ |
81 | /* dyn_load.c isn't linked in. */ | |
ebcc6a7e HB |
82 | #ifdef DYNAMIC_LOADING |
83 | # define GC_REGISTER_MAIN_STATIC_DATA() GC_register_main_static_data() | |
84 | #else | |
85 | # define GC_REGISTER_MAIN_STATIC_DATA() TRUE | |
86 | #endif | |
87 | ||
2f5f7a08 TT |
88 | GC_FAR struct _GC_arrays GC_arrays /* = { 0 } */; |
89 | ||
90 | ||
91 | GC_bool GC_debugging_started = FALSE; | |
92 | /* defined here so we don't have to load debug_malloc.o */ | |
93 | ||
9110a741 | 94 | void (*GC_check_heap) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0; |
30c3de1f | 95 | void (*GC_print_all_smashed) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0; |
2f5f7a08 | 96 | |
9110a741 | 97 | void (*GC_start_call_back) GC_PROTO((void)) = (void (*) GC_PROTO((void)))0; |
2f5f7a08 TT |
98 | |
99 | ptr_t GC_stackbottom = 0; | |
100 | ||
9110a741 BM |
101 | #ifdef IA64 |
102 | ptr_t GC_register_stackbottom = 0; | |
103 | #endif | |
104 | ||
2f5f7a08 TT |
105 | GC_bool GC_dont_gc = 0; |
106 | ||
9110a741 BM |
107 | GC_bool GC_dont_precollect = 0; |
108 | ||
2f5f7a08 TT |
109 | GC_bool GC_quiet = 0; |
110 | ||
9110a741 BM |
111 | GC_bool GC_print_stats = 0; |
112 | ||
79f777fd BM |
113 | GC_bool GC_print_back_height = 0; |
114 | ||
30c3de1f JS |
115 | #ifndef NO_DEBUGGING |
116 | GC_bool GC_dump_regularly = 0; /* Generate regular debugging dumps. */ | |
117 | #endif | |
118 | ||
4109fe85 BM |
119 | #ifdef KEEP_BACK_PTRS |
120 | long GC_backtraces = 0; /* Number of random backtraces to */ | |
121 | /* generate for each GC. */ | |
122 | #endif | |
123 | ||
20bbd3cd TT |
124 | #ifdef FIND_LEAK |
125 | int GC_find_leak = 1; | |
126 | #else | |
127 | int GC_find_leak = 0; | |
128 | #endif | |
129 | ||
9110a741 BM |
130 | #ifdef ALL_INTERIOR_POINTERS |
131 | int GC_all_interior_pointers = 1; | |
132 | #else | |
133 | int GC_all_interior_pointers = 0; | |
134 | #endif | |
135 | ||
787bf7e3 HB |
136 | long GC_large_alloc_warn_interval = 5; |
137 | /* Interval between unsuppressed warnings. */ | |
138 | ||
139 | long GC_large_alloc_warn_suppressed = 0; | |
140 | /* Number of warnings suppressed so far. */ | |
141 | ||
2f5f7a08 TT |
142 | /*ARGSUSED*/ |
143 | GC_PTR GC_default_oom_fn GC_PROTO((size_t bytes_requested)) | |
144 | { | |
145 | return(0); | |
146 | } | |
147 | ||
148 | GC_PTR (*GC_oom_fn) GC_PROTO((size_t bytes_requested)) = GC_default_oom_fn; | |
149 | ||
150 | extern signed_word GC_mem_found; | |
151 | ||
30c3de1f JS |
152 | void * GC_project2(arg1, arg2) |
153 | void *arg1; | |
154 | void *arg2; | |
155 | { | |
156 | return arg2; | |
157 | } | |
158 | ||
2f5f7a08 TT |
159 | # ifdef MERGE_SIZES |
160 | /* Set things up so that GC_size_map[i] >= words(i), */ | |
161 | /* but not too much bigger */ | |
162 | /* and so that size_map contains relatively few distinct entries */ | |
163 | /* This is stolen from Russ Atkinson's Cedar quantization */ | |
164 | /* alogrithm (but we precompute it). */ | |
165 | ||
166 | ||
167 | void GC_init_size_map() | |
168 | { | |
169 | register unsigned i; | |
170 | ||
9110a741 BM |
171 | /* Map size 0 to something bigger. */ |
172 | /* This avoids problems at lower levels. */ | |
173 | /* One word objects don't have to be 2 word aligned, */ | |
174 | /* unless we're using mark bytes. */ | |
41029b88 HB |
175 | for (i = 0; i < sizeof(word); i++) { |
176 | GC_size_map[i] = MIN_WORDS; | |
2f5f7a08 | 177 | } |
41029b88 HB |
178 | # if MIN_WORDS > 1 |
179 | GC_size_map[sizeof(word)] = MIN_WORDS; | |
180 | # else | |
181 | GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word)); | |
182 | # endif | |
2f5f7a08 | 183 | for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) { |
9110a741 | 184 | GC_size_map[i] = ALIGNED_WORDS(i); |
2f5f7a08 TT |
185 | } |
186 | for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) { | |
187 | GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1); | |
188 | } | |
93002327 BM |
189 | # ifdef GC_GCJ_SUPPORT |
190 | /* Make all sizes up to 32 words predictable, so that a */ | |
191 | /* compiler can statically perform the same computation, */ | |
192 | /* or at least a computation that results in similar size */ | |
193 | /* classes. */ | |
194 | for (i = 16*sizeof(word) + 1; i <= 32 * sizeof(word); i++) { | |
195 | GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 3) & (~3); | |
196 | } | |
197 | # endif | |
2f5f7a08 TT |
198 | /* We leave the rest of the array to be filled in on demand. */ |
199 | } | |
200 | ||
201 | /* Fill in additional entries in GC_size_map, including the ith one */ | |
202 | /* We assume the ith entry is currently 0. */ | |
203 | /* Note that a filled in section of the array ending at n always */ | |
204 | /* has length at least n/4. */ | |
205 | void GC_extend_size_map(i) | |
206 | word i; | |
207 | { | |
208 | word orig_word_sz = ROUNDED_UP_WORDS(i); | |
209 | word word_sz = orig_word_sz; | |
210 | register word byte_sz = WORDS_TO_BYTES(word_sz); | |
211 | /* The size we try to preserve. */ | |
212 | /* Close to to i, unless this would */ | |
213 | /* introduce too many distinct sizes. */ | |
214 | word smaller_than_i = byte_sz - (byte_sz >> 3); | |
215 | word much_smaller_than_i = byte_sz - (byte_sz >> 2); | |
216 | register word low_limit; /* The lowest indexed entry we */ | |
217 | /* initialize. */ | |
218 | register word j; | |
219 | ||
220 | if (GC_size_map[smaller_than_i] == 0) { | |
221 | low_limit = much_smaller_than_i; | |
222 | while (GC_size_map[low_limit] != 0) low_limit++; | |
223 | } else { | |
224 | low_limit = smaller_than_i + 1; | |
225 | while (GC_size_map[low_limit] != 0) low_limit++; | |
226 | word_sz = ROUNDED_UP_WORDS(low_limit); | |
227 | word_sz += word_sz >> 3; | |
228 | if (word_sz < orig_word_sz) word_sz = orig_word_sz; | |
229 | } | |
230 | # ifdef ALIGN_DOUBLE | |
231 | word_sz += 1; | |
232 | word_sz &= ~1; | |
233 | # endif | |
234 | if (word_sz > MAXOBJSZ) { | |
235 | word_sz = MAXOBJSZ; | |
236 | } | |
237 | /* If we can fit the same number of larger objects in a block, */ | |
238 | /* do so. */ | |
239 | { | |
240 | size_t number_of_objs = BODY_SZ/word_sz; | |
241 | word_sz = BODY_SZ/number_of_objs; | |
242 | # ifdef ALIGN_DOUBLE | |
243 | word_sz &= ~1; | |
244 | # endif | |
245 | } | |
246 | byte_sz = WORDS_TO_BYTES(word_sz); | |
9110a741 | 247 | if (GC_all_interior_pointers) { |
2f5f7a08 | 248 | /* We need one extra byte; don't fill in GC_size_map[byte_sz] */ |
54f28c21 | 249 | byte_sz -= EXTRA_BYTES; |
9110a741 | 250 | } |
2f5f7a08 TT |
251 | |
252 | for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz; | |
253 | } | |
254 | # endif | |
255 | ||
256 | ||
257 | /* | |
258 | * The following is a gross hack to deal with a problem that can occur | |
259 | * on machines that are sloppy about stack frame sizes, notably SPARC. | |
260 | * Bogus pointers may be written to the stack and not cleared for | |
261 | * a LONG time, because they always fall into holes in stack frames | |
262 | * that are not written. We partially address this by clearing | |
263 | * sections of the stack whenever we get control. | |
264 | */ | |
265 | word GC_stack_last_cleared = 0; /* GC_no when we last did this */ | |
266 | # ifdef THREADS | |
9110a741 BM |
267 | # define BIG_CLEAR_SIZE 2048 /* Clear this much now and then. */ |
268 | # define SMALL_CLEAR_SIZE 256 /* Clear this much every time. */ | |
2f5f7a08 | 269 | # endif |
9110a741 | 270 | # define CLEAR_SIZE 213 /* Granularity for GC_clear_stack_inner */ |
2f5f7a08 TT |
271 | # define DEGRADE_RATE 50 |
272 | ||
273 | word GC_min_sp; /* Coolest stack pointer value from which we've */ | |
274 | /* already cleared the stack. */ | |
275 | ||
2f5f7a08 TT |
276 | word GC_high_water; |
277 | /* "hottest" stack pointer value we have seen */ | |
278 | /* recently. Degrades over time. */ | |
279 | ||
280 | word GC_words_allocd_at_reset; | |
281 | ||
9110a741 | 282 | #if defined(ASM_CLEAR_CODE) |
2f5f7a08 | 283 | extern ptr_t GC_clear_stack_inner(); |
9110a741 | 284 | #else |
2f5f7a08 TT |
285 | /* Clear the stack up to about limit. Return arg. */ |
286 | /*ARGSUSED*/ | |
287 | ptr_t GC_clear_stack_inner(arg, limit) | |
288 | ptr_t arg; | |
289 | word limit; | |
290 | { | |
291 | word dummy[CLEAR_SIZE]; | |
292 | ||
293 | BZERO(dummy, CLEAR_SIZE*sizeof(word)); | |
294 | if ((word)(dummy) COOLER_THAN limit) { | |
295 | (void) GC_clear_stack_inner(arg, limit); | |
296 | } | |
297 | /* Make sure the recursive call is not a tail call, and the bzero */ | |
298 | /* call is not recognized as dead code. */ | |
299 | GC_noop1((word)dummy); | |
300 | return(arg); | |
301 | } | |
302 | #endif | |
303 | ||
304 | /* Clear some of the inaccessible part of the stack. Returns its */ | |
305 | /* argument, so it can be used in a tail call position, hence clearing */ | |
306 | /* another frame. */ | |
307 | ptr_t GC_clear_stack(arg) | |
308 | ptr_t arg; | |
309 | { | |
310 | register word sp = (word)GC_approx_sp(); /* Hotter than actual sp */ | |
311 | # ifdef THREADS | |
9110a741 BM |
312 | word dummy[SMALL_CLEAR_SIZE]; |
313 | static unsigned random_no = 0; | |
314 | /* Should be more random than it is ... */ | |
315 | /* Used to occasionally clear a bigger */ | |
316 | /* chunk. */ | |
2f5f7a08 | 317 | # endif |
9110a741 | 318 | register word limit; |
2f5f7a08 TT |
319 | |
320 | # define SLOP 400 | |
321 | /* Extra bytes we clear every time. This clears our own */ | |
322 | /* activation record, and should cause more frequent */ | |
323 | /* clearing near the cold end of the stack, a good thing. */ | |
324 | # define GC_SLOP 4000 | |
325 | /* We make GC_high_water this much hotter than we really saw */ | |
326 | /* saw it, to cover for GC noise etc. above our current frame. */ | |
327 | # define CLEAR_THRESHOLD 100000 | |
328 | /* We restart the clearing process after this many bytes of */ | |
329 | /* allocation. Otherwise very heavily recursive programs */ | |
330 | /* with sparse stacks may result in heaps that grow almost */ | |
331 | /* without bounds. As the heap gets larger, collection */ | |
332 | /* frequency decreases, thus clearing frequency would decrease, */ | |
333 | /* thus more junk remains accessible, thus the heap gets */ | |
334 | /* larger ... */ | |
335 | # ifdef THREADS | |
9110a741 BM |
336 | if (++random_no % 13 == 0) { |
337 | limit = sp; | |
338 | MAKE_HOTTER(limit, BIG_CLEAR_SIZE*sizeof(word)); | |
5a2586cf TT |
339 | limit &= ~0xf; /* Make it sufficiently aligned for assembly */ |
340 | /* implementations of GC_clear_stack_inner. */ | |
9110a741 BM |
341 | return GC_clear_stack_inner(arg, limit); |
342 | } else { | |
343 | BZERO(dummy, SMALL_CLEAR_SIZE*sizeof(word)); | |
344 | return arg; | |
345 | } | |
2f5f7a08 TT |
346 | # else |
347 | if (GC_gc_no > GC_stack_last_cleared) { | |
348 | /* Start things over, so we clear the entire stack again */ | |
349 | if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom; | |
350 | GC_min_sp = GC_high_water; | |
351 | GC_stack_last_cleared = GC_gc_no; | |
352 | GC_words_allocd_at_reset = GC_words_allocd; | |
353 | } | |
354 | /* Adjust GC_high_water */ | |
355 | MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP); | |
356 | if (sp HOTTER_THAN GC_high_water) { | |
357 | GC_high_water = sp; | |
358 | } | |
359 | MAKE_HOTTER(GC_high_water, GC_SLOP); | |
360 | limit = GC_min_sp; | |
361 | MAKE_HOTTER(limit, SLOP); | |
362 | if (sp COOLER_THAN limit) { | |
363 | limit &= ~0xf; /* Make it sufficiently aligned for assembly */ | |
364 | /* implementations of GC_clear_stack_inner. */ | |
365 | GC_min_sp = sp; | |
366 | return(GC_clear_stack_inner(arg, limit)); | |
367 | } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset) | |
368 | > CLEAR_THRESHOLD) { | |
369 | /* Restart clearing process, but limit how much clearing we do. */ | |
370 | GC_min_sp = sp; | |
371 | MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4); | |
372 | if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water; | |
373 | GC_words_allocd_at_reset = GC_words_allocd; | |
374 | } | |
9110a741 | 375 | return(arg); |
2f5f7a08 | 376 | # endif |
2f5f7a08 TT |
377 | } |
378 | ||
379 | ||
380 | /* Return a pointer to the base address of p, given a pointer to a */ | |
381 | /* an address within an object. Return 0 o.w. */ | |
382 | # ifdef __STDC__ | |
383 | GC_PTR GC_base(GC_PTR p) | |
384 | # else | |
385 | GC_PTR GC_base(p) | |
386 | GC_PTR p; | |
387 | # endif | |
388 | { | |
389 | register word r; | |
390 | register struct hblk *h; | |
391 | register bottom_index *bi; | |
392 | register hdr *candidate_hdr; | |
393 | register word limit; | |
394 | ||
395 | r = (word)p; | |
396 | if (!GC_is_initialized) return 0; | |
397 | h = HBLKPTR(r); | |
398 | GET_BI(r, bi); | |
399 | candidate_hdr = HDR_FROM_BI(bi, r); | |
400 | if (candidate_hdr == 0) return(0); | |
401 | /* If it's a pointer to the middle of a large object, move it */ | |
402 | /* to the beginning. */ | |
403 | while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) { | |
404 | h = FORWARDED_ADDR(h,candidate_hdr); | |
9110a741 | 405 | r = (word)h; |
2f5f7a08 TT |
406 | candidate_hdr = HDR(h); |
407 | } | |
408 | if (candidate_hdr -> hb_map == GC_invalid_map) return(0); | |
409 | /* Make sure r points to the beginning of the object */ | |
410 | r &= ~(WORDS_TO_BYTES(1) - 1); | |
411 | { | |
9110a741 | 412 | register int offset = HBLKDISPL(r); |
2f5f7a08 | 413 | register signed_word sz = candidate_hdr -> hb_sz; |
9110a741 | 414 | register signed_word map_entry; |
2f5f7a08 | 415 | |
9110a741 BM |
416 | map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset); |
417 | if (map_entry > CPP_MAX_OFFSET) { | |
418 | map_entry = (signed_word)(BYTES_TO_WORDS(offset)) % sz; | |
419 | } | |
420 | r -= WORDS_TO_BYTES(map_entry); | |
421 | limit = r + WORDS_TO_BYTES(sz); | |
422 | if (limit > (word)(h + 1) | |
423 | && sz <= BYTES_TO_WORDS(HBLKSIZE)) { | |
2f5f7a08 | 424 | return(0); |
9110a741 | 425 | } |
2f5f7a08 TT |
426 | if ((word)p >= limit) return(0); |
427 | } | |
428 | return((GC_PTR)r); | |
429 | } | |
430 | ||
431 | ||
432 | /* Return the size of an object, given a pointer to its base. */ | |
433 | /* (For small obects this also happens to work from interior pointers, */ | |
434 | /* but that shouldn't be relied upon.) */ | |
435 | # ifdef __STDC__ | |
436 | size_t GC_size(GC_PTR p) | |
437 | # else | |
438 | size_t GC_size(p) | |
439 | GC_PTR p; | |
440 | # endif | |
441 | { | |
442 | register int sz; | |
443 | register hdr * hhdr = HDR(p); | |
444 | ||
445 | sz = WORDS_TO_BYTES(hhdr -> hb_sz); | |
9110a741 | 446 | return(sz); |
2f5f7a08 TT |
447 | } |
448 | ||
449 | size_t GC_get_heap_size GC_PROTO(()) | |
450 | { | |
451 | return ((size_t) GC_heapsize); | |
452 | } | |
453 | ||
20bbd3cd TT |
454 | size_t GC_get_free_bytes GC_PROTO(()) |
455 | { | |
456 | return ((size_t) GC_large_free_bytes); | |
457 | } | |
458 | ||
2f5f7a08 TT |
459 | size_t GC_get_bytes_since_gc GC_PROTO(()) |
460 | { | |
461 | return ((size_t) WORDS_TO_BYTES(GC_words_allocd)); | |
462 | } | |
463 | ||
9110a741 BM |
464 | size_t GC_get_total_bytes GC_PROTO(()) |
465 | { | |
466 | return ((size_t) WORDS_TO_BYTES(GC_words_allocd+GC_words_allocd_before_gc)); | |
467 | } | |
468 | ||
2f5f7a08 TT |
469 | GC_bool GC_is_initialized = FALSE; |
470 | ||
471 | void GC_init() | |
472 | { | |
473 | DCL_LOCK_STATE; | |
474 | ||
475 | DISABLE_SIGNALS(); | |
b1d24685 | 476 | |
30c3de1f | 477 | #if defined(GC_WIN32_THREADS) && !defined(GC_PTHREADS) |
4109fe85 BM |
478 | if (!GC_is_initialized) { |
479 | BOOL (WINAPI *pfn) (LPCRITICAL_SECTION, DWORD) = NULL; | |
480 | HMODULE hK32 = GetModuleHandle("kernel32.dll"); | |
481 | if (hK32) | |
8f63f56b DS |
482 | pfn = (BOOL (WINAPI *) (LPCRITICAL_SECTION, DWORD)) |
483 | GetProcAddress (hK32, | |
484 | "InitializeCriticalSectionAndSpinCount"); | |
4109fe85 BM |
485 | if (pfn) |
486 | pfn(&GC_allocate_ml, 4000); | |
487 | else | |
488 | InitializeCriticalSection (&GC_allocate_ml); | |
489 | } | |
b1d24685 AM |
490 | #endif /* MSWIN32 */ |
491 | ||
2f5f7a08 TT |
492 | LOCK(); |
493 | GC_init_inner(); | |
494 | UNLOCK(); | |
495 | ENABLE_SIGNALS(); | |
496 | ||
5a2586cf TT |
497 | # if defined(PARALLEL_MARK) || defined(THREAD_LOCAL_ALLOC) |
498 | /* Make sure marker threads and started and thread local */ | |
499 | /* allocation is initialized, in case we didn't get */ | |
500 | /* called from GC_init_parallel(); */ | |
501 | { | |
502 | extern void GC_init_parallel(void); | |
503 | GC_init_parallel(); | |
504 | } | |
505 | # endif /* PARALLEL_MARK || THREAD_LOCAL_ALLOC */ | |
30c3de1f JS |
506 | |
507 | # if defined(DYNAMIC_LOADING) && defined(DARWIN) | |
508 | { | |
509 | /* This must be called WITHOUT the allocation lock held | |
510 | and before any threads are created */ | |
511 | extern void GC_init_dyld(); | |
512 | GC_init_dyld(); | |
513 | } | |
514 | # endif | |
2f5f7a08 TT |
515 | } |
516 | ||
9110a741 BM |
517 | #if defined(MSWIN32) || defined(MSWINCE) |
518 | CRITICAL_SECTION GC_write_cs; | |
519 | #endif | |
520 | ||
2f5f7a08 | 521 | #ifdef MSWIN32 |
9110a741 | 522 | extern void GC_init_win32 GC_PROTO((void)); |
2f5f7a08 TT |
523 | #endif |
524 | ||
525 | extern void GC_setpagesize(); | |
526 | ||
30c3de1f JS |
527 | |
528 | #ifdef MSWIN32 | |
529 | extern GC_bool GC_no_win32_dlls; | |
530 | #else | |
531 | # define GC_no_win32_dlls FALSE | |
532 | #endif | |
533 | ||
534 | void GC_exit_check GC_PROTO((void)) | |
535 | { | |
536 | GC_gcollect(); | |
537 | } | |
538 | ||
539 | #ifdef SEARCH_FOR_DATA_START | |
540 | extern void GC_init_linux_data_start GC_PROTO((void)); | |
541 | #endif | |
542 | ||
9110a741 BM |
543 | #ifdef UNIX_LIKE |
544 | ||
545 | extern void GC_set_and_save_fault_handler GC_PROTO((void (*handler)(int))); | |
546 | ||
547 | static void looping_handler(sig) | |
548 | int sig; | |
549 | { | |
550 | GC_err_printf1("Caught signal %d: looping in handler\n", sig); | |
551 | for(;;); | |
552 | } | |
9110a741 | 553 | |
30c3de1f JS |
554 | static GC_bool installed_looping_handler = FALSE; |
555 | ||
4109fe85 | 556 | static void maybe_install_looping_handler() |
30c3de1f JS |
557 | { |
558 | /* Install looping handler before the write fault handler, so we */ | |
559 | /* handle write faults correctly. */ | |
560 | if (!installed_looping_handler && 0 != GETENV("GC_LOOP_ON_ABORT")) { | |
561 | GC_set_and_save_fault_handler(looping_handler); | |
562 | installed_looping_handler = TRUE; | |
563 | } | |
564 | } | |
565 | ||
566 | #else /* !UNIX_LIKE */ | |
567 | ||
568 | # define maybe_install_looping_handler() | |
569 | ||
79f777fd BM |
570 | #endif |
571 | ||
2f5f7a08 TT |
572 | void GC_init_inner() |
573 | { | |
9110a741 | 574 | # if !defined(THREADS) && defined(GC_ASSERTIONS) |
2f5f7a08 TT |
575 | word dummy; |
576 | # endif | |
9110a741 | 577 | word initial_heap_sz = (word)MINHINCR; |
2f5f7a08 TT |
578 | |
579 | if (GC_is_initialized) return; | |
20bbd3cd | 580 | # ifdef PRINTSTATS |
9110a741 BM |
581 | GC_print_stats = 1; |
582 | # endif | |
512e32d2 | 583 | # if defined(MSWIN32) || defined(MSWINCE) |
30c3de1f | 584 | InitializeCriticalSection(&GC_write_cs); |
512e32d2 | 585 | # endif |
9110a741 BM |
586 | if (0 != GETENV("GC_PRINT_STATS")) { |
587 | GC_print_stats = 1; | |
588 | } | |
30c3de1f JS |
589 | # ifndef NO_DEBUGGING |
590 | if (0 != GETENV("GC_DUMP_REGULARLY")) { | |
591 | GC_dump_regularly = 1; | |
592 | } | |
4109fe85 BM |
593 | # endif |
594 | # ifdef KEEP_BACK_PTRS | |
595 | { | |
596 | char * backtraces_string = GETENV("GC_BACKTRACES"); | |
597 | if (0 != backtraces_string) { | |
598 | GC_backtraces = atol(backtraces_string); | |
599 | if (backtraces_string[0] == '\0') GC_backtraces = 1; | |
600 | } | |
601 | } | |
30c3de1f | 602 | # endif |
9110a741 BM |
603 | if (0 != GETENV("GC_FIND_LEAK")) { |
604 | GC_find_leak = 1; | |
30c3de1f JS |
605 | # ifdef __STDC__ |
606 | atexit(GC_exit_check); | |
607 | # endif | |
9110a741 BM |
608 | } |
609 | if (0 != GETENV("GC_ALL_INTERIOR_POINTERS")) { | |
610 | GC_all_interior_pointers = 1; | |
611 | } | |
612 | if (0 != GETENV("GC_DONT_GC")) { | |
613 | GC_dont_gc = 1; | |
614 | } | |
79f777fd BM |
615 | if (0 != GETENV("GC_PRINT_BACK_HEIGHT")) { |
616 | GC_print_back_height = 1; | |
617 | } | |
787bf7e3 HB |
618 | if (0 != GETENV("GC_NO_BLACKLIST_WARNING")) { |
619 | GC_large_alloc_warn_interval = LONG_MAX; | |
620 | } | |
79f777fd BM |
621 | { |
622 | char * time_limit_string = GETENV("GC_PAUSE_TIME_TARGET"); | |
623 | if (0 != time_limit_string) { | |
787bf7e3 | 624 | long time_limit = atol(time_limit_string); |
79f777fd BM |
625 | if (time_limit < 5) { |
626 | WARN("GC_PAUSE_TIME_TARGET environment variable value too small " | |
627 | "or bad syntax: Ignoring\n", 0); | |
628 | } else { | |
629 | GC_time_limit = time_limit; | |
630 | } | |
631 | } | |
632 | } | |
787bf7e3 HB |
633 | { |
634 | char * interval_string = GETENV("GC_LARGE_ALLOC_WARN_INTERVAL"); | |
635 | if (0 != interval_string) { | |
636 | long interval = atol(interval_string); | |
637 | if (interval <= 0) { | |
638 | WARN("GC_LARGE_ALLOC_WARN_INTERVAL environment variable has " | |
639 | "bad value: Ignoring\n", 0); | |
640 | } else { | |
641 | GC_large_alloc_warn_interval = interval; | |
642 | } | |
643 | } | |
644 | } | |
30c3de1f | 645 | maybe_install_looping_handler(); |
9110a741 BM |
646 | /* Adjust normal object descriptor for extra allocation. */ |
647 | if (ALIGNMENT > GC_DS_TAGS && EXTRA_BYTES != 0) { | |
648 | GC_obj_kinds[NORMAL].ok_descriptor = ((word)(-ALIGNMENT) | GC_DS_LENGTH); | |
649 | } | |
9110a741 BM |
650 | GC_setpagesize(); |
651 | GC_exclude_static_roots(beginGC_arrays, endGC_arrays); | |
652 | GC_exclude_static_roots(beginGC_obj_kinds, endGC_obj_kinds); | |
653 | # ifdef SEPARATE_GLOBALS | |
654 | GC_exclude_static_roots(beginGC_objfreelist, endGC_objfreelist); | |
655 | GC_exclude_static_roots(beginGC_aobjfreelist, endGC_aobjfreelist); | |
20bbd3cd | 656 | # endif |
2f5f7a08 TT |
657 | # ifdef MSWIN32 |
658 | GC_init_win32(); | |
659 | # endif | |
93002327 | 660 | # if defined(SEARCH_FOR_DATA_START) |
c62b9064 | 661 | GC_init_linux_data_start(); |
139386ba | 662 | # endif |
4c7726b1 | 663 | # if (defined(NETBSD) || defined(OPENBSD)) && defined(__ELF__) |
9110a741 | 664 | GC_init_netbsd_elf(); |
2f5f7a08 | 665 | # endif |
aa44273b HB |
666 | # if defined(GC_PTHREADS) || defined(GC_SOLARIS_THREADS) \ |
667 | || defined(GC_WIN32_THREADS) | |
20bbd3cd | 668 | GC_thr_init(); |
2f5f7a08 | 669 | # endif |
4c7726b1 | 670 | # ifdef GC_SOLARIS_THREADS |
9110a741 BM |
671 | /* We need dirty bits in order to find live stack sections. */ |
672 | GC_dirty_init(); | |
673 | # endif | |
4c7726b1 BM |
674 | # if !defined(THREADS) || defined(GC_PTHREADS) || defined(GC_WIN32_THREADS) \ |
675 | || defined(GC_SOLARIS_THREADS) | |
2f5f7a08 | 676 | if (GC_stackbottom == 0) { |
975147a4 | 677 | # if defined(GC_PTHREADS) && ! defined(GC_SOLARIS_THREADS) |
7ddf92a8 BM |
678 | /* Use thread_stack_base if available, as GC could be initialized from |
679 | a thread that is not the "main" thread. */ | |
680 | GC_stackbottom = GC_get_thread_stack_base(); | |
681 | # endif | |
682 | if (GC_stackbottom == 0) | |
683 | GC_stackbottom = GC_get_stack_base(); | |
4109fe85 | 684 | # if (defined(LINUX) || defined(HPUX)) && defined(IA64) |
9110a741 BM |
685 | GC_register_stackbottom = GC_get_register_stack_base(); |
686 | # endif | |
30c3de1f | 687 | } else { |
4109fe85 | 688 | # if (defined(LINUX) || defined(HPUX)) && defined(IA64) |
30c3de1f JS |
689 | if (GC_register_stackbottom == 0) { |
690 | WARN("GC_register_stackbottom should be set with GC_stackbottom", 0); | |
4109fe85 | 691 | /* The following may fail, since we may rely on */ |
30c3de1f JS |
692 | /* alignment properties that may not hold with a user set */ |
693 | /* GC_stackbottom. */ | |
694 | GC_register_stackbottom = GC_get_register_stack_base(); | |
695 | } | |
696 | # endif | |
2f5f7a08 TT |
697 | } |
698 | # endif | |
30c3de1f JS |
699 | GC_STATIC_ASSERT(sizeof (ptr_t) == sizeof(word)); |
700 | GC_STATIC_ASSERT(sizeof (signed_word) == sizeof(word)); | |
701 | GC_STATIC_ASSERT(sizeof (struct hblk) == HBLKSIZE); | |
2f5f7a08 TT |
702 | # ifndef THREADS |
703 | # if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN) | |
704 | ABORT( | |
705 | "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n"); | |
706 | # endif | |
707 | # if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN) | |
708 | ABORT( | |
709 | "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n"); | |
710 | # endif | |
711 | # ifdef STACK_GROWS_DOWN | |
9110a741 | 712 | GC_ASSERT((word)(&dummy) <= (word)GC_stackbottom); |
2f5f7a08 | 713 | # else |
9110a741 | 714 | GC_ASSERT((word)(&dummy) >= (word)GC_stackbottom); |
2f5f7a08 TT |
715 | # endif |
716 | # endif | |
717 | # if !defined(_AUX_SOURCE) || defined(__GNUC__) | |
9110a741 BM |
718 | GC_ASSERT((word)(-1) > (word)0); |
719 | /* word should be unsigned */ | |
2f5f7a08 | 720 | # endif |
9110a741 | 721 | GC_ASSERT((signed_word)(-1) < (signed_word)0); |
2f5f7a08 TT |
722 | |
723 | /* Add initial guess of root sets. Do this first, since sbrk(0) */ | |
724 | /* might be used. */ | |
ebcc6a7e | 725 | if (GC_REGISTER_MAIN_STATIC_DATA()) GC_register_data_segments(); |
2f5f7a08 TT |
726 | GC_init_headers(); |
727 | GC_bl_init(); | |
728 | GC_mark_init(); | |
9110a741 BM |
729 | { |
730 | char * sz_str = GETENV("GC_INITIAL_HEAP_SIZE"); | |
731 | if (sz_str != NULL) { | |
732 | initial_heap_sz = atoi(sz_str); | |
733 | if (initial_heap_sz <= MINHINCR * HBLKSIZE) { | |
734 | WARN("Bad initial heap size %s - ignoring it.\n", | |
735 | sz_str); | |
736 | } | |
737 | initial_heap_sz = divHBLKSZ(initial_heap_sz); | |
738 | } | |
739 | } | |
30c3de1f JS |
740 | { |
741 | char * sz_str = GETENV("GC_MAXIMUM_HEAP_SIZE"); | |
742 | if (sz_str != NULL) { | |
743 | word max_heap_sz = (word)atol(sz_str); | |
744 | if (max_heap_sz < initial_heap_sz * HBLKSIZE) { | |
745 | WARN("Bad maximum heap size %s - ignoring it.\n", | |
746 | sz_str); | |
747 | } | |
748 | if (0 == GC_max_retries) GC_max_retries = 2; | |
749 | GC_set_max_heap_size(max_heap_sz); | |
750 | } | |
751 | } | |
9110a741 | 752 | if (!GC_expand_hp_inner(initial_heap_sz)) { |
2f5f7a08 TT |
753 | GC_err_printf0("Can't start up: not enough memory\n"); |
754 | EXIT(); | |
755 | } | |
756 | /* Preallocate large object map. It's otherwise inconvenient to */ | |
757 | /* deal with failure. */ | |
758 | if (!GC_add_map_entry((word)0)) { | |
759 | GC_err_printf0("Can't start up: not enough memory\n"); | |
760 | EXIT(); | |
761 | } | |
762 | GC_register_displacement_inner(0L); | |
763 | # ifdef MERGE_SIZES | |
764 | GC_init_size_map(); | |
765 | # endif | |
766 | # ifdef PCR | |
767 | if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever) | |
768 | != PCR_ERes_okay) { | |
769 | ABORT("Can't lock load state\n"); | |
770 | } else if (PCR_IL_Unlock() != PCR_ERes_okay) { | |
771 | ABORT("Can't unlock load state\n"); | |
772 | } | |
773 | PCR_IL_Unlock(); | |
774 | GC_pcr_install(); | |
775 | # endif | |
79f777fd | 776 | # if !defined(SMALL_CONFIG) |
916c46b5 | 777 | if (!GC_no_win32_dlls && 0 != GETENV("GC_ENABLE_INCREMENTAL")) { |
79f777fd BM |
778 | GC_ASSERT(!GC_incremental); |
779 | GC_setpagesize(); | |
780 | # ifndef GC_SOLARIS_THREADS | |
781 | GC_dirty_init(); | |
782 | # endif | |
783 | GC_ASSERT(GC_words_allocd == 0) | |
784 | GC_incremental = TRUE; | |
785 | } | |
786 | # endif /* !SMALL_CONFIG */ | |
30c3de1f | 787 | COND_DUMP; |
4109fe85 | 788 | /* Get black list set up and/or incremental GC started */ |
79f777fd | 789 | if (!GC_dont_precollect || GC_incremental) GC_gcollect_inner(); |
9110a741 | 790 | GC_is_initialized = TRUE; |
2f5f7a08 TT |
791 | # ifdef STUBBORN_ALLOC |
792 | GC_stubborn_init(); | |
793 | # endif | |
2f5f7a08 TT |
794 | /* Convince lint that some things are used */ |
795 | # ifdef LINT | |
796 | { | |
797 | extern char * GC_copyright[]; | |
798 | extern int GC_read(); | |
799 | extern void GC_register_finalizer_no_order(); | |
800 | ||
801 | GC_noop(GC_copyright, GC_find_header, | |
802 | GC_push_one, GC_call_with_alloc_lock, GC_read, | |
803 | GC_dont_expand, | |
804 | # ifndef NO_DEBUGGING | |
805 | GC_dump, | |
806 | # endif | |
807 | GC_register_finalizer_no_order); | |
808 | } | |
809 | # endif | |
810 | } | |
811 | ||
812 | void GC_enable_incremental GC_PROTO(()) | |
813 | { | |
54f28c21 BM |
814 | # if !defined(SMALL_CONFIG) && !defined(KEEP_BACK_PTRS) |
815 | /* If we are keeping back pointers, the GC itself dirties all */ | |
816 | /* pages on which objects have been marked, making */ | |
817 | /* incremental GC pointless. */ | |
20bbd3cd | 818 | if (!GC_find_leak) { |
2f5f7a08 TT |
819 | DCL_LOCK_STATE; |
820 | ||
2f5f7a08 TT |
821 | DISABLE_SIGNALS(); |
822 | LOCK(); | |
823 | if (GC_incremental) goto out; | |
824 | GC_setpagesize(); | |
916c46b5 | 825 | if (GC_no_win32_dlls) goto out; |
30c3de1f JS |
826 | # ifndef GC_SOLARIS_THREADS |
827 | maybe_install_looping_handler(); /* Before write fault handler! */ | |
828 | GC_dirty_init(); | |
2f5f7a08 TT |
829 | # endif |
830 | if (!GC_is_initialized) { | |
831 | GC_init_inner(); | |
832 | } | |
79f777fd | 833 | if (GC_incremental) goto out; |
2f5f7a08 TT |
834 | if (GC_dont_gc) { |
835 | /* Can't easily do it. */ | |
836 | UNLOCK(); | |
837 | ENABLE_SIGNALS(); | |
838 | return; | |
839 | } | |
840 | if (GC_words_allocd > 0) { | |
841 | /* There may be unmarked reachable objects */ | |
842 | GC_gcollect_inner(); | |
843 | } /* else we're OK in assuming everything's */ | |
844 | /* clean since nothing can point to an */ | |
845 | /* unmarked object. */ | |
846 | GC_read_dirty(); | |
847 | GC_incremental = TRUE; | |
848 | out: | |
849 | UNLOCK(); | |
850 | ENABLE_SIGNALS(); | |
20bbd3cd | 851 | } |
2f5f7a08 TT |
852 | # endif |
853 | } | |
854 | ||
855 | ||
9110a741 BM |
856 | #if defined(MSWIN32) || defined(MSWINCE) |
857 | # define LOG_FILE _T("gc.log") | |
2f5f7a08 | 858 | |
9110a741 | 859 | HANDLE GC_stdout = 0; |
2f5f7a08 | 860 | |
9110a741 | 861 | void GC_deinit() |
2f5f7a08 | 862 | { |
9110a741 BM |
863 | if (GC_is_initialized) { |
864 | DeleteCriticalSection(&GC_write_cs); | |
865 | } | |
866 | } | |
867 | ||
868 | int GC_write(buf, len) | |
5a2586cf | 869 | GC_CONST char * buf; |
9110a741 BM |
870 | size_t len; |
871 | { | |
872 | BOOL tmp; | |
873 | DWORD written; | |
874 | if (len == 0) | |
875 | return 0; | |
876 | EnterCriticalSection(&GC_write_cs); | |
877 | if (GC_stdout == INVALID_HANDLE_VALUE) { | |
878 | return -1; | |
879 | } else if (GC_stdout == 0) { | |
880 | GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE, | |
881 | FILE_SHARE_READ | FILE_SHARE_WRITE, | |
882 | NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH, | |
883 | NULL); | |
884 | if (GC_stdout == INVALID_HANDLE_VALUE) ABORT("Open of log file failed"); | |
885 | } | |
886 | tmp = WriteFile(GC_stdout, buf, len, &written, NULL); | |
887 | if (!tmp) | |
888 | DebugBreak(); | |
889 | LeaveCriticalSection(&GC_write_cs); | |
890 | return tmp ? (int)written : -1; | |
2f5f7a08 TT |
891 | } |
892 | ||
893 | #endif | |
894 | ||
895 | #if defined(OS2) || defined(MACOS) | |
896 | FILE * GC_stdout = NULL; | |
897 | FILE * GC_stderr = NULL; | |
898 | int GC_tmp; /* Should really be local ... */ | |
899 | ||
900 | void GC_set_files() | |
901 | { | |
902 | if (GC_stdout == NULL) { | |
903 | GC_stdout = stdout; | |
904 | } | |
905 | if (GC_stderr == NULL) { | |
906 | GC_stderr = stderr; | |
907 | } | |
908 | } | |
909 | #endif | |
910 | ||
9110a741 | 911 | #if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32) && !defined(MSWINCE) |
2f5f7a08 TT |
912 | int GC_stdout = 1; |
913 | int GC_stderr = 2; | |
914 | # if !defined(AMIGA) | |
915 | # include <unistd.h> | |
916 | # endif | |
917 | #endif | |
918 | ||
b6459d9a AG |
919 | #if !defined(MSWIN32) && !defined(MSWINCE) && !defined(OS2) \ |
920 | && !defined(MACOS) && !defined(ECOS) && !defined(NOSYS) | |
2f5f7a08 TT |
921 | int GC_write(fd, buf, len) |
922 | int fd; | |
5a2586cf | 923 | GC_CONST char *buf; |
2f5f7a08 TT |
924 | size_t len; |
925 | { | |
926 | register int bytes_written = 0; | |
927 | register int result; | |
928 | ||
929 | while (bytes_written < len) { | |
4c7726b1 | 930 | # ifdef GC_SOLARIS_THREADS |
2f5f7a08 TT |
931 | result = syscall(SYS_write, fd, buf + bytes_written, |
932 | len - bytes_written); | |
933 | # else | |
934 | result = write(fd, buf + bytes_written, len - bytes_written); | |
935 | # endif | |
936 | if (-1 == result) return(result); | |
937 | bytes_written += result; | |
938 | } | |
939 | return(bytes_written); | |
940 | } | |
941 | #endif /* UN*X */ | |
942 | ||
b6459d9a | 943 | #ifdef ECOS |
1530be84 TT |
944 | int GC_write(fd, buf, len) |
945 | { | |
946 | _Jv_diag_write (buf, len); | |
947 | return len; | |
948 | } | |
949 | #endif | |
950 | ||
b6459d9a AG |
951 | #ifdef NOSYS |
952 | int GC_write(fd, buf, len) | |
953 | { | |
954 | /* No writing. */ | |
955 | return len; | |
956 | } | |
957 | #endif | |
958 | ||
1530be84 | 959 | |
9110a741 BM |
960 | #if defined(MSWIN32) || defined(MSWINCE) |
961 | # define WRITE(f, buf, len) GC_write(buf, len) | |
2f5f7a08 TT |
962 | #else |
963 | # if defined(OS2) || defined(MACOS) | |
964 | # define WRITE(f, buf, len) (GC_set_files(), \ | |
965 | GC_tmp = fwrite((buf), 1, (len), (f)), \ | |
966 | fflush(f), GC_tmp) | |
967 | # else | |
968 | # define WRITE(f, buf, len) GC_write((f), (buf), (len)) | |
969 | # endif | |
970 | #endif | |
971 | ||
972 | /* A version of printf that is unlikely to call malloc, and is thus safer */ | |
973 | /* to call from the collector in case malloc has been bound to GC_malloc. */ | |
974 | /* Assumes that no more than 1023 characters are written at once. */ | |
975 | /* Assumes that all arguments have been converted to something of the */ | |
976 | /* same size as long, and that the format conversions expect something */ | |
977 | /* of that size. */ | |
978 | void GC_printf(format, a, b, c, d, e, f) | |
9110a741 | 979 | GC_CONST char * format; |
2f5f7a08 TT |
980 | long a, b, c, d, e, f; |
981 | { | |
982 | char buf[1025]; | |
983 | ||
984 | if (GC_quiet) return; | |
985 | buf[1024] = 0x15; | |
986 | (void) sprintf(buf, format, a, b, c, d, e, f); | |
987 | if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack"); | |
988 | if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed"); | |
989 | } | |
990 | ||
991 | void GC_err_printf(format, a, b, c, d, e, f) | |
9110a741 | 992 | GC_CONST char * format; |
2f5f7a08 TT |
993 | long a, b, c, d, e, f; |
994 | { | |
995 | char buf[1025]; | |
996 | ||
997 | buf[1024] = 0x15; | |
998 | (void) sprintf(buf, format, a, b, c, d, e, f); | |
999 | if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack"); | |
1000 | if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed"); | |
1001 | } | |
1002 | ||
1003 | void GC_err_puts(s) | |
9110a741 | 1004 | GC_CONST char *s; |
2f5f7a08 TT |
1005 | { |
1006 | if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed"); | |
1007 | } | |
1008 | ||
9110a741 BM |
1009 | #if defined(LINUX) && !defined(SMALL_CONFIG) |
1010 | void GC_err_write(buf, len) | |
1011 | GC_CONST char *buf; | |
1012 | size_t len; | |
1013 | { | |
1014 | if (WRITE(GC_stderr, buf, len) < 0) ABORT("write to stderr failed"); | |
1015 | } | |
1016 | #endif | |
1017 | ||
2f5f7a08 TT |
1018 | # if defined(__STDC__) || defined(__cplusplus) |
1019 | void GC_default_warn_proc(char *msg, GC_word arg) | |
1020 | # else | |
1021 | void GC_default_warn_proc(msg, arg) | |
1022 | char *msg; | |
1023 | GC_word arg; | |
1024 | # endif | |
1025 | { | |
1026 | GC_err_printf1(msg, (unsigned long)arg); | |
1027 | } | |
1028 | ||
1029 | GC_warn_proc GC_current_warn_proc = GC_default_warn_proc; | |
1030 | ||
1031 | # if defined(__STDC__) || defined(__cplusplus) | |
1032 | GC_warn_proc GC_set_warn_proc(GC_warn_proc p) | |
1033 | # else | |
1034 | GC_warn_proc GC_set_warn_proc(p) | |
1035 | GC_warn_proc p; | |
1036 | # endif | |
1037 | { | |
1038 | GC_warn_proc result; | |
1039 | ||
aa44273b HB |
1040 | # ifdef GC_WIN32_THREADS |
1041 | GC_ASSERT(GC_is_initialized); | |
1042 | # endif | |
2f5f7a08 TT |
1043 | LOCK(); |
1044 | result = GC_current_warn_proc; | |
1045 | GC_current_warn_proc = p; | |
1046 | UNLOCK(); | |
1047 | return(result); | |
1048 | } | |
1049 | ||
30c3de1f JS |
1050 | # if defined(__STDC__) || defined(__cplusplus) |
1051 | GC_word GC_set_free_space_divisor (GC_word value) | |
1052 | # else | |
1053 | GC_word GC_set_free_space_divisor (value) | |
1054 | GC_word value; | |
1055 | # endif | |
1056 | { | |
1057 | GC_word old = GC_free_space_divisor; | |
1058 | GC_free_space_divisor = value; | |
1059 | return old; | |
1060 | } | |
2f5f7a08 TT |
1061 | |
1062 | #ifndef PCR | |
1063 | void GC_abort(msg) | |
9110a741 | 1064 | GC_CONST char * msg; |
2f5f7a08 | 1065 | { |
9110a741 BM |
1066 | # if defined(MSWIN32) |
1067 | (void) MessageBoxA(NULL, msg, "Fatal error in gc", MB_ICONERROR|MB_OK); | |
9110a741 BM |
1068 | # else |
1069 | GC_err_printf1("%s\n", msg); | |
1070 | # endif | |
1071 | if (GETENV("GC_LOOP_ON_ABORT") != NULL) { | |
1072 | /* In many cases it's easier to debug a running process. */ | |
1073 | /* It's arguably nicer to sleep, but that makes it harder */ | |
1074 | /* to look at the thread if the debugger doesn't know much */ | |
1075 | /* about threads. */ | |
5a2586cf | 1076 | for(;;) {} |
9110a741 | 1077 | } |
4109fe85 | 1078 | # if defined(MSWIN32) || defined(MSWINCE) |
9110a741 BM |
1079 | DebugBreak(); |
1080 | # else | |
1081 | (void) abort(); | |
1082 | # endif | |
2f5f7a08 TT |
1083 | } |
1084 | #endif | |
1085 | ||
2f5f7a08 TT |
1086 | void GC_enable() |
1087 | { | |
30c3de1f | 1088 | LOCK(); |
2f5f7a08 | 1089 | GC_dont_gc--; |
30c3de1f | 1090 | UNLOCK(); |
2f5f7a08 TT |
1091 | } |
1092 | ||
1093 | void GC_disable() | |
1094 | { | |
30c3de1f | 1095 | LOCK(); |
2f5f7a08 | 1096 | GC_dont_gc++; |
30c3de1f | 1097 | UNLOCK(); |
2f5f7a08 | 1098 | } |
2f5f7a08 | 1099 | |
4109fe85 BM |
1100 | /* Helper procedures for new kind creation. */ |
1101 | void ** GC_new_free_list_inner() | |
1102 | { | |
1103 | void *result = GC_INTERNAL_MALLOC((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE); | |
1104 | if (result == 0) ABORT("Failed to allocate freelist for new kind"); | |
1105 | BZERO(result, (MAXOBJSZ+1)*sizeof(ptr_t)); | |
1106 | return result; | |
1107 | } | |
1108 | ||
1109 | void ** GC_new_free_list() | |
1110 | { | |
1111 | void *result; | |
1112 | LOCK(); DISABLE_SIGNALS(); | |
1113 | result = GC_new_free_list_inner(); | |
1114 | UNLOCK(); ENABLE_SIGNALS(); | |
1115 | return result; | |
1116 | } | |
1117 | ||
1118 | int GC_new_kind_inner(fl, descr, adjust, clear) | |
1119 | void **fl; | |
1120 | GC_word descr; | |
1121 | int adjust; | |
1122 | int clear; | |
1123 | { | |
1124 | int result = GC_n_kinds++; | |
1125 | ||
1126 | if (GC_n_kinds > MAXOBJKINDS) ABORT("Too many kinds"); | |
1127 | GC_obj_kinds[result].ok_freelist = (ptr_t *)fl; | |
1128 | GC_obj_kinds[result].ok_reclaim_list = 0; | |
1129 | GC_obj_kinds[result].ok_descriptor = descr; | |
1130 | GC_obj_kinds[result].ok_relocate_descr = adjust; | |
1131 | GC_obj_kinds[result].ok_init = clear; | |
1132 | return result; | |
1133 | } | |
1134 | ||
1135 | int GC_new_kind(fl, descr, adjust, clear) | |
1136 | void **fl; | |
1137 | GC_word descr; | |
1138 | int adjust; | |
1139 | int clear; | |
1140 | { | |
1141 | int result; | |
1142 | LOCK(); DISABLE_SIGNALS(); | |
1143 | result = GC_new_kind_inner(fl, descr, adjust, clear); | |
1144 | UNLOCK(); ENABLE_SIGNALS(); | |
1145 | return result; | |
1146 | } | |
1147 | ||
1148 | int GC_new_proc_inner(proc) | |
1149 | GC_mark_proc proc; | |
1150 | { | |
1151 | int result = GC_n_mark_procs++; | |
1152 | ||
1153 | if (GC_n_mark_procs > MAX_MARK_PROCS) ABORT("Too many mark procedures"); | |
1154 | GC_mark_procs[result] = proc; | |
1155 | return result; | |
1156 | } | |
1157 | ||
1158 | int GC_new_proc(proc) | |
1159 | GC_mark_proc proc; | |
1160 | { | |
1161 | int result; | |
1162 | LOCK(); DISABLE_SIGNALS(); | |
1163 | result = GC_new_proc_inner(proc); | |
1164 | UNLOCK(); ENABLE_SIGNALS(); | |
1165 | return result; | |
1166 | } | |
1167 | ||
1168 | ||
2f5f7a08 TT |
1169 | #if !defined(NO_DEBUGGING) |
1170 | ||
1171 | void GC_dump() | |
1172 | { | |
1173 | GC_printf0("***Static roots:\n"); | |
1174 | GC_print_static_roots(); | |
1175 | GC_printf0("\n***Heap sections:\n"); | |
1176 | GC_print_heap_sects(); | |
1177 | GC_printf0("\n***Free blocks:\n"); | |
1178 | GC_print_hblkfreelist(); | |
1179 | GC_printf0("\n***Blocks in use:\n"); | |
1180 | GC_print_block_list(); | |
30c3de1f JS |
1181 | GC_printf0("\n***Finalization statistics:\n"); |
1182 | GC_print_finalization_stats(); | |
2f5f7a08 TT |
1183 | } |
1184 | ||
9110a741 | 1185 | #endif /* NO_DEBUGGING */ |