diff options
author | Adrian Reber <adrian@lisas.de> | 2008-11-21 12:45:38 +0100 |
---|---|---|
committer | Adrian Reber <adrian@lisas.de> | 2008-11-21 12:45:38 +0100 |
commit | 1015f69140c36be1c56653075636be60ca433a6d (patch) | |
tree | 23c81fb82a757758186b8ad9adab8f48badd3a16 /slof/fs/alloc-mem.fs | |
parent | 07ec038eec68116cbfcc42b4eea568fd334e8c88 (diff) | |
download | SLOF-slof-JX-1.4.0-0.zip SLOF-slof-JX-1.4.0-0.tar.gz SLOF-slof-JX-1.4.0-0.tar.bz2 |
imported slof-JX-1.4.0-0 releaseslof-JX-1.4.0-0
Diffstat (limited to 'slof/fs/alloc-mem.fs')
-rw-r--r-- | slof/fs/alloc-mem.fs | 86 |
1 files changed, 71 insertions, 15 deletions
diff --git a/slof/fs/alloc-mem.fs b/slof/fs/alloc-mem.fs index 7dc7bd4..89c6a61 100644 --- a/slof/fs/alloc-mem.fs +++ b/slof/fs/alloc-mem.fs @@ -1,19 +1,75 @@ -\ ============================================================================= -\ * Copyright (c) 2004, 2005 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 -\ ============================================================================= - +\ ***************************************************************************** +\ * Copyright (c) 2004, 2007 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. -\ For now, just allocate from the data space, and never take space back. +\ 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> -: alloc-mem ( len -- a-addr ) align here swap allot ; -: free-mem ( a-addr len -- ) 2drop ; |