1 \ tag: device tree administration
3 \ this code implements IEEE 1275-1994
5 \ Copyright (C) 2003 Samuel Rydh
6 \ Copyright (C) 2003-2006 Stefan Reinauer
8 \ See the file "COPYING" for further information about
9 \ the copyright and warranty status of this work.
13 \ 7.4.11.1 Device alias
15 : devalias ( "{alias-name}< >{device-specifier}<cr>" -- )
18 : nvalias ( "alias-name< >device-specifier<cr>" -- )
21 : $nvalias ( name-str name-len dev-str dev-len -- )
24 : nvunalias ( "alias-name< >" -- )
27 : $nvunalias ( name-str name-len -- )
31 \ 7.4.11.2 Device tree browsing
33 : dev ( "<spaces>device-specifier" -- )
42 \ find-device ( dev-str dev-len -- )
43 \ implemented in pathres.fs
49 \ Open selected device node and make it the current instance
50 \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible
52 open-dev dup 0= abort" failed opening parent."
54 ihandle>phandle active-package!
57 \ Close current node, deselect active package and current instance,
58 \ leaving no instance selected
59 \ section H.8 errata: pre OpenFirmware, but Sun OBP compatible
66 : begin-package ( arg-str arg-len reg-str reg-len dev-str dev-len -- )
77 : ?active-package ( -- phandle )
78 active-package dup 0= abort" no active device"
81 \ -------------------------------------------------------
83 \ -------------------------------------------------------
85 \ used if parent lacks an encode-unit method
86 : def-encode-unit ( unitaddr ... )
90 : get-encode-unit-xt ( phandle.parent -- xt )
92 " encode-unit" rot find-method
93 0= if ['] def-encode-unit then
96 : get-nodename ( phandle -- str len )
97 " name" rot get-package-property if " <noname>" else 1- then
100 \ helper, return the node name in the format 'cpus@addr'
101 : pnodename ( phandle -- str len )
103 dup " reg" rot get-package-property if drop exit then rot
105 \ set active-package and clear my-self (decode-phys needs this)
106 my-self >r 0 to my-self
110 ( name len prop len phandle )
113 ( name len prop len xt )
115 decode-phys r> execute
116 r> -rot >r >r depth! 3drop
118 ( name len R: len str )
120 here 20 + \ abuse dictionary for temporary storage
122 2swap r> tmpstrcat drop
123 pocket tmpstrcpy drop
129 : inodename ( ihandle -- str len )
130 my-self over to my-self >r
131 ihandle>phandle get-nodename
133 \ nonzero unit number?
135 depth >r my-unit r> 1+
136 begin depth over > while
137 swap 0<> if r> drop true >r then
141 \ if not... check for presence of "reg" property
143 " reg" my-self ihandle>phandle get-package-property
144 if false else 2drop true then
147 ( name len print-unit-flag )
149 my-self ihandle>phandle get-encode-unit-xt
154 r> -rot >r >r depth! drop
158 " @" rot tmpstrcat drop
159 2swap pocket tmpstrcat drop
164 " :" pocket tmpstrcat drop
165 2swap pocket tmpstrcat drop
173 \ helper, also used by client interface (package-to-path)
174 : get-package-path ( phandle -- str len )
177 dup >dn.parent @ 0= if drop " /" exit then
178 \ dictionary abused for temporary storage
180 begin r> dup >dn.parent @ dup >r while
181 ( path len tempbuf phandle R: phandle.parent )
182 pnodename rot tmpstrcat
186 pocket tmpstrcpy drop
189 \ used by client interface (instance-to-path)
190 : get-instance-path ( ihandle -- str len )
193 dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then
195 \ dictionary abused for temporary storage
197 begin r> dup >in.my-parent @ dup >r while
198 ( path len tempbuf ihandle R: ihandle.parent )
199 dup >in.interposed @ 0= if
200 inodename rot tmpstrcat
207 pocket tmpstrcpy drop
210 \ used by client interface (instance-to-interposed-path)
211 : get-instance-interposed-path ( ihandle -- str len )
214 dup ihandle>phandle >dn.parent @ 0= if drop " /" exit then
216 \ dictionary abused for temporary storage
218 begin r> dup >in.my-parent @ dup >r while
219 ( path len tempbuf ihandle R: ihandle.parent )
220 dup >r inodename rot tmpstrcat
221 r> >in.interposed @ if " /%" else " /" then
225 pocket tmpstrcpy drop
229 ?active-package get-package-path type
234 ?active-package >dn.child @
236 dup u. dup pnodename type cr
243 \ -------------------------------------------
245 \ -------------------------------------------
247 : .p-string? ( data len -- true | data len false )
249 2dup + 1- c@ if 0 exit then
252 \ count zeros and detect unprintable characters?
253 over 1- begin 1- dup 0>= while
260 dup 1b <= swap 80 >= or
261 if 2drop r> swap 0 exit then
268 ascii " emit 1- type ascii " emit true exit
271 \ make sure there are no double zeros (except possibly at the end)
276 2dup 1+ <> if 2drop false exit then
284 \ multistring ( cnt end ptr )
286 rot dup if ." , " then 1+ -rot
288 ascii " emit type ascii " emit
295 : .p-int? ( data len -- 1 | data len 0 )
296 dup 4 <> if false exit then
297 decode-int -rot 2drop true swap
298 dup 0>= if . exit then
299 dup -ff < if u. exit then
303 \ Print a number zero-padded
304 : 0.r ( u minlen -- )
305 0 swap <# 1 ?do # loop #s #> type
308 : .p-bytes? ( data len -- 1 | data len 0 )
321 \ this function tries to heuristically determine the data format
322 : (.property) ( data len -- )
323 dup 0= if 2drop ." <empty>" exit then
325 .p-string? if exit then
327 .p-bytes? if exit then
328 2drop ." <unimplemented type>"
331 \ Print the value of a property in "reg" format
332 : .p-reg ( #acells #scells data len -- )
333 2dup + -rot ( #acells #scells data+len data len )
334 >r >r -rot ( data+len #acells #scells R: len data )
335 4 * swap 4 * dup r> r> ( data+len #sbytes #abytes #abytes data len )
336 bounds ( data+len #sbytes #abytes #abytes data+len data ) ?do
337 dup 0= if 2 spaces then \ start of "size" part
338 2dup <> if \ non-first byte in row
339 dup 3 and 0= if space then \ make numbers more readable
341 i c@ 2 0.r \ print byte
342 1- 3dup nip + 0= if \ end of row
343 3 pick i 1+ > if \ non-last byte
345 d# 26 spaces \ indentation
347 drop dup \ update counter
353 \ Return the number of cells per physical address
354 : .p-translations-#pacells ( -- #cells )
356 " #address-cells" rot get-package-property if
359 decode-int nip nip 1 max
366 \ Return the number of cells per translation entry
367 : .p-translations-#cells ( -- #cells )
370 .p-translations-#pacells +
376 \ Set up column offsets
377 : .p-translations-cols ( -- col1 ... coln #cols )
378 .p-translations-#cells 4 *
382 dup .p-translations-#pacells 4 * -
391 \ Print the value of the MMU translations property
392 : .p-translations ( data len -- )
393 >r >r .p-translations-cols r> r> ( col1 ... coln #cols data len )
394 2dup + -rot ( col1 ... coln #cols data+len data len )
395 >r >r .p-translations-#cells 4 * dup r> r>
396 ( col1 ... coln #cols data+len #bytes #bytes len data )
397 bounds ( col1 ... coln #cols data+len #bytes #bytes data+len data ) ?do
398 3 pick 4 + 4 ?do \ check all defined columns
400 2 spaces \ start new column
403 2dup <> if \ non-first byte in row
404 dup 3 and 0= if space then \ make numbers more readable
406 i c@ 2 0.r \ print byte
407 1- dup 0= if \ end of row
408 2 pick i 1+ > if \ non-last byte
410 d# 26 spaces \ indentation
412 drop dup \ update counter
415 2drop drop 0 ?do drop loop
418 \ This function hardwires data formats to particular node properties
419 : (.property-by-name) ( name-str name-len data len -- )
420 2over " reg" strcmp 0= if
421 my-#acells my-#scells 2swap .p-reg
425 active-package get-nodename " memory" strcmp 0= if
426 2over " available" strcmp 0= if
427 my-#acells my-#scells 2swap .p-reg
431 " /chosen" find-dev if
432 " mmu" rot get-package-property 0= if
433 decode-int nip nip ihandle>phandle active-package = if
434 2over " available" strcmp 0= if
435 my-#acells my-#scells 1 max 2swap .p-reg
438 2over " translations" strcmp 0= if
446 2swap 2drop ( data len )
451 ?active-package dup >r if
456 cr 2dup dup -rot type
457 begin ." " 1+ dup d# 26 >= until drop
459 2dup active-package get-package-property drop
460 ( name-str name-len data len )
471 : print-dev ( phandle -- phandle )
473 dup get-package-path type
474 dup " device_type" rot get-package-property if
477 ." (" decode-string type ." )" cr 2drop
481 : show-sub-devs ( subtree-phandle -- )
491 : show-all-devs ( -- )
494 ?active-package show-sub-devs
499 : show-devs ( "{device-specifier}<cr>" -- )
502 linefeed parse find-device
503 ?active-package show-sub-devs
509 \ 7.4.11.3 Device probing
511 \ Set to true if the last probe-self was successful