1 files changed, 75 insertions, 0 deletions
diff --git a/roms/SLOF/slof/fs/alloc-mem.fs b/roms/SLOF/slof/fs/alloc-mem.fs
new file mode 100644
index 000000000..59381a72b
--- /dev/null
+++ b/roms/SLOF/slof/fs/alloc-mem.fs
@@ -0,0 +1,75 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+#include <claim.fs>
+\ Memory "heap" (de-)allocation.
+
+\ Keep a linked list of free blocks per power-of-two size.
+\ Never coalesce entries when freed; split blocks when needed while allocating.
+
+\ 3f CONSTANT (max-heads#)
+heap-end heap-start - log2 1+ CONSTANT (max-heads#)
+
+CREATE heads (max-heads#) cells allot
+heads (max-heads#) cells erase
+
+
+: size>head  ( size -- headptr )  log2 3 max cells heads + ;
+
+
+\ Allocate a memory block
+: alloc-mem  ( len -- a-addr )
+   dup 0= IF EXIT THEN
+   1 over log2 3 max                   ( len 1 log_len )
+   dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN
+   lshift >r                           ( len  R: 1<<log_len )
+   size>head dup @ IF
+      dup @ dup >r @ swap ! r> r> drop EXIT
+   THEN                                ( headptr  R: 1<<log_len)
+   r@ 2* recurse dup                   ( headptr a-addr2 a-addr2  R: 1<<log_len)
+   dup 0= IF r> 2drop 2drop 0 EXIT THEN
+   r> + >r 0 over ! swap ! r>
+;
+
+
+\ Free a memory block
+
+: free-mem  ( a-addr len -- )
+   dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! !
+;
+
+
+: #links  ( a -- n )
+   @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip
+;
+
+
+: .free  ( -- )
+   0 (max-heads#) 0 DO
+      heads i cells + #links dup IF
+         cr dup . ." * " 1 i lshift dup . ." = " * dup .
+      THEN
+      +
+   LOOP
+   cr ." Total " .
+;
+
+
+\ Start with just one free block.
+heap-start heap-end heap-start - free-mem
+
+
+\ : free-mem  ( a-addr len -- ) 2drop ;
+
+\ Uncomment the following line for debugging:
+\ #include <alloc-mem-debug.fs>
+