--- /dev/null
+\ 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
+ ;
Code Review / kvmfornfv.git / blobdiff