Initial commit of OpenSPARC T2 architecture model.

[OpenSPARC-T2-SAM] / obp / obp / os / bootprom / memlist.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: memlist.fth
\ 
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ 
\  - Do no alter or remove copyright notices
\ 
\  - Redistribution and use of this software in source and binary forms, with 
\    or without modification, are permitted provided that the following 
\    conditions are met: 
\ 
\  - Redistribution of source code must retain the above copyright notice, 
\    this list of conditions and the following disclaimer.
\ 
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution. 
\ 
\    Neither the name of Sun Microsystems, Inc. or the names of contributors 
\ may be used to endorse or promote products derived from this software 
\ without specific prior written permission. 
\ 
\     This software is provided "AS IS," without a warranty of any kind. 
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES, 
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A 
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN 
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR 
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR 
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN 
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR 
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE 
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY, 
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF 
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ 
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility. 
\ 
\ ========== Copyright Header End ============================================
id: @(#)memlist.fth 2.9 05/04/08
purpose: 
copyright: Copyright 2005 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ Common routines for memory list manipulation

listnode
   /n field >adr
   /n field >size
nodetype: memrange

\ local variable for use by memory list code
headerless

0 value prev-node	\ The node preceding (above) the insertion point
0 value next-node	\ The node following (below) the insertion point
0 value memlist		\ The memory list we're working on

defer ?splice	( adr node -- )  \ Routine to free spanning resources

headers
: node-range  ( node -- adr size )   dup >adr @  swap >size @ ;

headerless
\ Convenience functions

: prev-start  ( -- adr )  prev-node >adr @  ;
: next-end  ( -- adr )  next-node node-range +  ;

defer memrange-hook

\ alloc 20 more nodes before dropping below 4 free nodes.
\ clear defer before allocating more nodes to prevent reentry
\ in case more-nodes needs to modify memlist to allocate more heap
: (memrange-hook ( -- ) recursive
   0 memrange 
   begin				( #free node )
      @ dup if				( #free node )
         swap 1+ swap			( #free node )
      then				( #free node )
      over d# 4 >=			( #free node flag )
      over 0= or			( #free node flag )
   until				( #free node )
   drop d# 4 <  if			( )
      ['] noop is  memrange-hook
      d# 20 memrange more-nodes
      ['] (memrange-hook  is memrange-hook
   then
;

' (memrange-hook is  memrange-hook

\ Used with "find-node" to locate the pair of nodes around "adr"

: lower?  ( adr node -- adr flag )  >adr @  over u<=  ;

\ Used with "find-node" to locate a memory node at least as big as "size"

: big-enough?  ( size node-adr -- size flag )  >size @  over u>=  ;

\ Handle possible singularity at 0
: handle-0  ( end-adr start-adr -- end-adr' start-adr' )
   2dup =  if  exit  then               \ Don't do it for 0-length ranges
   over  0=  if  nip -1 swap  then
;

\ Used with "find-node" to locate a memory node containing the range adr,len

: contained?  ( adr len node-adr -- adr len flag )
   node-range bounds handle-0   ( adr len  node-end node-start )
   2over bounds handle-0        ( adr len  node-end,start end,start )
   rot u>= -rot  u>=  and       ( adr len flag )
;

: collapse-nodes ( next prev -- )
   over >size @ over >size +!				( next prev )
   swap >adr @ swap >adr !				( )
;

: suitable?  ( alignment size node-adr -- alignment size flag )
   >r r@ >adr @  2 pick round-up          ( alignment size aligned-adr )
   r> node-range -rot -                   ( alignment size node-size waste )
   2dup u<=  if  2drop false  exit  then  ( alignment size node-size waste )
   -                                      ( alignment size aln-node-size )
   over u>=                               ( alignment size flag )
;

: mem-node! ( adr size node -- )
   tuck >size ! >adr !			( )
;

\ Allocates and initializes a new memory node

headers
: set-node  ( adr size -- node )
   memrange allocate-node		( adr sz node )
   dup >r mem-node! r> memrange-hook	( node )
;

: end-piece-aligned?  ( aln size -- flag )
   next-end           ( aln size end-adr )
   swap - dup rot     ( adr adr aln )
   round-up =         ( flag )
;

\ Frees the range of memory "adr size", adding it to the free list "list".
\ Every attempt is made to add the memory range to an existing node, and
\ to join adjacent nodes into one larger node.  When memory is added to an
\ existing node, or when nodes are joined, the defer word "?splice" is
\ called with the join address as an argument, allowing for spanning
\ resources (e.g. PMEGS) to be freed if possible.
headers
: free-memrange  ( adr size list -- )
   is memlist                             ( adr size )

   swap memlist  ['] lower?  find-node    ( size adr prev-node this-node|0 )
   is next-node  is prev-node             ( size adr )

   \ Error check to catch attempts to free already-free memory.

   next-node  if                          ( size adr )
      dup  next-node >adr @  next-end  within
      abort" Freeing memory that is already free"
   then                                   ( size adr )

   \ Try to add this node to the end of the lower piece in the available list

   next-node  if                          ( size adr )
      dup next-end =  if                  ( size adr )

         \ This piece can be added to the end of the lower piece

         swap  next-node >size +!         ( adr )
	 next-node ?splice                ( )  \ Perhaps free PMEG

	 \ Now try to collapse 2 adjacent nodes
 prev-node memlist <>  if                             ( )
    next-end prev-start =  if                         ( )
               next-end                                       ( splice-adr )
               next-node prev-node collapse-nodes	      ( splice-adr )
	       prev-node delete-after  memrange free-node     ( splice-adr )
               prev-node ?splice          ( )  \ Perhaps free PMEG
	    then
         then

         exit
      then
   then

   \ Try to add this node to the start of the upper piece in the available list
   prev-node memlist <>  if               ( size adr )
      2dup +  prev-start =  if            ( size adr )
         2dup prev-node >adr !            ( size adr size )
         prev-node >size +!               ( size adr )
         +  prev-node ?splice             ( )  \ Perhaps free PMEG
	 exit
      then
   then                                   ( size adr )

   \ Oh bother!  We have to create another node
   \ leave the current prev-node on stack in case it changes while
   \ allocating more nodes in set-node
   swap prev-node -rot  set-node  swap insert-after
;

: allocate-memrange  ( alignment size list -- phys-adr false | true )
   ['] suitable?  find-node is next-node  is prev-node ( aln+ size+ )

   next-node 0=  if  2drop true  exit  then               ( aln+ size+ )

   2dup  end-piece-aligned?  if                           ( aln+ size+ )
      dup  next-node >size @ =  if                        ( aln+ size+ )
         \ Node is exactly the right size; return the
         \ address and remove the node from the list
         next-node >adr @                                 ( aln+ size+ adr )
         prev-node delete-after  memrange free-node       ( aln+ size+ adr )
      else                                                ( aln+ size+ )
         \ Node is bigger than requested size.  Decrease the size of the
         \ node's region and return the last part of its address range.
         dup negate next-node >size +!                    ( aln+ size+ )
         next-end                                         ( aln+ size+ adr )
      then
   else         \ The piece was not already aligned       ( aln+ size+ )

      \ Change the size of the current node to reflect only the
      \ fragment after the allocated piece.

      next-end  over - 2 pick round-down                  ( aln+ size+ adr )
      2dup +  dup  next-end swap -      ( aln+ size+ adr frag-adr frag-len )
      next-node >adr @ >r                                 \ Save for later
      next-node mem-node!

      r> 2dup -                         ( aln+ size+ adr frag-adr frag-len )
      dup if                            ( aln+ size+ adr frag-adr frag-len )
         \ Create a new node for the fragment before the allocated range.
         \ We don't have to worry about splicing it to adjacent nodes,
         \ because we know that it came from the beginning of an existing
         \ separate node.
         \ leave the current next-node on stack in case it changes while
         \ allocating more nodes in set-node
         next-node -rot set-node swap insert-after        ( aln+ size+ adr )
      else                              ( aln+ size+ adr frag-adr frag-len )
         \ There is no fragment before the allocated range.
         2drop                                            ( aln+ size+ adr )
      then                                                ( aln+ size+ adr )
   then                                                   ( aln+ size+ adr )
   nip nip  false                                         ( adr false )
;

headers