\ tag: device tree administration \ \ this code implements IEEE 1275-1994 \ \ Copyright (C) 2003 Samuel Rydh \ Copyright (C) 2003-2006 Stefan Reinauer \ \ See the file "COPYING" for further information about \ the copyright and warranty status of this work. \ \ 7.4.11.1 Device alias : devalias ( "{alias-name}< >{device-specifier}" -- ) ; : nvalias ( "alias-name< >device-specifier" -- ) ; : $nvalias ( name-str name-len dev-str dev-len -- ) ; : nvunalias ( "alias-name< >" -- ) ; : $nvunalias ( name-str name-len -- ) ; \ 7.4.11.2 Device tree browsing : dev ( "device-specifier" -- ) bl parse find-device ; : cd dev ; \ find-device ( dev-str dev-len -- ) \ implemented in pathres.fs : device-end ( -- ) 0 active-package! ; \ Open selected device node and make it the current instance \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible : select-dev ( -- ) open-dev dup 0= abort" failed opening parent." dup to my-self ihandle>phandle active-package! ; \ Close current node, deselect active package and current instance, \ leaving no instance selected \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible : unselect-dev ( -- ) my-self close-dev device-end 0 to my-self ; : begin-package ( arg-str arg-len reg-str reg-len dev-str dev-len -- ) select-dev new-device set-args ; : end-package ( -- ) finish-device unselect-dev ; : ?active-package ( -- phandle ) active-package dup 0= abort" no active device" ; \ ------------------------------------------------------- \ path handling \ ------------------------------------------------------- \ used if parent lacks an encode-unit method : def-encode-unit ( unitaddr ... ) pocket tohexstr ; : get-encode-unit-xt ( phandle.parent -- xt ) >dn.parent @ " encode-unit" rot find-method 0= if ['] def-encode-unit then ; : get-nodename ( phandle -- str len ) " name" rot get-package-property if " " else 1- then ; \ helper, return the node name in the format 'cpus@addr' : pnodename ( phandle -- str len ) dup get-nodename rot dup " reg" rot get-package-property if drop exit then rot \ set active-package and clear my-self (decode-phys needs this) my-self >r 0 to my-self active-package >r dup active-package! ( name len prop len phandle ) get-encode-unit-xt ( name len prop len xt ) depth >r >r decode-phys r> execute r> -rot >r >r depth! 3drop ( name len R: len str ) r> r> " @" here 20 + \ abuse dictionary for temporary storage tmpstrcat >r 2swap r> tmpstrcat drop pocket tmpstrcpy drop r> active-package! r> to my-self ; : inodename ( ihandle -- str len ) my-self over to my-self >r ihandle>phandle get-nodename \ nonzero unit number? false >r depth >r my-unit r> 1+ begin depth over > while swap 0<> if r> drop true >r then repeat drop \ if not... check for presence of "reg" property r> ?dup 0= if " reg" my-self ihandle>phandle get-package-property if false else 2drop true then then ( name len print-unit-flag ) if my-self ihandle>phandle get-encode-unit-xt ( name len xt ) depth >r >r my-unit r> execute r> -rot >r >r depth! drop r> r> ( name len str len ) here 20 + tmpstrcpy " @" rot tmpstrcat drop 2swap pocket tmpstrcat drop then \ add :arguments my-args dup if " :" pocket tmpstrcat drop 2swap pocket tmpstrcat drop else 2drop then r> to my-self ; \ helper, also used by client interface (package-to-path) : get-package-path ( phandle -- str len ) ?dup 0= if 0 0 then dup >dn.parent @ 0= if drop " /" exit then \ dictionary abused for temporary storage >r 0 0 here 40 + begin r> dup >dn.parent @ dup >r while ( path len tempbuf phandle R: phandle.parent ) pnodename rot tmpstrcat " /" rot tmpstrcat repeat r> 3drop pocket tmpstrcpy drop ; \ used by client interface (instance-to-path) : get-instance-path ( ihandle -- str len ) ?dup 0= if 0 0 then dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then \ dictionary abused for temporary storage >r 0 0 here 40 + begin r> dup >in.my-parent @ dup >r while ( path len tempbuf ihandle R: ihandle.parent ) dup >in.interposed @ 0= if inodename rot tmpstrcat " /" rot tmpstrcat else drop then repeat r> 3drop pocket tmpstrcpy drop ; \ used by client interface (instance-to-interposed-path) : get-instance-interposed-path ( ihandle -- str len ) ?dup 0= if 0 0 then dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then \ dictionary abused for temporary storage >r 0 0 here 40 + begin r> dup >in.my-parent @ dup >r while ( path len tempbuf ihandle R: ihandle.parent ) dup >r inodename rot tmpstrcat r> >in.interposed @ if " /%" else " /" then rot tmpstrcat repeat r> 3drop pocket tmpstrcpy drop ; : pwd ( -- ) ?active-package get-package-path type ; : ls ( -- ) cr ?active-package >dn.child @ begin dup while dup u. dup pnodename type cr >dn.peer @ repeat drop ; \ ------------------------------------------- \ property printing \ ------------------------------------------- : .p-string? ( data len -- true | data len false ) \ no trailing zero? 2dup + 1- c@ if 0 exit then swap >r 0 \ count zeros and detect unprintable characters? over 1- begin 1- dup 0>= while dup r@ + c@ ( len zerocnt n ch ) ?dup 0= if swap 1+ swap else dup 1b <= swap 80 >= or if 2drop r> swap 0 exit then then repeat drop r> -rot ( data len zerocnt ) \ simple string 0= if ascii " emit 1- type ascii " emit true exit then \ make sure there are no double zeros (except possibly at the end) 2dup over + swap ( data len end ptr ) begin 2dup <> while dup c@ 0= if 2dup 1+ <> if 2drop false exit then then dup cstrlen 1+ + repeat 2drop ." {" 0 -rot over + swap \ multistring ( cnt end ptr ) begin 2dup <> while rot dup if ." , " then 1+ -rot dup cstrlen 2dup ascii " emit type ascii " emit 1+ + repeat ." }" 3drop true ; : .p-int? ( data len -- 1 | data len 0 ) dup 4 <> if false exit then decode-int -rot 2drop true swap dup 0>= if . exit then dup -ff < if u. exit then . ; \ Print a number zero-padded : 0.r ( u minlen -- ) 0 swap <# 1 ?do # loop #s #> type ; : .p-bytes? ( data len -- 1 | data len 0 ) ." -- " dup . ." : " swap >r 0 begin 2dup > while dup r@ + c@ ( len n ch ) 2 0.r space 1+ repeat 2drop r> drop 1 ; \ this function tries to heuristically determine the data format : (.property) ( data len -- ) dup 0= if 2drop ." " exit then .p-string? if exit then .p-int? if exit then .p-bytes? if exit then 2drop ." " ; \ Print the value of a property in "reg" format : .p-reg ( #acells #scells data len -- ) 2dup + -rot ( #acells #scells data+len data len ) >r >r -rot ( data+len #acells #scells R: len data ) 4 * swap 4 * dup r> r> ( data+len #sbytes #abytes #abytes data len ) bounds ( data+len #sbytes #abytes #abytes data+len data ) ?do dup 0= if 2 spaces then \ start of "size" part 2dup <> if \ non-first byte in row dup 3 and 0= if space then \ make numbers more readable then i c@ 2 0.r \ print byte 1- 3dup nip + 0= if \ end of row 3 pick i 1+ > if \ non-last byte cr \ start new line d# 26 spaces \ indentation then drop dup \ update counter then loop 3drop drop ; \ Return the number of cells per physical address : .p-translations-#pacells ( -- #cells ) " /" find-package if " #address-cells" rot get-package-property if 1 else decode-int nip nip 1 max then else 1 then ; \ Return the number of cells per translation entry : .p-translations-#cells ( -- #cells ) [IFDEF] CONFIG_PPC my-#acells 3 * .p-translations-#pacells + [ELSE] my-#acells 3 * [THEN] ; \ Set up column offsets : .p-translations-cols ( -- col1 ... coln #cols ) .p-translations-#cells 4 * [IFDEF] CONFIG_PPC 4 - dup 4 - dup .p-translations-#pacells 4 * - 3 [ELSE] my-#acells 4 * - dup my-#scells 4 * - 2 [THEN] ; \ Print the value of the MMU translations property : .p-translations ( data len -- ) >r >r .p-translations-cols r> r> ( col1 ... coln #cols data len ) 2dup + -rot ( col1 ... coln #cols data+len data len ) >r >r .p-translations-#cells 4 * dup r> r> ( col1 ... coln #cols data+len #bytes #bytes len data ) bounds ( col1 ... coln #cols data+len #bytes #bytes data+len data ) ?do 3 pick 4 + 4 ?do \ check all defined columns i pick over = if 2 spaces \ start new column then loop 2dup <> if \ non-first byte in row dup 3 and 0= if space then \ make numbers more readable then i c@ 2 0.r \ print byte 1- dup 0= if \ end of row 2 pick i 1+ > if \ non-last byte cr \ start new line d# 26 spaces \ indentation then drop dup \ update counter then loop 2drop drop 0 ?do drop loop ; \ This function hardwires data formats to particular node properties : (.property-by-name) ( name-str name-len data len -- ) 2over " reg" strcmp 0= if my-#acells my-#scells 2swap .p-reg 2drop exit then active-package get-nodename " memory" strcmp 0= if 2over " available" strcmp 0= if my-#acells my-#scells 2swap .p-reg 2drop exit then then " /chosen" find-dev if " mmu" rot get-package-property 0= if decode-int nip nip ihandle>phandle active-package = if 2over " available" strcmp 0= if my-#acells my-#scells 1 max 2swap .p-reg 2drop exit then 2over " translations" strcmp 0= if .p-translations 2drop exit then then then then 2swap 2drop ( data len ) (.property) ; : .properties ( -- ) ?active-package dup >r if 0 0 begin r@ next-property while cr 2dup dup -rot type begin ." " 1+ dup d# 26 >= until drop 2dup 2dup active-package get-package-property drop ( name-str name-len data len ) (.property-by-name) repeat then r> drop cr ; \ 7.4.11 Device tree : print-dev ( phandle -- phandle ) dup u. dup get-package-path type dup " device_type" rot get-package-property if cr else ." (" decode-string type ." )" cr 2drop then ; : show-sub-devs ( subtree-phandle -- ) print-dev >dn.child @ begin dup while dup recurse >dn.peer @ repeat drop ; : show-all-devs ( -- ) active-package cr " /" find-device ?active-package show-sub-devs active-package! ; : show-devs ( "{device-specifier}" -- ) active-package cr " /" find-device linefeed parse find-device ?active-package show-sub-devs active-package! ; \ 7.4.11.3 Device probing \ Set to true if the last probe-self was successful 0 value probe-fcode? : probe-all ( -- ) ;