extra/memory/piles/piles.factor

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