Logo Search packages:      
Sourcecode: helium version File versions  Download package

heapfast.h

/*-----------------------------------------------------------------------
  The Lazy Virtual Machine.

  Daan Leijen.

  Copyright 2001, Daan Leijen. All rights reserved. This file is
  distributed under the terms of the GNU Library General Public License.
-----------------------------------------------------------------------*/

/* $Id: */

#ifndef _heapfast_h
#define _heapfast_h

#include "heap.h"

/* convenience macros */
#undef Store_field
#undef Init_field
#define Store_field(block, offset, val) Modify (&Field (block, offset), val)
#define Init_field(block, offset, val)  Initialize( &Field(block,offset), val )

/*---------------------------------------------------------
   Alloc_small, Modify, Initialize
---------------------------------------------------------*/
#define Alloc_small(result, wosize, tag) {        Assert (wosize >= 1); \
                                            Assert ((tag_t) tag < 256); \
  young_ptr -= Bhsize_wosize (wosize);                                      \
  if (young_ptr < young_limit){                                             \
    Setup_for_gc;                                                           \
    Garbage_collection_function ();                                         \
    Restore_after_gc;                                                       \
    young_ptr -= Bhsize_wosize (wosize);                                    \
  }                                                                         \
  Hd_hp (young_ptr) = Make_header ((wosize), (tag), Caml_black);            \
  (result) = Val_hp (young_ptr);                                            \
  DEBUG_clear (result, wosize);                                             \
}

/* You must use [Modify] to change a field of an existing shared block,
   unless you are sure the value being overwritten is not a shared block and
   the value being written is not a young block. */
/* [Modify] never calls the GC. */

#define Modify(fp, val) {                                                   \
  value _old_ = *(fp);                                                      \
  *(fp) = (val);                                                            \
  if (Is_in_heap (fp)){                                                     \
    if (gc_phase == Phase_mark) darken (_old_, NULL);                       \
    if (Is_block (val) && Is_young (val)                                    \
        && ! (Is_block (_old_) && Is_young (_old_))){                       \
      *ref_table_ptr++ = (fp);                                              \
      if (ref_table_ptr >= ref_table_limit){                                \
        Assert (ref_table_ptr == ref_table_limit);                      \
        realloc_ref_table ();                                               \
      }                                                                     \
    }                                                                       \
  }                                                                         \
}                                                                           \


/* You must use [initialize] to store the initial value in a field of
   a shared block, unless you are sure the value is not a young block.
   A block value [v] is a shared block if and only if [Is_in_heap (v)]
   is true.
*/
/* [initialize] never calls the GC, so you may call it while an object is
   unfinished (i.e. just after a call to [alloc_shr].) */
#define Initialize(fp,val) { \
  *(fp) = (val); \
  if (Is_in_heap (fp) && Is_block (val) && Is_young (val)){ \
    *ref_table_ptr++ = (fp); \
    if (ref_table_ptr >= ref_table_limit){ \
      realloc_ref_table (); \
    } \
  } \
}


/*---------------------------------------------------------
   General allocation
---------------------------------------------------------*/
#define Allocate(v,_sz,t) { wsize_t sz = _sz; /* sharing */ \
                            if (sz == 0) { (v) = Atom(t); } \
                            else if (sz < Max_young_wosize) { Alloc_small(v,sz,t); } \
                            else { Alloc_large(v,sz,t); } \
                          }

#define Alloc_large(v,sz,t)  { Setup_for_gc; \
                               (v) = alloc_shr(sz,t); \
                               Restore_after_gc; \
                             }

#define Alloc_con(v,consize,contag) { \
    wsize_t size;  \
    tag_t   tag;   \
    if (contag >= Con_max_tag) { tag = Con_max_tag; size = consize+1; } \
                          else { tag = contag; size = consize; } \
    Allocate(v,size,tag); \
    if (contag >= Con_max_tag) { Field(v,consize) = Val_long(contag); } \
  }
/*
                            if (t >= Con_max_tag) {\
                               Allocate(v,sz+1,Con_max_tag); \
                               Field(v,sz) = Val_long(t); \
                            } else { \
                               Allocate(v,sz,t); \
                            } \
                          }
*/

/*---------------------------------------------------------
   Indirections
---------------------------------------------------------*/

