Add qemu 2.4.0

Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5
Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>

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? )
+\   ;