boehm-gc: revert all CACAO-specific modifications; this is now an exact copy of the...
[cacao.git] / src / mm / boehm-gc / allchblk.c
1 /* 
2  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
3  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
4  * Copyright (c) 1998-1999 by Silicon Graphics.  All rights reserved.
5  * Copyright (c) 1999 by Hewlett-Packard Company. All rights reserved.
6  *
7  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
8  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
9  *
10  * Permission is hereby granted to use or copy this program
11  * for any purpose,  provided the above notices are retained on all copies.
12  * Permission to modify the code and to distribute modified code is granted,
13  * provided the above notices are retained, and a notice that the code was
14  * modified is included with the above copyright notice.
15  */
16
17 /* #define DEBUG */
18 #include <stdio.h>
19 #include "private/gc_priv.h"
20
21 GC_bool GC_use_entire_heap = 0;
22
23 /*
24  * Free heap blocks are kept on one of several free lists,
25  * depending on the size of the block.  Each free list is doubly linked.
26  * Adjacent free blocks are coalesced.
27  */
28
29  
30 # define MAX_BLACK_LIST_ALLOC (2*HBLKSIZE)
31                 /* largest block we will allocate starting on a black   */
32                 /* listed block.  Must be >= HBLKSIZE.                  */
33
34
35 # define UNIQUE_THRESHOLD 32
36         /* Sizes up to this many HBLKs each have their own free list    */
37 # define HUGE_THRESHOLD 256
38         /* Sizes of at least this many heap blocks are mapped to a      */
39         /* single free list.                                            */
40 # define FL_COMPRESSION 8
41         /* In between sizes map this many distinct sizes to a single    */
42         /* bin.                                                         */
43
44 # define N_HBLK_FLS (HUGE_THRESHOLD - UNIQUE_THRESHOLD)/FL_COMPRESSION \
45                                  + UNIQUE_THRESHOLD
46
47 struct hblk * GC_hblkfreelist[N_HBLK_FLS+1] = { 0 };
48
49 #ifndef USE_MUNMAP
50
51   STATIC word GC_free_bytes[N_HBLK_FLS+1] = { 0 };
52         /* Number of free bytes on each list.   */
53
54   /* Return the largest n such that                                     */
55   /* Is GC_large_allocd_bytes + the number of free bytes on lists       */
56   /* n .. N_HBLK_FLS > GC_max_large_allocd_bytes.                       */
57   /* If there is no such n, return 0.                                   */
58 # ifdef __GNUC__
59   __inline__
60 # endif
61   static int GC_enough_large_bytes_left(void)
62   {
63     int n;
64     word bytes = GC_large_allocd_bytes;
65
66     GC_ASSERT(GC_max_large_allocd_bytes <= GC_heapsize);
67     for (n = N_HBLK_FLS; n >= 0; --n) {
68         bytes += GC_free_bytes[n];
69         if (bytes >= GC_max_large_allocd_bytes) return n;
70     }
71     return 0;
72   }
73
74 # define INCR_FREE_BYTES(n, b) GC_free_bytes[n] += (b);
75
76 # define FREE_ASSERT(e) GC_ASSERT(e)
77
78 #else /* USE_MUNMAP */
79
80 # define INCR_FREE_BYTES(n, b)
81 # define FREE_ASSERT(e)
82
83 #endif /* USE_MUNMAP */
84
85 /* Map a number of blocks to the appropriate large block free list index. */
86 STATIC int GC_hblk_fl_from_blocks(word blocks_needed)
87 {
88     if (blocks_needed <= UNIQUE_THRESHOLD) return (int)blocks_needed;
89     if (blocks_needed >= HUGE_THRESHOLD) return N_HBLK_FLS;
90     return (int)(blocks_needed - UNIQUE_THRESHOLD)/FL_COMPRESSION
91                                         + UNIQUE_THRESHOLD;
92     
93 }
94
95 # define PHDR(hhdr) HDR(hhdr -> hb_prev)
96 # define NHDR(hhdr) HDR(hhdr -> hb_next)
97
98 # ifdef USE_MUNMAP
99 #   define IS_MAPPED(hhdr) (((hhdr) -> hb_flags & WAS_UNMAPPED) == 0)
100 # else  /* !USE_MUNMAP */
101 #   define IS_MAPPED(hhdr) 1
102 # endif /* USE_MUNMAP */
103
104 # if !defined(NO_DEBUGGING)
105 void GC_print_hblkfreelist(void)
106 {
107     struct hblk * h;
108     word total_free = 0;
109     hdr * hhdr;
110     word sz;
111     unsigned i;
112     
113     for (i = 0; i <= N_HBLK_FLS; ++i) {
114       h = GC_hblkfreelist[i];
115 #     ifdef USE_MUNMAP
116         if (0 != h) GC_printf("Free list %u:\n", i);
117 #     else
118         if (0 != h) GC_printf("Free list %u (Total size %lu):\n",
119                               i, (unsigned long)GC_free_bytes[i]);
120 #     endif
121       while (h != 0) {
122         hhdr = HDR(h);
123         sz = hhdr -> hb_sz;
124         total_free += sz;
125         GC_printf("\t%p size %lu %s black listed\n", h, (unsigned long)sz, 
126                 GC_is_black_listed(h, HBLKSIZE) != 0 ? "start" :
127                 GC_is_black_listed(h, hhdr -> hb_sz) != 0 ? "partially" :
128                                                         "not");
129         h = hhdr -> hb_next;
130       }
131     }
132 #   ifndef USE_MUNMAP
133       if (total_free != GC_large_free_bytes) {
134         GC_printf("GC_large_free_bytes = %lu (INCONSISTENT!!)\n",
135                   (unsigned long) GC_large_free_bytes);
136       }
137 #   endif
138     GC_printf("Total of %lu bytes on free list\n", (unsigned long)total_free);
139 }
140
141 /* Return the free list index on which the block described by the header */
142 /* appears, or -1 if it appears nowhere.                                 */
143 static int free_list_index_of(hdr *wanted)
144 {
145     struct hblk * h;
146     hdr * hhdr;
147     int i;
148     
149     for (i = 0; i <= N_HBLK_FLS; ++i) {
150       h = GC_hblkfreelist[i];
151       while (h != 0) {
152         hhdr = HDR(h);
153         if (hhdr == wanted) return i;
154         h = hhdr -> hb_next;
155       }
156     }
157     return -1;
158 }
159
160 void GC_dump_regions(void)
161 {
162     unsigned i;
163     ptr_t start, end;
164     ptr_t p;
165     size_t bytes;
166     hdr *hhdr;
167     for (i = 0; i < GC_n_heap_sects; ++i) {
168         start = GC_heap_sects[i].hs_start;
169         bytes = GC_heap_sects[i].hs_bytes;
170         end = start + bytes;
171         /* Merge in contiguous sections.        */
172           while (i+1 < GC_n_heap_sects && GC_heap_sects[i+1].hs_start == end) {
173             ++i;
174             end = GC_heap_sects[i].hs_start + GC_heap_sects[i].hs_bytes;
175           }
176         GC_printf("***Section from %p to %p\n", start, end);
177         for (p = start; p < end;) {
178             hhdr = HDR(p);
179             if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
180                 GC_printf("\t%p Missing header!!(%p)\n", p, hhdr);
181                 p += HBLKSIZE;
182                 continue;
183             }
184             if (HBLK_IS_FREE(hhdr)) {
185                 int correct_index = GC_hblk_fl_from_blocks(
186                                         divHBLKSZ(hhdr -> hb_sz));
187                 int actual_index;
188                 
189                 GC_printf("\t%p\tfree block of size 0x%lx bytes%s\n", p,
190                           (unsigned long)(hhdr -> hb_sz),
191                           IS_MAPPED(hhdr) ? "" : " (unmapped)");
192                 actual_index = free_list_index_of(hhdr);
193                 if (-1 == actual_index) {
194                     GC_printf("\t\tBlock not on free list %d!!\n",
195                               correct_index);
196                 } else if (correct_index != actual_index) {
197                     GC_printf("\t\tBlock on list %d, should be on %d!!\n",
198                               actual_index, correct_index);
199                 }
200                 p += hhdr -> hb_sz;
201             } else {
202                 GC_printf("\t%p\tused for blocks of size 0x%lx bytes\n", p,
203                           (unsigned long)(hhdr -> hb_sz));
204                 p += HBLKSIZE * OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz);
205             }
206         }
207     }
208 }
209
210 # endif /* NO_DEBUGGING */
211
212 /* Initialize hdr for a block containing the indicated size and         */
213 /* kind of objects.                                                     */
214 /* Return FALSE on failure.                                             */
215 static GC_bool setup_header(hdr * hhdr, struct hblk *block, size_t byte_sz,
216                             int kind, unsigned flags)
217 {
218     word descr;
219 #   ifndef MARK_BIT_PER_OBJ
220       size_t granules;
221 #   endif
222     
223     /* Set size, kind and mark proc fields */
224       hhdr -> hb_sz = byte_sz;
225       hhdr -> hb_obj_kind = (unsigned char)kind;
226       hhdr -> hb_flags = (unsigned char)flags;
227       hhdr -> hb_block = block;
228       descr = GC_obj_kinds[kind].ok_descriptor;
229       if (GC_obj_kinds[kind].ok_relocate_descr) descr += byte_sz;
230       hhdr -> hb_descr = descr;
231     
232 #   ifdef MARK_BIT_PER_OBJ
233      /* Set hb_inv_sz as portably as possible.                          */
234      /* We set it to the smallest value such that sz * inv_sz > 2**32    */
235      /* This may be more precision than necessary.                      */
236       if (byte_sz > MAXOBJBYTES) {
237          hhdr -> hb_inv_sz = LARGE_INV_SZ;
238       } else {
239         word inv_sz;
240
241 #       if CPP_WORDSZ == 64
242           inv_sz = ((word)1 << 32)/byte_sz;
243           if (((inv_sz*byte_sz) >> 32) == 0) ++inv_sz;
244 #       else  /* 32 bit words */
245           GC_ASSERT(byte_sz >= 4);
246           inv_sz = ((unsigned)1 << 31)/byte_sz;
247           inv_sz *= 2;
248           while (inv_sz*byte_sz > byte_sz) ++inv_sz;
249 #       endif
250         hhdr -> hb_inv_sz = inv_sz;
251       }
252 #   else /* MARK_BIT_PER_GRANULE */
253       hhdr -> hb_large_block = (unsigned char)(byte_sz > MAXOBJBYTES);
254       granules = BYTES_TO_GRANULES(byte_sz);
255       if (EXPECT(!GC_add_map_entry(granules), FALSE)) {
256         /* Make it look like a valid block. */
257         hhdr -> hb_sz = HBLKSIZE;
258         hhdr -> hb_descr = 0;
259         hhdr -> hb_large_block = TRUE;
260         hhdr -> hb_map = 0;
261         return FALSE;
262       } else {
263         size_t index = (hhdr -> hb_large_block? 0 : granules);
264         hhdr -> hb_map = GC_obj_map[index];
265       }
266 #   endif /* MARK_BIT_PER_GRANULE */
267       
268     /* Clear mark bits */
269       GC_clear_hdr_marks(hhdr);
270       
271     hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
272     return(TRUE);
273 }
274
275 #define FL_UNKNOWN -1
276 /*
277  * Remove hhdr from the appropriate free list.
278  * We assume it is on the nth free list, or on the size
279  * appropriate free list if n is FL_UNKNOWN.
280  */
281 STATIC void GC_remove_from_fl(hdr *hhdr, int n)
282 {
283     int index;
284
285     GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
286 #   ifndef USE_MUNMAP
287       /* We always need index to mainatin free counts.  */
288       if (FL_UNKNOWN == n) {
289           index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
290       } else {
291           index = n;
292       }
293 #   endif
294     if (hhdr -> hb_prev == 0) {
295 #       ifdef USE_MUNMAP
296           if (FL_UNKNOWN == n) {
297             index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
298           } else {
299             index = n;
300           }
301 #       endif
302         GC_ASSERT(HDR(GC_hblkfreelist[index]) == hhdr);
303         GC_hblkfreelist[index] = hhdr -> hb_next;
304     } else {
305         hdr *phdr;
306         GET_HDR(hhdr -> hb_prev, phdr);
307         phdr -> hb_next = hhdr -> hb_next;
308     }
309     FREE_ASSERT(GC_free_bytes[index] >= hhdr -> hb_sz);
310     INCR_FREE_BYTES(index, - (signed_word)(hhdr -> hb_sz));
311     if (0 != hhdr -> hb_next) {
312         hdr * nhdr;
313         GC_ASSERT(!IS_FORWARDING_ADDR_OR_NIL(NHDR(hhdr)));
314         GET_HDR(hhdr -> hb_next, nhdr);
315         nhdr -> hb_prev = hhdr -> hb_prev;
316     }
317 }
318
319 /*
320  * Return a pointer to the free block ending just before h, if any.
321  */
322 STATIC struct hblk * GC_free_block_ending_at(struct hblk *h)
323 {
324     struct hblk * p = h - 1;
325     hdr * phdr;
326
327     GET_HDR(p, phdr);
328     while (0 != phdr && IS_FORWARDING_ADDR_OR_NIL(phdr)) {
329         p = FORWARDED_ADDR(p,phdr);
330         phdr = HDR(p);
331     }
332     if (0 != phdr) {
333         if(HBLK_IS_FREE(phdr)) {
334             return p;
335         } else {
336             return 0;
337         }
338     }
339     p = GC_prev_block(h - 1);
340     if (0 != p) {
341       phdr = HDR(p);
342       if (HBLK_IS_FREE(phdr) && (ptr_t)p + phdr -> hb_sz == (ptr_t)h) {
343         return p;
344       }
345     }
346     return 0;
347 }
348
349 /*
350  * Add hhdr to the appropriate free list.
351  * We maintain individual free lists sorted by address.
352  */
353 STATIC void GC_add_to_fl(struct hblk *h, hdr *hhdr)
354 {
355     int index = GC_hblk_fl_from_blocks(divHBLKSZ(hhdr -> hb_sz));
356     struct hblk *second = GC_hblkfreelist[index];
357     hdr * second_hdr;
358 #   if defined(GC_ASSERTIONS) && !defined(USE_MUNMAP)
359       struct hblk *next = (struct hblk *)((word)h + hhdr -> hb_sz);
360       hdr * nexthdr = HDR(next);
361       struct hblk *prev = GC_free_block_ending_at(h);
362       hdr * prevhdr = HDR(prev);
363       GC_ASSERT(nexthdr == 0 || !HBLK_IS_FREE(nexthdr)
364                 || (signed_word)GC_heapsize < 0);
365                 /* In the last case, blocks may be too large to merge. */
366       GC_ASSERT(prev == 0 || !HBLK_IS_FREE(prevhdr)
367                 || (signed_word)GC_heapsize < 0);
368 #   endif
369     GC_ASSERT(((hhdr -> hb_sz) & (HBLKSIZE-1)) == 0);
370     GC_hblkfreelist[index] = h;
371     INCR_FREE_BYTES(index, hhdr -> hb_sz);
372     FREE_ASSERT(GC_free_bytes[index] <= GC_large_free_bytes)
373     hhdr -> hb_next = second;
374     hhdr -> hb_prev = 0;
375     if (0 != second) {
376       GET_HDR(second, second_hdr);
377       second_hdr -> hb_prev = h;
378     }
379     hhdr -> hb_flags |= FREE_BLK;
380 }
381
382 #ifdef USE_MUNMAP
383
384 /* Unmap blocks that haven't been recently touched.  This is the only way */
385 /* way blocks are ever unmapped.                                          */
386 void GC_unmap_old(void)
387 {
388     struct hblk * h;
389     hdr * hhdr;
390     word sz;
391     unsigned short last_rec, threshold;
392     int i;
393 #   ifndef MUNMAP_THRESHOLD
394 #     define MUNMAP_THRESHOLD 6
395 #   endif
396     
397     for (i = 0; i <= N_HBLK_FLS; ++i) {
398       for (h = GC_hblkfreelist[i]; 0 != h; h = hhdr -> hb_next) {
399         hhdr = HDR(h);
400         if (!IS_MAPPED(hhdr)) continue;
401         threshold = (unsigned short)(GC_gc_no - MUNMAP_THRESHOLD);
402         last_rec = hhdr -> hb_last_reclaimed;
403         if ((last_rec > GC_gc_no || last_rec < threshold)
404             && threshold < GC_gc_no /* not recently wrapped */) {
405           sz = hhdr -> hb_sz;
406           GC_unmap((ptr_t)h, sz);
407           hhdr -> hb_flags |= WAS_UNMAPPED;
408         }
409       }
410     }  
411 }
412
413 /* Merge all unmapped blocks that are adjacent to other free            */
414 /* blocks.  This may involve remapping, since all blocks are either     */
415 /* fully mapped or fully unmapped.                                      */
416 void GC_merge_unmapped(void)
417 {
418     struct hblk * h, *next;
419     hdr * hhdr, *nexthdr;
420     word size, nextsize;
421     int i;
422     
423     for (i = 0; i <= N_HBLK_FLS; ++i) {
424       h = GC_hblkfreelist[i];
425       while (h != 0) {
426         GET_HDR(h, hhdr);
427         size = hhdr->hb_sz;
428         next = (struct hblk *)((word)h + size);
429         GET_HDR(next, nexthdr);
430         /* Coalesce with successor, if possible */
431           if (0 != nexthdr && HBLK_IS_FREE(nexthdr)
432               && (signed_word) (size + (nextsize = nexthdr->hb_sz)) > 0
433                  /* no pot. overflow */) {
434             /* Note that we usually try to avoid adjacent free blocks   */
435             /* that are either both mapped or both unmapped.  But that  */
436             /* isn't guaranteed to hold since we remap blocks when we   */
437             /* split them, and don't merge at that point.  It may also  */
438             /* not hold if the merged block would be too big.           */
439             if (IS_MAPPED(hhdr) && !IS_MAPPED(nexthdr)) {
440               /* make both consistent, so that we can merge */
441                 if (size > nextsize) {
442                   GC_remap((ptr_t)next, nextsize);
443                 } else {
444                   GC_unmap((ptr_t)h, size);
445                   GC_unmap_gap((ptr_t)h, size, (ptr_t)next, nextsize);
446                   hhdr -> hb_flags |= WAS_UNMAPPED;
447                 }
448             } else if (IS_MAPPED(nexthdr) && !IS_MAPPED(hhdr)) {
449               if (size > nextsize) {
450                 GC_unmap((ptr_t)next, nextsize);
451                 GC_unmap_gap((ptr_t)h, size, (ptr_t)next, nextsize);
452               } else {
453                 GC_remap((ptr_t)h, size);
454                 hhdr -> hb_flags &= ~WAS_UNMAPPED;
455                 hhdr -> hb_last_reclaimed = nexthdr -> hb_last_reclaimed;
456               }
457             } else if (!IS_MAPPED(hhdr) && !IS_MAPPED(nexthdr)) {
458               /* Unmap any gap in the middle */
459                 GC_unmap_gap((ptr_t)h, size, (ptr_t)next, nextsize);
460             }
461             /* If they are both unmapped, we merge, but leave unmapped. */
462             GC_remove_from_fl(hhdr, i);
463             GC_remove_from_fl(nexthdr, FL_UNKNOWN);
464             hhdr -> hb_sz += nexthdr -> hb_sz; 
465             GC_remove_header(next);
466             GC_add_to_fl(h, hhdr); 
467             /* Start over at beginning of list */
468             h = GC_hblkfreelist[i];
469           } else /* not mergable with successor */ {
470             h = hhdr -> hb_next;
471           }
472       } /* while (h != 0) ... */
473     } /* for ... */
474 }
475
476 #endif /* USE_MUNMAP */
477
478 /*
479  * Return a pointer to a block starting at h of length bytes.
480  * Memory for the block is mapped.
481  * Remove the block from its free list, and return the remainder (if any)
482  * to its appropriate free list.
483  * May fail by returning 0.
484  * The header for the returned block must be set up by the caller.
485  * If the return value is not 0, then hhdr is the header for it.
486  */
487 STATIC struct hblk * GC_get_first_part(struct hblk *h, hdr *hhdr,
488                                        size_t bytes, int index)
489 {
490     word total_size = hhdr -> hb_sz;
491     struct hblk * rest;
492     hdr * rest_hdr;
493
494     GC_ASSERT((total_size & (HBLKSIZE-1)) == 0);
495     GC_remove_from_fl(hhdr, index);
496     if (total_size == bytes) return h;
497     rest = (struct hblk *)((word)h + bytes);
498     rest_hdr = GC_install_header(rest);
499     if (0 == rest_hdr) {
500         /* FIXME: This is likely to be very bad news ... */
501         WARN("Header allocation failed: Dropping block.\n", 0);
502         return(0);
503     }
504     rest_hdr -> hb_sz = total_size - bytes;
505     rest_hdr -> hb_flags = 0;
506 #   ifdef GC_ASSERTIONS
507       /* Mark h not free, to avoid assertion about adjacent free blocks. */
508         hhdr -> hb_flags &= ~FREE_BLK;
509 #   endif
510     GC_add_to_fl(rest, rest_hdr);
511     return h;
512 }
513
514 /*
515  * H is a free block.  N points at an address inside it.
516  * A new header for n has already been set up.  Fix up h's header
517  * to reflect the fact that it is being split, move it to the
518  * appropriate free list.
519  * N replaces h in the original free list.
520  *
521  * Nhdr is not completely filled in, since it is about to allocated.
522  * It may in fact end up on the wrong free list for its size.
523  * That's not a disaster, since n is about to be allocated
524  * by our caller.
525  * (Hence adding it to a free list is silly.  But this path is hopefully
526  * rare enough that it doesn't matter.  The code is cleaner this way.)
527  */
528 STATIC void GC_split_block(struct hblk *h, hdr *hhdr, struct hblk *n,
529                            hdr *nhdr, int index /* Index of free list */)
530 {
531     word total_size = hhdr -> hb_sz;
532     word h_size = (word)n - (word)h;
533     struct hblk *prev = hhdr -> hb_prev;
534     struct hblk *next = hhdr -> hb_next;
535
536     /* Replace h with n on its freelist */
537       nhdr -> hb_prev = prev;
538       nhdr -> hb_next = next;
539       nhdr -> hb_sz = total_size - h_size;
540       nhdr -> hb_flags = 0;
541       if (0 != prev) {
542         HDR(prev) -> hb_next = n;
543       } else {
544         GC_hblkfreelist[index] = n;
545       }
546       if (0 != next) {
547         HDR(next) -> hb_prev = n;
548       }
549       INCR_FREE_BYTES(index, -(signed_word)h_size);
550       FREE_ASSERT(GC_free_bytes[index] > 0);
551 #   ifdef USE_MUNMAP
552       hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
553 #   endif
554     hhdr -> hb_sz = h_size;
555     GC_add_to_fl(h, hhdr);
556     nhdr -> hb_flags |= FREE_BLK;
557 }
558         
559 STATIC struct hblk *
560 GC_allochblk_nth(size_t sz/* bytes */, int kind, unsigned flags, int n,
561                  GC_bool may_split);
562
563 /*
564  * Allocate (and return pointer to) a heap block
565  *   for objects of size sz bytes, searching the nth free list.
566  *
567  * NOTE: We set obj_map field in header correctly.
568  *       Caller is responsible for building an object freelist in block.
569  *
570  * The client is responsible for clearing the block, if necessary.
571  */
572 struct hblk *
573 GC_allochblk(size_t sz, int kind, unsigned flags/* IGNORE_OFF_PAGE or 0 */)
574 {
575     word blocks;
576     int start_list;
577     int i;
578     struct hblk *result;
579     int split_limit; /* Highest index of free list whose blocks we      */
580                      /* split.                                          */
581
582     GC_ASSERT((sz & (GRANULE_BYTES - 1)) == 0);
583     blocks = OBJ_SZ_TO_BLOCKS(sz);
584     if ((signed_word)(blocks * HBLKSIZE) < 0) {
585       return 0;
586     }
587     start_list = GC_hblk_fl_from_blocks(blocks);
588     /* Try for an exact match first. */
589     result = GC_allochblk_nth(sz, kind, flags, start_list, FALSE);
590     if (0 != result) return result;
591     if (GC_use_entire_heap || GC_dont_gc
592         || USED_HEAP_SIZE < GC_requested_heapsize
593         || GC_incremental || !GC_should_collect()) {
594         /* Should use more of the heap, even if it requires splitting. */
595         split_limit = N_HBLK_FLS;
596     } else {
597 #     ifdef USE_MUNMAP
598         /* avoid splitting, since that might require remapping */
599         split_limit = 0;
600 #     else
601         if (GC_finalizer_bytes_freed > (GC_heapsize >> 4))  {
602           /* If we are deallocating lots of memory from         */
603           /* finalizers, fail and collect sooner rather         */
604           /* than later.                                        */
605           split_limit = 0;
606         } else {
607           /* If we have enough large blocks left to cover any   */
608           /* previous request for large blocks, we go ahead     */
609           /* and split.  Assuming a steady state, that should   */
610           /* be safe.  It means that we can use the full        */
611           /* heap if we allocate only small objects.            */
612           split_limit = GC_enough_large_bytes_left();
613         }
614 #     endif
615     }
616     if (start_list < UNIQUE_THRESHOLD) {
617       /* No reason to try start_list again, since all blocks are exact  */
618       /* matches.                                                       */
619       ++start_list;
620     }
621     for (i = start_list; i <= split_limit; ++i) {
622         struct hblk * result = GC_allochblk_nth(sz, kind, flags, i, TRUE);
623         if (0 != result) return result;
624     }
625     return 0;
626 }
627 /*
628  * The same, but with search restricted to nth free list.
629  * Flags is IGNORE_OFF_PAGE or zero.
630  * Unlike the above, sz is in bytes.
631  * The may_split flag indicates whether it's OK to split larger blocks.
632  */
633 STATIC struct hblk *
634 GC_allochblk_nth(size_t sz, int kind, unsigned flags, int n, GC_bool may_split)
635 {
636     struct hblk *hbp;
637     hdr * hhdr;         /* Header corr. to hbp */
638                         /* Initialized after loop if hbp !=0    */
639                         /* Gcc uninitialized use warning is bogus.      */
640     struct hblk *thishbp;
641     hdr * thishdr;              /* Header corr. to hbp */
642     signed_word size_needed;    /* number of bytes in requested objects */
643     signed_word size_avail;     /* bytes available in this block        */
644
645     size_needed = HBLKSIZE * OBJ_SZ_TO_BLOCKS(sz);
646
647     /* search for a big enough block in free list */
648         hbp = GC_hblkfreelist[n];
649         for(; 0 != hbp; hbp = hhdr -> hb_next) {
650             GET_HDR(hbp, hhdr);
651             size_avail = hhdr->hb_sz;
652             if (size_avail < size_needed) continue;
653             if (size_avail != size_needed) {
654               signed_word next_size;
655
656               if (!may_split) continue;
657               /* If the next heap block is obviously better, go on.     */
658               /* This prevents us from disassembling a single large block */
659               /* to get tiny blocks.                                    */
660               thishbp = hhdr -> hb_next;
661               if (thishbp != 0) {
662                 GET_HDR(thishbp, thishdr);
663                 next_size = (signed_word)(thishdr -> hb_sz);
664                 if (next_size < size_avail
665                     && next_size >= size_needed
666                     && !GC_is_black_listed(thishbp, (word)size_needed)) {
667                     continue;
668                 }
669               }
670             }
671             if ( !IS_UNCOLLECTABLE(kind) &&
672                  (kind != PTRFREE || size_needed > MAX_BLACK_LIST_ALLOC)) {
673               struct hblk * lasthbp = hbp;
674               ptr_t search_end = (ptr_t)hbp + size_avail - size_needed;
675               signed_word orig_avail = size_avail;
676               signed_word eff_size_needed = ((flags & IGNORE_OFF_PAGE)?
677                                                 HBLKSIZE
678                                                 : size_needed);
679               
680               
681               while ((ptr_t)lasthbp <= search_end
682                      && (thishbp = GC_is_black_listed(lasthbp,
683                                                       (word)eff_size_needed))
684                         != 0) {
685                 lasthbp = thishbp;
686               }
687               size_avail -= (ptr_t)lasthbp - (ptr_t)hbp;
688               thishbp = lasthbp;
689               if (size_avail >= size_needed) {
690                 if (thishbp != hbp &&
691                     0 != (thishdr = GC_install_header(thishbp))) {
692                   /* Make sure it's mapped before we mangle it. */
693 #                   ifdef USE_MUNMAP
694                       if (!IS_MAPPED(hhdr)) {
695                         GC_remap((ptr_t)hbp, hhdr -> hb_sz);
696                         hhdr -> hb_flags &= ~WAS_UNMAPPED;
697                       }
698 #                   endif
699                   /* Split the block at thishbp */
700                       GC_split_block(hbp, hhdr, thishbp, thishdr, n);
701                   /* Advance to thishbp */
702                       hbp = thishbp;
703                       hhdr = thishdr;
704                       /* We must now allocate thishbp, since it may     */
705                       /* be on the wrong free list.                     */
706                 }
707               } else if (size_needed > (signed_word)BL_LIMIT
708                          && orig_avail - size_needed
709                             > (signed_word)BL_LIMIT) {
710                 /* Punt, since anything else risks unreasonable heap growth. */
711                 if (++GC_large_alloc_warn_suppressed
712                     >= GC_large_alloc_warn_interval) {
713                   WARN("Repeated allocation of very large block "
714                        "(appr. size %ld):\n"
715                        "\tMay lead to memory leak and poor performance.\n",
716                        size_needed);
717                   GC_large_alloc_warn_suppressed = 0;
718                 }
719                 size_avail = orig_avail;
720               } else if (size_avail == 0 && size_needed == HBLKSIZE
721                          && IS_MAPPED(hhdr)) {
722                 if (!GC_find_leak) {
723                   static unsigned count = 0;
724                   
725                   /* The block is completely blacklisted.  We need      */
726                   /* to drop some such blocks, since otherwise we spend */
727                   /* all our time traversing them if pointerfree        */
728                   /* blocks are unpopular.                              */
729                   /* A dropped block will be reconsidered at next GC.   */
730                   if ((++count & 3) == 0) {
731                     /* Allocate and drop the block in small chunks, to  */
732                     /* maximize the chance that we will recover some    */
733                     /* later.                                           */
734                       word total_size = hhdr -> hb_sz;
735                       struct hblk * limit = hbp + divHBLKSZ(total_size);
736                       struct hblk * h;
737                       struct hblk * prev = hhdr -> hb_prev;
738                       
739                       GC_large_free_bytes -= total_size;
740                       GC_bytes_dropped += total_size;
741                       GC_remove_from_fl(hhdr, n);
742                       for (h = hbp; h < limit; h++) {
743                         if (h == hbp || 0 != (hhdr = GC_install_header(h))) {
744                           (void) setup_header(
745                                   hhdr, h,
746                                   HBLKSIZE,
747                                   PTRFREE, 0); /* Cant fail */
748                           if (GC_debugging_started) {
749                             BZERO(h, HBLKSIZE);
750                           }
751                         }
752                       }
753                     /* Restore hbp to point at free block */
754                       hbp = prev;
755                       if (0 == hbp) {
756                         return GC_allochblk_nth(sz, kind, flags, n, may_split);
757                       }
758                       hhdr = HDR(hbp);
759                   }
760                 }
761               }
762             }
763             if( size_avail >= size_needed ) {
764 #               ifdef USE_MUNMAP
765                   if (!IS_MAPPED(hhdr)) {
766                     GC_remap((ptr_t)hbp, hhdr -> hb_sz);
767                     hhdr -> hb_flags &= ~WAS_UNMAPPED;
768                     /* Note: This may leave adjacent, mapped free blocks. */
769                   }
770 #               endif
771                 /* hbp may be on the wrong freelist; the parameter n    */
772                 /* is important.                                        */
773                 hbp = GC_get_first_part(hbp, hhdr, size_needed, n);
774                 break;
775             }
776         }
777
778     if (0 == hbp) return 0;
779         
780     /* Add it to map of valid blocks */
781         if (!GC_install_counts(hbp, (word)size_needed)) return(0);
782         /* This leaks memory under very rare conditions. */
783                 
784     /* Set up header */
785         if (!setup_header(hhdr, hbp, sz, kind, flags)) {
786             GC_remove_counts(hbp, (word)size_needed);
787             return(0); /* ditto */
788         }
789
790     /* Notify virtual dirty bit implementation that we are about to write.  */
791     /* Ensure that pointerfree objects are not protected if it's avoidable. */
792     /* This also ensures that newly allocated blocks are treated as dirty.  */
793     /* Necessary since we don't protect free blocks.                        */
794         GC_ASSERT((size_needed & (HBLKSIZE-1)) == 0);
795         GC_remove_protection(hbp, divHBLKSZ(size_needed),
796                              (hhdr -> hb_descr == 0) /* pointer-free */);
797         
798     /* We just successfully allocated a block.  Restart count of        */
799     /* consecutive failures.                                            */
800     {
801         extern unsigned GC_fail_count;
802         
803         GC_fail_count = 0;
804     }
805
806     GC_large_free_bytes -= size_needed;
807     
808     GC_ASSERT(IS_MAPPED(hhdr));
809     return( hbp );
810 }
811  
812 /*
813  * Free a heap block.
814  *
815  * Coalesce the block with its neighbors if possible.
816  *
817  * All mark words are assumed to be cleared.
818  */
819 void
820 GC_freehblk(struct hblk *hbp)
821 {
822 struct hblk *next, *prev;
823 hdr *hhdr, *prevhdr, *nexthdr;
824 signed_word size;
825
826
827     GET_HDR(hbp, hhdr);
828     size = hhdr->hb_sz;
829     size = HBLKSIZE * OBJ_SZ_TO_BLOCKS(size);
830     if (size <= 0)
831       ABORT("Deallocating excessively large block.  Too large an allocation?");
832       /* Probably possible if we try to allocate more than half the address */
833       /* space at once.  If we dont catch it here, strange things happen    */
834       /* later.                                                             */
835     GC_remove_counts(hbp, (word)size);
836     hhdr->hb_sz = size;
837 #   ifdef USE_MUNMAP
838       hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
839 #   endif
840     
841     /* Check for duplicate deallocation in the easy case */
842       if (HBLK_IS_FREE(hhdr)) {
843         GC_printf("Duplicate large block deallocation of %p\n", hbp);
844         ABORT("Duplicate large block deallocation");
845       }
846
847     GC_ASSERT(IS_MAPPED(hhdr));
848     hhdr -> hb_flags |= FREE_BLK;
849     next = (struct hblk *)((word)hbp + size);
850     GET_HDR(next, nexthdr);
851     prev = GC_free_block_ending_at(hbp);
852     /* Coalesce with successor, if possible */
853       if(0 != nexthdr && HBLK_IS_FREE(nexthdr) && IS_MAPPED(nexthdr)
854          && (signed_word)(hhdr -> hb_sz + nexthdr -> hb_sz) > 0
855          /* no overflow */) {
856         GC_remove_from_fl(nexthdr, FL_UNKNOWN);
857         hhdr -> hb_sz += nexthdr -> hb_sz; 
858         GC_remove_header(next);
859       }
860     /* Coalesce with predecessor, if possible. */
861       if (0 != prev) {
862         prevhdr = HDR(prev);
863         if (IS_MAPPED(prevhdr)
864             && (signed_word)(hhdr -> hb_sz + prevhdr -> hb_sz) > 0) {
865           GC_remove_from_fl(prevhdr, FL_UNKNOWN);
866           prevhdr -> hb_sz += hhdr -> hb_sz;
867 #         ifdef USE_MUNMAP
868             prevhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
869 #         endif
870           GC_remove_header(hbp);
871           hbp = prev;
872           hhdr = prevhdr;
873         }
874       }
875     /* FIXME: It is not clear we really always want to do these merges  */
876     /* with -DUSE_MUNMAP, since it updates ages and hence prevents      */
877     /* unmapping.                                                       */
878
879     GC_large_free_bytes += size;
880     GC_add_to_fl(hbp, hhdr);    
881 }
882