515 lines
11 KiB
Forth
515 lines
11 KiB
Forth
\ 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}<cr>" -- )
|
|
;
|
|
|
|
: nvalias ( "alias-name< >device-specifier<cr>" -- )
|
|
;
|
|
|
|
: $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 ( "<spaces>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 " <noname>" 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 ." <empty>" exit then
|
|
|
|
.p-string? if exit then
|
|
.p-int? if exit then
|
|
.p-bytes? if exit then
|
|
2drop ." <unimplemented type>"
|
|
;
|
|
|
|
\ 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 2dup " reg" strcmp 0= -rot " assigned-addresses" strcmp 0= or 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}<cr>" -- )
|
|
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 ( -- )
|
|
;
|