typd_mlc.c

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