← Back to branch summary

~pmdj/ubuntu/trusty/qemu/2.9+applesmc+fadtv3

« back to all changes in this revision

Viewing changes to roms/openbios/forth/bootstrap/memory.fs

  • Committer: Phil Dennis-Jordan
  • Date: 2017-07-21 08:03:43 UTC
  • mfrom: (1.1.1)
  • Revision ID: phil@philjordan.eu-20170721080343-2yr2vdj7713czahv
New upstream release 2.9.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
roms/openbios/forth/bootstrap/memory.fs
 
1
\ tag: forth memory allocation
 
2
\ 
 
3
\ Copyright (C) 2002-2003 Stefan Reinauer
 
4
\ 
 
5
\ See the file "COPYING" for further information about
 
6
\ the copyright and warranty status of this work.
 
7
\ 
 
8
 
 
9
\ 7.3.3.2 memory allocation
 
10
 
 
11
\ these need to be initialized by the forth kernel by now.
 
12
variable start-mem 0 start-mem !        \ start of memory
 
13
variable end-mem   0 end-mem   !        \ end of memory
 
14
variable free-list 0 free-list !        \ free list head
 
15
 
 
16
\ initialize necessary variables and write a valid 
 
17
\ free-list entry containing all of the memory.
 
18
\   start-mem: pointer to start of memory.
 
19
\   end-mem:   pointer to end of memory.
 
20
\   free-list: head of linked free list
 
21
 
 
22
: init-mem ( start-addr size )
 
23
  over dup
 
24
  start-mem !           \ write start-mem 
 
25
  free-list !           \ write first freelist entry
 
26
  2dup /n - swap !      \ write 'len'  entry
 
27
  over cell+ 0 swap !   \ write 'next' entry
 
28
  + end-mem  !          \ write end-mem 
 
29
  ;
 
30
 
 
31
\ --------------------------------------------------------------------
 
32
 
 
33
\ return pointer to smallest free block that contains 
 
34
\ at least nb bytes and the block previous the the 
 
35
\ actual block. On failure the pointer to the smallest
 
36
\ free block is 0.
 
37
 
 
38
: smallest-free-block ( nb -- prev ptr | 0 0 )
 
39
  0 free-list @
 
40
  fffffff 0 0 >r >r >r
 
41
  begin
 
42
    dup
 
43
  while
 
44
    ( nb prev pp R: best_nb best_pp )
 
45
    dup @ 3 pick r@ within if
 
46
      ( nb prev pp )
 
47
      r> r> r> 3drop            \ drop old smallest
 
48
      2dup >r >r dup @ >r       \ new smallest
 
49
    then
 
50
    nip dup                     \ prev = pp
 
51
    cell + @                    \ pp = pp->next
 
52
  repeat
 
53
  3drop r> drop r> r>
 
54
;
 
55
 
 
56
 
 
57
\ --------------------------------------------------------------------
 
58
 
 
59
\ allocate size bytes of memory
 
60
\ return pointer to memory (or throws an exception on failure).
 
61
 
 
62
: alloc-mem ( size -- addr )
 
63
 
 
64
  \ make it legal (and fast) to allocate 0 bytes
 
65
  dup 0= if exit then
 
66
 
 
67
  aligned                       \ keep memory aligned.
 
68
  dup smallest-free-block       \ look up smallest free block.
 
69
  
 
70
  dup 0= if 
 
71
    \ 2drop
 
72
    -15 throw \ out of memory
 
73
  then
 
74
  
 
75
  ( al-size prev addr )
 
76
  
 
77
  \ If the smallest fitting block found is bigger than
 
78
  \ the size of the requested block plus 2*cellsize we
 
79
  \ can split the block in 2 parts. otherwise return a
 
80
  \ slightly bigger block than requested.
 
81
 
 
82
  dup @ ( d->len ) 3 pick cell+ cell+ > if
 
83
  
 
84
    \ splitting the block in 2 pieces.
 
85
    \ new block = old block + len field + size of requested mem
 
86
    dup 3 pick cell+ +  (  al-size prev addr nd )
 
87
 
 
88
    \ new block len = old block len - req. mem size - 1 cell
 
89
    over @              ( al-size prev addr nd addr->len )
 
90
    4 pick              ( ... al-size )
 
91
    cell+ -             ( al-size prev addr nd nd nd->len )
 
92
    over !              ( al-size prev addr nd )
 
93
 
 
94
    over cell+ @        ( al-size prev addr nd addr->next )
 
95
                        \ write addr->next to nd->next
 
96
    over cell+ !        ( al-size prev addr nd )
 
97
    over 4 pick swap !
 
