diff options
Diffstat (limited to 'qemu/roms/openbios/forth/admin/devices.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/admin/devices.fs | 515 |
1 files changed, 515 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/admin/devices.fs b/qemu/roms/openbios/forth/admin/devices.fs new file mode 100644 index 000000000..6f9e8efbb --- /dev/null +++ b/qemu/roms/openbios/forth/admin/devices.fs @@ -0,0 +1,515 @@ +\ 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 " 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}<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 ( -- ) + ; |