qemu/roms/SLOF/slof/fs/claim.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2011 IBM Corporation
   3 \ * All rights reserved.
   4 \ * This program and the accompanying materials
   5 \ * are made available under the terms of the BSD License
   6 \ * which accompanies this distribution, and is available at
   7 \ * http://www.opensource.org/licenses/bsd-license.php
   8 \ *
   9 \ * Contributors:
  10 \ *     IBM Corporation - initial implementation
  11 \ ****************************************************************************/
  12
  13 \ \\\\\\\\\\\\\\ Constants
  14 500 CONSTANT AVAILABLE-SIZE
  15 4000 CONSTANT MIN-RAM-RESERVE \ prevent from using first pages
  16
  17 : MIN-RAM-SIZE         \ Initially available memory size
  18    epapr-ima-size IF
  19       epapr-ima-size
  20    ELSE
  21       20000000         \ assumed minimal memory size
  22    THEN
  23 ;
  24 MIN-RAM-SIZE CONSTANT MIN-RAM-SIZE
  25
  26 \ \\\\\\\\\\\\\\ Structures
  27 \ +
  28 \ The available element size depends strictly on the address/size
  29 \ value formats and will be different for various device types
  30 \ +
  31 STRUCT
  32         cell field available>address
  33         cell field available>size
  34 CONSTANT /available
  35
  36
  37 \ \\\\\\\\\\\\\\ Global Data
  38 CREATE available AVAILABLE-SIZE /available * allot available AVAILABLE-SIZE /available * erase
  39 VARIABLE mem-pre-released 0 mem-pre-released !
  40
  41 \ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
  42 : available>size@       available>size @ ;
  43 : available>address@    available>address @ ;
  44 : available>size!       available>size ! ;
  45 : available>address!    available>address ! ;
  46
  47 : available! ( addr size available-ptr -- )
  48         dup -rot available>size! available>address!
  49 ;
  50
  51 : available@ ( available-ptr -- addr size )
  52         dup available>address@ swap available>size@
  53 ;
  54
  55
  56 \ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
  57 \ +
  58 \ Warning: They are not yet really independent from available formatting
  59 \ +
  60
  61 \ +
  62 \ Find position in the "available" where given range exists or can be inserted,
  63 \ return pointer and logical found/notfound value
  64 \ If error, return NULL pointer in addition to notfound code
  65 \ +
  66 : (?available-segment<) ( start1 end1 start2 end2 -- true/false ) drop < nip ;
  67
  68 : (?available-segment>) ( start1 end1 start2 end2 -- true/false ) -rot 2drop > ;
  69
  70 \ start1 to end1 is the area that should be claimed
  71 \ start2 to end2 is the available segment
  72 \ return true if it can not be claimed, false if it can be claimed
  73 : (?available-segment-#) ( start1 end1 start2 end2 -- true/false )
  74         2dup 5 roll -rot                ( e1 s2 e2 s1 s2 e2 )
  75         between >r between r> and not
  76 ;
  77
  78 : (find-available) ( addr addr+size-1 a-ptr a-size -- a-ptr' found )
  79         ?dup 0= IF -rot 2drop false EXIT THEN   \ Not Found
  80
  81         2dup 2/ dup >r /available * +
  82         ( addr addr+size-1 a-ptr a-size a-ptr'  R: a-size' )
  83         dup available>size@ 0= IF 2drop r> RECURSE EXIT THEN
  84
  85         ( addr addr+size-1 a-ptr a-size a-ptr'  R: a-size' )
  86         dup >r available@
  87         ( addr addr+size-1 a-ptr a-size addr' size'  R: a-size' a-ptr' )
  88         over + 1- 2>r 2swap
  89         ( a-ptr a-size addr addr+size-1 )
  90         ( R: a-size' a-ptr' addr' addr'+size'-1 )
  91
  92         2dup 2r@ (?available-segment>) IF
  93                 2swap 2r> 2drop r>
  94                 /available + -rot r> - 1- nip RECURSE EXIT      \ Look Right
  95         THEN
  96         2dup 2r@ (?available-segment<) IF
  97                 2swap 2r> 2drop r>
  98                 2drop r> RECURSE EXIT   \ Look Left
  99         THEN
 100         2dup 2r@ (?available-segment-#) IF      \ Conflict - segments overlap
 101                 2r> 2r> 3drop 3drop 2drop
 102                 1212 throw
 103         THEN
 104         2r> 3drop 3drop r> r> drop      ( a-ptr' -- )
 105         dup available>size@ 0<>         ( a-ptr' found -- )
 106 ;
 107
 108 : (find-available) ( addr size -- seg-ptr found )
 109         over + 1- available AVAILABLE-SIZE ['] (find-available) catch IF
 110                 2drop 2drop 0 false
 111         THEN
 112 ;
 113
 114
 115 : dump-available ( available-ptr -- )
 116         cr
 117         dup available - /available / AVAILABLE-SIZE swap - 0 ?DO
 118                 dup available@ ?dup 0= IF
 119                         2drop UNLOOP EXIT
 120                 THEN
 121                 swap . . cr
 122                 /available +
 123         LOOP
 124         dup
 125 ;
 126
 127 : .available available dump-available ;
 128
 129 \ +
 130 \ release utils:
 131 \ +
 132
 133 \ +
 134 \ (drop-available) just blindly compresses space of available map
 135 \ +
 136 : (drop-available) ( available-ptr -- )
 137         dup available - /available /    \ current element index
 138         AVAILABLE-SIZE swap -           \ # of remaining elements
 139
 140         ( first nelements ) 1- 0 ?DO
 141                 dup /available + dup available@
 142
 143                 ( current next next>address next>size ) ?dup 0= IF
 144                         2drop LEAVE \ NULL element - goto last copy
 145                 THEN
 146                 3 roll available!               ( next )
 147         LOOP
 148
 149         \ Last element : just zero it out
 150         0 0 rot available!
 151 ;
 152
 153 \ +
 154 \ (stick-to-previous-available) merge the segment on stack
 155 \ with the previous one, if possible, and modified segment parameters if merged
 156 \ Return success code
 157 \ +
 158 : (stick-to-previous-available) ( addr size available-ptr -- naddr nsize nptr success )
 159         dup available = IF
 160                 false EXIT              \ This was the first available segment
 161         THEN
 162
 163         dup /available - dup available@
 164         + 4 pick = IF
 165                 nip     \ Drop available-ptr since we are going to previous one
 166                 rot drop        \ Drop start addr, we take the previous one
 167
 168                 dup available@ 3 roll + rot true
 169                 ( prev-addr prev-size+size prev-ptr true )
 170         ELSE
 171                 drop false
 172                 ( addr size available-ptr false )
 173         THEN
 174 ;
 175
 176 \ +
 177 \ (insert-available) just blindly makes space for another element on given
 178 \ position
 179 \ +
 180 \ insert-available should also check adjacent elements and merge if new
 181 \ region is contiguos w. others
 182 \ +
 183 : (insert-available) ( available-ptr -- available-ptr )
 184         dup                             \ current element
 185         dup available - /available /    \ current element index
 186         AVAILABLE-SIZE swap -           \ # of remaining elements
 187
 188         dup 0<= 3 pick available>size@ 0= or IF
 189                 \ End of "available" or came to an empty element - Exit
 190                 drop drop EXIT
 191         THEN
 192
 193         over available@ rot
 194
 195         ( first first/=current/ first>address first>size nelements ) 1- 0 ?DO
 196                 2>r
 197                 ( first current R: current>address current>size )
 198
 199                 /available + dup available@
 200                 ( first current+1/=next/ next>address next>size )
 201                 ( R: current>address current>size )
 202
 203                 2r> 4 pick available! dup 0= IF
 204                         \ NULL element - last copy
 205                         rot /available + available!
 206                         UNLOOP EXIT
 207                 THEN
 208         LOOP
 209
 210         ( first next/=last/ last[0]>address last[0]>size ) ?dup 0<> IF
 211                 cr ." release error: available map overflow"
 212                 cr ." Dumping available property"
 213                 .available
 214                 cr ." No space for one before last entry:" cr swap . .
 215                 cr ." Dying ..." cr 123 throw
 216         THEN
 217
 218         2drop
 219 ;
 220
 221 : insert-available ( addr size available-ptr -- addr size available-ptr )
 222         dup available>address@ 0<> IF
 223                 \ Not empty :
 224                 dup available>address@ rot dup -rot -
 225
 226                 ( addr available-ptr size available>address@-size )
 227
 228                 3 pick = IF     \ if (available>address@ - size == addr)
 229                         \ Merge w. next segment - no insert needed
 230
 231                         over available>size@ + swap
 232                         ( addr size+available>size@ available-ptr )
 233
 234                         (stick-to-previous-available) IF
 235                                 \ Merged w. prev & next one : discard extra seg
 236                                 dup /available + (drop-available)
 237                         THEN
 238                 ELSE
 239                         \ shift the rest of "available" to make space
 240
 241                         swap (stick-to-previous-available)
 242                         not IF (insert-available) THEN
 243                 THEN
 244         ELSE
 245                 (stick-to-previous-available) drop
 246         THEN
 247 ;
 248
 249 defer release
 250
 251 \ +
 252 \ claim utils:
 253 \ +
 254 : drop-available ( addr size available-ptr -- addr )
 255         dup >r available@
 256         ( req_addr req_size segment_addr segment_size   R: available-ptr )
 257
 258         over 4 pick swap - ?dup 0<> IF
 259                 \ Segment starts before requested address : free the head space
 260                 dup 3 roll swap r> available! -
 261
 262                 ( req_addr req_size segment_size-segment_addr+req_addr )
 263                 over - ?dup 0= IF
 264                         \ That's it - remainder of segment is what we claim
 265                         drop
 266                 ELSE
 267                         \ Both head and tail of segment remain unclaimed :
 268                         \ need an extra available element
 269                         swap 2 pick + swap release
 270                 THEN
 271         ELSE
 272                 nip ( req_addr req_size segment_size )
 273                 over - ?dup 0= IF
 274                         \ Exact match : drop the whole available segment
 275                         drop r> (drop-available)
 276                 ELSE
 277                         \ We claimed the head, need to leave the tail available
 278                         -rot over + rot r> available!
 279                 THEN
 280         THEN
 281         ( base  R: -- )
 282 ;
 283
 284 : pwr2roundup ( value -- pwr2value )
 285         dup CASE
 286                 0 OF EXIT ENDOF
 287                 1 OF EXIT ENDOF
 288         ENDCASE
 289         dup 1 DO drop i dup +LOOP
 290         dup +
 291 ;
 292
 293 : (claim-best-fit) ( len align -- len base )
 294         pwr2roundup 1- -1 -1
 295         ( len align-1 best-fit-residue/=-1/ best-fit-base/=-1/ )
 296
 297         available AVAILABLE-SIZE /available * + available DO
 298                 i               \ Must be saved now, before we use Return stack
 299                 -rot >r >r swap >r
 300
 301                 ( len i         R: best-fit-base best-fit-residue align-1 )
 302
 303                 available@ ?dup 0= IF drop r> r> r> LEAVE THEN          \ EOL
 304
 305                 2 pick - dup 0< IF
 306                         2drop                   \ Can't Fit: Too Small
 307                 ELSE
 308                         dup 2 pick r@ and - 0< IF
 309                                 2drop           \ Can't Fit When Aligned
 310                         ELSE
 311                                 ( len i>address i>size-len )
 312                                 ( R: best-fit-base best-fit-residue align-1 )
 313                                 r> -rot dup r@ U< IF
 314                                         \ Best Fit so far: drop the old one
 315                                         2r> 2drop
 316
 317                                         ( len align-1 nu-base nu-residue   R: )
 318                                         \ Now align new base and push to R:
 319                                         swap 2 pick + 2 pick invert and >r >r >r
 320                                 ELSE
 321                                         2drop >r
 322                                 THEN
 323                         THEN
 324                 THEN
 325                 r> r> r>
 326         /available +LOOP
 327
 328         -rot 2drop      ( len best-fit-base/or -1 if none found/ )
 329 ;
 330
 331 : (adjust-release0) ( 0 size -- addr' size' )
 332         \ segment 0 already pre-relased in early phase: adjust
 333         2dup MIN-RAM-SIZE dup 3 roll + -rot -
 334         dup 0< IF 2drop ELSE
 335                 2swap 2drop 0 mem-pre-released !
 336         THEN
 337 ;
 338
 339
 340 \ \\\\\\\\\\\\\\ Exported Interface:
 341 \ +
 342 \ IEEE 1275 implementation:
 343 \       claim
 344 \ Claim the region with given start address and size (if align parameter is 0);
 345 \ alternatively claim any region of given alignment
 346 \ +
 347 \ Throw an exception if failed
 348 \ +
 349 : claim ( [ addr ] len align -- base )
 350         ?dup 0<> IF
 351                 (claim-best-fit) dup -1 = IF
 352                         2drop cr ." claim error : aligned allocation failed" cr
 353                         ." available:" cr .available
 354                         321 throw EXIT
 355                 THEN
 356                 swap
 357         THEN
 358
 359         2dup (find-available) not IF
 360                 drop
 361 \               cr ." claim error : requested " . ." bytes of memory at " .
 362 \               ." not available" cr
 363 \               ." available:" cr .available
 364                 2drop
 365                 321 throw EXIT
 366         THEN
 367         ( req_addr req_size available-ptr ) drop-available
 368
 369         ( req_addr )
 370 ;
 371
 372
 373 \ +
 374 \ IEEE 1275 implementation:
 375 \       release
 376 \ Free the region with given start address and size
 377 \ +
 378 : .release ( addr len -- )
 379         over 0= mem-pre-released @ and IF (adjust-release0) THEN
 380
 381         2dup (find-available) IF
 382                 drop swap
 383                 cr ." release error: region " . ." , " . ." already released" cr
 384         ELSE
 385                 ?dup 0= IF
 386                         swap
 387                         cr ." release error: Bad/conflicting region " . ." , " .
 388                         ." or available list full " cr
 389                 ELSE
 390                         ( addr size available-ptr ) insert-available
 391
 392                         \ NOTE: insert did not change the stack layout
 393                         \       but it may have changed any of the three values
 394                         \       in order to implement merge of free regions
 395                         \       We do not interpret these values any more
 396                         \       just blindly copy it in
 397
 398                         ( addr size available-ptr ) available!
 399                 THEN
 400         THEN
 401 ;
 402
 403 ' .release to release
 404
 405
 406 \ pre-release minimal memory size
 407 0 MIN-RAM-SIZE release 1 mem-pre-released !
 408
 409 \ claim first pages used for PPC exception vectors
 410 0 MIN-RAM-RESERVE 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop
 411
 412 \ claim region used by firmware (assume 31 MiB size right now)
 413 paflof-start ffff not and 1f00000 0 ' claim CATCH IF
 414    ." claim failed!" cr 2drop
 415 THEN drop