typd_mlc.c

Boost provides free peer-reviewed portable C++ source libraries. We emphasize libraries that work

/*
 * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
 * opyright (c) 1999-2000 by Hewlett-Packard Company.  All rights reserved.
 *
 * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
 * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
 *
 * Permission is hereby granted to use or copy this program
 * for any purpose,  provided the above notices are retained on all copies.
 * Permission to modify the code and to distribute modified code is granted,
 * provided the above notices are retained, and a notice that the code was
 * modified is included with the above copyright notice.
 *
 */


/*
 * Some simple primitives for allocation with explicit type information.
 * Simple objects are allocated such that they contain a GC_descr at the
 * end (in the last allocated word).  This descriptor may be a procedure
 * which then examines an extended descriptor passed as its environment.
 *
 * Arrays are treated as simple objects if they have sufficiently simple
 * structure.  Otherwise they are allocated from an array kind that supplies
 * a special mark procedure.  These arrays contain a pointer to a
 * complex_descriptor as their last word.
 * This is done because the environment field is too small, and the collector
 * must trace the complex_descriptor.
 *
 * Note that descriptors inside objects may appear cleared, if we encounter a
 * false refrence to an object on a free list.  In the GC_descr case, this
 * is OK, since a 0 descriptor corresponds to examining no fields.
 * In the complex_descriptor case, we explicitly check for that case.
 *
 * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
 * since they are not accessible through the current interface.
 */

#include "private/gc_pmark.h"
#include "gc_typed.h"

# define TYPD_EXTRA_BYTES (sizeof(word) - EXTRA_BYTES)

GC_bool GC_explicit_typing_initialized = FALSE;

int GC_explicit_kind;	/* Object kind for objects with indirect	*/
			/* (possibly extended) descriptors.		*/

int GC_array_kind;	/* Object kind for objects with complex		*/
			/* descriptors and GC_array_mark_proc.		*/

/* Extended descriptors.  GC_typed_mark_proc understands these.	*/
/* These are used for simple objects that are larger than what	*/
/* can be described by a BITMAP_BITS sized bitmap.		*/
typedef struct {
	word ed_bitmap;	/* lsb corresponds to first word.	*/
	GC_bool ed_continued;	/* next entry is continuation.	*/
} ext_descr;

/* Array descriptors.  GC_array_mark_proc understands these.	*/
/* We may eventually need to add provisions for headers and	*/
/* trailers.  Hence we provide for tree structured descriptors, */
/* though we don't really use them currently.			*/
typedef union ComplexDescriptor {
    struct LeafDescriptor {	/* Describes simple array	*/
        word ld_tag;
#	define LEAF_TAG 1
	size_t ld_size;		/* bytes per element	*/
				/* multiple of ALIGNMENT	*/
	size_t ld_nelements;	/* Number of elements.	*/
	GC_descr ld_descriptor; /* A simple length, bitmap,	*/
				/* or procedure descriptor.	*/
    } ld;
    struct ComplexArrayDescriptor {
        word ad_tag;
#	define ARRAY_TAG 2
	size_t ad_nelements;
	union ComplexDescriptor * ad_element_descr;
    } ad;
    struct SequenceDescriptor {
        word sd_tag;
#	define SEQUENCE_TAG 3
	union ComplexDescriptor * sd_first;
	union ComplexDescriptor * sd_second;
    } sd;
} complex_descriptor;
#define TAG ld.ld_tag

ext_descr * GC_ext_descriptors;	/* Points to array of extended 	*/
				/* descriptors.			*/

size_t GC_ed_size = 0;	/* Current size of above arrays.	*/
# define ED_INITIAL_SIZE 100;

size_t GC_avail_descr = 0;	/* Next available slot.		*/

int GC_typed_mark_proc_index;	/* Indices of my mark		*/
int GC_array_mark_proc_index;	/* procedures.			*/

