piles vocab (pools of raw memory)

diff --git a/extra/memory/piles/authors.txt b/extra/memory/piles/authors.txt
new file mode 100644 (file)
index 0000000..f13c9c1
--- /dev/null
+++ b/extra/memory/piles/authors.txt
@@ -0,0 +1 @@
+Joe Groff

diff --git a/extra/memory/piles/piles-docs.factor b/extra/memory/piles/piles-docs.factor
new file mode 100644 (file)
index 0000000..7779d39
--- /dev/null
+++ b/extra/memory/piles/piles-docs.factor
@@ -0,0 +1,48 @@
+! (c)2009 Joe Groff bsd license
+USING: alien destructors help.markup help.syntax kernel math ;
+IN: memory.piles
+
+HELP: <pile>
+{ $values
+    { "size" integer }
+    { "pile" pile }
+}
+{ $description "Allocates " { $snippet "size" } " bytes of raw memory for a new " { $link pile } ". The pile should be " { $link dispose } "d when it is no longer needed." } ;
+
+HELP: not-enough-pile-space
+{ $values
+    { "pile" pile }
+}
+{ $description "This error is thrown by " { $link pile-alloc } " when the " { $link pile } " does not have enough remaining space for the requested allocation." } ;
+
+HELP: pile
+{ $class-description "A " { $snippet "pile" } " is a block of raw memory that can be apportioned out in constant time. A pile is allocated using the " { $link <pile> } " word. Blocks of memory can be requested from the pile using " { $link pile-alloc } ", and all the pile's memory can be reclaimed with " { $link pile-empty } "." } ;
+
+HELP: pile-align
+{ $values
+    { "pile" pile } { "align" "a power of two" }
+    { "pile" pile }
+}
+{ $description "Adjusts a " { $link pile } "'s internal state so that the next call to " { $link pile-alloc } " will return a pointer aligned to " { $snippet "align" } " bytes relative to the pile's initial offset." } ;
+
+HELP: pile-alloc
+{ $values
+    { "pile" pile } { "size" integer }
+    { "alien" alien }
+}
+{ $description "Requests " { $snippet "size" } " bytes from a " { $link pile } ". If the pile does not have enough space to satisfy the request, a " { $link not-enough-pile-space } " error is thrown." } ;
+
+HELP: pile-empty
+{ $values
+    { "pile" pile }
+}
+{ $description "Reclaims all the memory allocated out of a " { $link pile } ". Allocations will resume from the beginning of the pile." } ;
+
+ARTICLE: "memory.piles" "Piles"
+"A " { $link pile } " is a block of raw memory. Portions of its memory can be allocated from the beginning of the pile in constant time, and the pile can be emptied and its pointer reset to the beginning."
+{ $subsection <pile> }
+{ $subsection pile-alloc }
+{ $subsection pile-align }
+{ $subsection pile-empty } ;
+
+ABOUT: "memory.piles"

diff --git a/extra/memory/piles/piles-tests.factor b/extra/memory/piles/piles-tests.factor
new file mode 100644 (file)
index 0000000..11b6399
--- /dev/null
+++ b/extra/memory/piles/piles-tests.factor
@@ -0,0 +1,46 @@
+USING: accessors alien destructors kernel math
+memory.piles tools.test ;
+IN: memory.piles.tests
+
+[ 25 ] [
+    [
+        100 <pile> &dispose
+        [ 25 pile-alloc ] [ 50 pile-alloc ] bi
+        swap [ alien-address ] bi@ -
+    ] with-destructors
+] unit-test
+
+[ 32 ] [
+    [
+        100 <pile> &dispose
+        [ 25 pile-alloc ] [ 8 pile-align 50 pile-alloc ] bi
+        swap [ alien-address ] bi@ -
+    ] with-destructors
+] unit-test
+
+[ 75 ] [
+    [
+        100 <pile> &dispose
+        dup 25 pile-alloc drop
+        dup 50 pile-alloc drop
+        offset>>
+    ] with-destructors
+] unit-test
+
+[ 100 ] [
+    [
+        100 <pile> &dispose
+        dup 25 pile-alloc drop
+        dup 75 pile-alloc drop
+        offset>>
+    ] with-destructors
+] unit-test
+
+[
+    [
+        100 <pile> &dispose
+        dup 25 pile-alloc drop
+        dup 76 pile-alloc drop
+    ] with-destructors
+] [ not-enough-pile-space? ] must-fail-with
+

diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor
new file mode 100644 (file)
index 0000000..b8a79b4
--- /dev/null
+++ b/extra/memory/piles/piles.factor
@@ -0,0 +1,33 @@
+! (c)2009 Joe Groff bsd license
+USING: accessors alien destructors kernel libc math ;
+IN: memory.piles
+
+TUPLE: pile
+    { underlying c-ptr }
+    { size integer }
+    { offset integer } ;
+
+ERROR: not-enough-pile-space pile ;
+
+M: pile dispose
+    [ [ free ] when* f ] change-underlying drop ;
+
+: <pile> ( size -- pile )
+    [ malloc ] keep 0 pile boa ;
+
+: pile-empty ( pile -- )
+    0 >>offset drop ;
+
+: pile-alloc ( pile size -- alien )
+    [
+        [ [ ] [ size>> ] [ offset>> ] tri ] dip +
+        < [ not-enough-pile-space ] [ drop ] if
+    ] [
+        drop [ offset>> ] [ underlying>> ] bi <displaced-alien>
+    ] [
+        [ + ] curry change-offset drop
+    ] 2tri ;
+
+: pile-align ( pile align -- pile )
+    [ align ] curry change-offset ;
+    

diff --git a/extra/memory/piles/summary.txt b/extra/memory/piles/summary.txt
new file mode 100644 (file)
index 0000000..f217f30
--- /dev/null
+++ b/extra/memory/piles/summary.txt
@@ -0,0 +1 @@
+Preallocated raw memory blocks