blob: d4ca70bbd3213f1804ef374f4d4a7f3e7f98e64c (
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
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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
\ *****************************************************************************
\ * Copyright (c) 2011 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
\ ****************************************************************************/
\ * Dynamic memory allocation/de-allocation debug functions
\ *****************************************************************************
\ Uncomment the following code for debugging bad write accesses beyond
\ the end of the allocated block:
\ Store magic value past the end of the block during alloc-mem and
\ check for this magic value when free-mem has been called.
#if 1
: alloc-mem ( len -- addr )
dup /n + alloc-mem ( len addr )
2dup + 3141592653589793 swap ! nip
;
: free-mem ( addr len -- )
2dup + @ 3141592653589793 <> IF
cr ." Detected memory corrupt during free-mem of "
swap . . cr EXIT
THEN
/n + free-mem
;
#endif
\ Never ever assume that allocated memory is pre-initialized with 0 ...
: alloc-mem ( len -- addr )
dup alloc-mem swap 2dup ff fill drop
;
\ Make sure that memory block do not contain "valid" data after free-mem:
: free-mem ( addr len -- )
2dup ff fill free-mem
;
\ The following definitions are used for debugging the parameters of free-mem:
\ Store block address and size of allocated blocks
\ in an array, then check for right values on free-mem.
1000 CONSTANT max-malloced-blocks
CREATE malloced-blocks max-malloced-blocks 2 * cells allot
malloced-blocks max-malloced-blocks 2 * cells erase
: alloc-mem ( len -- addr )
dup alloc-mem dup 0= IF
cr ." alloc-mem returned 0 for size " swap . cr EXIT
THEN ( len addr )
malloced-blocks max-malloced-blocks 0 DO ( len addr m-blocks-ptr )
dup @ 0= IF ( len addr m-blocks-ptr )
\ Found a free entry: store addr and len
over >r dup >r !
r> cell+ !
r> UNLOOP EXIT
THEN
cell+ cell+ ( len addr next-m-blocks-ptr )
LOOP
." Please increase max-malloced-blocks." cr ( len addr next-m-blocks-ptr )
drop nip
;
: free-mem ( addr len -- )
malloced-blocks max-malloced-blocks 0 DO ( addr len m-blocks-ptr )
dup @ ?dup IF
( addr len m-blocks-ptr s-addr )
3 pick = IF
( addr len m-blocks-ptr )
dup cell+ @ ( addr len m-blocks-ptr s-len )
2 pick = IF ( addr len m-blocks-ptr )
\ All right, addr and len matched,
\ clear entry and call original free-mem.
dup cell+ 0 swap !
0 swap !
free-mem
ELSE
>r swap cr
." free-mem called for block " . ." with wrong size=" . cr
." ( correct size should be: " r> cell+ @ . ." )" cr
THEN
UNLOOP EXIT
THEN ( addr len m-blocks-ptr )
THEN
cell+ cell+ ( addr len next-m-blocks-ptr )
LOOP
drop swap cr
." free-mem called for block " .
." ( size=" .
." ) which has never been allocated before!" cr
;
\ Enable these for verbose debug messages:
#if 0
: alloc-mem
cr ." alloc-mem with len=" dup .
alloc-mem
." returned addr=" dup . cr
;
: free-mem
cr ." free mem addr=" over . ." len=" dup . cr
free-mem
;
#endif
|