/* Add a multiword bitmap to GC_ext_descriptors arrays.  Return	*/
/* starting index.						*/
/* Returns -1 on failure.					*/
/* Caller does not hold allocation lock.			*/
signed_word GC_add_ext_descriptor(GC_bitmap bm, word nbits)
{
    size_t nwords = divWORDSZ(nbits + WORDSZ-1);
    signed_word result;
    size_t i;
    word last_part;
    size_t extra_bits;
    DCL_LOCK_STATE;

    LOCK();
    while (GC_avail_descr + nwords >= GC_ed_size) {
    	ext_descr * new;
    	size_t new_size;
    	word ed_size = GC_ed_size;
    	
    	UNLOCK();
    	if (ed_size == 0) {
    	    new_size = ED_INITIAL_SIZE;
    	} else {
    	    new_size = 2 * ed_size;
    	    if (new_size > MAX_ENV) return(-1);
    	} 
    	new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
    	if (new == 0) return(-1);
        LOCK();
        if (ed_size == GC_ed_size) {
            if (GC_avail_descr != 0) {
    	        BCOPY(GC_ext_descriptors, new,
    	              GC_avail_descr * sizeof(ext_descr));
    	    }
    	    GC_ed_size = new_size;
    	    GC_ext_descriptors = new;
    	}  /* else another thread already resized it in the meantime */
    }
    result = GC_avail_descr;
    for (i = 0; i < nwords-1; i++) {
        GC_ext_descriptors[result + i].ed_bitmap = bm[i];
        GC_ext_descriptors[result + i].ed_continued = TRUE;
    }
    last_part = bm[i];
    /* Clear irrelevant bits. */
    extra_bits = nwords * WORDSZ - nbits;
    last_part <<= extra_bits;
    last_part >>= extra_bits;
    GC_ext_descriptors[result + i].ed_bitmap = last_part;
    GC_ext_descriptors[result + i].ed_continued = FALSE;
    GC_avail_descr += nwords;
    UNLOCK();
    return(result);
}

/* Table of bitmap descriptors for n word long all pointer objects.	*/
GC_descr GC_bm_table[WORDSZ/2];
	
/* Return a descriptor for the concatenation of 2 nwords long objects,	*/
/* each of which is described by descriptor.				*/
/* The result is known to be short enough to fit into a bitmap		*/
/* descriptor.								*/
/* Descriptor is a GC_DS_LENGTH or GC_DS_BITMAP descriptor.		*/
GC_descr GC_double_descr(GC_descr descriptor, word nwords)
{
    if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
        descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
    };
    descriptor |= (descriptor & ~GC_DS_TAGS) >> nwords;
    return(descriptor);
}

complex_descriptor * GC_make_sequence_descriptor();

/* Build a descriptor for an array with nelements elements,	*/
/* each of which can be described by a simple descriptor.	*/
/* We try to optimize some common cases.			*/
/* If the result is COMPLEX, then a complex_descr* is returned  */
/* in *complex_d.							*/
/* If the result is LEAF, then we built a LeafDescriptor in	*/
/* the structure pointed to by leaf.				*/
/* The tag in the leaf structure is not set.			*/
/* If the result is SIMPLE, then a GC_descr			*/
/* is returned in *simple_d.					*/
/* If the result is NO_MEM, then				*/
/* we failed to allocate the descriptor.			*/
/* The implementation knows that GC_DS_LENGTH is 0.		*/
/* *leaf, *complex_d, and *simple_d may be used as temporaries	*/
/* during the construction.					*/
# define COMPLEX 2
# define LEAF 1
# define SIMPLE 0
# define NO_MEM (-1)
int GC_make_array_descriptor(size_t nelements, size_t size, GC_descr descriptor,
			     GC_descr *simple_d,
			     complex_descriptor **complex_d,
			     struct LeafDescriptor * leaf)
{
#   define OPT_THRESHOLD 50
	/* For larger arrays, we try to combine descriptors of adjacent	*/
	/* descriptors to speed up marking, and to reduce the amount	*/
	/* of space needed on the mark stack.				*/
    if ((descriptor & GC_DS_TAGS) == GC_DS_LENGTH) {
      if (descriptor == (GC_descr)size) {
    	*simple_d = nelements * descriptor;
    	return(SIMPLE);
      } else if ((word)descriptor == 0) {
        *simple_d = (GC_descr)0;
        return(SIMPLE);
      }
    }
    if (nelements <= OPT_THRESHOLD) {
      if (nelements <= 1) {
        if (nelements == 1) {
            *simple_d = descriptor;
            return(SIMPLE);
        } else {
            *simple_d = (GC_descr)0;
            return(SIMPLE);
        }
      }
    } else if (size <= BITMAP_BITS/2
    	       && (descriptor & GC_DS_TAGS) != GC_DS_PROC
    	       && (size & (sizeof(word)-1)) == 0) {
      int result =      
          GC_make_array_descriptor(nelements/2, 2*size,
      				   GC_double_descr(descriptor,
      				   		   BYTES_TO_WORDS(size)),
      				   simple_d, complex_d, leaf);
      if ((nelements & 1) == 0) {
          return(result);
      } else {
          struct LeafDescriptor * one_element =
              (struct LeafDescriptor *)
        	GC_malloc_atomic(sizeof(struct LeafDescriptor));
          
          if (result == NO_MEM || one_element == 0) return(NO_MEM);
          one_element -> ld_tag = LEAF_TAG;
          one_element -> ld_size = size;
          one_element -> ld_nelements = 1;
          one_element -> ld_descriptor = descriptor;
          switch(result) {
            case SIMPLE:
            {
              struct LeafDescriptor * beginning =
                (struct LeafDescriptor *)
        	  GC_malloc_atomic(sizeof(struct LeafDescriptor));
              if (beginning == 0) return(NO_MEM);
              beginning -> ld_tag = LEAF_TAG;
              beginning -> ld_size = size;
              beginning -> ld_nelements = 1;
              beginning -> ld_descriptor = *simple_d;
              *complex_d = GC_make_sequence_descriptor(
              			(complex_descriptor *)beginning,
              			(complex_descriptor *)one_element);
              break;
            }
            case LEAF:
            {
              struct LeafDescriptor * beginning =
                (struct LeafDescriptor *)
        	  GC_malloc_atomic(sizeof(struct LeafDescriptor));
              if (beginning == 0) return(NO_MEM);
              beginning -> ld_tag = LEAF_TAG;
              beginning -> ld_size = leaf -> ld_size;
              beginning -> ld_nelements = leaf -> ld_nelements;
              beginning -> ld_descriptor = leaf -> ld_descriptor;
              *complex_d = GC_make_sequence_descriptor(
              			(complex_descriptor *)beginning,
              			(complex_descriptor *)one_element);
              break;
            }
            case COMPLEX:
              *complex_d = GC_make_sequence_descriptor(
              			*complex_d,
              			(complex_descriptor *)one_element);
              break;
          }
          return(COMPLEX);
      }
    }
    {
        leaf -> ld_size = size;
        leaf -> ld_nelements = nelements;
        leaf -> ld_descriptor = descriptor;
        return(LEAF);
    }
}

