\ 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! ; : ?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 . ; : .p-bytes? ( data len -- 1 | data len 0 ) ." -- " dup . ." : " swap >r 0 begin 2dup > while dup r@ + c@ ( len n ch ) pocket tohexstr type ." " 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 ." " ; : .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 active-package get-package-property drop (.property) 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 : probe-all ( -- ) ;