98
  else
 
99
    \ don't split the block, it's too small.
 
100
    dup cell+ @
 
101
  then
 
102
 
 
103
  ( al-size prev addr nd )
 
104
 
 
105
  \ If the free block we got is the first one rewrite free-list
 
106
  \ pointer instead of the previous entry's next field.
 
107
  rot dup 0= if drop free-list else cell+ then
 
108
  ( al-size addr nd prev->next|fl )
 
109
  !
 
110
  nip cell+     \ remove al-size and skip len field of returned pointer
 
111
 
 
112
  ;
 
113
 
 
114
 
 
115
\ --------------------------------------------------------------------
 
116
  
 
117
\ free block given by addr. The length of the
 
118
\ given block is stored at addr - cellsize.
 
119
\ 
 
120
\ merge with blocks to the left and right 
 
121
\ immediately, if they are free.
 
122
 
 
123
: free-mem ( addr len -- )
 
124
 
 
125
  \ we define that it is legal to free 0-byte areas
 
126
  0= if drop exit then
 
127
  ( addr )
 
128
        
 
129
  \ check if the address to free is somewhere within
 
130
  \ our available memory. This fails badly on discontigmem
 
131
  \ architectures. If we need more RAM than fits on one 
 
132
  \ contiguous memory area we are too bloated anyways. ;)
 
133
  
 
134
  dup start-mem @ end-mem @ within 0= if
 
135
 \   ." free-mem: no such memory: 0x" u. cr
 
136
    exit
 
137
  then
 
138
 
 
139
  /n -                          \ get real block address
 
140
  0 free-list @                 ( addr prev l )
 
141
  
 
142
  begin                         \ now scan the free list
 
143
    dup 0<> if                  \ only check len, if block ptr != 0
 
144
      dup dup @ cell+ + 3 pick < 
 
145
    else
 
146
      false
 
147
    then
 
148
  while 
 
149
    nip dup                     \ prev=l
 
150
    cell+ @                     \ l=l->next
 
151
  repeat
 
152
 
 
153
  ( addr prev l )
 
154
 
 
155
  dup 0<> if                            \ do we have free memory to merge with?
 
156
  
 
157
    dup dup @ cell+ + 3 pick  = if      \ hole hit. adding bytes.
 
158
      \ freeaddr = end of current block -> merge
 
159
      ( addr prev l )
 
160
      rot @ cell+               ( prev l f->len+cellsize )
 
161
      over @ +                  \ add l->len
 
162
      over !                    ( prev l )
 
163
      swap over cell+ @         \ f = l; l = l->next;
 
164
 
 
165
      \ The free list is sorted by addresses. When merging at the
 
166
      \ start of our block we might also want to merge at the end
 
167
      \ of it. Therefore we fall through to the next border check
 
168
      \ instead of returning.
 
169
      true                              \ fallthrough value
 
170
    else
 
171
      false                             \ no fallthrough
 
172
    then
 
173
    >r                                  \ store fallthrough on ret stack
 
174
    
 
175
    ( addr prev l )
 
176
 
 
177
    dup 3 pick dup @ cell+ + = if       \ hole hit. real merging.
 
178
      \ current block starts where block to free ends.
 
179
      \ end of free block addr = current block -> merge and exit
 
180
                                        ( addr prev l )
 
181
      2 pick dup @                      ( f f->len ) 
 
182
      2 pick @ cell+ +                  ( f newlen )
 
183
      swap !                            ( addr prev l )
 
184
      3dup drop
 
185
      0= if
 
186
        free-list
 
187
      else
 
188
        2 pick cell+ 
 
189
      then                              ( value prev->next|free-list )
 
190
      !                                 ( addr prev l )
 
191
      cell+ @ rot                       ( prev l->next addr )
 
192
      cell+ ! drop
 
193
      r> drop exit                      \ clean up return stack
 
194
    then
 
195
 
 
196
    r> if 3drop exit then               \ fallthrough? -> exit
 
197
  then
 
198
  
 
199
  \ loose block - hang it before current.
 
200
 
 
201
  ( addr prev l )
 
202
 
 
203
  \ hang block to free in front of the current entry.
 
204
  dup 3 pick cell+ !                    \ f->next = l;
 
205
  free-list @ = if                      \ is block to free new list head?
 
206
    over free-list !
 
207
  then
 
208
  
 
209
  ( addr prev )
 
210
  dup 0<> if                            \ if (prev) prev->next=f
 
211
    cell+ !
 
212
  else 
 
213
    2drop                               \ no fixup needed. clean up.
 
214
  then
 
215
    
 
216
  ;