summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/alloc-mem.fs
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>