Back to index

lightning-sunbird  0.9+nobinonly
typd_mlc.c
Go to the documentation of this file.
00001 /*
00002  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
00003  *
00004  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
00005  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
00006  *
00007  * Permission is hereby granted to use or copy this program
00008  * for any purpose,  provided the above notices are retained on all copies.
00009  * Permission to modify the code and to distribute modified code is granted,
00010  * provided the above notices are retained, and a notice that the code was
00011  * modified is included with the above copyright notice.
00012  *
00013  */
00014 /* Boehm, July 31, 1995 5:02 pm PDT */
00015 
00016 
00017 /*
00018  * Some simple primitives for allocation with explicit type information.
00019  * Simple objects are allocated such that they contain a GC_descr at the
00020  * end (in the last allocated word).  This descriptor may be a procedure
00021  * which then examines an extended descriptor passed as its environment.
00022  *
00023  * Arrays are treated as simple objects if they have sufficiently simple
00024  * structure.  Otherwise they are allocated from an array kind that supplies
00025  * a special mark procedure.  These arrays contain a pointer to a
00026  * complex_descriptor as their last word.
00027  * This is done because the environment field is too small, and the collector
00028  * must trace the complex_descriptor.
00029  *
00030  * Note that descriptors inside objects may appear cleared, if we encounter a
00031  * false refrence to an object on a free list.  In the GC_descr case, this
00032  * is OK, since a 0 descriptor corresponds to examining no fields.
00033  * In the complex_descriptor case, we explicitly check for that case.
00034  *
00035  * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
00036  * since they are not accessible through the current interface.
00037  */
00038 
00039 #include "gc_priv.h"
00040 #include "gc_mark.h"
00041 #include "gc_typed.h"
00042 
00043 # ifdef ADD_BYTE_AT_END
00044 #   define EXTRA_BYTES (sizeof(word) - 1)
00045 # else
00046 #   define EXTRA_BYTES (sizeof(word))
00047 # endif
00048 
00049 GC_bool GC_explicit_typing_initialized = FALSE;
00050 
00051 int GC_explicit_kind;       /* Object kind for objects with indirect  */
00052                      /* (possibly extended) descriptors.              */
00053 
00054 int GC_array_kind;   /* Object kind for objects with complex          */
00055                      /* descriptors and GC_array_mark_proc.           */
00056 
00057 /* Extended descriptors.  GC_typed_mark_proc understands these.       */
00058 /* These are used for simple objects that are larger than what */
00059 /* can be described by a BITMAP_BITS sized bitmap.             */
00060 typedef struct {
00061        word ed_bitmap;      /* lsb corresponds to first word.  */
00062        GC_bool ed_continued;       /* next entry is continuation.     */
00063 } ext_descr;
00064 
00065 /* Array descriptors.  GC_array_mark_proc understands these.   */
00066 /* We may eventually need to add provisions for headers and    */
00067 /* trailers.  Hence we provide for tree structured descriptors, */
00068 /* though we don't really use them currently.                  */
00069 typedef union ComplexDescriptor {
00070     struct LeafDescriptor { /* Describes simple array   */
00071         word ld_tag;
00072 #      define LEAF_TAG 1
00073        word ld_size;        /* bytes per element */
00074                             /* multiple of ALIGNMENT    */
00075        word ld_nelements;   /* Number of elements.      */
00076        GC_descr ld_descriptor; /* A simple length, bitmap,     */
00077                             /* or procedure descriptor. */
00078     } ld;
00079     struct ComplexArrayDescriptor {
00080         word ad_tag;
00081 #      define ARRAY_TAG 2
00082        word ad_nelements;
00083        union ComplexDescriptor * ad_element_descr;
00084     } ad;
00085     struct SequenceDescriptor {
00086         word sd_tag;
00087 #      define SEQUENCE_TAG 3
00088        union ComplexDescriptor * sd_first;
00089        union ComplexDescriptor * sd_second;
00090     } sd;
00091 } complex_descriptor;
00092 #define TAG ld.ld_tag
00093 
00094 ext_descr * GC_ext_descriptors;    /* Points to array of extended     */
00095                             /* descriptors.                    */
00096 
00097 word GC_ed_size = 0; /* Current size of above arrays.   */
00098 # define ED_INITIAL_SIZE 100;
00099 
00100 word GC_avail_descr = 0;    /* Next available slot.            */
00101 
00102 int GC_typed_mark_proc_index;      /* Indices of my mark              */
00103 int GC_array_mark_proc_index;      /* procedures.                     */
00104 
00105 /* Add a multiword bitmap to GC_ext_descriptors arrays.  Return       */
00106 /* starting index.                                      */
00107 /* Returns -1 on failure.                               */
00108 /* Caller does not hold allocation lock.                */
00109 signed_word GC_add_ext_descriptor(bm, nbits)
00110 GC_bitmap bm;
00111 word nbits;
00112 {
00113     register size_t nwords = divWORDSZ(nbits + WORDSZ-1);
00114     register signed_word result;
00115     register word i;
00116     register word last_part;
00117     register int extra_bits;
00118     DCL_LOCK_STATE;
00119 
00120     DISABLE_SIGNALS();
00121     LOCK();
00122     while (GC_avail_descr + nwords >= GC_ed_size) {
00123        ext_descr * new;
00124        size_t new_size;
00125        word ed_size = GC_ed_size;
00126        
00127        UNLOCK();
00128         ENABLE_SIGNALS();
00129        if (ed_size == 0) {
00130            new_size = ED_INITIAL_SIZE;
00131        } else {
00132            new_size = 2 * ed_size;
00133            if (new_size > MAX_ENV) return(-1);
00134        } 
00135        new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
00136        if (new == 0) return(-1);
00137        DISABLE_SIGNALS();
00138         LOCK();
00139         if (ed_size == GC_ed_size) {
00140             if (GC_avail_descr != 0) {
00141                BCOPY(GC_ext_descriptors, new,
00142                      GC_avail_descr * sizeof(ext_descr));
00143            }
00144            GC_ed_size = new_size;
00145            GC_ext_descriptors = new;
00146        }  /* else another thread already resized it in the meantime */
00147     }
00148     result = GC_avail_descr;
00149     for (i = 0; i < nwords-1; i++) {
00150         GC_ext_descriptors[result + i].ed_bitmap = bm[i];
00151         GC_ext_descriptors[result + i].ed_continued = TRUE;
00152     }
00153     last_part = bm[i];
00154     /* Clear irrelevant bits. */
00155     extra_bits = nwords * WORDSZ - nbits;
00156     last_part <<= extra_bits;
00157     last_part >>= extra_bits;
00158     GC_ext_descriptors[result + i].ed_bitmap = last_part;
00159     GC_ext_descriptors[result + i].ed_continued = FALSE;
00160     GC_avail_descr += nwords;
00161     UNLOCK();
00162     ENABLE_SIGNALS();
00163     return(result);
00164 }
00165 
00166 /* Table of bitmap descriptors for n word long all pointer objects.   */
00167 GC_descr GC_bm_table[WORDSZ/2];
00168        
00169 /* Return a descriptor for the concatenation of 2 nwords long objects,       */
00170 /* each of which is described by descriptor.                          */
00171 /* The result is known to be short enough to fit into a bitmap        */
00172 /* descriptor.                                                        */
00173 /* Descriptor is a DS_LENGTH or DS_BITMAP descriptor.                 */
00174 GC_descr GC_double_descr(descriptor, nwords)
00175 register GC_descr descriptor;
00176 register word nwords;
00177 {
00178     if (descriptor && DS_TAGS == DS_LENGTH) {
00179         descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
00180     };
00181     descriptor |= (descriptor & ~DS_TAGS) >> nwords;
00182     return(descriptor);
00183 }
00184 
00185 complex_descriptor * GC_make_sequence_descriptor();
00186 
00187 /* Build a descriptor for an array with nelements elements,    */
00188 /* each of which can be described by a simple descriptor.      */
00189 /* We try to optimize some common cases.                */
00190 /* If the result is COMPLEX, then a complex_descr* is returned  */
00191 /* in *complex_d.                                              */
00192 /* If the result is LEAF, then we built a LeafDescriptor in    */
00193 /* the structure pointed to by leaf.                           */
00194 /* The tag in the leaf structure is not set.                   */
00195 /* If the result is SIMPLE, then a GC_descr                    */
00196 /* is returned in *simple_d.                                   */
00197 /* If the result is NO_MEM, then                        */
00198 /* we failed to allocate the descriptor.                */
00199 /* The implementation knows that DS_LENGTH is 0.        */
00200 /* *leaf, *complex_d, and *simple_d may be used as temporaries */
00201 /* during the construction.                             */
00202 # define COMPLEX 2
00203 # define LEAF 1
00204 # define SIMPLE 0
00205 # define NO_MEM (-1)
00206 int GC_make_array_descriptor(nelements, size, descriptor,
00207                           simple_d, complex_d, leaf)
00208 word size;
00209 word nelements;
00210 GC_descr descriptor;
00211 GC_descr *simple_d;
00212 complex_descriptor **complex_d;
00213 struct LeafDescriptor * leaf;
00214 {
00215 #   define OPT_THRESHOLD 50
00216        /* For larger arrays, we try to combine descriptors of adjacent       */
00217        /* descriptors to speed up marking, and to reduce the amount   */
00218        /* of space needed on the mark stack.                          */
00219     if ((descriptor & DS_TAGS) == DS_LENGTH) {
00220       if ((word)descriptor == size) {
00221        *simple_d = nelements * descriptor;
00222        return(SIMPLE);
00223       } else if ((word)descriptor == 0) {
00224         *simple_d = (GC_descr)0;
00225         return(SIMPLE);
00226       }
00227     }
00228     if (nelements <= OPT_THRESHOLD) {
00229       if (nelements <= 1) {
00230         if (nelements == 1) {
00231             *simple_d = descriptor;
00232             return(SIMPLE);
00233         } else {
00234             *simple_d = (GC_descr)0;
00235             return(SIMPLE);
00236         }
00237       }
00238     } else if (size <= BITMAP_BITS/2
00239               && (descriptor & DS_TAGS) != DS_PROC
00240               && (size & (sizeof(word)-1)) == 0) {
00241       int result =      
00242           GC_make_array_descriptor(nelements/2, 2*size,
00243                                GC_double_descr(descriptor,
00244                                              BYTES_TO_WORDS(size)),
00245                                simple_d, complex_d, leaf);
00246       if ((nelements & 1) == 0) {
00247           return(result);
00248       } else {
00249           struct LeafDescriptor * one_element =
00250               (struct LeafDescriptor *)
00251               GC_malloc_atomic(sizeof(struct LeafDescriptor));
00252           
00253           if (result == NO_MEM || one_element == 0) return(NO_MEM);
00254           one_element -> ld_tag = LEAF_TAG;
00255           one_element -> ld_size = size;
00256           one_element -> ld_nelements = 1;
00257           one_element -> ld_descriptor = descriptor;
00258           switch(result) {
00259             case SIMPLE:
00260             {
00261               struct LeafDescriptor * beginning =
00262                 (struct LeafDescriptor *)
00263                 GC_malloc_atomic(sizeof(struct LeafDescriptor));
00264               if (beginning == 0) return(NO_MEM);
00265               beginning -> ld_tag = LEAF_TAG;
00266               beginning -> ld_size = size;
00267               beginning -> ld_nelements = 1;
00268               beginning -> ld_descriptor = *simple_d;
00269               *complex_d = GC_make_sequence_descriptor(
00270                                    (complex_descriptor *)beginning,
00271                                    (complex_descriptor *)one_element);
00272               break;
00273             }
00274             case LEAF:
00275             {
00276               struct LeafDescriptor * beginning =
00277                 (struct LeafDescriptor *)
00278                 GC_malloc_atomic(sizeof(struct LeafDescriptor));
00279               if (beginning == 0) return(NO_MEM);
00280               beginning -> ld_tag = LEAF_TAG;
00281               beginning -> ld_size = leaf -> ld_size;
00282               beginning -> ld_nelements = leaf -> ld_nelements;
00283               beginning -> ld_descriptor = leaf -> ld_descriptor;
00284               *complex_d = GC_make_sequence_descriptor(
00285                                    (complex_descriptor *)beginning,
00286                                    (complex_descriptor *)one_element);
00287               break;
00288             }
00289             case COMPLEX:
00290               *complex_d = GC_make_sequence_descriptor(
00291                                    *complex_d,
00292                                    (complex_descriptor *)one_element);
00293               break;
00294           }
00295           return(COMPLEX);
00296       }
00297     }
00298     {
00299         leaf -> ld_size = size;
00300         leaf -> ld_nelements = nelements;
00301         leaf -> ld_descriptor = descriptor;
00302         return(LEAF);
00303     }
00304 }
00305 
00306 complex_descriptor * GC_make_sequence_descriptor(first, second)
00307 complex_descriptor * first;
00308 complex_descriptor * second;
00309 {
00310     struct SequenceDescriptor * result =
00311         (struct SequenceDescriptor *)
00312               GC_malloc(sizeof(struct SequenceDescriptor));
00313     /* Can't result in overly conservative marking, since tags are    */
00314     /* very small integers. Probably faster than maintaining type     */
00315     /* info.                                                   */    
00316     if (result != 0) {
00317        result -> sd_tag = SEQUENCE_TAG;
00318         result -> sd_first = first;
00319         result -> sd_second = second;
00320     }
00321     return((complex_descriptor *)result);
00322 }
00323 
00324 #ifdef UNDEFINED
00325 complex_descriptor * GC_make_complex_array_descriptor(nelements, descr)
00326 word nelements;
00327 complex_descriptor * descr;
00328 {
00329     struct ComplexArrayDescriptor * result =
00330         (struct ComplexArrayDescriptor *)
00331               GC_malloc(sizeof(struct ComplexArrayDescriptor));
00332     
00333     if (result != 0) {
00334        result -> ad_tag = ARRAY_TAG;
00335         result -> ad_nelements = nelements;
00336         result -> ad_element_descr = descr;
00337     }
00338     return((complex_descriptor *)result);
00339 }
00340 #endif
00341 
00342 ptr_t * GC_eobjfreelist;
00343 
00344 ptr_t * GC_arobjfreelist;
00345 
00346 mse * GC_typed_mark_proc();
00347 
00348 mse * GC_array_mark_proc();
00349 
00350 GC_descr GC_generic_array_descr;
00351 
00352 /* Caller does not hold allocation lock. */
00353 void GC_init_explicit_typing()
00354 {
00355     register int i;
00356     DCL_LOCK_STATE;
00357 
00358     
00359 #   ifdef PRINTSTATS
00360        if (sizeof(struct LeafDescriptor) % sizeof(word) != 0)
00361            ABORT("Bad leaf descriptor size");
00362 #   endif
00363     DISABLE_SIGNALS();
00364     LOCK();
00365     if (GC_explicit_typing_initialized) {
00366       UNLOCK();
00367       ENABLE_SIGNALS();
00368       return;
00369     }
00370     GC_explicit_typing_initialized = TRUE;
00371     /* Set up object kind with simple indirect descriptor. */
00372       GC_eobjfreelist = (ptr_t *)
00373           GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
00374       if (GC_eobjfreelist == 0) ABORT("Couldn't allocate GC_eobjfreelist");
00375       BZERO(GC_eobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
00376       GC_explicit_kind = GC_n_kinds++;
00377       GC_obj_kinds[GC_explicit_kind].ok_freelist = GC_eobjfreelist;
00378       GC_obj_kinds[GC_explicit_kind].ok_reclaim_list = 0;
00379       GC_obj_kinds[GC_explicit_kind].ok_descriptor =
00380               (((word)WORDS_TO_BYTES(-1)) | DS_PER_OBJECT);
00381       GC_obj_kinds[GC_explicit_kind].ok_relocate_descr = TRUE;
00382       GC_obj_kinds[GC_explicit_kind].ok_init = TRUE;
00383               /* Descriptors are in the last word of the object. */
00384       GC_typed_mark_proc_index = GC_n_mark_procs;
00385       GC_mark_procs[GC_typed_mark_proc_index] = GC_typed_mark_proc;
00386       GC_n_mark_procs++;
00387         /* Moving this up breaks DEC AXP compiler.      */
00388     /* Set up object kind with array descriptor. */
00389       GC_arobjfreelist = (ptr_t *)
00390           GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
00391       if (GC_arobjfreelist == 0) ABORT("Couldn't allocate GC_arobjfreelist");
00392       BZERO(GC_arobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
00393       if (GC_n_mark_procs >= MAX_MARK_PROCS)
00394               ABORT("No slot for array mark proc");
00395       GC_array_mark_proc_index = GC_n_mark_procs++;
00396       if (GC_n_kinds >= MAXOBJKINDS)
00397               ABORT("No kind available for array objects");
00398       GC_array_kind = GC_n_kinds++;
00399       GC_obj_kinds[GC_array_kind].ok_freelist = GC_arobjfreelist;
00400       GC_obj_kinds[GC_array_kind].ok_reclaim_list = 0;
00401       GC_obj_kinds[GC_array_kind].ok_descriptor =
00402               MAKE_PROC(GC_array_mark_proc_index, 0);;
00403       GC_obj_kinds[GC_array_kind].ok_relocate_descr = FALSE;
00404       GC_obj_kinds[GC_array_kind].ok_init = TRUE;
00405               /* Descriptors are in the last word of the object. */
00406             GC_mark_procs[GC_array_mark_proc_index] = GC_array_mark_proc;
00407       for (i = 0; i < WORDSZ/2; i++) {
00408           GC_descr d = (((word)(-1)) >> (WORDSZ - i)) << (WORDSZ - i);
00409           d |= DS_BITMAP;
00410           GC_bm_table[i] = d;
00411       }
00412       GC_generic_array_descr = MAKE_PROC(GC_array_mark_proc_index, 0); 
00413     UNLOCK();
00414     ENABLE_SIGNALS();
00415 }
00416 
00417 mse * GC_typed_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
00418 register word * addr;
00419 register mse * mark_stack_ptr;
00420 mse * mark_stack_limit;
00421 word env;
00422 {
00423     register word bm = GC_ext_descriptors[env].ed_bitmap;
00424     register word * current_p = addr;
00425     register word current;
00426     register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
00427     register ptr_t least_ha = GC_least_plausible_heap_addr;
00428     
00429     for (; bm != 0; bm >>= 1, current_p++) {
00430        if (bm & 1) {
00431            current = *current_p;
00432            if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
00433                PUSH_CONTENTS(current, mark_stack_ptr,
00434                            mark_stack_limit, current_p, exit1);
00435            }
00436        }
00437     }
00438     if (GC_ext_descriptors[env].ed_continued) {
00439         /* Push an entry with the rest of the descriptor back onto the       */
00440         /* stack.  Thus we never do too much work at once.  Note that */
00441         /* we also can't overflow the mark stack unless we actually   */
00442         /* mark something.                                     */
00443         mark_stack_ptr++;
00444         if (mark_stack_ptr >= mark_stack_limit) {
00445             mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
00446         }
00447         mark_stack_ptr -> mse_start = addr + WORDSZ;
00448         mark_stack_ptr -> mse_descr =
00449               MAKE_PROC(GC_typed_mark_proc_index, env+1);
00450     }
00451     return(mark_stack_ptr);
00452 }
00453 
00454 /* Return the size of the object described by d.  It would be faster to      */
00455 /* store this directly, or to compute it as part of                   */
00456 /* GC_push_complex_descriptor, but hopefully it doesn't matter.              */
00457 word GC_descr_obj_size(d)
00458 register complex_descriptor *d;
00459 {
00460     switch(d -> TAG) {
00461       case LEAF_TAG:
00462        return(d -> ld.ld_nelements * d -> ld.ld_size);
00463       case ARRAY_TAG:
00464         return(d -> ad.ad_nelements
00465                * GC_descr_obj_size(d -> ad.ad_element_descr));
00466       case SEQUENCE_TAG:
00467         return(GC_descr_obj_size(d -> sd.sd_first)
00468                + GC_descr_obj_size(d -> sd.sd_second));
00469       default:
00470         ABORT("Bad complex descriptor");
00471         /*NOTREACHED*/ return 0; /*NOTREACHED*/
00472     }
00473 }
00474 
00475 /* Push descriptors for the object at addr with complex descriptor d  */
00476 /* onto the mark stack.  Return 0 if the mark stack overflowed.       */
00477 mse * GC_push_complex_descriptor(addr, d, msp, msl)
00478 word * addr;
00479 register complex_descriptor *d;
00480 register mse * msp;
00481 mse * msl;
00482 {
00483     register ptr_t current = (ptr_t) addr;
00484     register word nelements;
00485     register word sz;
00486     register word i;
00487     
00488     switch(d -> TAG) {
00489       case LEAF_TAG:
00490         {
00491           register GC_descr descr = d -> ld.ld_descriptor;
00492           
00493           nelements = d -> ld.ld_nelements;
00494           if (msl - msp <= (ptrdiff_t)nelements) return(0);
00495           sz = d -> ld.ld_size;
00496           for (i = 0; i < nelements; i++) {
00497               msp++;
00498               msp -> mse_start = (word *)current;
00499               msp -> mse_descr = descr;
00500               current += sz;
00501           }
00502           return(msp);
00503         }
00504       case ARRAY_TAG:
00505         {
00506           register complex_descriptor *descr = d -> ad.ad_element_descr;
00507           
00508           nelements = d -> ad.ad_nelements;
00509           sz = GC_descr_obj_size(descr);
00510           for (i = 0; i < nelements; i++) {
00511               msp = GC_push_complex_descriptor((word *)current, descr,
00512                                                  msp, msl);
00513               if (msp == 0) return(0);
00514               current += sz;
00515           }
00516           return(msp);
00517         }
00518       case SEQUENCE_TAG:
00519         {
00520           sz = GC_descr_obj_size(d -> sd.sd_first);
00521           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
00522                                       msp, msl);
00523           if (msp == 0) return(0);
00524           current += sz;
00525           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
00526                                       msp, msl);
00527           return(msp);
00528         }
00529       default:
00530         ABORT("Bad complex descriptor");
00531         /*NOTREACHED*/ return 0; /*NOTREACHED*/
00532    }
00533 }
00534 
00535 /*ARGSUSED*/
00536 mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
00537 register word * addr;
00538 register mse * mark_stack_ptr;
00539 mse * mark_stack_limit;
00540 word env;
00541 {
00542     register hdr * hhdr = HDR(addr);
00543     register word sz = hhdr -> hb_sz;
00544     register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
00545     mse * orig_mark_stack_ptr = mark_stack_ptr;
00546     mse * new_mark_stack_ptr;
00547     
00548     if (descr == 0) {
00549        /* Found a reference to a free list entry.  Ignore it. */
00550        return(orig_mark_stack_ptr);
00551     }
00552     /* In use counts were already updated when array descriptor was   */
00553     /* pushed.  Here we only replace it by subobject descriptors, so  */
00554     /* no update is necessary.                                        */
00555     new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
00556                                               mark_stack_ptr,
00557                                               mark_stack_limit-1);
00558     if (new_mark_stack_ptr == 0) {
00559        /* Doesn't fit.  Conservatively push the whole array as a unit */
00560        /* and request a mark stack expansion.                         */
00561        /* This cannot cause a mark stack overflow, since it replaces  */
00562        /* the original array entry.                                   */
00563        GC_mark_stack_too_small = TRUE;
00564        new_mark_stack_ptr = orig_mark_stack_ptr + 1;
00565        new_mark_stack_ptr -> mse_start = addr;
00566        new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | DS_LENGTH;
00567     } else {
00568         /* Push descriptor itself */
00569         new_mark_stack_ptr++;
00570         new_mark_stack_ptr -> mse_start = addr + sz - 1;
00571         new_mark_stack_ptr -> mse_descr = sizeof(word) | DS_LENGTH;
00572     }
00573     return(new_mark_stack_ptr);
00574 }
00575 
00576 #if defined(__STDC__) || defined(__cplusplus)
00577   GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
00578 #else
00579   GC_descr GC_make_descriptor(bm, len)
00580   GC_bitmap bm;
00581   size_t len;
00582 #endif
00583 {
00584     register signed_word last_set_bit = len - 1;
00585     register word result;
00586     register int i;
00587 #   define HIGH_BIT (((word)1) << (WORDSZ - 1))
00588     
00589     if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
00590     while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
00591     if (last_set_bit < 0) return(0 /* no pointers */);
00592 #   if ALIGNMENT == CPP_WORDSZ/8
00593     {
00594       register GC_bool all_bits_set = TRUE;
00595       for (i = 0; i < last_set_bit; i++) {
00596        if (!GC_get_bit(bm, i)) {
00597            all_bits_set = FALSE;
00598            break;
00599        }
00600       }
00601       if (all_bits_set) {
00602        /* An initial section contains all pointers.  Use length descriptor. */
00603         return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
00604       }
00605     }
00606 #   endif
00607     if (last_set_bit < BITMAP_BITS) {
00608        /* Hopefully the common case.                    */
00609        /* Build bitmap descriptor (with bits reversed)  */
00610        result = HIGH_BIT;
00611        for (i = last_set_bit - 1; i >= 0; i--) {
00612            result >>= 1;
00613            if (GC_get_bit(bm, i)) result |= HIGH_BIT;
00614        }
00615        result |= DS_BITMAP;
00616        return(result);
00617     } else {
00618        signed_word index;
00619        
00620        index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
00621        if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
00622                             /* Out of memory: use conservative */
00623                             /* approximation.                  */
00624        result = MAKE_PROC(GC_typed_mark_proc_index, (word)index);
00625        return(result);
00626     }
00627 }
00628 
00629 ptr_t GC_clear_stack();
00630 
00631 #define GENERAL_MALLOC(lb,k) \
00632     (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
00633     
00634 #define GENERAL_MALLOC_IOP(lb,k) \
00635     (GC_PTR)GC_clear_stack(GC_generic_malloc_ignore_off_page(lb, k))
00636 
00637 #if defined(__STDC__) || defined(__cplusplus)
00638   void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
00639 #else
00640   char * GC_malloc_explicitly_typed(lb, d)
00641   size_t lb;
00642   GC_descr d;
00643 #endif
00644 {
00645 register ptr_t op;
00646 register ptr_t * opp;
00647 register word lw;
00648 DCL_LOCK_STATE;
00649 
00650     lb += EXTRA_BYTES;
00651     if( SMALL_OBJ(lb) ) {
00652 #       ifdef MERGE_SIZES
00653          lw = GC_size_map[lb];
00654 #      else
00655          lw = ALIGNED_WORDS(lb);
00656 #       endif
00657        opp = &(GC_eobjfreelist[lw]);
00658        FASTLOCK();
00659         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
00660             FASTUNLOCK();
00661             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
00662            if (0 == op) return(0);
00663 #          ifdef MERGE_SIZES
00664               lw = GC_size_map[lb];       /* May have been uninitialized.    */            
00665 #          endif
00666         } else {
00667             *opp = obj_link(op);
00668             GC_words_allocd += lw;
00669             FASTUNLOCK();
00670         }
00671    } else {
00672        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
00673        if (op != NULL)
00674            lw = BYTES_TO_WORDS(GC_size(op));
00675    }
00676    if (op != NULL)
00677        ((word *)op)[lw - 1] = d;
00678    return((GC_PTR) op);
00679 }
00680 
00681 #if defined(__STDC__) || defined(__cplusplus)
00682   void * GC_malloc_explicitly_typed_ignore_off_page(size_t lb, GC_descr d)
00683 #else
00684   char * GC_malloc_explicitly_typed_ignore_off_page(lb, d)
00685   size_t lb;
00686   GC_descr d;
00687 #endif
00688 {
00689 register ptr_t op;
00690 register ptr_t * opp;
00691 register word lw;
00692 DCL_LOCK_STATE;
00693 
00694     lb += EXTRA_BYTES;
00695     if( SMALL_OBJ(lb) ) {
00696 #       ifdef MERGE_SIZES
00697          lw = GC_size_map[lb];
00698 #      else
00699          lw = ALIGNED_WORDS(lb);
00700 #       endif
00701        opp = &(GC_eobjfreelist[lw]);
00702        FASTLOCK();
00703         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
00704             FASTUNLOCK();
00705             op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
00706 #          ifdef MERGE_SIZES
00707               lw = GC_size_map[lb];       /* May have been uninitialized.    */            
00708 #          endif
00709         } else {
00710             *opp = obj_link(op);
00711             GC_words_allocd += lw;
00712             FASTUNLOCK();
00713         }
00714    } else {
00715        op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
00716        if (op != NULL)
00717        lw = BYTES_TO_WORDS(GC_size(op));
00718    }
00719    if (op != NULL)
00720    ((word *)op)[lw - 1] = d;
00721    return((GC_PTR) op);
00722 }
00723 
00724 #if defined(__STDC__) || defined(__cplusplus)
00725   void * GC_calloc_explicitly_typed(size_t n,
00726                                 size_t lb,
00727                                 GC_descr d)
00728 #else
00729   char * GC_calloc_explicitly_typed(n, lb, d)
00730   size_t n;
00731   size_t lb;
00732   GC_descr d;
00733 #endif
00734 {
00735 register ptr_t op;
00736 register ptr_t * opp;
00737 register word lw;
00738 GC_descr simple_descr;
00739 complex_descriptor *complex_descr;
00740 register int descr_type;
00741 struct LeafDescriptor leaf;
00742 DCL_LOCK_STATE;
00743 
00744     descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
00745                                      &simple_descr, &complex_descr, &leaf);
00746     switch(descr_type) {
00747        case NO_MEM: return(0);
00748        case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
00749        case LEAF:
00750            lb *= n;
00751            lb += sizeof(struct LeafDescriptor) + EXTRA_BYTES;
00752            break;
00753        case COMPLEX:
00754            lb *= n;
00755            lb += EXTRA_BYTES;
00756            break;
00757     }
00758     if( SMALL_OBJ(lb) ) {
00759 #       ifdef MERGE_SIZES
00760          lw = GC_size_map[lb];
00761 #      else
00762          lw = ALIGNED_WORDS(lb);
00763 #       endif
00764        opp = &(GC_arobjfreelist[lw]);
00765        FASTLOCK();
00766         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
00767             FASTUNLOCK();
00768             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
00769            if (0 == op) return(0);
00770 #          ifdef MERGE_SIZES
00771               lw = GC_size_map[lb];       /* May have been uninitialized.    */            
00772 #          endif
00773         } else {
00774             *opp = obj_link(op);
00775             GC_words_allocd += lw;
00776             FASTUNLOCK();
00777         }
00778    } else {
00779        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
00780        if (0 == op) return(0);
00781        lw = BYTES_TO_WORDS(GC_size(op));
00782    }
00783    if (descr_type == LEAF) {
00784        /* Set up the descriptor inside the object itself. */
00785        VOLATILE struct LeafDescriptor * lp =
00786            (struct LeafDescriptor *)
00787                ((word *)op
00788                 + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
00789                 
00790        lp -> ld_tag = LEAF_TAG;
00791        lp -> ld_size = leaf.ld_size;
00792        lp -> ld_nelements = leaf.ld_nelements;
00793        lp -> ld_descriptor = leaf.ld_descriptor;
00794        ((VOLATILE word *)op)[lw - 1] = (word)lp;
00795    } else {
00796        extern unsigned GC_finalization_failures;
00797        unsigned ff = GC_finalization_failures;
00798        
00799        ((word *)op)[lw - 1] = (word)complex_descr;
00800        /* Make sure the descriptor is cleared once there is any danger       */
00801        /* it may have been collected.                                 */
00802        (void)
00803          GC_general_register_disappearing_link((GC_PTR *)
00804                                             ((word *)op+lw-1),
00805                                                     (GC_PTR) op);
00806        if (ff != GC_finalization_failures) {
00807           /* Couldn't register it due to lack of memory.  Punt.       */
00808           /* This will probably fail too, but gives the recovery code  */
00809           /* a chance.                                                */
00810           return(GC_malloc(n*lb));
00811        }                              
00812    }
00813    return((GC_PTR) op);
00814 }