diff options
Diffstat (limited to 'qemu/roms/openbios/forth/device/property.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/device/property.fs | 335 |
1 files changed, 335 insertions, 0 deletions
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 + ; |