/* Indirect(v,w): overwrite [v] with an indirection to [w] */
#define Indirect(v,w) { \
    wsize_t vsz; \
    Assert( Is_block(v) && Wosize_val(v) > 0); \
    vsz = Wosize_val(v); \
    Indirect_size(v,vsz,w); \
  }

#define Indirect_size(v,sz,w) { \
    /* wsize_t i; */ \
    Assert( Is_block(v) && Wosize_val(v) == sz && sz > 0 ); \
    Store_field(v,0,w); \
    Downsize(v,sz,1,Ind_tag);  \
    /* Tag_val(v) = Ind_tag; \
    for( i = 1; i < sz; i++) Store_field_inv(v,i); */ \
  }


/*---------------------------------------------------------
   Updates
---------------------------------------------------------*/

/* Truncate(v,sz,newsz,newtag): truncate block [v] with size [sz] to [newsz] and set its
   tag to [newtag]. The [newsz] should always be smaller than [sz] and greater than zero. */
#define Truncate(v,sz,newsz,newtag) { \
    wsize_t i; \
    Assert(Is_block(v) &&  Wosize_val(v) == sz && newsz > 0 && newsz < sz); \
    /* Assert(sz != newsz+1 || Is_young(v)); // triggers gc bug */ \
    /* erase trailing values explicitly for the GC */ \
    for( i = newsz; i < sz; i++) { Store_field_inv(v,i); } \
    /* create a trailing fragment */ \
    Field(v,newsz) = Make_header (Wosize_whsize(sz-newsz), 0, Caml_white); \
    /* set the new size & tag */ \
    Hd_val(v) = Make_header( newsz, newtag, Color_val(v) ); \
  }

#define Downsize(v,sz,newsz,newtag) { \
    Assert(Is_block(v) && Wosize_val(v) == sz && newsz > 0 && newsz <= sz); \
    if (sz == newsz) { Tag_val(v) = newtag; } \
                else { Truncate(v,sz,newsz,newtag); } \
    }



/* Update(v,w,sz,tag) => update [v] with a block [w] of size [sz] and tag [tag] */
#ifdef LVM_UPDATE_INPLACE
# define Update_alloc(v,w,_newsz,newtag) { \
    wsize_t sz    = Wosize_val(v); \
    wsize_t newsz = _newsz; /* sharing */ \
    Assert( Is_block(v) && Wosize_val(v) > 0); \
    if (sz == newsz) { \
      w = v; \
      Tag_val(v) = newtag; \
    } else if (sz > newsz) { \
      w = v; \
      Truncate(v,sz,newsz,newtag); \
    } else { \
      Allocate(w,newsz,newtag); \
      Indirect(v,w); \
    } \
  }

#else
#define Update_alloc(v,w,newsz,newtag) { \
    Allocate(w,newsz,newtag); \
    Indirect(v,w); \
  }
#endif

#ifdef LVM_UPDATE_INPLACE
# define Update_alloc_con(v,w,consize,contag) { \
    wsize_t size; \
    tag_t   tag;  \
    if (contag >= Con_max_tag) { tag = Con_max_tag; size = consize + 1; } \
                          else { tag = contag; size = consize; } \
    Update_alloc(v,w,size,tag); \
    if (contag >= Con_max_tag) { Store_field(w,consize,Val_long(contag)); } \
  }
#else
# define Update_alloc_con(v,w,size,tag) { \
    Alloc_con(w,size,tag); \
    Indirect(v,w); \
  }
#endif

#if defined(LVM_UPDATE_INPLACE) && defined(LVM_UPDATE_CON_INPLACE)
#define Update(v,w) { \
    wsize_t sz = Wosize_val(v); \
    wsize_t newsz; \
    if (Is_block(w) && (newsz = Wosize_val(w)) <= sz && newsz > 0) { \
      wsize_t i; \
      Downsize(v,sz,newsz,Tag_val(w)); \
      for( i = 0; i < newsz; i++ ) { Store_field(v,i,Field(w,i)); } \
    } else { \
      Indirect_size(v,sz,w); \
    } \
  }
#else
#define Update(v,w) { \
    Indirect(v,w); \
  }
#endif

#endif /* _heapfast_h */

Generated by  Doxygen 1.6.0   Back to index