forth/device/property.fs

   1 \ tag: Property management
   2 \
   3 \ this code implements IEEE 1275-1994 ch. 5.3.5
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 \ small helpers.. these should go elsewhere.
  12 : bigendian?
  13   10 here ! here c@ 10 <>
  14   ;
  15
  16 : l!-be ( val addr )
  17   3 bounds swap do
  18     dup ff and i c!
  19     8 rshift
  20   -1 +loop
  21   drop
  22   ;
  23
  24 : l@-be ( addr )
  25   0 swap 4 bounds do
  26     i c@ swap 8 << or
  27   loop
  28   ;
  29
  30 \ allocate n bytes for device tree information
  31 \ until I know where to put this, I put it in the
  32 \ dictionary.
  33
  34 : alloc-tree ( n -- addr )
  35   dup >r           \ save len
  36   here swap allot
  37   dup r> 0 fill    \ clear memory
  38   ;
  39
  40 : align-tree ( -- )
  41   null-align
  42   ;
  43
  44 : no-active true abort" no active package." ;
  45
  46 \
  47 \ 5.3.5 Property management
  48 \
  49
  50 \ Helper function
  51 : find-property ( name len phandle -- &&prop|0 )
  52   >dn.properties
  53   begin
  54     dup @
  55   while
  56     dup @ >prop.name @  ( name len prop propname )
  57     2over comp0         ( name len prop equal? )
  58     0= if nip nip exit then
  59     >prop.next @
  60   repeat
  61   ( name len false )
  62   3drop false
  63   ;
  64
  65 \ From package (5.3.4.1)
  66 : next-property
  67 ( previous-str previous-len phandle -- false | name-str name-len true )
  68   >r
  69   2dup 0= swap 0= or if
  70     2drop r> >dn.properties @
  71   else
  72     r> find-property dup if @ then
  73     ?dup if >prop.next @ then
  74   then
  75
  76   ?dup if
  77     >prop.name @ dup cstrlen true
  78     ( phandle name-str name-len true )
  79   else
  80     false
  81   then
  82 ;
  83
  84
  85 \
  86 \ 5.3.5.4 Property value access
  87 \
  88
  89 \ Return value for name string property in package phandle.
  90 : get-package-property
  91   ( name-str name-len phandle -- true | prop-addr prop-len false )
  92   find-property ?dup if
  93     @ dup >prop.addr @
  94     swap >prop.len  @
  95     false
  96   else
  97     true
  98   then
  99   ;
 100
 101 \ Return value for given property in the current instance or its parents.
 102 : get-inherited-property
 103   ( name-str name-len -- true | prop-addr prop-len false )
 104   my-self
 105   begin
 106     ?dup
 107   while
 108     dup >in.device-node @   ( str len ihandle phandle )
 109     2over rot find-property ?dup if
 110       @
 111       ( str len ihandle prop )
 112       nip nip nip ( prop )
 113       dup >prop.addr @ swap >prop.len @
 114       false
 115       exit
 116     then
 117     ( str len ihandle )
 118     >in.my-parent @
 119   repeat
 120   2drop
 121   true
 122   ;
 123
 124 \ Return value for given property in this package.
 125 : get-my-property ( name-str name-len -- true | prop-addr prop-len false )
 126   my-self >in.device-node @  ( -- phandle )
 127   get-package-property
 128   ;
 129
 130
 131 \
 132 \ 5.3.5.2 Property array decoding
 133 \
 134
 135 : decode-int ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 n )
 136   dup 0> if
 137     dup 4 min >r     ( addr1 len1 R:minlen )
 138     over r@ + swap   ( addr1 addr2 len1 R:minlen )
 139     r> -             ( addr1 addr2 len2 )
 140     rot l@-be
 141   else
 142     0
 143   then
 144   ;
 145
 146 \ HELPER: get #address-cell value (from parent)
 147 \ Legal values are 1..4 (we may optionally support longer addresses)
 148 : my-#acells ( -- #address-cells )
 149   my-self ?dup if >in.device-node @ else active-package then
 150   ?dup if >dn.parent @ then
 151   ?dup if
 152     " #address-cells" rot get-package-property if 2 exit then
 153     \ we don't have to support more than 4 (and 0 is illegal)
 154     decode-int nip nip 4 min 1 max
 155   else
 156     2
 157   then
 158 ;
 159
 160 \ HELPER: get #size-cells value (from parent)
 161 : my-#scells ( -- #size-cells )
 162   my-self ?dup if >in.device-node @ else active-package then
 163   ?dup if >dn.parent @ then
 164   ?dup if
 165     " #size-cells" rot get-package-property if 1 exit then
 166     decode-int nip nip
 167   else
 168     1
 169   then
 170 ;
 171
 172 : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
 173   dup 0> if
 174     2dup bounds \ check property for 0 bytes
 175     0 -rot      \ initial string len is 0
 176     do
 177       i c@ 0= if
 178         leave
 179       then
 180       1+
 181     loop              ( prop-addr1 prop-len1 len )
 182     1+ rot >r         ( prop-len1 len R: prop-addr1 )
 183     over min 2dup -   ( prop-len1 nlen prop-len2 R: prop-addr1 )
 184     r@ 2 pick +       ( prop-len1 nlen prop-len2 prop-addr2 )
 185     >r >r >r          ( R: prop-addr1 prop-addr2 prop-len2 nlen )
 186     drop
 187     r> r> r>          ( nlen prop-len2 prop-addr2 )
 188     -rot swap         ( prop-addr2 prop-len2 nlen )
 189     r> swap           ( prop-addr2 prop-len2 str len )
 190   else
 191     0 0
 192   then
 193   ;
 194
 195 : decode-bytes  ( addr1 len1 #bytes -- addr len2 addr1 #bytes )
 196   tuck -  ( addr1 #bytes len2 )
 197   r> 2dup +  ( addr1 #bytes addr2 ) ( R: len2 )
 198   r> 2swap
 199   ;
 200
 201 : decode-phys
 202   ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 phys.lo ...  phys.hi )
 203   my-#acells 0 ?do
 204     decode-int r> r> rot >r >r >r
 205   loop
 206   my-#acells 0 ?do
 207     r> r> r> -rot >r >r
 208   loop
 209   ;
 210
 211
 212 \
 213 \ 5.3.5.1 Property array encoding
 214 \
 215
 216 : encode-int    ( n -- prop-addr prop-len )
 217   /l alloc-tree tuck l!-be /l
 218   ;
 219
 220 : encode-string ( str len -- prop-addr prop-len )
 221   \ we trust len here. should probably check string?
 222   tuck char+ alloc-tree ( len str prop-addr )
 223   tuck 3 pick move      ( len prop-addr )
 224   swap 1+
 225   ;
 226
 227 : encode-bytes ( data-addr data-len -- prop-addr prop-len )
 228   tuck alloc-tree ( len str prop-addr )
 229   tuck 3 pick move
 230   swap
 231   ;
 232
 233 : encode+ ( prop-addr1 prop-len1 prop-addr2 prop-len2 -- prop-addr3 prop-len3 )
 234   nip +
 235   ;
 236
 237 : encode-phys ( phys.lo ... phys.hi -- prop-addr prop-len )
 238   encode-int my-#acells 1- 0 ?do
 239     rot encode-int encode+
 240   loop
 241   ;
 242
 243 defer sbus-intr>cpu ( sbus-intr# -- cpu-intr# )
 244 : (sbus-intr>cpu) ." No SBUS present on this machine." cr ;
 245 ['] (sbus-intr>cpu) to sbus-intr>cpu
 246
 247
 248 \
 249 \ 5.3.5.3 Property declaration
 250 \
 251
 252 : (property) ( prop-addr prop-len name-str name-len dnode -- )
 253   >r 2dup r@
 254   align-tree
 255   find-property ?dup if
 256     \ If a property with that property name already exists in the
 257     \ package in which the property would be created, replace its
 258     \ value with the new value.
 259     @ r> drop        \ don't need the device node anymore.
 260     -rot 2drop tuck  \ drop property name
 261     >prop.len  !     \ overwrite old values
 262     >prop.addr !
 263     exit
 264   then
 265
 266   ( prop-addr prop-len name-str name-len R: dn )
 267   prop-node.size alloc-tree
 268   dup >prop.next off
 269
 270   dup r> >dn.properties
 271   begin dup @ while @ >prop.next repeat !
 272   >r
 273
 274   ( prop-addr prop-len name-str name-len R: prop )
 275
 276   \ create copy of property name
 277   dup char+ alloc-tree
 278   dup >r swap move r>
 279   ( prop-addr prop-len new-name R: prop )
 280   r@ >prop.name !
 281   r@ >prop.len  !
 282   r> >prop.addr !
 283   align-tree
 284   ;
 285
 286 : property ( prop-addr prop-len name-str name-len -- )
 287   my-self ?dup if
 288     >in.device-node @
 289   else
 290     active-package
 291   then
 292   dup if
 293     (property)
 294   else
 295     no-active
 296   then
 297   ;
 298
 299 : (delete-property) ( name len dnode -- )
 300   find-property ?dup if
 301     dup @ >prop.next @ swap !
 302     \ maybe we should try to reclaim the space?
 303   then
 304 ;
 305
 306 : delete-property ( name-str name-len -- )
 307   active-package ?dup if
 308     (delete-property)
 309   else
 310     2drop
 311   then
 312   ;
 313
 314 \ Create the "name"  property; value is indicated string.
 315 : device-name    ( str len -- )
 316   encode-string  " name"  property
 317   ;
 318
 319 \ Create "device_type" property, value is indicated string.
 320 : device-type    ( str len -- )
 321   encode-string  " device_type"  property
 322   ;
 323
 324 \ Create the "reg" property with the given values.
 325 : reg ( phys.lo ... phys.hi size -- )
 326   >r  ( phys.lo ... phys.hi ) encode-phys  ( addr len )
 327   r>  ( addr1 len1 size )     encode-int   ( addr1 len1 addr2 len2 )
 328   encode+  ( addr len )
 329   " reg"  property
 330   ;
 331
 332 \ Create the "model" property; value is indicated string.
 333 : model    ( str len -- )
 334   encode-string  " model"  property
 335   ;