summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/translate.fs
blob: 9654f242f361d85275b78d46884e6fec4c65c573 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ *     IBM Corporation - initial implementation
\ ****************************************************************************/

\ this is a C-to-Forth translation from the translate
\ address code in the client
\ with extensions to handle different sizes of #size-cells

\ this tries to figure out if it is a PCI device what kind of
\ translation is wanted
\ if prop_type is 0, "reg" property is used, otherwise "assigned-addresses"
: pci-address-type  ( node address prop_type -- type )
   -rot 2 pick ( prop_type node address prop_type )
   0= IF
      swap s" reg" rot get-property  ( prop_type address data dlen false )
   ELSE
      swap s" assigned-addresses" rot get-property  ( prop_type address data dlen false )
   THEN
   IF  2drop -1  EXIT  THEN  4 / 5 /
   \ advance (phys-addr(3) size(2)) steps
   0 DO
      \ BARs and Expansion ROM must be in assigned-addresses...
      \ so if prop_type is 0 ("reg") and a config space offset is set
      \ we skip this entry...
      dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? )
      3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? )
      AND NOT IF 
         2dup 4 + ( prop_type address data address data' )
         2dup @ 2 pick 8 + @ + <= -rot @  >= and  IF
            l@ 03000000 and 18 rshift nip
            ( prop_type type )
            swap drop ( type )
            UNLOOP EXIT
         THEN
      THEN
      \ advance in 4 byte steps and (phys-addr(3) size(2)) steps
      4 5 * +
   LOOP
   3drop -1
;

: (range-read-cells)  ( range-addr #cells -- range-value )
   \ if number of cells != 1; do 64bit read; else a 32bit read
   1 =  IF  l@  ELSE  @  THEN
;

\ this functions tries to find a mapping for the given address
\ it assumes that if we have #address-cells == 3 that we are trying
\ to do a PCI translation

\ nac - #address-cells
\ nsc - #size-cells
\ pnac - parent #address-cells

: (map-one-range)  ( type range pnac nsc nac address -- address true | address false )
   \ only check for the type if nac == 3 (PCI)
   over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and  IF
      >r 2drop 3drop r> false EXIT
   THEN
   \ get size
   4 pick 4 pick 3 pick + 4 * +
   \ get nsc
   3 pick
   \ read size
   ( type range pnac nsc nac address range nsc )
   (range-read-cells)
   ( type range pnac nsc nac address size )
   \ skip type if PCI
   5 pick 3 pick 3 =  IF
      4 +
   THEN
   \ get nac
   3 pick
   ( type range pnac nsc nac address size range nac )
   \ read child-mapping
   (range-read-cells)
   ( type range pnac nsc nac address size child-mapping )
   dup >r dup 3 pick > >r + over <= r> or  IF
      \ address is not inside the mapping range
      >r 2drop 3drop r> r> drop false EXIT
   THEN
   dup r> -
   ( type range pnac nsc nac address offset )
   \ add the offset on the parent mapping
   5 pick 5 pick 3 =  IF
      \ skip type if PCI
      4 +
   THEN
   3 pick 4 * +
   ( type range pnac nsc nac address offset parent-mapping-address )
   \ get pnac
   5 pick
   \ read parent mapping
   (range-read-cells)
   ( type range pnac nsc nac address offset parent-mapping )
   + >r 3drop 3drop r> true
;

\ this word translates the given address starting from the node specified
\ in node; the word will return to the node it was started from
: translate-address  ( node address -- address )
   \ check for address type in "assigned-addresses"
   2dup 1 pci-address-type  ( node address type )
   dup -1 = IF
      \ not found in "assigned-addresses", check in "reg"
      drop 2dup 0 pci-address-type ( node address type )
   THEN
   rot parent BEGIN
      \ check if it is the root node
      dup parent 0=  IF  2drop EXIT  THEN
      ( address type parent )
      s" #address-cells" 2 pick get-property 2drop l@ >r        \ nac
      s" #size-cells" 2 pick get-property 2drop l@ >r           \ nsc
      s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac
      -rot ( node address type )
      s" ranges" 4 pick get-property  IF
         3drop
         ABORT" no ranges property; not translatable"
      THEN
      r> r> r> 3 roll
      ( node address type ranges pnac nsc nac length )
      4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO
         ( node type ranges pnac nsc nac address )
         6dup (map-one-range) IF
            nip leave
         THEN
         nip
         \ advance ranges
         4 roll
         ( node type pnac nsc nac address ranges )
         4 pick 4 pick 4 pick + + 4 * + 4 -roll
      LOOP
      >r 2drop 2drop r> ( node type address )
      swap rot parent ( address type node )
      dup 0=
   UNTIL
;

\ this words translates the given address starting from the current node
: translate-my-address  ( address -- address' )
   get-node swap translate-address
;