-
Notifications
You must be signed in to change notification settings - Fork 10
/
heap.f
101 lines (91 loc) · 1.61 KB
/
heap.f
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
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
\ heap class for fixed size object allocation
base-class begin-class
field _osize
field _bsize
field _free
list-structure +field _blist
method heap-alloc
method heap-free
method heap-free-all
end-class heap-class
\ ( object_size num_per_block o -- 0 | -err_code )
:noname
>r
r@ [ base-class :: base-init ]
?dup
if
\ error with parent init, so return -err_code
nip nip
else
over * [ list-structure ] literal + r@ !field _bsize
r@ !field _osize
r@ >field _blist list-init
0
then
rdrop
; heap-class defines base-init
\ ( 0 mn lh -- 0 )
: heap-deinit-cb
drop
dup node-remove
mem-free
;
\ ( o -- )
:noname
>r
0 ['] heap-deinit-cb r@ >field _blist list-enumerate-forwards
r@ !field _free
r> [ base-class :: base-deinit ]
; heap-class defines base-deinit
\ ( addr o -- )
:noname
>r
r@ @field _free
over !
r> !field _free
; heap-class defines heap-free
\ ( o mn -- )
: heap-free-block
over @field _bsize over +
swap [ list-structure ] literal +
do
i over -> heap-free
dup @field _osize
+loop
drop
;
\ ( o mn lh -- 0 )
: heap-free-all-cb
drop heap-free-block 0
;
\ ( o -- )
:noname
0 over !field _free
['] heap-free-all-cb over >field _blist list-enumerate-forwards drop
; heap-class defines heap-free-all
\ ( o -- 0 | addr )
:noname
>r
r@ @field _free ?dup
if
dup @
r@ !field _free
else
\ allocate new block
r@ @field _bsize mem-alloc
dup
if
dup r@ >field _blist list-add-at-tail
r@ swap heap-free-block
r@ recurse
then
then
rdrop
; heap-class defines heap-alloc
hide _osize
hide _bsize
hide _free
hide _blist
hide heap-deinit-cb
hide heap-free-all-cb
hide heap-free-block