extra/memory/piles/piles.factor

   1 ! (c)2009 Joe Groff bsd license
   2 USING: accessors alien alien.c-types alien.data destructors kernel libc math ;
   3 IN: memory.piles
   4
   5 TUPLE: pile
   6     { underlying c-ptr }
   7     { size integer }
   8     { offset integer } ;
   9
  10 ERROR: not-enough-pile-space pile ;
  11
  12 M: pile dispose
  13     [ [ free ] when* f ] change-underlying drop ;
  14
  15 : <pile> ( size -- pile )
  16     [ malloc ] keep 0 pile boa ;
  17
  18 : pile-empty ( pile -- )
  19     0 >>offset drop ;
  20
  21 : pile-alloc ( pile size -- alien )
  22     [
  23         [ [ ] [ size>> ] [ offset>> ] tri ] dip +
  24         < [ not-enough-pile-space ] [ drop ] if
  25     ] [
  26         drop [ offset>> ] [ underlying>> ] bi <displaced-alien>
  27     ] [
  28         [ + ] curry change-offset drop
  29     ] 2tri ;
  30
  31 : <pile-c-object> ( pile c-type -- alien )
  32     heap-size pile-alloc ; inline
  33
  34 : <pile-c-array> ( pile n c-type -- alien )
  35     heap-size * pile-alloc ; inline
  36
  37 : pile-align ( pile align -- pile )
  38     [ align ] curry change-offset ;
  39