complex_descriptor * GC_make_sequence_descriptor(complex_descriptor *first,
						 complex_descriptor *second)
{
    struct SequenceDescriptor * result =
        (struct SequenceDescriptor *)
        	GC_malloc(sizeof(struct SequenceDescriptor));
    /* Can't result in overly conservative marking, since tags are	*/
    /* very small integers. Probably faster than maintaining type	*/
    /* info.								*/    
    if (result != 0) {
    	result -> sd_tag = SEQUENCE_TAG;
        result -> sd_first = first;
        result -> sd_second = second;
    }
    return((complex_descriptor *)result);
}

#ifdef UNDEFINED
complex_descriptor * GC_make_complex_array_descriptor(word nelements,
						      complex_descriptor *descr)
{
    struct ComplexArrayDescriptor * result =
        (struct ComplexArrayDescriptor *)
        	GC_malloc(sizeof(struct ComplexArrayDescriptor));
    
    if (result != 0) {
    	result -> ad_tag = ARRAY_TAG;
        result -> ad_nelements = nelements;
        result -> ad_element_descr = descr;
    }
    return((complex_descriptor *)result);
}
#endif

ptr_t * GC_eobjfreelist;

ptr_t * GC_arobjfreelist;

mse * GC_typed_mark_proc(word * addr, mse * mark_stack_ptr,
			 mse * mark_stack_limit, word env);

mse * GC_array_mark_proc(word * addr, mse * mark_stack_ptr,
			 mse * mark_stack_limit, word env);

/* Caller does not hold allocation lock. */
void GC_init_explicit_typing(void)
{
    register int i;
    DCL_LOCK_STATE;

    
    /* Ignore gcc "no effect" warning.	*/
    GC_STATIC_ASSERT(sizeof(struct LeafDescriptor) % sizeof(word) == 0);
    LOCK();
    if (GC_explicit_typing_initialized) {
      UNLOCK();
      return;
    }
    GC_explicit_typing_initialized = TRUE;
    /* Set up object kind with simple indirect descriptor. */
      GC_eobjfreelist = (ptr_t *)GC_new_free_list_inner();
      GC_explicit_kind = GC_new_kind_inner(
		      	    (void **)GC_eobjfreelist,
		      	    (((word)WORDS_TO_BYTES(-1)) | GC_DS_PER_OBJECT),
			    TRUE, TRUE);
    		/* Descriptors are in the last word of the object. */
      GC_typed_mark_proc_index = GC_new_proc_inner(GC_typed_mark_proc);
    /* Set up object kind with array descriptor. */
      GC_arobjfreelist = (ptr_t *)GC_new_free_list_inner();
      GC_array_mark_proc_index = GC_new_proc_inner(GC_array_mark_proc);
      GC_array_kind = GC_new_kind_inner(
		      	    (void **)GC_arobjfreelist,
			    GC_MAKE_PROC(GC_array_mark_proc_index, 0),
			    FALSE, TRUE);