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, 0 insertions, 515 deletions
diff --git a/qemu/roms/openbios/forth/admin/devices.fs b/qemu/roms/openbios/forth/admin/devices.fs deleted file mode 100644 index 6f9e8efbb..000000000 --- a/qemu/roms/openbios/forth/admin/devices.fs +++ /dev/null @@ -1,515 +0,0 @@ -\ 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 ( -- ) - ; |