[BACK]Return to typd_mlc.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / gc

Annotation of OpenXM_contrib2/asir2000/gc/typd_mlc.c, Revision 1.3

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>