diff options
Diffstat (limited to 'qemu/roms/openbios/forth/admin')
| -rw-r--r-- | qemu/roms/openbios/forth/admin/README | 3 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/banner.fs | 49 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/build.xml | 25 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/callback.fs | 10 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/devices.fs | 515 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/help.fs | 51 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/iocontrol.fs | 168 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/nvram.fs | 385 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/reset.fs | 12 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/script.fs | 16 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/security.fs | 10 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/selftest.fs | 49 | ||||
| -rw-r--r-- | qemu/roms/openbios/forth/admin/userboot.fs | 29 |
13 files changed, 1322 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/admin/README b/qemu/roms/openbios/forth/admin/README new file mode 100644 index 000000000..711f7e0e8 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/README @@ -0,0 +1,3 @@ +\ This directory contains code that implements +\ the Administration command group +\ (Chapter 7.4 in the IEEE 1275-1994) diff --git a/qemu/roms/openbios/forth/admin/banner.fs b/qemu/roms/openbios/forth/admin/banner.fs new file mode 100644 index 000000000..5439fc082 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/banner.fs @@ -0,0 +1,49 @@ +\ 7.4.10 Banner + +defer builtin-logo +defer builtin-banner +0 value suppress-banner? + +:noname + 0 0 +; to builtin-logo + +:noname + builddate s" built on " version s" Welcome to OpenBIOS v" pocket + tmpstrcat tmpstrcat tmpstrcat drop +; to builtin-banner + +: suppress-banner ( -- ) + 1 to suppress-banner? +; + +: banner ( -- ) + suppress-banner + stdout @ ?dup 0= if exit then + + \ draw logo if stdout is a "display" node + dup ihandle>phandle " device_type" rot get-package-property if 0 0 then + " display" strcmp if + drop + else + \ draw logo ( ihandle ) + dup ihandle>phandle " draw-logo" rot find-method if + ( ihandle xt ) + swap >r >r + 0 \ line # + oem-logo? if oem-logo else builtin-logo then + ( 0 addr logo-len ) + 200 = if + d# 64 d# 64 + r> r> call-package + else + r> r> 2drop 2drop + then + else + drop + then + then + + oem-banner? if oem-banner else builtin-banner then + type cr +; diff --git a/qemu/roms/openbios/forth/admin/build.xml b/qemu/roms/openbios/forth/admin/build.xml new file mode 100644 index 000000000..665449672 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/build.xml @@ -0,0 +1,25 @@ +<build> + + <!-- + build description for forth administrative command group + + Copyright (C) 2003-2005 by Stefan Reinauer + See the file "COPYING" for further information about + the copyright and warranty status of this work. + --> + + <dictionary name="openbios" target="forth"> + <object source="devices.fs"/> + <object source="nvram.fs"/> + <object source="callback.fs"/> + <object source="help.fs"/> + <object source="iocontrol.fs"/> + <object source="banner.fs"/> + <object source="reset.fs"/> + <object source="script.fs"/> + <object source="security.fs"/> + <object source="selftest.fs"/> + <object source="userboot.fs"/> + </dictionary> + +</build> diff --git a/qemu/roms/openbios/forth/admin/callback.fs b/qemu/roms/openbios/forth/admin/callback.fs new file mode 100644 index 000000000..e318af23b --- /dev/null +++ b/qemu/roms/openbios/forth/admin/callback.fs @@ -0,0 +1,10 @@ +\ 7.4.9 Client program callback + +: callback ( "service-name< >" "arguments<cr>" -- ) + ; + +: $callback ( argn ... arg1 nargs addr len -- retn ... ret2 Nreturns-1 ) + ; + +: sync ( -- ) + ; 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 ( -- ) + ; diff --git a/qemu/roms/openbios/forth/admin/help.fs b/qemu/roms/openbios/forth/admin/help.fs new file mode 100644 index 000000000..e6e624b2a --- /dev/null +++ b/qemu/roms/openbios/forth/admin/help.fs @@ -0,0 +1,51 @@ +\ tag: firmware help +\ +\ this code implements IEEE 1275-1994 ch. 7.4.1 +\ +\ Copyright (C) 2003 Stefan Reinauer +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +hex + +: (help-generic) + ." Enter 'help command-name' or 'help category-name' for more help" cr + ." (Use ONLY the first word of a category description)" cr + ." Examples: help select -or- help line" cr cr + ." Categories:" cr + ." boot (Load and execute a client program)" cr + ." diag (Diagnostic routines)" cr + ; + +: (help-diag) + ." test <device> Run the selftest method for specified device" cr + ." test-all Execute test for all devices using selftest method" cr + ; + +: (help-boot) + ." boot [<device-specifier>:<device-arguments>] [boot-arguments]" cr + ." Examples:" cr + ." boot Default boot (values specified in nvram variables)" cr + ." boot disk1:a Boot from disk1 partition a" cr + ." boot hd:1,\boot\vmlinuz root=/dev/hda1" cr + ; + +: help ( "{name}<cr>" -- ) + \ Provide information for category or specific command. + linefeed parse cr + dup 0= if + (help-generic) + 2drop + else + 2dup " diag" rot min comp not if + (help-diag) 2drop exit + then + 2dup " boot" rot min comp not if + (help-boot) 2drop exit + then + ." No help available for " type cr + then + ; + diff --git a/qemu/roms/openbios/forth/admin/iocontrol.fs b/qemu/roms/openbios/forth/admin/iocontrol.fs new file mode 100644 index 000000000..b0f578f4d --- /dev/null +++ b/qemu/roms/openbios/forth/admin/iocontrol.fs @@ -0,0 +1,168 @@ +\ tag: stdin/stdout handling +\ +\ Copyright (C) 2003 Samuel Rydh +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +\ 7.4.5 I/O control + +variable stdout +variable stdin + +: input ( dev-str dev-len -- ) + 2dup find-dev 0= if + ." Input device " type ." not found." cr exit + then + + " read" rot find-method 0= if + type ." has no read method." cr exit + then + drop + + \ open stdin device + 2dup open-dev ?dup 0= if + ." Opening " type ." failed." cr exit + then + -rot 2drop + + \ call install-abort if present + dup " install-abort" rot ['] $call-method catch if 3drop then + + \ close old stdin + stdin @ ?dup if + dup " remove-abort" rot ['] $call-method catch if 3drop then + close-dev + then + stdin ! + + \ update /chosen + " /chosen" find-package if + >r stdin @ encode-int " stdin" r> (property) + then + +[IFDEF] CONFIG_SPARC32 + \ update stdin-path properties + \ (this isn't part of the IEEE1275 spec but needed by older Solaris) + " /" find-package if + >r stdin @ get-instance-path encode-string " stdin-path" r> (property) + then +[THEN] +; + +: output ( dev-str dev-len -- ) + 2dup find-dev 0= if + ." Output device " type ." not found." cr exit + then + + " write" rot find-method 0= if + type ." has no write method." cr exit + then + drop + + \ open stdin device + 2dup open-dev ?dup 0= if + ." Opening " type ." failed." cr exit + then + -rot 2drop + + \ close old stdout + stdout @ ?dup if close-dev then + stdout ! + + \ update /chosen + " /chosen" find-package if + >r stdout @ encode-int " stdout" r> (property) + then + +[IFDEF] CONFIG_SPARC32 + \ update stdout-path properties + \ (this isn't part of the IEEE1275 spec but needed by older Solaris) + " /" find-package if + >r stdout @ get-instance-path encode-string " stdout-path" r> (property) + then +[THEN] +; + +: io ( dev-str dev-len -- ) + 2dup input output +; + +\ key?, key and emit implementation +variable io-char +variable io-out-char + +: io-key? ( -- available? ) + io-char @ -1 <> if true exit then + io-char 1 " read" stdin @ $call-method + 1 = +; + +: io-key ( -- key ) + \ poll for key + begin io-key? until + io-char c@ -1 to io-char +; + +: io-emit ( char -- ) + stdout @ if + io-out-char c! + io-out-char 1 " write" stdout @ $call-method + then + drop +; + +variable CONSOLE-IN-list +variable CONSOLE-OUT-list + +: CONSOLE-IN-initializer ( xt -- ) + CONSOLE-IN-list list-add , +; +: CONSOLE-OUT-initializer ( xt -- ) + CONSOLE-OUT-list list-add , +; + +: install-console ( -- ) + + \ create screen alias + " /aliases" find-package if + >r + " screen" find-package if drop else + \ bad (or missing) screen alias + 0 " display" iterate-device-type ?dup if + ( display-ph R: alias-ph ) + get-package-path encode-string " screen" r@ (property) + then + then + r> drop + then + + output-device output + input-device input + + \ let arch determine a useful output device + CONSOLE-OUT-list begin list-get while + stdout @ if drop else @ execute then + repeat + + \ let arch determine a useful input device + CONSOLE-IN-list begin list-get while + stdin @ if drop else @ execute then + repeat + + \ activate console + stdout @ if + ['] io-emit to emit + then + + stdin @ if + -1 to io-char + ['] io-key? to key? + ['] io-key to key + then +; + +:noname + " screen" output +; CONSOLE-OUT-initializer diff --git a/qemu/roms/openbios/forth/admin/nvram.fs b/qemu/roms/openbios/forth/admin/nvram.fs new file mode 100644 index 000000000..20f6462b9 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/nvram.fs @@ -0,0 +1,385 @@ +\ tag: nvram config handling +\ +\ this code implements IEEE 1275-1994 +\ +\ Copyright (C) 2003, 2004 Samuel Rydh +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +struct ( config ) + 2 cells field >cf.name + 2 cells field >cf.default \ 0 -1 if no default + /n field >cf.check-xt + /n field >cf.exec-xt + /n field >cf.next +constant config-info.size + +0 value config-root + +\ -------------------------------------------------------- +\ config handling +\ -------------------------------------------------------- + +: find-config ( name-str len -- 0|configptr ) + config-root + begin ?dup while + -rot + 2dup 4 pick >cf.name 2@ + strcmp 0= if + 2drop exit + then + rot >cf.next @ + repeat + 2drop 0 +; + +: is-config-word ( configp -- ) + dup >cf.name 2@ $create , + does> @ + dup >cf.name 2@ + s" /options" find-dev if + get-package-property if 0 -1 then + ( configp prop-str prop-len ) + \ drop trailing zero + ?dup if 1- then + else + 2drop 0 -1 + then + \ use default value if property is missing + dup 0< if 2drop dup >cf.default 2@ then + \ no default value, use empty string + dup 0< if 2drop 0 0 then + + rot >cf.exec-xt @ execute +; + +: new-config ( name-str name-len -- configp ) + 2dup find-config ?dup if + nip nip + 0 0 2 pick >cf.default 2! + else + dict-strdup + here config-info.size allot + dup config-info.size 0 fill + config-root over >cf.next ! + dup to config-root + dup >r >cf.name 2! r> + dup is-config-word + then + ( configp ) +; + +: config-default ( str len configp -- ) + -rot + dup 0> if dict-strdup then + rot >cf.default 2! +; + +: no-conf-def ( configp -- ) + 0 -1 +; + +\ -------------------------------------------------------- +\ config types +\ -------------------------------------------------------- + +: exec-str-conf ( str len -- str len ) + \ trivial +; +: check-str-conf ( str len -- str len valid? ) + \ nothing + true +; + +: str-config ( def-str len name len -- configp ) + new-config >r + ['] exec-str-conf r@ >cf.exec-xt ! + ['] check-str-conf r@ >cf.check-xt ! + r> config-default +; + +\ ------------------------------------------------------------ + +: exec-int-conf ( str len -- value ) + \ fixme + parse-hex +; +: check-int-conf ( str len -- str len valid? ) + true +; + +: int-config ( def-str len name len -- configp ) + new-config >r + ['] exec-int-conf r@ >cf.exec-xt ! + ['] check-int-conf r@ >cf.check-xt ! + r> config-default +; + +\ ------------------------------------------------------------ + +: exec-secmode-conf ( str len -- n ) + 2dup s" command" strcmp 0= if 2drop 1 exit then + 2dup s" full" strcmp 0= if 2drop 2 exit then + 2drop 0 +; +: check-secmode-conf ( str len -- str len valid? ) + 2dup s" none" strcmp 0= if true exit then + 2dup s" command" strcmp 0= if true exit then + 2dup s" full" strcmp 0= if true exit then + false +; + +: secmode-config ( def-str len name len -- configp ) + new-config >r + ['] exec-secmode-conf r@ >cf.exec-xt ! + ['] check-secmode-conf r@ >cf.check-xt ! + r> config-default +; + +\ ------------------------------------------------------------ + +: exec-bool-conf ( str len -- value ) + 2dup s" true" strcmp 0= if 2drop true exit then + 2dup s" false" strcmp 0= if 2drop false exit then + 2dup s" TRUE" strcmp 0= if 2drop false exit then + 2dup s" FALSE" strcmp 0= if 2drop false exit then + parse-hex 0<> +; + +: check-bool-conf ( name len -- str len valid? ) + 2dup s" true" strcmp 0= if true exit then + 2dup s" false" strcmp 0= if true exit then + 2dup s" TRUE" strcmp 0= if 2drop s" true" true exit then + 2dup s" FALSE" strcmp 0= if 2drop s" false" true exit then + false +; + +: bool-config ( configp -- configp ) + new-config >r + ['] exec-bool-conf r@ >cf.exec-xt ! + ['] check-bool-conf r@ >cf.check-xt ! + r> config-default +; + + +\ -------------------------------------------------------- +\ 7.4.4 Nonvolatile memory +\ -------------------------------------------------------- + +: $setenv ( data-addr data-len name-str name-len -- ) + 2dup find-config ?dup if + >r 2swap r> + ( name len data len configptr ) + >cf.check-xt @ execute + 0= abort" Invalid value." + 2swap + else + \ create string config type + 2dup no-conf-def 2swap str-config + then + + 2swap encode-string 2swap + s" /options" find-package drop + encode-property +; + +: setenv ( "nv-param< >new-value<eol>" -- ) + parse-word + \ XXX drop blanks + dup if linefeed parse else 0 0 then + + dup 0= abort" Invalid value." + 2swap $setenv +; + +: printenv ( "{param-name}<eol>" -- ) + \ XXX temporary implementation + linefeed parse 2drop + + active-package + s" /options" find-device + .properties + active-package! +; + +: (set-default) ( configptr -- ) + dup >cf.default 2@ dup 0>= if + rot >cf.name 2@ $setenv + else + \ no default value + 3drop + then +; + +: set-default ( "param-name<eol>" -- ) + linefeed parse + find-config ?dup if + (set-default) + else + ." No such parameter." -2 throw + then +; + +: set-defaults ( -- ) + config-root + begin ?dup while + dup (set-default) + >cf.next @ + repeat +; + +( maxlen "new-name< >" -- ) ( E: -- addr len ) +: nodefault-bytes + ; + + +\ -------------------------------------------------------- +\ initialize config from nvram +\ -------------------------------------------------------- + +\ CHRP format (array of null-terminated strings, "variable=value") +: nvram-load-configs ( data len -- ) + \ XXX: no len checking performed... + drop + begin dup c@ while + ( data ) + dup cstrlen 2dup + 1+ -rot + ( next str len ) + ascii = left-split ( next val len name str ) + ['] $setenv catch if + 2drop 2drop + then + repeat drop +; + +: (nvram-store-one) ( buf len str len -- buf len success? ) + swap >r + 2dup < if r> 2drop 2drop false exit then + ( buf len strlen R: str ) + swap over - r> swap >r -rot + ( str buf strlen R: res_len ) + 2dup + >r move r> r> true +; + +: (make-configstr) ( configptr ph -- str len ) + >r + >cf.name 2@ + 2dup r> get-package-property if + 2drop 0 0 exit + else + dup if 1- then + then + ( name len value-str len ) + 2swap s" =" 2swap + pocket tmpstrcat tmpstrcat drop + 2dup + 0 swap c! + 1+ +; + +: nvram-store-configs ( data len -- ) + 2 - \ make room for two trailing zeros + + s" /options" find-dev 0= if 2drop exit then + >r + config-root + ( data len configptr R: phandle ) + begin ?dup while + r@ over >r (make-configstr) + ( buf len val len R: configptr phandle ) + (nvram-store-one) drop + r> >cf.next @ + repeat + \ null terminate + 2 + 0 fill + r> drop +; + + +\ -------------------------------------------------------- +\ NVRAM variables +\ -------------------------------------------------------- +\ fcode-debug? input-device output-device +s" true" s" auto-boot?" bool-config \ 7.4.3.5 +s" boot" s" boot-command" str-config \ 7.4.3.5 +s" " s" boot-file" str-config \ 7.4.3.5 +s" false" s" diag-switch?" bool-config \ 7.4.3.5 +no-conf-def s" diag-device" str-config \ 7.4.3.5 +no-conf-def s" diag-file" str-config \ 7.4.3.5 +s" false" s" fcode-debug?" bool-config \ 7.7 +s" " s" nvramrc" str-config \ 7.4.4.2 +s" false" s" oem-banner?" bool-config +s" " s" oem-banner" str-config +s" false" s" oem-logo?" bool-config +no-conf-def s" oem-logo" str-config +s" false" s" use-nvramrc?" bool-config \ 7.4.4.2 +s" keyboard" s" input-device" str-config \ 7.4.5 +s" screen" s" output-device" str-config \ 7.4.5 +s" 80" s" screen-#columns" int-config \ 7.4.5 +s" 24" s" screen-#rows" int-config \ 7.4.5 +s" 0" s" selftest-#megs" int-config +no-conf-def s" security-mode" secmode-config + +\ --- devices --- +s" -1" s" pci-probe-mask" int-config +s" false" s" default-mac-address" bool-config +s" false" s" skip-netboot?" bool-config +s" true" s" scroll-lock" bool-config + +[IFDEF] CONFIG_PPC +\ ---- PPC ---- +s" false" s" little-endian?" bool-config +s" false" s" real-mode?" bool-config +s" -1" s" real-base" int-config +s" -1" s" real-size" int-config +s" 4000000" s" load-base" int-config +s" -1" s" virt-base" int-config +s" -1" s" virt-size" int-config +[THEN] + +[IFDEF] CONFIG_X86 +\ ---- X86 ---- +s" true" s" little-endian?" bool-config +[THEN] + +[IFDEF] CONFIG_SPARC32 +\ ---- SPARC32 ---- +s" 4000" s" load-base" int-config +s" true" s" tpe-link-test?" bool-config +s" 9600,8,n,1,-" s" ttya-mode" str-config +s" true" s" ttya-ignore-cd" bool-config +s" false" s" ttya-rts-dtr-off" bool-config +s" 9600,8,n,1,-" s" ttyb-mode" str-config +s" true" s" ttyb-ignore-cd" bool-config +s" false" s" ttyb-rts-dtr-off" bool-config +[THEN] + +[IFDEF] CONFIG_SPARC64 +\ ---- SPARC64 ---- +s" 4000" s" load-base" int-config +s" false" s" little-endian?" bool-config +[THEN] + +\ --- ??? --- +s" " s" boot-screen" str-config +s" " s" boot-script" str-config +s" false" s" use-generic?" bool-config +s" disk" s" boot-device" str-config \ 7.4.3.5 +s" " s" boot-args" str-config \ ??? + +\ defers +['] fcode-debug? to _fcode-debug? +['] diag-switch? to _diag-switch? + +\ Hack for load-base: it seems that some Sun bootloaders try +\ and execute "<value> to load-base" which will only work if +\ load-base is value. Hence we redefine load-base here as a +\ value using its normal default. +[IFDEF] CONFIG_SPARC64 +load-base value load-base +[THEN] + +: release-load-area + drop +; diff --git a/qemu/roms/openbios/forth/admin/reset.fs b/qemu/roms/openbios/forth/admin/reset.fs new file mode 100644 index 000000000..565692658 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/reset.fs @@ -0,0 +1,12 @@ +\ 7.4.7 Reset + +defer reset-all ( -- ) + +: no-reset-all + s" reset-all is not available on this platform." type cr + ; + +' no-reset-all to reset-all + +\ OpenBOOT knows reset as well. +: reset reset-all ; diff --git a/qemu/roms/openbios/forth/admin/script.fs b/qemu/roms/openbios/forth/admin/script.fs new file mode 100644 index 000000000..a65adb207 --- /dev/null +++ b/qemu/roms/openbios/forth/admin/script.fs @@ -0,0 +1,16 @@ +\ 7.4.4.2 The script + +: nvedit ( -- ) + ; + +: nvstore ( -- ) + ; + +: nvquit ( -- ) + ; + +: nvrecover ( -- ) + ; + +: nvrun ( -- ) + ; diff --git a/qemu/roms/openbios/forth/admin/security.fs b/qemu/roms/openbios/forth/admin/security.fs new file mode 100644 index 000000000..ef2ec30be --- /dev/null +++ b/qemu/roms/openbios/forth/admin/security.fs @@ -0,0 +1,10 @@ +\ 7.4.6 Security + +: password ( -- ) + ; + +: security-password ( -- password-str password-len ) + ; + +: security-#badlogins ( -- n ) + ; diff --git a/qemu/roms/openbios/forth/admin/selftest.fs b/qemu/roms/openbios/forth/admin/selftest.fs new file mode 100644 index 000000000..20c0c963b --- /dev/null +++ b/qemu/roms/openbios/forth/admin/selftest.fs @@ -0,0 +1,49 @@ +\ tag: self-test +\ +\ this code implements IEEE 1275-1994 ch. 7.4.8 +\ +\ Copyright (C) 2003 Stefan Reinauer +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + +\ +\ 7.4.8 Self-test +\ + +: $test ( devname-addr devname-len -- ) + 2dup ." Testing device " type ." : " + find-dev if + s" self-test" rot find-method if + execute + else + ." no self-test method." + then + else + ." no such device." + then + cr +; + +: test ( "device-specifier<cr>"-- ) + linefeed parse cr $test + ; + +: test-sub-devs + >dn.child @ + begin dup while + dup get-package-path $test + dup recurse + >dn.peer @ + repeat + drop +; + +: test-all ( "{device-specifier}<cr>" -- ) + active-package + cr " /" find-device + linefeed parse find-device + ?active-package test-sub-devs + active-package! + ; diff --git a/qemu/roms/openbios/forth/admin/userboot.fs b/qemu/roms/openbios/forth/admin/userboot.fs new file mode 100644 index 000000000..3ae899c2f --- /dev/null +++ b/qemu/roms/openbios/forth/admin/userboot.fs @@ -0,0 +1,29 @@ +\ 7.4.3.5 User commands for booting + +: boot ( "{param-text}<cr>" -- ) + linefeed parse + + \ Copy NVRAM parameters from boot-file to bootargs in case any parameters have + \ been specified for the platform-specific boot code + s" boot-file" $find drop execute + encode-string + " /chosen" (find-dev) if + " bootargs" rot (property) + then + + \ Execute platform-specific boot code, e.g. kernel + s" platform-boot" $find if + execute + then + + (find-bootdevice) \ Setup bootargs + $load \ load and go + go +; + + +\ : diagnostic-mode? ( -- diag? ) +\ ; + +\ : diag-switch? ( -- diag? ) +\ ; |