X-Git-Url: https://gerrit.opnfv.org/gerrit/gitweb?a=blobdiff_plain;f=qemu%2Froms%2Fopenbios%2Fforth%2Fdevice%2Fproperty.fs;fp=qemu%2Froms%2Fopenbios%2Fforth%2Fdevice%2Fproperty.fs;h=1d54e3ec3f8963eecd38659028e35896229e4f0b;hb=e44e3482bdb4d0ebde2d8b41830ac2cdb07948fb;hp=0000000000000000000000000000000000000000;hpb=9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00;p=kvmfornfv.git

diff --git a/qemu/roms/openbios/forth/device/property.fs b/qemu/roms/openbios/forth/device/property.fs
new file mode 100644
index 000000000..1d54e3ec3
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/property.fs
@@ -0,0 +1,335 @@
+\ tag: Property management
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.5
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ small helpers.. these should go elsewhere.
+: bigendian?
+  10 here ! here c@ 10 <>
+  ;
+
+: l!-be ( val addr )
+  3 bounds swap do
+    dup ff and i c! 
+    8 rshift
+  -1 +loop
+  drop
+  ;
+
+: l@-be ( addr )
+  0 swap 4 bounds do
+    i c@ swap 8 << or
+  loop
+  ;
+
+\ allocate n bytes for device tree information
+\ until I know where to put this, I put it in the
+\ dictionary.
+
+: alloc-tree ( n -- addr )
+  dup >r           \ save len
+  here swap allot
+  dup r> 0 fill    \ clear memory
+  ;
+
+: align-tree ( -- )
+  null-align
+  ;
+
+: no-active true abort" no active package." ;
+
+\ 
+\ 5.3.5 Property management
+\ 
+
+\ Helper function
+: find-property ( name len phandle -- &&prop|0 )
+  >dn.properties
+  begin
+    dup @
+  while
+    dup @ >prop.name @  ( name len prop propname )
+    2over comp0         ( name len prop equal? )
+    0= if nip nip exit then
+    >prop.next @
+  repeat
+  ( name len false )
+  3drop false
+  ;
+
+\ From package (5.3.4.1)
+: next-property 
+( previous-str previous-len phandle -- false | name-str name-len true )
+  >r
+  2dup 0= swap 0= or if
+    2drop r> >dn.properties @
+  else
+    r> find-property dup if @ then
+    dup if >prop.next @ then
+  then
+
+  ?dup if
+    >prop.name @ dup cstrlen true
+    ( phandle name-str name-len true )
+  else
+    false
+  then
+;
+
+
+\ 
+\ 5.3.5.4 Property value access
+\ 
+
+\ Return value for name string property in package phandle.
+: get-package-property
+  ( name-str name-len phandle -- true | prop-addr prop-len false )
+  find-property ?dup if
+    @ dup >prop.addr @
+    swap >prop.len  @
+    false
+  else
+    true
+  then
+  ;
+
+\ Return value for given property in the current instance or its parents.
+: get-inherited-property 
+  ( name-str name-len -- true | prop-addr prop-len false )
+  my-self 
+  begin
+    ?dup
+  while
+    dup >in.device-node @   ( str len ihandle phandle )
+    2over rot find-property ?dup if
+      @
+      ( str len ihandle prop )
+      nip nip nip ( prop )
+      dup >prop.addr @ swap >prop.len @
+      false 
+      exit
+    then
+    ( str len ihandle )
+    >in.my-parent @
+  repeat
+  2drop
+  true
+  ;
+
+\ Return value for given property in this package.
+: get-my-property ( name-str name-len -- true | prop-addr prop-len false )
+  my-self >in.device-node @  ( -- phandle )
+  get-package-property
+  ;
+
+
+\   
+\ 5.3.5.2 Property array decoding
+\ 
+
+: decode-int ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 n )
+  dup 0> if
+    dup 4 min >r     ( addr1 len1 R:minlen )
+    over r@ + swap   ( addr1 addr2 len1 R:minlen )
+    r> -             ( addr1 addr2 len2 )
+    rot l@-be
+  else
+    0
+  then
+  ;
+
+\ HELPER: get #address-cell value (from parent)
+\ Legal values are 1..4 (we may optionally support longer addresses)
+: my-#acells ( -- #address-cells )
+  my-self ?dup if >in.device-node @ else active-package then
+  ?dup if >dn.parent @ then
+  ?dup if
+    " #address-cells" rot get-package-property if 2 exit then
+    \ we don't have to support more than 4 (and 0 is illegal)
+    decode-int nip nip 4 min 1 max
+  else
+    2
+  then
+;
+
+\ HELPER: get #size-cells value (from parent)
+: my-#scells ( -- #size-cells )
+  my-self ?dup if >in.device-node @ else active-package then
+  ?dup if >dn.parent @ then
+  ?dup if
+    " #size-cells" rot get-package-property if 1 exit then
+    decode-int nip nip
+  else
+    1
+  then
+;
+
+: decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
+  dup 0> if
+    2dup bounds \ check property for 0 bytes
+    0 -rot      \ initial string len is 0
+    do
+      i c@ 0= if
+        leave
+      then
+      1+
+    loop              ( prop-addr1 prop-len1 len )
+    1+ rot >r         ( prop-len1 len R: prop-addr1 )
+    over min 2dup -   ( prop-len1 nlen prop-len2 R: prop-addr1 )
+    r@ 2 pick +       ( prop-len1 nlen prop-len2 prop-addr2 )
+    >r >r >r          ( R: prop-addr1 prop-addr2 prop-len2 nlen )
+    drop
+    r> r> r>          ( nlen prop-len2 prop-addr2 )
+    -rot swap 1-      ( prop-addr2 prop-len2 nlen )
+    r> swap           ( prop-addr2 prop-len2 str len )
+  else
+    0 0
+  then
+  ;
+
+: decode-bytes  ( addr1 len1 #bytes -- addr len2 addr1 #bytes )
+  tuck -  ( addr1 #bytes len2 )
+  r> 2dup +  ( addr1 #bytes addr2 ) ( R: len2 )
+  r> 2swap
+  ;
+  
+: decode-phys 
+  ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 phys.lo ...  phys.hi )
+  my-#acells 0 ?do
+    decode-int r> r> rot >r >r >r
+  loop
+  my-#acells 0 ?do
+    r> r> r> -rot >r >r 
+  loop
+  ;
+
+  
+\ 
+\ 5.3.5.1 Property array encoding
+\ 
+
+: encode-int    ( n -- prop-addr prop-len )
+  /l alloc-tree tuck l!-be /l
+  ;
+
+: encode-string ( str len -- prop-addr prop-len )
+  \ we trust len here. should probably check string?
+  tuck char+ alloc-tree ( len str prop-addr )
+  tuck 3 pick move      ( len prop-addr )
+  swap 1+
+  ;
+
+: encode-bytes ( data-addr data-len -- prop-addr prop-len )
+  tuck alloc-tree ( len str prop-addr )
+  tuck 3 pick move
+  swap
+  ;
+
+: encode+ ( prop-addr1 prop-len1 prop-addr2 prop-len2 -- prop-addr3 prop-len3 )
+  nip +
+  ;
+
+: encode-phys ( phys.lo ... phys.hi -- prop-addr prop-len )
+  encode-int my-#acells 1- 0 ?do
+    rot encode-int encode+
+  loop
+  ;
+
+defer sbus-intr>cpu ( sbus-intr# -- cpu-intr# )
+: (sbus-intr>cpu) ." No SBUS present on this machine." cr ;
+['] (sbus-intr>cpu) to sbus-intr>cpu
+
+
+\ 
+\ 5.3.5.3 Property declaration
+\ 
+
+: (property) ( prop-addr prop-len name-str name-len dnode -- )
+  >r 2dup r@
+  align-tree
+  find-property ?dup if 
+    \ If a property with that property name already exists in the 
+    \ package in which the property would be created, replace its
+    \ value with the new value.
+    @ r> drop        \ don't need the device node anymore.
+    -rot 2drop tuck  \ drop property name 
+    >prop.len  !     \ overwrite old values
+    >prop.addr !
+    exit
+  then
+
+  ( prop-addr prop-len name-str name-len R: dn )
+  prop-node.size alloc-tree
+  dup >prop.next off
+  
+  dup r> >dn.properties
+  begin dup @ while @ >prop.next repeat !
+  >r
+  
+  ( prop-addr prop-len name-str name-len R: prop )
+  
+  \ create copy of property name
+  dup char+ alloc-tree 
+  dup >r swap move r>
+  ( prop-addr prop-len new-name R: prop )
+  r@ >prop.name !
+  r@ >prop.len  !
+  r> >prop.addr !
+  align-tree 
+  ;
+
+: property ( prop-addr prop-len name-str name-len -- )
+  my-self ?dup if
+    >in.device-node @
+  else
+    active-package
+  then
+  dup if
+    (property)
+  else
+    no-active
+  then
+  ;
+
+: (delete-property) ( name len dnode -- )
+  find-property ?dup if
+    dup @ >prop.next @ swap !
+    \ maybe we should try to reclaim the space?
+  then
+;
+  
+: delete-property ( name-str name-len -- )
+  active-package ?dup if
+    (delete-property)
+  else
+    2drop
+  then
+  ;
+
+\ Create the "name"  property; value is indicated string.
+: device-name    ( str len -- )
+  encode-string  " name"  property
+  ;
+
+\ Create "device_type" property, value is indicated string.
+: device-type    ( str len -- )
+  encode-string  " device_type"  property
+  ;
+
+\ Create the "reg" property with the given values.
+: reg ( phys.lo ... phys.hi size -- )
+  >r  ( phys.lo ... phys.hi ) encode-phys  ( addr len )
+  r>  ( addr1 len1 size )     encode-int   ( addr1 len1 addr2 len2 )
+  encode+  ( addr len )
+  " reg"  property
+  ;
+
+\ Create the "model" property; value is indicated string.
+: model    ( str len -- )
+  encode-string  " model"  property
+  ;