summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/forth/admin
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/openbios/forth/admin
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/openbios/forth/admin')
-rw-r--r--qemu/roms/openbios/forth/admin/README3
-rw-r--r--qemu/roms/openbios/forth/admin/banner.fs49
-rw-r--r--qemu/roms/openbios/forth/admin/build.xml25
-rw-r--r--qemu/roms/openbios/forth/admin/callback.fs10
-rw-r--r--qemu/roms/openbios/forth/admin/devices.fs515
-rw-r--r--qemu/roms/openbios/forth/admin/help.fs51
-rw-r--r--qemu/roms/openbios/forth/admin/iocontrol.fs168
-rw-r--r--qemu/roms/openbios/forth/admin/nvram.fs385
-rw-r--r--qemu/roms/openbios/forth/admin/reset.fs12
-rw-r--r--qemu/roms/openbios/forth/admin/script.fs16
-rw-r--r--qemu/roms/openbios/forth/admin/security.fs10
-rw-r--r--qemu/roms/openbios/forth/admin/selftest.fs49
-rw-r--r--qemu/roms/openbios/forth/admin/userboot.fs29
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? )
+\ ;