blob: 59381a72b60a47cf4f8cc60d5d665ee69fdf8c77 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
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>
|
