[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.6

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;
1.6     ! noro      440:            FIXUP_POINTER(current);
1.1       noro      441:            if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
1.2       noro      442:                PUSH_CONTENTS((ptr_t)current, mark_stack_ptr,
1.1       noro      443:                              mark_stack_limit, current_p, exit1);
                    444:            }
                    445:        }
                    446:     }
                    447:     if (GC_ext_descriptors[env].ed_continued) {
                    448:         /* Push an entry with the rest of the descriptor back onto the */
                    449:         /* stack.  Thus we never do too much work at once.  Note that  */
                    450:         /* we also can't overflow the mark stack unless we actually    */
                    451:         /* mark something.                                             */
                    452:         mark_stack_ptr++;
                    453:         if (mark_stack_ptr >= mark_stack_limit) {
                    454:             mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
                    455:         }
                    456:         mark_stack_ptr -> mse_start = addr + WORDSZ;
                    457:         mark_stack_ptr -> mse_descr =
1.3       noro      458:                GC_MAKE_PROC(GC_typed_mark_proc_index, env+1);
1.1       noro      459:     }
                    460:     return(mark_stack_ptr);
                    461: }
                    462:
                    463: /* Return the size of the object described by d.  It would be faster to        */
                    464: /* store this directly, or to compute it as part of                    */
                    465: /* GC_push_complex_descriptor, but hopefully it doesn't matter.                */
                    466: word GC_descr_obj_size(d)
                    467: register complex_descriptor *d;
                    468: {
                    469:     switch(d -> TAG) {
                    470:       case LEAF_TAG:
                    471:        return(d -> ld.ld_nelements * d -> ld.ld_size);
                    472:       case ARRAY_TAG:
                    473:         return(d -> ad.ad_nelements
                    474:                * GC_descr_obj_size(d -> ad.ad_element_descr));
                    475:       case SEQUENCE_TAG:
                    476:         return(GC_descr_obj_size(d -> sd.sd_first)
                    477:                + GC_descr_obj_size(d -> sd.sd_second));
                    478:       default:
                    479:         ABORT("Bad complex descriptor");
                    480:         /*NOTREACHED*/ return 0; /*NOTREACHED*/
                    481:     }
                    482: }
                    483:
                    484: /* Push descriptors for the object at addr with complex descriptor d   */
                    485: /* onto the mark stack.  Return 0 if the mark stack overflowed.        */
                    486: mse * GC_push_complex_descriptor(addr, d, msp, msl)
                    487: word * addr;
                    488: register complex_descriptor *d;
                    489: register mse * msp;
                    490: mse * msl;
                    491: {
                    492:     register ptr_t current = (ptr_t) addr;
                    493:     register word nelements;
                    494:     register word sz;
                    495:     register word i;
                    496:
                    497:     switch(d -> TAG) {
                    498:       case LEAF_TAG:
                    499:         {
                    500:           register GC_descr descr = d -> ld.ld_descriptor;
                    501:
                    502:           nelements = d -> ld.ld_nelements;
                    503:           if (msl - msp <= (ptrdiff_t)nelements) return(0);
                    504:           sz = d -> ld.ld_size;
                    505:           for (i = 0; i < nelements; i++) {
                    506:               msp++;
                    507:               msp -> mse_start = (word *)current;
                    508:               msp -> mse_descr = descr;
                    509:               current += sz;
                    510:           }
                    511:           return(msp);
                    512:         }
                    513:       case ARRAY_TAG:
                    514:         {
                    515:           register complex_descriptor *descr = d -> ad.ad_element_descr;
                    516:
                    517:           nelements = d -> ad.ad_nelements;
                    518:           sz = GC_descr_obj_size(descr);
                    519:           for (i = 0; i < nelements; i++) {
                    520:               msp = GC_push_complex_descriptor((word *)current, descr,
                    521:                                                msp, msl);
                    522:               if (msp == 0) return(0);
                    523:               current += sz;
                    524:           }
                    525:           return(msp);
                    526:         }
                    527:       case SEQUENCE_TAG:
                    528:         {
                    529:           sz = GC_descr_obj_size(d -> sd.sd_first);
                    530:           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
                    531:                                           msp, msl);
                    532:           if (msp == 0) return(0);
                    533:           current += sz;
                    534:           msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
                    535:                                           msp, msl);
                    536:           return(msp);
                    537:         }
                    538:       default:
                    539:         ABORT("Bad complex descriptor");
                    540:         /*NOTREACHED*/ return 0; /*NOTREACHED*/
                    541:    }
                    542: }
                    543:
                    544: /*ARGSUSED*/
