src/mm/boehm-gc/typd_mlc.c

   1 /*
   2  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
   3  * opyright (c) 1999-2000 by Hewlett-Packard Company.  All rights reserved.
   4  *
   5  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
   6  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
   7  *
   8  * Permission is hereby granted to use or copy this program
   9  * for any purpose,  provided the above notices are retained on all copies.
  10  * Permission to modify the code and to distribute modified code is granted,
  11  * provided the above notices are retained, and a notice that the code was
  12  * modified is included with the above copyright notice.
  13  *
  14  */
  15
  16
  17 /*
  18  * Some simple primitives for allocation with explicit type information.
  19  * Simple objects are allocated such that they contain a GC_descr at the
  20  * end (in the last allocated word).  This descriptor may be a procedure
  21  * which then examines an extended descriptor passed as its environment.
  22  *
  23  * Arrays are treated as simple objects if they have sufficiently simple
  24  * structure.  Otherwise they are allocated from an array kind that supplies
  25  * a special mark procedure.  These arrays contain a pointer to a
  26  * complex_descriptor as their last word.
  27  * This is done because the environment field is too small, and the collector
  28  * must trace the complex_descriptor.
  29  *
  30  * Note that descriptors inside objects may appear cleared, if we encounter a
  31  * false refrence to an object on a free list.  In the GC_descr case, this
  32  * is OK, since a 0 descriptor corresponds to examining no fields.
  33  * In the complex_descriptor case, we explicitly check for that case.
  34  *
  35  * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
  36  * since they are not accessible through the current interface.
  37  */
  38
  39 #include "config.h"
  40
  41 #include "private/gc_pmark.h"
  42 #include "gc_typed.h"
  43
  44 # define TYPD_EXTRA_BYTES (sizeof(word) - EXTRA_BYTES)
  45
  46 GC_bool GC_explicit_typing_initialized = FALSE;
  47
  48 int GC_explicit_kind;   /* Object kind for objects with indirect        */
  49                         /* (possibly extended) descriptors.             */
  50
  51 int GC_array_kind;      /* Object kind for objects with complex         */
  52                         /* descriptors and GC_array_mark_proc.          */
  53
  54 /* Extended descriptors.  GC_typed_mark_proc understands these. */
  55 /* These are used for simple objects that are larger than what  */
  56 /* can be described by a BITMAP_BITS sized bitmap.              */
  57 typedef struct {
  58         word ed_bitmap; /* lsb corresponds to first word.       */
  59         GC_bool ed_continued;   /* next entry is continuation.  */
  60 } ext_descr;
  61
  62 /* Array descriptors.  GC_array_mark_proc understands these.    */
  63 /* We may eventually need to add provisions for headers and     */
  64 /* trailers.  Hence we provide for tree structured descriptors, */
  65 /* though we don't really use them currently.                   */
  66 typedef union ComplexDescriptor {
  67     struct LeafDescriptor {     /* Describes simple array       */
  68         word ld_tag;
  69 #       define LEAF_TAG 1
  70         word ld_size;           /* bytes per element    */
  71                                 /* multiple of ALIGNMENT        */
  72         word ld_nelements;      /* Number of elements.  */
  73         GC_descr ld_descriptor; /* A simple length, bitmap,     */
  74                                 /* or procedure descriptor.     */
  75     } ld;
  76     struct ComplexArrayDescriptor {
  77         word ad_tag;
  78 #       define ARRAY_TAG 2
  79         word ad_nelements;
  80         union ComplexDescriptor * ad_element_descr;
  81     } ad;
  82     struct SequenceDescriptor {
  83         word sd_tag;
  84 #       define SEQUENCE_TAG 3
  85         union ComplexDescriptor * sd_first;
  86         union ComplexDescriptor * sd_second;
  87     } sd;
  88 } complex_descriptor;
  89 #define TAG ld.ld_tag
  90
  91 ext_descr * GC_ext_descriptors; /* Points to array of extended  */
  92                                 /* descriptors.                 */
  93
  94 word GC_ed_size = 0;    /* Current size of above arrays.        */
  95 # define ED_INITIAL_SIZE 100;
  96
  97 word GC_avail_descr = 0;        /* Next available slot.         */
  98
  99 int GC_typed_mark_proc_index;   /* Indices of my mark           */
 100 int GC_array_mark_proc_index;   /* procedures.                  */
 101
 102 /* Add a multiword bitmap to GC_ext_descriptors arrays.  Return */
 103 /* starting index.                                              */
 104 /* Returns -1 on failure.                                       */
 105 /* Caller does not hold allocation lock.                        */
 106 signed_word GC_add_ext_descriptor(bm, nbits)
 107 GC_bitmap bm;
 108 word nbits;
 109 {
 110     register size_t nwords = divWORDSZ(nbits + WORDSZ-1);
 111     register signed_word result;
 112     register word i;
 113     register word last_part;
 114     register int extra_bits;
 115     DCL_LOCK_STATE;
 116
 117     DISABLE_SIGNALS();
 118     LOCK();
 119     while (GC_avail_descr + nwords >= GC_ed_size) {
 120         ext_descr * new;
 121         size_t new_size;
 122         word ed_size = GC_ed_size;
 123
 124         UNLOCK();
 125         ENABLE_SIGNALS();
 126         if (ed_size == 0) {
 127             new_size = ED_INITIAL_SIZE;
 128         } else {
 129             new_size = 2 * ed_size;
 130             if (new_size > MAX_ENV) return(-1);
 131         }
 132         new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
 133         if (new == 0) return(-1);
 134         DISABLE_SIGNALS();
 135         LOCK();
 136         if (ed_size == GC_ed_size) {
 137             if (GC_avail_descr != 0) {
 138                 BCOPY(GC_ext_descriptors, new,
 139                       GC_avail_descr * sizeof(ext_descr));
 140             }
 141             GC_ed_size = new_size;
 142             GC_ext_descriptors = new;
 143         }  /* else another thread already resized it in the meantime */
 144     }
 145     result = GC_avail_descr;
 146     for (i = 0; i < nwords-1; i++) {
 147         GC_ext_descriptors[result + i].ed_bitmap = bm[i];
 148         GC_ext_descriptors[result + i].ed_continued = TRUE;
 149     }
 150     last_part = bm[i];
 151     /* Clear irrelevant bits. */
 152     extra_bits = nwords * WORDSZ - nbits;
 153     last_part <<= extra_bits;
 154     last_part >>= extra_bits;
 155     GC_ext_descriptors[result + i].ed_bitmap = last_part;
 156     GC_ext_descriptors[result + i].ed_continued = FALSE;
 157     GC_avail_descr += nwords;
 158     UNLOCK();
 159     ENABLE_SIGNALS();
 160     return(result);
 161 }
 162
 163 /* Table of bitmap descriptors for n word long all pointer objects.     */
 164 GC_descr GC_bm_table[WORDSZ/2];
 165
 166 /* Return a descriptor for the concatenation of 2 nwords long objects,  */
 167 /* each of which is described by descriptor.                            */
 168 /* The result is known to be short enough to fit into a bitmap          */
 169 /* descriptor.                                                          */
 170 /* Descriptor is a GC_DS_LENGTH or GC_DS_BITMAP descriptor.             */
 171 GC_descr GC_double_descr(descriptor, nwords)
 172 register GC_descr descriptor;
 173 register word nwords;
 174 {
 175     if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
 176         descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
 177     };
 178     descriptor |= (descriptor & ~GC_DS_TAGS) >> nwords;
 179     return(descriptor);
 180 }
 181
 182 complex_descriptor * GC_make_sequence_descriptor();
 183
 184 /* Build a descriptor for an array with nelements elements,     */
 185 /* each of which can be described by a simple descriptor.       */
 186 /* We try to optimize some common cases.                        */
 187 /* If the result is COMPLEX, then a complex_descr* is returned  */
 188 /* in *complex_d.                                                       */
 189 /* If the result is LEAF, then we built a LeafDescriptor in     */
 190 /* the structure pointed to by leaf.                            */
 191 /* The tag in the leaf structure is not set.                    */
 192 /* If the result is SIMPLE, then a GC_descr                     */
 193 /* is returned in *simple_d.                                    */
 194 /* If the result is NO_MEM, then                                */
 195 /* we failed to allocate the descriptor.                        */
 196 /* The implementation knows that GC_DS_LENGTH is 0.             */
 197 /* *leaf, *complex_d, and *simple_d may be used as temporaries  */
 198 /* during the construction.                                     */
 199 # define COMPLEX 2
 200 # define LEAF 1
 201 # define SIMPLE 0
 202 # define NO_MEM (-1)
 203 int GC_make_array_descriptor(nelements, size, descriptor,
 204                              simple_d, complex_d, leaf)
 205 word size;
 206 word nelements;
 207 GC_descr descriptor;
 208 GC_descr *simple_d;
 209 complex_descriptor **complex_d;
 210 struct LeafDescriptor * leaf;
 211 {
 212 #   define OPT_THRESHOLD 50
 213         /* For larger arrays, we try to combine descriptors of adjacent */
 214         /* descriptors to speed up marking, and to reduce the amount    */
 215         /* of space needed on the mark stack.                           */
 216     if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
 217       if ((word)descriptor == size) {
 218         *simple_d = nelements * descriptor;
 219         return(SIMPLE);
 220       } else if ((word)descriptor == 0) {
 221         *simple_d = (GC_descr)0;
 222         return(SIMPLE);
 223       }
 224     }
 225     if (nelements <= OPT_THRESHOLD) {
 226       if (nelements <= 1) {
 227         if (nelements == 1) {
 228             *simple_d = descriptor;
 229             return(SIMPLE);
 230         } else {
 231             *simple_d = (GC_descr)0;
 232             return(SIMPLE);
 233         }
 234       }
 235     } else if (size <= BITMAP_BITS/2
 236                && (descriptor & GC_DS_TAGS) != GC_DS_PROC
 237                && (size & (sizeof(word)-1)) == 0) {
 238       int result =
 239           GC_make_array_descriptor(nelements/2, 2*size,
 240                                    GC_double_descr(descriptor,
 241                                                    BYTES_TO_WORDS(size)),
 242                                    simple_d, complex_d, leaf);
 243       if ((nelements & 1) == 0) {
 244           return(result);
 245       } else {
 246           struct LeafDescriptor * one_element =
 247               (struct LeafDescriptor *)
 248                 GC_malloc_atomic(sizeof(struct LeafDescriptor));
 249
 250           if (result == NO_MEM || one_element == 0) return(NO_MEM);
 251           one_element -> ld_tag = LEAF_TAG;
 252           one_element -> ld_size = size;
 253           one_element -> ld_nelements = 1;
 254           one_element -> ld_descriptor = descriptor;
 255           switch(result) {
 256             case SIMPLE:
 257             {
 258               struct LeafDescriptor * beginning =
 259                 (struct LeafDescriptor *)
 260                   GC_malloc_atomic(sizeof(struct LeafDescriptor));
 261               if (beginning == 0) return(NO_MEM);
 262               beginning -> ld_tag = LEAF_TAG;
 263               beginning -> ld_size = size;
 264               beginning -> ld_nelements = 1;
 265               beginning -> ld_descriptor = *simple_d;
 266               *complex_d = GC_make_sequence_descriptor(
 267                                 (complex_descriptor *)beginning,
 268                                 (complex_descriptor *)one_element);
 269               break;
 270             }
 271             case LEAF:
 272             {
 273               struct LeafDescriptor * beginning =
 274                 (struct LeafDescriptor *)
 275                   GC_malloc_atomic(sizeof(struct LeafDescriptor));
 276               if (beginning == 0) return(NO_MEM);
 277               beginning -> ld_tag = LEAF_TAG;
 278               beginning -> ld_size = leaf -> ld_size;
 279               beginning -> ld_nelements = leaf -> ld_nelements;
 280               beginning -> ld_descriptor = leaf -> ld_descriptor;
 281               *complex_d = GC_make_sequence_descriptor(
 282                                 (complex_descriptor *)beginning,
 283                                 (complex_descriptor *)one_element);
 284               break;
 285             }
 286             case COMPLEX:
 287               *complex_d = GC_make_sequence_descriptor(
 288                                 *complex_d,
 289                                 (complex_descriptor *)one_element);
 290               break;
 291           }
 292           return(COMPLEX);
 293       }
 294     }
 295     {
 296         leaf -> ld_size = size;
 297         leaf -> ld_nelements = nelements;
 298         leaf -> ld_descriptor = descriptor;
 299         return(LEAF);
 300     }
 301 }
 302
 303 complex_descriptor * GC_make_sequence_descriptor(first, second)
 304 complex_descriptor * first;
 305 complex_descriptor * second;
 306 {
 307     struct SequenceDescriptor * result =
 308         (struct SequenceDescriptor *)
 309                 GC_malloc(sizeof(struct SequenceDescriptor));
 310     /* Can't result in overly conservative marking, since tags are      */
 311     /* very small integers. Probably faster than maintaining type       */
 312     /* info.                                                            */
 313     if (result != 0) {
 314         result -> sd_tag = SEQUENCE_TAG;
 315         result -> sd_first = first;
 316         result -> sd_second = second;
 317     }
 318     return((complex_descriptor *)result);
 319 }
 320
 321 #ifdef UNDEFINED
 322 complex_descriptor * GC_make_complex_array_descriptor(nelements, descr)
 323 word nelements;
 324 complex_descriptor * descr;
 325 {
 326     struct ComplexArrayDescriptor * result =
 327         (struct ComplexArrayDescriptor *)
 328                 GC_malloc(sizeof(struct ComplexArrayDescriptor));
 329
 330     if (result != 0) {
 331         result -> ad_tag = ARRAY_TAG;
 332         result -> ad_nelements = nelements;
 333         result -> ad_element_descr = descr;
 334     }
 335     return((complex_descriptor *)result);
 336 }
 337 #endif
 338
 339 ptr_t * GC_eobjfreelist;
 340
 341 ptr_t * GC_arobjfreelist;
 342
 343 mse * GC_typed_mark_proc GC_PROTO((register word * addr,
 344                                    register mse * mark_stack_ptr,
 345                                    mse * mark_stack_limit,
 346                                    word env));
 347
 348 mse * GC_array_mark_proc GC_PROTO((register word * addr,
 349                                    register mse * mark_stack_ptr,
 350                                    mse * mark_stack_limit,
 351                                    word env));
 352
 353 /* Caller does not hold allocation lock. */
 354 void GC_init_explicit_typing()
 355 {
 356     register int i;
 357     DCL_LOCK_STATE;
 358
 359
 360 #   ifdef PRINTSTATS
 361         if (sizeof(struct LeafDescriptor) % sizeof(word) != 0)
 362             ABORT("Bad leaf descriptor size");
 363 #   endif
 364     DISABLE_SIGNALS();
 365     LOCK();
 366     if (GC_explicit_typing_initialized) {
 367       UNLOCK();
 368       ENABLE_SIGNALS();
 369       return;
 370     }
 371     GC_explicit_typing_initialized = TRUE;
 372     /* Set up object kind with simple indirect descriptor. */
 373       GC_eobjfreelist = (ptr_t *)GC_new_free_list_inner();
 374       GC_explicit_kind = GC_new_kind_inner(
 375                             (void **)GC_eobjfreelist,
 376                             (((word)WORDS_TO_BYTES(-1)) | GC_DS_PER_OBJECT),
 377                             TRUE, TRUE);
 378                 /* Descriptors are in the last word of the object. */
 379       GC_typed_mark_proc_index = GC_new_proc_inner(GC_typed_mark_proc);
 380     /* Set up object kind with array descriptor. */
 381       GC_arobjfreelist = (ptr_t *)GC_new_free_list_inner();
 382       GC_array_mark_proc_index = GC_new_proc_inner(GC_array_mark_proc);
 383       GC_array_kind = GC_new_kind_inner(
 384                             (void **)GC_arobjfreelist,
 385                             GC_MAKE_PROC(GC_array_mark_proc_index, 0),
 386                             FALSE, TRUE);
 387       for (i = 0; i < WORDSZ/2; i++) {
 388           GC_descr d = (((word)(-1)) >> (WORDSZ - i)) << (WORDSZ - i);
 389           d |= GC_DS_BITMAP;
 390           GC_bm_table[i] = d;
 391       }
 392     UNLOCK();
 393     ENABLE_SIGNALS();
 394 }
 395
 396 # if defined(__STDC__) || defined(__cplusplus)
 397     mse * GC_typed_mark_proc(register word * addr,
 398                              register mse * mark_stack_ptr,
 399                              mse * mark_stack_limit,
 400                              word env)
 401 # else
 402     mse * GC_typed_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
 403     register word * addr;
 404     register mse * mark_stack_ptr;
 405     mse * mark_stack_limit;
 406     word env;
 407 # endif
 408 {
 409     register word bm = GC_ext_descriptors[env].ed_bitmap;
 410     register word * current_p = addr;
 411     register word current;
 412     register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
 413     register ptr_t least_ha = GC_least_plausible_heap_addr;
 414
 415     for (; bm != 0; bm >>= 1, current_p++) {
 416         if (bm & 1) {
 417             current = *current_p;
 418             FIXUP_POINTER(current);
 419             if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
 420                 PUSH_CONTENTS((ptr_t)current, mark_stack_ptr,
 421                               mark_stack_limit, current_p, exit1);
 422             }
 423         }
 424     }
 425     if (GC_ext_descriptors[env].ed_continued) {
 426         /* Push an entry with the rest of the descriptor back onto the  */
 427         /* stack.  Thus we never do too much work at once.  Note that   */
 428         /* we also can't overflow the mark stack unless we actually     */
 429         /* mark something.                                              */
 430         mark_stack_ptr++;
 431         if (mark_stack_ptr >= mark_stack_limit) {
 432             mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
 433         }
 434         mark_stack_ptr -> mse_start = addr + WORDSZ;
 435         mark_stack_ptr -> mse_descr =
 436                 GC_MAKE_PROC(GC_typed_mark_proc_index, env+1);
 437     }
 438     return(mark_stack_ptr);
 439 }
 440
 441 /* Return the size of the object described by d.  It would be faster to */
 442 /* store this directly, or to compute it as part of                     */
 443 /* GC_push_complex_descriptor, but hopefully it doesn't matter.         */
 444 word GC_descr_obj_size(d)
 445 register complex_descriptor *d;
 446 {
 447     switch(d -> TAG) {
 448       case LEAF_TAG:
 449         return(d -> ld.ld_nelements * d -> ld.ld_size);
 450       case ARRAY_TAG:
 451         return(d -> ad.ad_nelements
 452                * GC_descr_obj_size(d -> ad.ad_element_descr));
 453       case SEQUENCE_TAG:
 454         return(GC_descr_obj_size(d -> sd.sd_first)
 455                + GC_descr_obj_size(d -> sd.sd_second));
 456       default:
 457         ABORT("Bad complex descriptor");
 458         /*NOTREACHED*/ return 0; /*NOTREACHED*/
 459     }
 460 }
 461
 462 /* Push descriptors for the object at addr with complex descriptor d    */
 463 /* onto the mark stack.  Return 0 if the mark stack overflowed.         */
 464 mse * GC_push_complex_descriptor(addr, d, msp, msl)
 465 word * addr;
 466 register complex_descriptor *d;
 467 register mse * msp;
 468 mse * msl;
 469 {
 470     register ptr_t current = (ptr_t) addr;
 471     register word nelements;
 472     register word sz;
 473     register word i;
 474
 475     switch(d -> TAG) {
 476       case LEAF_TAG:
 477         {
 478           register GC_descr descr = d -> ld.ld_descriptor;
 479
 480           nelements = d -> ld.ld_nelements;
 481           if (msl - msp <= (ptrdiff_t)nelements) return(0);
 482           sz = d -> ld.ld_size;
 483           for (i = 0; i < nelements; i++) {
 484               msp++;
 485               msp -> mse_start = (word *)current;
 486               msp -> mse_descr = descr;
 487               current += sz;
 488           }
 489           return(msp);
 490         }
 491       case ARRAY_TAG:
 492         {
 493           register complex_descriptor *descr = d -> ad.ad_element_descr;
 494
 495           nelements = d -> ad.ad_nelements;
 496           sz = GC_descr_obj_size(descr);
 497           for (i = 0; i < nelements; i++) {
 498               msp = GC_push_complex_descriptor((word *)current, descr,
 499                                                 msp, msl);
 500               if (msp == 0) return(0);
 501               current += sz;
 502           }
 503           return(msp);
 504         }
 505       case SEQUENCE_TAG:
 506         {
 507           sz = GC_descr_obj_size(d -> sd.sd_first);
 508           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
 509                                            msp, msl);
 510           if (msp == 0) return(0);
 511           current += sz;
 512           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
 513                                            msp, msl);
 514           return(msp);
 515         }
 516       default:
 517         ABORT("Bad complex descriptor");
 518         /*NOTREACHED*/ return 0; /*NOTREACHED*/
 519    }
 520 }
 521
 522 /*ARGSUSED*/
 523 # if defined(__STDC__) || defined(__cplusplus)
 524     mse * GC_array_mark_proc(register word * addr,
 525                              register mse * mark_stack_ptr,
 526                              mse * mark_stack_limit,
 527                              word env)
 528 # else
 529     mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
 530     register word * addr;
 531     register mse * mark_stack_ptr;
 532     mse * mark_stack_limit;
 533     word env;
 534 # endif
 535 {
 536     register hdr * hhdr = HDR(addr);
 537     register word sz = hhdr -> hb_sz;
 538     register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
 539     mse * orig_mark_stack_ptr = mark_stack_ptr;
 540     mse * new_mark_stack_ptr;
 541
 542     if (descr == 0) {
 543         /* Found a reference to a free list entry.  Ignore it. */
 544         return(orig_mark_stack_ptr);
 545     }
 546     /* In use counts were already updated when array descriptor was     */
 547     /* pushed.  Here we only replace it by subobject descriptors, so    */
 548     /* no update is necessary.                                          */
 549     new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
 550                                                     mark_stack_ptr,
 551                                                     mark_stack_limit-1);
 552     if (new_mark_stack_ptr == 0) {
 553         /* Doesn't fit.  Conservatively push the whole array as a unit  */
 554         /* and request a mark stack expansion.                          */
 555         /* This cannot cause a mark stack overflow, since it replaces   */
 556         /* the original array entry.                                    */
 557         GC_mark_stack_too_small = TRUE;
 558         new_mark_stack_ptr = orig_mark_stack_ptr + 1;
 559         new_mark_stack_ptr -> mse_start = addr;
 560         new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | GC_DS_LENGTH;
 561     } else {
 562         /* Push descriptor itself */
 563         new_mark_stack_ptr++;
 564         new_mark_stack_ptr -> mse_start = addr + sz - 1;
 565         new_mark_stack_ptr -> mse_descr = sizeof(word) | GC_DS_LENGTH;
 566     }
 567     return(new_mark_stack_ptr);
 568 }
 569
 570 #if defined(__STDC__) || defined(__cplusplus)
 571   GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
 572 #else
 573   GC_descr GC_make_descriptor(bm, len)
 574   GC_bitmap bm;
 575   size_t len;
 576 #endif
 577 {
 578     register signed_word last_set_bit = len - 1;
 579     register word result;
 580     register int i;
 581 #   define HIGH_BIT (((word)1) << (WORDSZ - 1))
 582
 583     if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
 584     while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
 585     if (last_set_bit < 0) return(0 /* no pointers */);
 586 #   if ALIGNMENT == CPP_WORDSZ/8
 587     {
 588       register GC_bool all_bits_set = TRUE;
 589       for (i = 0; i < last_set_bit; i++) {
 590         if (!GC_get_bit(bm, i)) {
 591             all_bits_set = FALSE;
 592             break;
 593         }
 594       }
 595       if (all_bits_set) {
 596         /* An initial section contains all pointers.  Use length descriptor. */
 597         return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
 598       }
 599     }
 600 #   endif
 601     if (last_set_bit < BITMAP_BITS) {
 602         /* Hopefully the common case.                   */
 603         /* Build bitmap descriptor (with bits reversed) */
 604         result = HIGH_BIT;
 605         for (i = last_set_bit - 1; i >= 0; i--) {
 606             result >>= 1;
 607             if (GC_get_bit(bm, i)) result |= HIGH_BIT;
 608         }
 609         result |= GC_DS_BITMAP;
 610         return(result);
 611     } else {
 612         signed_word index;
 613
 614         index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
 615         if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
 616                                 /* Out of memory: use conservative      */
 617                                 /* approximation.                       */
 618         result = GC_MAKE_PROC(GC_typed_mark_proc_index, (word)index);
 619         return(result);
 620     }
 621 }
 622
 623 ptr_t GC_clear_stack();
 624
 625 #define GENERAL_MALLOC(lb,k) \
 626     (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
 627
 628 #define GENERAL_MALLOC_IOP(lb,k) \
 629     (GC_PTR)GC_clear_stack(GC_generic_malloc_ignore_off_page(lb, k))
 630
 631 #if defined(__STDC__) || defined(__cplusplus)
 632   void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
 633 #else
 634   char * GC_malloc_explicitly_typed(lb, d)
 635   size_t lb;
 636   GC_descr d;
 637 #endif
 638 {
 639 register ptr_t op;
 640 register ptr_t * opp;
 641 register word lw;
 642 DCL_LOCK_STATE;
 643
 644     lb += TYPD_EXTRA_BYTES;
 645     if( SMALL_OBJ(lb) ) {
 646 #       ifdef MERGE_SIZES
 647           lw = GC_size_map[lb];
 648 #       else
 649           lw = ALIGNED_WORDS(lb);
 650 #       endif
 651         opp = &(GC_eobjfreelist[lw]);
 652         FASTLOCK();
 653         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
 654             FASTUNLOCK();
 655             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
 656             if (0 == op) return 0;
 657 #           ifdef MERGE_SIZES
 658                 lw = GC_size_map[lb];   /* May have been uninitialized. */
 659 #           endif
 660         } else {
 661             *opp = obj_link(op);
 662             obj_link(op) = 0;
 663             GC_words_allocd += lw;
 664             FASTUNLOCK();
 665         }
 666    } else {
 667        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
 668        if (op != NULL)
 669             lw = BYTES_TO_WORDS(GC_size(op));
 670    }
 671    if (op != NULL)
 672        ((word *)op)[lw - 1] = d;
 673    return((GC_PTR) op);
 674 }
 675
 676 #if defined(__STDC__) || defined(__cplusplus)
 677   void * GC_malloc_explicitly_typed_ignore_off_page(size_t lb, GC_descr d)
 678 #else
 679   char * GC_malloc_explicitly_typed_ignore_off_page(lb, d)
 680   size_t lb;
 681   GC_descr d;
 682 #endif
 683 {
 684 register ptr_t op;
 685 register ptr_t * opp;
 686 register word lw;
 687 DCL_LOCK_STATE;
 688
 689     lb += TYPD_EXTRA_BYTES;
 690     if( SMALL_OBJ(lb) ) {
 691 #       ifdef MERGE_SIZES
 692           lw = GC_size_map[lb];
 693 #       else
 694           lw = ALIGNED_WORDS(lb);
 695 #       endif
 696         opp = &(GC_eobjfreelist[lw]);
 697         FASTLOCK();
 698         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
 699             FASTUNLOCK();
 700             op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
 701 #           ifdef MERGE_SIZES
 702                 lw = GC_size_map[lb];   /* May have been uninitialized. */
 703 #           endif
 704         } else {
 705             *opp = obj_link(op);
 706             obj_link(op) = 0;
 707             GC_words_allocd += lw;
 708             FASTUNLOCK();
 709         }
 710    } else {
 711        op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
 712        if (op != NULL)
 713        lw = BYTES_TO_WORDS(GC_size(op));
 714    }
 715    if (op != NULL)
 716        ((word *)op)[lw - 1] = d;
 717    return((GC_PTR) op);
 718 }
 719
 720 #if defined(__STDC__) || defined(__cplusplus)
 721   void * GC_calloc_explicitly_typed(size_t n,
 722                                     size_t lb,
 723                                     GC_descr d)
 724 #else
 725   char * GC_calloc_explicitly_typed(n, lb, d)
 726   size_t n;
 727   size_t lb;
 728   GC_descr d;
 729 #endif
 730 {
 731 register ptr_t op;
 732 register ptr_t * opp;
 733 register word lw;
 734 GC_descr simple_descr;
 735 complex_descriptor *complex_descr;
 736 register int descr_type;
 737 struct LeafDescriptor leaf;
 738 DCL_LOCK_STATE;
 739
 740     descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
 741                                           &simple_descr, &complex_descr, &leaf);
 742     switch(descr_type) {
 743         case NO_MEM: return(0);
 744         case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
 745         case LEAF:
 746             lb *= n;
 747             lb += sizeof(struct LeafDescriptor) + TYPD_EXTRA_BYTES;
 748             break;
 749         case COMPLEX:
 750             lb *= n;
 751             lb += TYPD_EXTRA_BYTES;
 752             break;
 753     }
 754     if( SMALL_OBJ(lb) ) {
 755 #       ifdef MERGE_SIZES
 756           lw = GC_size_map[lb];
 757 #       else
 758           lw = ALIGNED_WORDS(lb);
 759 #       endif
 760         opp = &(GC_arobjfreelist[lw]);
 761         FASTLOCK();
 762         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
 763             FASTUNLOCK();
 764             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
 765             if (0 == op) return(0);
 766 #           ifdef MERGE_SIZES
 767                 lw = GC_size_map[lb];   /* May have been uninitialized. */
 768 #           endif
 769         } else {
 770             *opp = obj_link(op);
 771             obj_link(op) = 0;
 772             GC_words_allocd += lw;
 773             FASTUNLOCK();
 774         }
 775    } else {
 776        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
 777        if (0 == op) return(0);
 778        lw = BYTES_TO_WORDS(GC_size(op));
 779    }
 780    if (descr_type == LEAF) {
 781        /* Set up the descriptor inside the object itself. */
 782        VOLATILE struct LeafDescriptor * lp =
 783            (struct LeafDescriptor *)
 784                ((word *)op
 785                 + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
 786
 787        lp -> ld_tag = LEAF_TAG;
 788        lp -> ld_size = leaf.ld_size;
 789        lp -> ld_nelements = leaf.ld_nelements;
 790        lp -> ld_descriptor = leaf.ld_descriptor;
 791        ((VOLATILE word *)op)[lw - 1] = (word)lp;
 792    } else {
 793        extern unsigned GC_finalization_failures;
 794        unsigned ff = GC_finalization_failures;
 795
 796        ((word *)op)[lw - 1] = (word)complex_descr;
 797        /* Make sure the descriptor is cleared once there is any danger  */
 798        /* it may have been collected.                                   */
 799        (void)
 800          GC_general_register_disappearing_link((GC_PTR *)
 801                                                   ((word *)op+lw-1),
 802                                                   (GC_PTR) op);
 803        if (ff != GC_finalization_failures) {
 804            /* Couldn't register it due to lack of memory.  Punt.        */
 805            /* This will probably fail too, but gives the recovery code  */
 806            /* a chance.                                                 */
 807            return(GC_malloc(n*lb));
 808        }
 809    }
 810    return((GC_PTR) op);
 811 }