qemu/roms/SLOF/slof/fs/translate.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 \ this is a C-to-Forth translation from the translate
  14 \ address code in the client
  15 \ with extensions to handle different sizes of #size-cells
  16
  17 \ this tries to figure out if it is a PCI device what kind of
  18 \ translation is wanted
  19 \ if prop_type is 0, "reg" property is used, otherwise "assigned-addresses"
  20 : pci-address-type  ( node address prop_type -- type )
  21    -rot 2 pick ( prop_type node address prop_type )
  22    0= IF
  23       swap s" reg" rot get-property  ( prop_type address data dlen false )
  24    ELSE
  25       swap s" assigned-addresses" rot get-property  ( prop_type address data dlen false )
  26    THEN
  27    IF  2drop -1  EXIT  THEN  4 / 5 /
  28    \ advance (phys-addr(3) size(2)) steps
  29    0 DO
  30       \ BARs and Expansion ROM must be in assigned-addresses...
  31       \ so if prop_type is 0 ("reg") and a config space offset is set
  32       \ we skip this entry...
  33       dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? )
  34       3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? )
  35       AND NOT IF
  36          2dup 4 + ( prop_type address data address data' )
  37          2dup @ 2 pick 8 + @ + <= -rot @  >= and  IF
  38             l@ 03000000 and 18 rshift nip
  39             ( prop_type type )
  40             swap drop ( type )
  41             UNLOOP EXIT
  42          THEN
  43       THEN
  44       \ advance in 4 byte steps and (phys-addr(3) size(2)) steps
  45       4 5 * +
  46    LOOP
  47    3drop -1
  48 ;
  49
  50 : (range-read-cells)  ( range-addr #cells -- range-value )
  51    \ if number of cells != 1; do 64bit read; else a 32bit read
  52    1 =  IF  l@  ELSE  @  THEN
  53 ;
  54
  55 \ this functions tries to find a mapping for the given address
  56 \ it assumes that if we have #address-cells == 3 that we are trying
  57 \ to do a PCI translation
  58
  59 \ nac - #address-cells
  60 \ nsc - #size-cells
  61 \ pnac - parent #address-cells
  62
  63 : (map-one-range)  ( type range pnac nsc nac address -- address true | address false )
  64    \ only check for the type if nac == 3 (PCI)
  65    over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and  IF
  66       >r 2drop 3drop r> false EXIT
  67    THEN
  68    \ get size
  69    4 pick 4 pick 3 pick + 4 * +
  70    \ get nsc
  71    3 pick
  72    \ read size
  73    ( type range pnac nsc nac address range nsc )
  74    (range-read-cells)
  75    ( type range pnac nsc nac address size )
  76    \ skip type if PCI
  77    5 pick 3 pick 3 =  IF
  78       4 +
  79    THEN
  80    \ get nac
  81    3 pick
  82    ( type range pnac nsc nac address size range nac )
  83    \ read child-mapping
  84    (range-read-cells)
  85    ( type range pnac nsc nac address size child-mapping )
  86    dup >r dup 3 pick > >r + over <= r> or  IF
  87       \ address is not inside the mapping range
  88       >r 2drop 3drop r> r> drop false EXIT
  89    THEN
  90    dup r> -
  91    ( type range pnac nsc nac address offset )
  92    \ add the offset on the parent mapping
  93    5 pick 5 pick 3 =  IF
  94       \ skip type if PCI
  95       4 +
  96    THEN
  97    3 pick 4 * +
  98    ( type range pnac nsc nac address offset parent-mapping-address )
  99    \ get pnac
 100    5 pick
 101    \ read parent mapping
 102    (range-read-cells)
 103    ( type range pnac nsc nac address offset parent-mapping )
 104    + >r 3drop 3drop r> true
 105 ;
 106
 107 \ this word translates the given address starting from the node specified
 108 \ in node; the word will return to the node it was started from
 109 : translate-address  ( node address -- address )
 110    \ check for address type in "assigned-addresses"
 111    2dup 1 pci-address-type  ( node address type )
 112    dup -1 = IF
 113       \ not found in "assigned-addresses", check in "reg"
 114       drop 2dup 0 pci-address-type ( node address type )
 115    THEN
 116    rot parent BEGIN
 117       \ check if it is the root node
 118       dup parent 0=  IF  2drop EXIT  THEN
 119       ( address type parent )
 120       s" #address-cells" 2 pick get-property 2drop l@ >r        \ nac
 121       s" #size-cells" 2 pick get-property 2drop l@ >r           \ nsc
 122       s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac
 123       -rot ( node address type )
 124       s" ranges" 4 pick get-property  IF
 125          3drop
 126          ABORT" no ranges property; not translatable"
 127       THEN
 128       r> r> r> 3 roll
 129       ( node address type ranges pnac nsc nac length )
 130       4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO
 131          ( node type ranges pnac nsc nac address )
 132          6dup (map-one-range) IF
 133             nip leave
 134          THEN
 135          nip
 136          \ advance ranges
 137          4 roll
 138          ( node type pnac nsc nac address ranges )
 139          4 pick 4 pick 4 pick + + 4 * + 4 -roll
 140       LOOP
 141       >r 2drop 2drop r> ( node type address )
 142       swap rot parent ( address type node )
 143       dup 0=
 144    UNTIL
 145 ;
 146
 147 \ this words translates the given address starting from the current node
 148 : translate-my-address  ( address -- address' )
 149    get-node swap translate-address
 150 ;