1.3       noro      545: # if defined(__STDC__) || defined(__cplusplus)
                    546:     mse * GC_array_mark_proc(register word * addr,
                    547:                             register mse * mark_stack_ptr,
                    548:                             mse * mark_stack_limit,
                    549:                             word env)
                    550: # else
                    551:     mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
                    552:     register word * addr;
                    553:     register mse * mark_stack_ptr;
                    554:     mse * mark_stack_limit;
                    555:     word env;
                    556: # endif
1.1       noro      557: {
                    558:     register hdr * hhdr = HDR(addr);
                    559:     register word sz = hhdr -> hb_sz;
                    560:     register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
                    561:     mse * orig_mark_stack_ptr = mark_stack_ptr;
                    562:     mse * new_mark_stack_ptr;
                    563:
                    564:     if (descr == 0) {
                    565:        /* Found a reference to a free list entry.  Ignore it. */
                    566:        return(orig_mark_stack_ptr);
                    567:     }
                    568:     /* In use counts were already updated when array descriptor was    */
                    569:     /* pushed.  Here we only replace it by subobject descriptors, so   */
                    570:     /* no update is necessary.                                         */
                    571:     new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
                    572:                                                    mark_stack_ptr,
                    573:                                                    mark_stack_limit-1);
                    574:     if (new_mark_stack_ptr == 0) {
                    575:        /* Doesn't fit.  Conservatively push the whole array as a unit  */
                    576:        /* and request a mark stack expansion.                          */
                    577:        /* This cannot cause a mark stack overflow, since it replaces   */
                    578:        /* the original array entry.                                    */
                    579:        GC_mark_stack_too_small = TRUE;
                    580:        new_mark_stack_ptr = orig_mark_stack_ptr + 1;
                    581:        new_mark_stack_ptr -> mse_start = addr;
1.3       noro      582:        new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | GC_DS_LENGTH;
1.1       noro      583:     } else {
                    584:         /* Push descriptor itself */
                    585:         new_mark_stack_ptr++;
                    586:         new_mark_stack_ptr -> mse_start = addr + sz - 1;
1.3       noro      587:         new_mark_stack_ptr -> mse_descr = sizeof(word) | GC_DS_LENGTH;
1.1       noro      588:     }
                    589:     return(new_mark_stack_ptr);
                    590: }
                    591:
                    592: #if defined(__STDC__) || defined(__cplusplus)
                    593:   GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
                    594: #else
                    595:   GC_descr GC_make_descriptor(bm, len)
                    596:   GC_bitmap bm;
                    597:   size_t len;
                    598: #endif
                    599: {
                    600:     register signed_word last_set_bit = len - 1;
                    601:     register word result;
                    602:     register int i;
                    603: #   define HIGH_BIT (((word)1) << (WORDSZ - 1))
                    604:
                    605:     if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
                    606:     while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
                    607:     if (last_set_bit < 0) return(0 /* no pointers */);
                    608: #   if ALIGNMENT == CPP_WORDSZ/8
                    609:     {
                    610:       register GC_bool all_bits_set = TRUE;
                    611:       for (i = 0; i < last_set_bit; i++) {
                    612:        if (!GC_get_bit(bm, i)) {
                    613:            all_bits_set = FALSE;
                    614:            break;
                    615:        }
                    616:       }
                    617:       if (all_bits_set) {
                    618:        /* An initial section contains all pointers.  Use length descriptor. */
1.3       noro      619:         return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
1.1       noro      620:       }
                    621:     }
                    622: #   endif
                    623:     if (last_set_bit < BITMAP_BITS) {
                    624:        /* Hopefully the common case.                   */
                    625:        /* Build bitmap descriptor (with bits reversed) */
                    626:        result = HIGH_BIT;
                    627:        for (i = last_set_bit - 1; i >= 0; i--) {
                    628:            result >>= 1;
                    629:            if (GC_get_bit(bm, i)) result |= HIGH_BIT;
                    630:        }
1.3       noro      631:        result |= GC_DS_BITMAP;
1.1       noro      632:        return(result);
                    633:     } else {
                    634:        signed_word index;
                    635:
                    636:        index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
1.3       noro      637:        if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | GC_DS_LENGTH);
1.1       noro      638:                                /* Out of memory: use conservative      */
                    639:                                /* approximation.                       */
1.3       noro      640:        result = GC_MAKE_PROC(GC_typed_mark_proc_index, (word)index);
1.1       noro      641:        return(result);
                    642:     }
                    643: }
                    644:
                    645: ptr_t GC_clear_stack();
                    646:
                    647: #define GENERAL_MALLOC(lb,k) \
                    648:     (GC_PTR)GC_clear_stack(GC_generic_malloc((word)lb, k))
                    649:
                    650: #define GENERAL_MALLOC_IOP(lb,k) \
                    651:     (GC_PTR)GC_clear_stack(GC_generic_malloc_ignore_off_page(lb, k))
                    652:
                    653: #if defined(__STDC__) || defined(__cplusplus)
                    654:   void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
                    655: #else
                    656:   char * GC_malloc_explicitly_typed(lb, d)
                    657:   size_t lb;
                    658:   GC_descr d;
                    659: #endif
                    660: {
                    661: register ptr_t op;
                    662: register ptr_t * opp;
                    663: register word lw;
                    664: DCL_LOCK_STATE;
                    665:
1.3       noro      666:     lb += TYPD_EXTRA_BYTES;
1.1       noro      667:     if( SMALL_OBJ(lb) ) {
                    668: #       ifdef MERGE_SIZES
                    669:          lw = GC_size_map[lb];
                    670: #      else
                    671:          lw = ALIGNED_WORDS(lb);
                    672: #       endif
                    673:        opp = &(GC_eobjfreelist[lw]);
                    674:        FASTLOCK();
                    675:         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
                    676:             FASTUNLOCK();
                    677:             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
1.6     ! noro      678:            if (0 == op) return 0;
1.1       noro      679: #          ifdef MERGE_SIZES
1.6     ! noro      680:                lw = GC_size_map[lb];   /* May have been uninitialized. */
1.1       noro      681: #          endif
                    682:         } else {
                    683:             *opp = obj_link(op);
1.2       noro      684:            obj_link(op) = 0;
1.1       noro      685:             GC_words_allocd += lw;
                    686:             FASTUNLOCK();
                    687:         }
                    688:    } else {
                    689:        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
                    690:        if (op != NULL)
                    691:            lw = BYTES_TO_WORDS(GC_size(op));
                    692:    }
                    693:    if (op != NULL)
                    694:        ((word *)op)[lw - 1] = d;
                    695:    return((GC_PTR) op);
                    696: }
                    697:
                    698: #if defined(__STDC__) || defined(__cplusplus)
                    699:   void * GC_malloc_explicitly_typed_ignore_off_page(size_t lb, GC_descr d)
                    700: #else
                    701:   char * GC_malloc_explicitly_typed_ignore_off_page(lb, d)
                    702:   size_t lb;
                    703:   GC_descr d;
                    704: #endif
                    705: {
                    706: register ptr_t op;
                    707: register ptr_t * opp;
                    708: register word lw;
                    709: DCL_LOCK_STATE;
                    710:
1.3       noro      711:     lb += TYPD_EXTRA_BYTES;
1.1       noro      712:     if( SMALL_OBJ(lb) ) {
                    713: #       ifdef MERGE_SIZES
                    714:          lw = GC_size_map[lb];
                    715: #      else
                    716:          lw = ALIGNED_WORDS(lb);
                    717: #       endif
                    718:        opp = &(GC_eobjfreelist[lw]);
                    719:        FASTLOCK();
                    720:         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
                    721:             FASTUNLOCK();
                    722:             op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
                    723: #          ifdef MERGE_SIZES
1.6     ! noro      724:                lw = GC_size_map[lb];   /* May have been uninitialized. */
1.1       noro      725: #          endif
                    726:         } else {
                    727:             *opp = obj_link(op);
1.2       noro      728:            obj_link(op) = 0;
1.1       noro      729:             GC_words_allocd += lw;
                    730:             FASTUNLOCK();
                    731:         }
                    732:    } else {
                    733:        op = (ptr_t)GENERAL_MALLOC_IOP(lb, GC_explicit_kind);
                    734:        if (op != NULL)
                    735:        lw = BYTES_TO_WORDS(GC_size(op));
                    736:    }
                    737:    if (op != NULL)
