qemu/roms/SLOF/slof/fs/alloc-mem.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 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 #include <claim.fs>
  14 \ Memory "heap" (de-)allocation.
  15
  16 \ Keep a linked list of free blocks per power-of-two size.
  17 \ Never coalesce entries when freed; split blocks when needed while allocating.
  18
  19 \ 3f CONSTANT (max-heads#)
  20 heap-end heap-start - log2 1+ CONSTANT (max-heads#)
  21
  22 CREATE heads (max-heads#) cells allot
  23 heads (max-heads#) cells erase
  24
  25
  26 : size>head  ( size -- headptr )  log2 3 max cells heads + ;
  27
  28
  29 \ Allocate a memory block
  30 : alloc-mem  ( len -- a-addr )
  31    dup 0= IF EXIT THEN
  32    1 over log2 3 max                   ( len 1 log_len )
  33    dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN
  34    lshift >r                           ( len  R: 1<<log_len )
  35    size>head dup @ IF
  36       dup @ dup >r @ swap ! r> r> drop EXIT
  37    THEN                                ( headptr  R: 1<<log_len)
  38    r@ 2* recurse dup                   ( headptr a-addr2 a-addr2  R: 1<<log_len)
  39    dup 0= IF r> 2drop 2drop 0 EXIT THEN
  40    r> + >r 0 over ! swap ! r>
  41 ;
  42
  43
  44 \ Free a memory block
  45
  46 : free-mem  ( a-addr len -- )
  47    dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! !
  48 ;
  49
  50
  51 : #links  ( a -- n )
  52    @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip
  53 ;
  54
  55
  56 : .free  ( -- )
  57    0 (max-heads#) 0 DO
  58       heads i cells + #links dup IF
  59          cr dup . ." * " 1 i lshift dup . ." = " * dup .
  60       THEN
  61       +
  62    LOOP
  63    cr ." Total " .
  64 ;
  65
  66
  67 \ Start with just one free block.
  68 heap-start heap-end heap-start - free-mem
  69
  70
  71 \ : free-mem  ( a-addr len -- ) 2drop ;
  72
  73 \ Uncomment the following line for debugging:
  74 \ #include <alloc-mem-debug.fs>
  75