mirror of
https://gitlab.com/qemu-project/openbios.git
synced 2024-02-13 08:34:06 +08:00
1be046b641
Some device trees can contain large chunks of binary data that result in .properties output to get lost in the dump of all binary bytes. Put an upper limit of the bytes dumped. Signed-off-by: BALATON Zoltan <balaton@eik.bme.hu> Signed-off-by: Mark Cave-Ayland <mark.cave-ayland@ilande.co.uk>
517 lines
11 KiB
Forth
517 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 dup 100 min 0
|
|
begin 2dup > while
|
|
dup r@ + c@
|
|
( len n ch )
|
|
|
|
2 0.r space
|
|
1+
|
|
repeat
|
|
drop > if ." ..." then
|
|
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 ( -- )
|
|
;
|