1.2       noro      738:        ((word *)op)[lw - 1] = d;
1.1       noro      739:    return((GC_PTR) op);
                    740: }
                    741:
                    742: #if defined(__STDC__) || defined(__cplusplus)
                    743:   void * GC_calloc_explicitly_typed(size_t n,
                    744:                                    size_t lb,
                    745:                                    GC_descr d)
                    746: #else
                    747:   char * GC_calloc_explicitly_typed(n, lb, d)
                    748:   size_t n;
                    749:   size_t lb;
                    750:   GC_descr d;
                    751: #endif
                    752: {
                    753: register ptr_t op;
                    754: register ptr_t * opp;
                    755: register word lw;
                    756: GC_descr simple_descr;
                    757: complex_descriptor *complex_descr;
                    758: register int descr_type;
                    759: struct LeafDescriptor leaf;
                    760: DCL_LOCK_STATE;
                    761:
                    762:     descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
                    763:                                          &simple_descr, &complex_descr, &leaf);
                    764:     switch(descr_type) {
                    765:        case NO_MEM: return(0);
                    766:        case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
                    767:        case LEAF:
                    768:            lb *= n;
1.3       noro      769:            lb += sizeof(struct LeafDescriptor) + TYPD_EXTRA_BYTES;
1.1       noro      770:            break;
                    771:        case COMPLEX:
                    772:            lb *= n;
1.3       noro      773:            lb += TYPD_EXTRA_BYTES;
1.1       noro      774:            break;
                    775:     }
                    776:     if( SMALL_OBJ(lb) ) {
                    777: #       ifdef MERGE_SIZES
                    778:          lw = GC_size_map[lb];
                    779: #      else
                    780:          lw = ALIGNED_WORDS(lb);
                    781: #       endif
                    782:        opp = &(GC_arobjfreelist[lw]);
                    783:        FASTLOCK();
                    784:         if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
                    785:             FASTUNLOCK();
                    786:             op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
                    787:            if (0 == op) return(0);
                    788: #          ifdef MERGE_SIZES
                    789:                lw = GC_size_map[lb];   /* May have been uninitialized. */
                    790: #          endif
                    791:         } else {
                    792:             *opp = obj_link(op);
1.2       noro      793:            obj_link(op) = 0;
1.1       noro      794:             GC_words_allocd += lw;
                    795:             FASTUNLOCK();
                    796:         }
                    797:    } else {
                    798:        op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
                    799:        if (0 == op) return(0);
                    800:        lw = BYTES_TO_WORDS(GC_size(op));
                    801:    }
                    802:    if (descr_type == LEAF) {
                    803:        /* Set up the descriptor inside the object itself. */
                    804:        VOLATILE struct LeafDescriptor * lp =
                    805:            (struct LeafDescriptor *)
                    806:                ((word *)op
                    807:                 + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
                    808:
                    809:        lp -> ld_tag = LEAF_TAG;
                    810:        lp -> ld_size = leaf.ld_size;
                    811:        lp -> ld_nelements = leaf.ld_nelements;
                    812:        lp -> ld_descriptor = leaf.ld_descriptor;
                    813:        ((VOLATILE word *)op)[lw - 1] = (word)lp;
                    814:    } else {
                    815:        extern unsigned GC_finalization_failures;
                    816:        unsigned ff = GC_finalization_failures;
                    817:
                    818:        ((word *)op)[lw - 1] = (word)complex_descr;
                    819:        /* Make sure the descriptor is cleared once there is any danger */
                    820:        /* it may have been collected.                                  */
                    821:        (void)
                    822:          GC_general_register_disappearing_link((GC_PTR *)
                    823:                                                  ((word *)op+lw-1),
                    824:                                                          (GC_PTR) op);
                    825:        if (ff != GC_finalization_failures) {
                    826:           /* Couldn't register it due to lack of memory.  Punt.        */
                    827:           /* This will probably fail too, but gives the recovery code  */
                    828:           /* a chance.                                                 */
                    829:           return(GC_malloc(n*lb));
                    830:        }
                    831:    }
                    832:    return((GC_PTR) op);
                    833: }

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