Add qemu 2.4.0

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

21 files changed, 3938 insertions, 0 deletions

diff --git a/qemu/roms/openbios/forth/device/README.device b/qemu/roms/openbios/forth/device/README.device
new file mode 100644
index 000000000..0d4d6e58d
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/README.device
@@ -0,0 +1,22 @@
+The code you find here implements the IEEE 1275-1994 Open Firmware
+device interface.
+
+Chapter     File                    Comment
+<none>      structures.fs           generic structures used by 5.3
+5.3.2       <none>                  defined in user interface
+5.3.3       fcode.fs                complete, partly untested
+5.3.4       package.fs              incomplete
+5.3.5       property.fs             incomplete
+5.3.6       display.fs              incomplete
+5.3.7       other.fs                incomplete
+
+H2 and
+5.3.1.1.1   preof.fs                pre-IEEE-1275-1994 words
+	    split.fs
+	    pathres.fs		    path resolution
+
+	    table.fs		    fcode evaluator
+	    feval.fs		    (byte-load)
+
+
+2003/11/12 Stefan Reinauer <stepan@openbios.org>
diff --git a/qemu/roms/openbios/forth/device/build.xml b/qemu/roms/openbios/forth/device/build.xml
new file mode 100644
index 000000000..11544964a
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/build.xml
@@ -0,0 +1,31 @@
+<build>
+
+ <!--
+  build description for open firmware device interface
+ 
+  Copyright (C) 2004-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="structures.fs"/>
+  <object source="fcode.fs"/>
+  <object source="property.fs"/>
+  <object source="device.fs"/>
+  <object source="package.fs"/>
+  <object source="other.fs"/>
+  <object source="pathres.fs"/>
+  <object source="preof.fs"/>
+  <object source="font.fs"/>
+  <object source="logo.fs"/>
+  <object source="display.fs"/>
+  <object source="terminal.fs"/>
+  <object source="extra.fs"/>
+  <object source="feval.fs"/>
+  <object source="table.fs"/>
+  <object source="tree.fs"/>
+  <object source="builtin.fs"/>
+ </dictionary>
+
+</build>
diff --git a/qemu/roms/openbios/forth/device/builtin.fs b/qemu/roms/openbios/forth/device/builtin.fs
new file mode 100644
index 000000000..aaefba87b
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/builtin.fs
@@ -0,0 +1,30 @@
+\ tag: builtin devices
+\ 
+\ this code implements IEEE 1275-1994 
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ nodes it's children:
+
+" /" find-device
+  
+new-device
+  " builtin" device-name
+  : open true ;
+  : close ;
+
+new-device
+  " console" device-name
+  : open true ;
+  : close ;
+  : write dup >r bounds ?do i c@ (emit) loop r> ;
+  : read dup >r bounds ?do (key) i c! loop r> ;
+finish-device
+
+\ clean up afterwards
+finish-device
+0 active-package!
diff --git a/qemu/roms/openbios/forth/device/device.fs b/qemu/roms/openbios/forth/device/device.fs
new file mode 100644
index 000000000..562c9196e
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/device.fs
@@ -0,0 +1,202 @@
+\ tag: Package creation and deletion
+\ 
+\ 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.
+\ 
+
+variable device-tree
+
+\ make defined words globally visible
+\ 
+: external ( -- )
+  active-package ?dup if
+    >dn.methods @ set-current
+  then
+;
+
+\ make the private wordlist active (not an OF word)
+\ 
+: private ( -- )
+  active-package ?dup if
+    >r
+    forth-wordlist r@ >dn.methods @ r@ >dn.priv-methods @ 3 set-order
+    r> >dn.priv-methods @ set-current
+  then
+;
+
+\ set activate package and make the world visible package wordlist
+\ the current one.
+\ 
+: active-package! ( phandle -- )
+  dup to active-package
+  \ locally defined words are not available
+  ?dup if
+    forth-wordlist over >dn.methods @ 2 set-order
+    >dn.methods @ set-current
+  else
+    forth-wordlist dup 1 set-order set-current
+  then
+;
+
+
+\ new-device ( -- )
+\ 
+\ Start new package, as child of active package.
+\ Create a new device node as a child of the active package and make the 
+\ new node the active package. Create a new instance and make it the current
+\ instance; the instance that invoked new-device becomes the parent instance 
+\ of the new instance.
+\ Subsequently, newly defined Forth words become the methods of the new node 
+\ and newly defined data items (such as types variable, value, buffer:, and 
+\ defer) are allocated and stored within the new instance.
+
+: new-device ( -- )
+  align-tree dev-node.size alloc-tree >r
+  active-package
+  dup r@ >dn.parent !
+
+  \ ( parent ) hook up at the end of the peer list
+  ?dup if
+    >dn.child
+    begin dup @ while @ >dn.peer repeat
+    r@ swap !
+  else
+    \ we are the root node!
+    r@ to device-tree
+  then
+
+  \ ( -- ) fill in device node stuff
+  inst-node.size r@ >dn.isize !
+
+  \ create two wordlists
+  wordlist r@ >dn.methods !
+  wordlist r@ >dn.priv-methods !
+  
+  \ initialize template data
+  r@ >dn.itemplate
+  r@ over >in.device-node !
+  my-self over >in.my-parent !
+
+  \ make it the active package and current instance
+  to my-self
+  r@ active-package!
+  
+  \ swtich to public wordlist
+  external
+  r> drop
+;
+
+\ helpers for finish-device (OF does not actually define words
+\ for device node deletion)
+
+: (delete-device) \ ( phandle )
+  >r
+  r@ >dn.parent @
+  ?dup if
+    >dn.child    \ ( &first-child )
+    begin dup @ r@ <> while @ >dn.peer repeat
+    r@ >dn.peer @ swap !
+  else
+    \ root node
+    0 to device-tree
+  then
+
+  \ XXX: free any memory related to this node.
+  \ we could have a list with free device-node headers...
+  r> drop
+;
+
+: delete-device \ ( phandle )
+  >r 
+  \ first, get rid of any children
+  begin r@ >dn.child @ dup while
+    (delete-device)
+  repeat
+  drop
+  
+  \ then free this node
+  r> (delete-device)
+;
+
+\ finish-device ( -- )
+\ 
+\ Finish this package, set active package to parent.
+\ Complete a device node that was created by new-device, as follows: If the
+\ device node has no "name" property, remove the device node from the device 
+\ tree. Otherwise, save the current values of the current instance's 
+\ initialized data items within the active package for later use in
+\ initializing the data items of instances created from that node. In any 
+\ case, destroy the current instance, make its parent instance the current
+\ instance, and select the parent node of the device node just completed, 
+\ making the parent node the active package again.
+
+: finish-device \ ( -- )
+  my-self
+  dup >in.device-node @ >r
+  >in.my-parent @ to my-self
+
+  ( -- )
+  r@ >dn.parent @ active-package!
+  s" name" r@ get-package-property if
+    \ delete the node (and any children)
+    r@ delete-device
+  else
+    2drop
+    \ node OK
+  then
+  r> drop
+;
+
+
+\ helper function which creates and initializes an instance.
+\ open is not called. The current instance is not changed.
+\ 
+: create-instance ( phandle -- ihandle|0 )
+  dup >dn.isize @ ['] alloc-mem catch if 2drop 0 exit then
+  >r
+  \ we need to save the size in order to be able to release it properly
+  dup >dn.isize @ r@ >in.alloced-size !
+
+  \ clear memory (we only need to clear the head; all other data is copied)
+  r@ inst-node.size 0 fill
+  
+  ( phandle R: ihandle )
+
+  \ instantiate data
+  dup >dn.methods @ r@ instance-init
+  dup >dn.priv-methods @ r@ instance-init
+
+  \ instantiate 
+  dup >dn.itemplate r@ inst-node.size move
+  r@ r@ >in.instance-data !
+  my-self r@ >in.my-parent !
+  drop
+
+  r>
+;
+
+\ helper function which tears down and frees an instance
+: destroy-instance ( ihandle )
+  ?dup if
+    \ free arguments
+    dup >in.arguments 2@ free-mem
+    \ and the instance block
+    dup >in.alloced-size @
+    free-mem
+  then
+;
+
+\ Redefine to word so that statements of the form "0 to active-package"
+\ are supported for bootloaders that require it
+: to
+  ['] ' execute
+  dup ['] active-package = if
+    drop active-package!
+  else
+    (to-xt)
+  then
+; immediate
diff --git a/qemu/roms/openbios/forth/device/display.fs b/qemu/roms/openbios/forth/device/display.fs
new file mode 100644
index 000000000..fff44e00a
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/display.fs
@@ -0,0 +1,421 @@
+\ tag: Display device management
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.6
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+hex 
+
+\ 
+\ 5.3.6.1 Terminal emulator routines
+\ 
+
+\ The following values are used and set by the terminal emulator
+\ defined and described in 3.8.4.2
+0 value line# ( -- line# )
+0 value column# ( -- column# )
+0 value inverse? ( -- white-on-black? )
+0 value inverse-screen? ( -- black? )
+0 value #lines ( -- rows )
+0 value #columns ( -- columns )
+
+\ The following values are used internally by both the 1-bit and the 
+\ 8-bit frame-buffer support routines.
+  
+0 value frame-buffer-adr ( -- addr )
+0 value screen-height    ( -- height )
+0 value screen-width     ( -- width )
+0 value window-top       ( -- border-height )
+0 value window-left      ( -- border-width )
+0 value char-height      ( -- height )
+0 value char-width       ( -- width )
+0 value fontbytes        ( -- bytes )
+
+\ these values are used internally and do not represent any
+\ official open firmware words
+0 value char-min
+0 value char-num
+0 value font
+
+0 value foreground-color
+0 value background-color
+create color-palette 100 cells allot
+
+2 value font-spacing
+0 value depth-bits
+0 value line-bytes
+0 value display-ih
+
+\ internal values
+0 value openbios-video-height
+0 value openbios-video-width
+
+\ The following wordset is called the "defer word interface" of the 
+\ terminal-emulator support package. It gets overloaded by fb1-install
+\ or fb8-install (initiated by the framebuffer fcode driver)
+
+defer draw-character    ( char -- )
+defer reset-screen      ( -- )
+defer toggle-cursor     ( -- )
+defer erase-screen      ( -- )
+defer blink-screen      ( -- )
+defer invert-screen     ( -- )
+defer insert-characters ( n -- )
+defer delete-characters ( n -- )
+defer insert-lines ( n -- )
+defer delete-lines ( n -- )
+defer draw-logo ( line# addr width height -- )
+
+defer fb-emit ( x -- )
+
+: depth-bytes ( -- bytes )
+  depth-bits 1+ 8 /
+;
+
+\ 
+\ 5.3.6.2 Frame-buffer support routines
+\ 
+
+: default-font ( -- addr width height advance min-char #glyphs )
+  (romfont) (romfont-width) (romfont-height) (romfont-height) 0 100
+  ;
+
+: set-font ( addr width height advance min-char #glyphs -- )
+  to char-num
+  to char-min
+  to fontbytes
+  font-spacing + to char-height
+  to char-width
+  to font
+  ;
+
+: >font ( char -- addr )
+  char-min - 
+  char-num min
+  fontbytes *
+  font +
+  ;
+
+\ 
+\ 5.3.6.3 Display device support
+\ 
+
+\ 
+\ 5.3.6.3.1 Frame-buffer package interface
+\ 
+
+: is-install    ( xt -- )
+  external
+  \ Create open and other methods for this display device.
+  \ Methods to be created: open, write, draw-logo, restore
+  s" open" header 
+  1 , \ colon definition
+  ,
+  ['] (lit) ,
+  -1 ,
+  ['] (semis) ,
+  reveal
+  s" : write dup >r bounds do i c@ fb-emit loop r> ; " evaluate
+  s" : draw-logo draw-logo ; " evaluate
+  s" : restore reset-screen ; " evaluate
+  ;
+
+: is-remove    ( xt -- )
+  external
+  \ Create close method for this display device.
+  s" close" header 
+  1 , \ colon definition
+  ,
+  ['] (semis) ,
+  reveal
+  ;
+  
+: is-selftest    ( xt -- )
+  external
+  \ Create selftest method for this display device.
+  s" selftest" header 
+  1 , \ colon definition
+  ,
+  ['] (semis) ,
+  reveal
+  ;
+
+
+\ 5.3.6.3.2 Generic one-bit frame-buffer support (optional)
+
+: fb1-nonimplemented
+  ." Monochrome framebuffer support is not implemented." cr
+  end0
+  ;
+
+: fb1-draw-character	fb1-nonimplemented ; \ historical
+: fb1-reset-screen	fb1-nonimplemented ;
+: fb1-toggle-cursor	fb1-nonimplemented ;
+: fb1-erase-screen	fb1-nonimplemented ;
+: fb1-blink-screen	fb1-nonimplemented ;
+: fb1-invert-screen	fb1-nonimplemented ;
+: fb1-insert-characters fb1-nonimplemented ;
+: fb1-delete-characters	fb1-nonimplemented ;
+: fb1-insert-lines	fb1-nonimplemented ;
+: fb1-delete-lines	fb1-nonimplemented ;
+: fb1-slide-up		fb1-nonimplemented ;
+: fb1-draw-logo		fb1-nonimplemented ;
+: fb1-install		fb1-nonimplemented ;
+
+  
+\ 5.3.6.3.3 Generic eight-bit frame-buffer support
+
+\ bind to low-level C function later
+defer fb8-blitmask
+defer fb8-fillrect
+defer fb8-invertrect
+
+: fb8-line2addr ( line -- addr )
+  window-top +
+  screen-width * depth-bytes *
+  frame-buffer-adr + 
+  window-left depth-bytes * +
+;
+
+: fb8-curpos2addr ( col line -- addr )
+  char-height * fb8-line2addr
+  swap char-width * depth-bytes * +
+;
+
+: fb8-copy-lines ( count from to -- )
+  fb8-line2addr swap
+  fb8-line2addr swap
+  #columns char-width * depth-bytes *
+  3 pick * move drop
+;
+
+: fb8-clear-lines ( count line -- )
+  background-color 0
+  2 pick window-top +
+  #columns char-width *
+  5 pick
+  fb8-fillrect
+  2drop
+;
+  
+: fb8-draw-character ( char -- )
+  \ erase the current character
+  background-color
+  column# char-width * window-left +
+  line# char-height * window-top +
+  char-width char-height fb8-fillrect
+  \ draw the character:
+  >font  
+  line# char-height * window-top + screen-width * depth-bytes *
+  column# char-width * depth-bytes *
+  window-left depth-bytes * + + frame-buffer-adr +
+  swap char-width char-height font-spacing -
+  \ normal or inverse?
+  foreground-color background-color
+  inverse? if
+    swap
+  then
+  fb8-blitmask
+  ;
+
+: fb8-reset-screen ( -- )
+  false to inverse?
+  false to inverse-screen?
+  0 to foreground-color 
+  d# 15 to background-color
+
+  \ override with OpenBIOS defaults
+  fe to background-color
+  0 to foreground-color
+  ;
+
+: fb8-toggle-cursor ( -- )
+  column# char-width * window-left +
+  line# char-height * window-top +
+  char-width char-height font-spacing -
+  foreground-color background-color
+  fb8-invertrect
+  ;
+
+: fb8-erase-screen ( -- )
+  inverse-screen? if
+    foreground-color
+  else
+    background-color
+  then
+  0 0 screen-width screen-height
+  fb8-fillrect
+  ;
+
+: fb8-invert-screen ( -- )
+  0 0 screen-width screen-height
+  background-color foreground-color
+  fb8-invertrect
+  ;
+
+: fb8-blink-screen ( -- )
+  fb8-invert-screen 2000 ms
+  fb8-invert-screen
+  ;
+  
+: fb8-insert-characters ( n -- )
+  \ numcopy = ( #columns - column# - n )
+  #columns over - column# -
+  char-width * depth-bytes * ( n numbytescopy )
+
+  over column# + line# fb8-curpos2addr
+  column# line# fb8-curpos2addr ( n numbytescopy destaddr srcaddr )
+  char-height 0 do
+    3dup swap rot move
+    line-bytes + swap line-bytes + swap
+  loop 3drop
+  
+  background-color
+  column# char-width * window-left + line# char-height * window-top +
+  3 pick char-width * char-height
+  fb8-fillrect
+  drop
+  ;
+
+: fb8-delete-characters ( n -- )
+  \ numcopy = ( #columns - column# - n )
+  #columns over - column# -
+  char-width * depth-bytes * ( n numbytescopy )
+
+  over column# + line# fb8-curpos2addr
+  column# line# fb8-curpos2addr swap ( n numbytescopy destaddr srcaddr )
+  char-height 0 do
+    3dup swap rot move
+    line-bytes + swap line-bytes + swap
+  loop 3drop
+
+  background-color
+  over #columns swap - char-width * window-left + line# char-height * window-top +
+  3 pick char-width * char-height
+  fb8-fillrect
+  drop
+  ;
+
+: fb8-insert-lines ( n -- )
+  \ numcopy = ( #lines - n )
+  #lines over - char-height *
+  over line# char-height *
+  swap char-height * over +
+  fb8-copy-lines
+
+  char-height * line# char-height *
+  fb8-clear-lines
+  ;
+  
+: fb8-delete-lines ( n -- )
+  \ numcopy = ( #lines - ( line# + n )) * char-height
+  #lines over line# + - char-height *
+  over line# + char-height *
+  line# char-height *
+  fb8-copy-lines
+  
+  #lines over - char-height *
+  dup #lines char-height * swap - swap
+  fb8-clear-lines
+  drop
+;
+
+
+: fb8-draw-logo ( line# addr width height -- )
+  2swap swap
+  char-height  * window-top  + 
+  screen-width * window-left +
+  frame-buffer-adr + 
+  swap 2swap
+  \ in-fb-start-adr logo-adr logo-width logo-height 
+
+  fb8-blitmask ( fbaddr mask-addr width height --  )
+;
+
+
+: fb8-install ( width height #columns #lines -- )
+
+  \ set state variables
+  to #lines
+  to #columns
+  to screen-height
+  to screen-width
+
+  screen-width #columns char-width * - 2/ to window-left
+  screen-height #lines char-height * - 2/ to window-top
+  
+  0 to column#
+  0 to line#
+  0 to inverse? 
+  0 to inverse-screen?
+
+  my-self to display-ih
+
+  \ set /chosen display property
+  my-self active-package 0 to my-self
+  " /chosen" (find-dev) 0<> if
+    active-package!
+    display-ih encode-int " display" property
+  then
+  active-package! to my-self
+
+  \ set defer functions to 8bit versions
+
+  ['] fb8-draw-character to draw-character
+  ['] fb8-toggle-cursor to toggle-cursor
+  ['] fb8-erase-screen to erase-screen
+  ['] fb8-blink-screen to blink-screen
+  ['] fb8-invert-screen to invert-screen
+  ['] fb8-insert-characters to insert-characters
+  ['] fb8-delete-characters to delete-characters
+  ['] fb8-insert-lines to insert-lines
+  ['] fb8-delete-lines to delete-lines
+  ['] fb8-draw-logo to draw-logo
+  ['] fb8-reset-screen to reset-screen
+
+  \ recommended practice
+  s" iso6429-1983-colors" get-my-property if
+    0 ff
+  else
+    2drop d# 15 0
+  then
+  to foreground-color to background-color
+
+  \ setup palette
+  10101 ['] color-palette cell+ ff 0 do
+    dup 2 pick i * swap ! cell+
+  loop 2drop
+
+  \ special background color
+  ffffcc ['] color-palette cell+ fe cells + !
+
+  \ load palette onto the hardware
+  ['] color-palette cell+ ff 0 do
+    dup @ ff0000 and d# 16 rshift
+    1 pick @ ff00 and d# 8 rshift
+    2 pick @ ff and
+    i
+    s" color!" $find if
+      execute
+    else
+      2drop
+    then
+    cell+
+  loop drop
+
+  \ ... but let's override with some better defaults
+  fe to background-color
+  0 to foreground-color
+
+  fb8-erase-screen
+
+  \ If we have a startup splash then display it
+  [IFDEF] CONFIG_MOL
+      mol-startup-splash 2000 ms
+      fb8-erase-screen
+  [THEN]
+;
diff --git a/qemu/roms/openbios/forth/device/extra.fs b/qemu/roms/openbios/forth/device/extra.fs
new file mode 100644
index 000000000..9ca6b78e3
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/extra.fs
@@ -0,0 +1,103 @@
+\ tag: Useful device related functions
+\ 
+\ Copyright (C) 2003, 2004 Samuel Rydh
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+
+: parent ( phandle -- parent.phandle|0 )
+  >dn.parent @
+;
+
+\ -------------------------------------------------------------------
+\ property helpers
+\ -------------------------------------------------------------------
+
+: int-property ( value name-str name-len -- )
+	rot encode-int 2swap property
+;
+
+\ -------------------------------------------------------------------------
+\ property utils
+\ -------------------------------------------------------------------------
+
+\ like property (except it takes a phandle as an argument)
+: encode-property ( buf len propname propname-len phandle -- )
+	dup 0= abort" null phandle"
+
+  my-self >r 0 to my-self
+  active-package >r active-package!
+
+  property
+
+  r> active-package!
+  r> to my-self
+;
+
+\ -------------------------------------------------------------------
+\ device tree iteration
+\ -------------------------------------------------------------------
+
+: iterate-tree ( phandle -- phandle|0 )
+  ?dup 0= if device-tree @ exit then
+
+  \ children first
+  dup child if
+    child exit
+  then
+
+  \ then peers
+  dup peer if
+    peer exit
+  then
+
+  \ then peer of a parent
+  begin >dn.parent @ dup while
+    dup peer if peer exit then
+  repeat
+;
+
+: iterate-tree-begin ( -- first_node )
+  device-tree @
+;
+
+
+\ -------------------------------------------------------------------
+\ device tree iteration
+\ -------------------------------------------------------------------
+
+: iterate-device-type ( lastph|0 type-str type-len -- 0|nextph )
+  rot
+  begin iterate-tree ?dup while
+    >r
+    2dup " device_type" r@ get-package-property if 0 0 then
+    dup 0> if 1- then
+    strcmp 0= if 2drop r> exit then
+    r>
+  repeat
+  2drop 0
+;
+
+\ -------------------------------------------------------------------
+\ device tree "cut and paste"
+\ -------------------------------------------------------------------
+
+\ add a subtree to the current device node
+: link-nodes ( phandle -- )
+  \ reparent phandle and peers
+  dup begin ?dup while
+    dup >dn.parent active-package !
+    >dn.peer @
+  repeat
+
+  \ add to list of children
+  active-package >dn.child
+  begin dup @ while @ >dn.peer repeat dup . !
+;
+
+: link-node ( phandle -- )
+  0 over >dn.peer !
+  link-nodes
+;
diff --git a/qemu/roms/openbios/forth/device/fcode.fs b/qemu/roms/openbios/forth/device/fcode.fs
new file mode 100644
index 000000000..9083ed0e0
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/fcode.fs
@@ -0,0 +1,573 @@
+\ tag: FCode implementation functions
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.3
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+hex 
+
+0    value fcode-sys-table \ table with built-in fcodes (0-0x7ff)
+
+true value ?fcode-offset16 \ fcode offsets are 16 instead of 8 bit?
+1    value fcode-spread    \ fcode spread (1, 2 or 4)
+0    value fcode-table     \ pointer to fcode table
+false value ?fcode-verbose  \ do verbose fcode execution?
+
+defer _fcode-debug?        \ If true, save names for FCodes with headers
+true value fcode-headers?  \ If true, possibly save names for FCodes.
+
+0 value fcode-stream-start \ start address of fcode stream
+0 value fcode-stream       \ current fcode stream address
+
+variable fcode-end         \ state variable, if true, fcode program terminates.
+defer fcode-c@             \ get byte
+
+: fcode-push-state ( -- <state information> )
+  ?fcode-offset16
+  fcode-spread
+  fcode-table
+  fcode-headers?
+  fcode-stream-start
+  fcode-stream
+  fcode-end @
+  ['] fcode-c@ behavior
+;
+
+: fcode-pop-state ( <state information> -- )
+  to fcode-c@
+  fcode-end !
+  to fcode-stream
+  to fcode-stream-start
+  to fcode-headers?
+  to fcode-table
+  to fcode-spread
+  to ?fcode-offset16
+;
+  
+\ 
+\ fcode access helper functions
+\ 
+
+\ fcode-ptr
+\   convert FCode number to pointer to xt in FCode table.
+
+: fcode-ptr ( u16 -- *xt )
+  cells
+  fcode-table ?dup if + exit then
+  
+  \ we are not parsing fcode at the moment
+  dup 800 cells u>= abort" User FCODE# referenced."
+  fcode-sys-table +
+;
+  
+\ fcode>xt
+\   get xt according to an FCode#
+
+: fcode>xt ( u16 -- xt )
+  fcode-ptr @
+  ;
+
+\ fcode-num8
+\   get 8bit from FCode stream, taking spread into regard.
+
+: fcode-num8 ( -- c ) ( F: c -- )
+  fcode-stream
+  dup fcode-spread + to fcode-stream 
+  fcode-c@
+  ;
+
+\ fcode-num8-signed ( -- c ) ( F: c -- )
+\   get 8bit signed from FCode stream
+
+: fcode-num8-signed
+  fcode-num8
+  dup 80 and 0> if
+     ff invert or
+  then
+  ;
+
+\ fcode-num16
+\   get 16bit from FCode stream
+
+: fcode-num16 ( -- num16 )
+  fcode-num8 fcode-num8 swap bwjoin
+  ;
+
+\ fcode-num16-signed ( -- c ) ( F: c -- )
+\   get 16bit signed from FCode stream
+
+: fcode-num16-signed
+  fcode-num16
+  dup 8000 and 0> if
+     ffff invert or
+  then
+  ;
+
+\ fcode-num32
+\   get 32bit from FCode stream
+
+: fcode-num32 ( -- num32 )
+  fcode-num8 fcode-num8
+  fcode-num8 fcode-num8
+  swap 2swap swap bljoin
+  ;
+ 
+\ fcode#
+\   Get an FCode# from FCode stream
+
+: fcode# ( -- fcode# )
+  fcode-num8
+  dup 1 f between if
+    fcode-num8 swap bwjoin
+  then
+  ;
+
+\ fcode-offset
+\   get offset from FCode stream.
+
+: fcode-offset ( -- offset )
+  ?fcode-offset16 if
+    fcode-num16-signed
+  else
+    fcode-num8-signed
+  then
+
+  \ Display offset in verbose mode
+  ?fcode-verbose if
+    dup ."        (offset) " . cr
+  then
+  ;
+
+\ fcode-string
+\   get a string from FCode stream, store in pocket.
+
+: fcode-string ( -- addr len )
+  pocket dup
+  fcode-num8
+  dup rot c!
+  2dup bounds ?do
+    fcode-num8 i c!
+  loop
+
+  \ Display string in verbose mode
+  ?fcode-verbose if
+    2dup ."        (const) " type cr
+  then
+  ;
+    
+\ fcode-header
+\   retrieve FCode header from FCode stream
+
+: fcode-header
+  fcode-num8
+  fcode-num16
+  fcode-num32
+  ?fcode-verbose if
+    ." Found FCode header:" cr rot
+    ."   Format   : " u. cr swap
+    ."   Checksum : " u. cr
+    ."   Length   : " u. cr
+  else
+    3drop
+  then
+  \ TODO checksum
+  ;
+
+\ writes currently created word as fcode# read from stream
+\ 
+
+: fcode! ( F:FCode# -- )
+  here fcode#
+
+  \ Display fcode# in verbose mode
+  ?fcode-verbose if
+    dup ."        (fcode#) " . cr
+  then
+  fcode-ptr !
+  ;
+
+  
+\ 
+\ 5.3.3.1 Defining new FCode functions.
+\ 
+
+\ instance ( -- )   
+\   Mark next defining word as instance specific.
+\  (defined in bootstrap.fs)
+
+\ instance-init ( wid buffer -- )
+\   Copy template from specified wordlist to instance
+\ 
+
+: instance-init
+  swap
+  begin @ dup 0<> while
+    dup /n + @ instance-cfa? if         \ buffer dict
+      2dup 2 /n* + @ +                  \ buffer dict dest
+      over 3 /n* + @                    \ buffer dict dest size
+      2 pick 4 /n* +                    \ buffer dict dest size src
+      -rot
+      move
+    then
+  repeat
+  2drop
+  ;
+
+
+\ new-token ( F:/FCode#/ -- ) 
+\   Create a new unnamed FCode function
+
+: new-token 
+  0 0 header
+  fcode!
+  ;
+
+  
+\ named-token (F:FCode-string FCode#/ -- )
+\   Create a new possibly named FCode function.
+
+: named-token 
+  fcode-string
+  _fcode-debug? not if
+    2drop 0 0
+  then
+  header
+  fcode!
+  ;
+
+  
+\ external-token (F:/FCode-string FCode#/ -- )
+\   Create a new named FCode function
+
+: external-token 
+  fcode-string header
+  fcode!
+  ;
+
+  
+\ b(;) ( -- ) 
+\   End an FCode colon definition.
+
+: b(;)
+  ['] ; execute
+  ; immediate
+
+
+\ b(:) ( -- ) ( E: ... -- ??? )
+\   Defines type of new FCode function as colon definition.
+
+: b(:)
+  1 , ]
+  ;
+
+
+\ b(buffer:) ( size -- ) ( E:  -- a-addr )  
+\   Defines type of new FCode function as buffer:.
+
+: b(buffer:)
+  4 , allot
+  reveal
+  ;
+
+\ b(constant) ( nl -- ) ( E: -- nl )
+\   Defines type of new FCode function as constant.
+
+: b(constant)
+  3 , , 
+  reveal
+  ;
+
+
+\ b(create) ( -- ) ( E: -- a-addr )
+\   Defines type of new FCode function as create word.
+
+: b(create)
+  6 , 
+  ['] noop ,
+  reveal
+  ;
+
+
+\ b(defer) ( -- ) ( E: ... -- ??? )  
+\   Defines type of new FCode function as defer word.
+
+: b(defer)
+  5 ,
+  ['] (undefined-defer) ,
+  ['] (semis) ,
+  reveal
+  ;
+
+
+\ b(field) ( offset size -- offset+size ) ( E: addr -- addr+offset )
+\   Defines type of new FCode function as field.
+
+: b(field)
+  6 ,
+  ['] noop ,
+  reveal
+    over ,
+    +
+  does>
+    @ +
+  ;
+
+  
+\ b(value) ( x -- ) (E: -- x )
+\   Defines type of new FCode function as value.
+  
+: b(value)
+  3 , , reveal
+  ;
+
+
+\ b(variable) ( -- ) ( E: -- a-addr )
+\   Defines type of new FCode function as variable.
+
+: b(variable)
+  4 , 0 ,
+  reveal
+  ;
+  
+  
+\ (is-user-word) ( name-str name-len xt -- ) ( E: ... -- ??? )
+\   Create a new named user interface command.
+
+: (is-user-word)
+  ;
+
+  
+\ get-token ( fcode# -- xt immediate? )
+\   Convert FCode number to function execution token.
+
+: get-token
+  fcode>xt dup immediate?
+  ;
+
+
+\ set-token ( xt immediate? fcode# -- )
+\   Assign FCode number to existing function.
+  
+: set-token
+  nip \ TODO we use the xt's immediate state for now.
+  fcode-ptr !
+  ;
+
+  
+  
+
+\ 
+\ 5.3.3.2 Literals
+\ 
+
+
+\ b(lit) ( -- n1 ) 
+\   Numeric literal FCode. Followed by FCode-num32.
+
+64bit? [IF]
+: b(lit)
+  fcode-num32 32>64
+  state @ if
+    ['] (lit) , ,
+  then
+  ; immediate
+[ELSE]
+: b(lit)
+  fcode-num32 
+  state @ if
+    ['] (lit) , ,
+  then
+  ; immediate
+[THEN]
+
+
+\ b(') ( -- xt )  
+\   Function literal FCode. Followed by FCode#
+
+: b(')
+  fcode# fcode>xt
+  state @ if
+    ['] (lit) , , 
+  then
+  ; immediate
+
+  
+\ b(") ( -- str len )
+\   String literal FCode. Followed by FCode-string.
+  
+: b(")
+  fcode-string
+  state @ if
+    \ only run handle-text in compile-mode,
+    \ otherwise we would waste a pocket.
+    handle-text
+  then
+  ; immediate
+
+
+\ 
+\ 5.3.3.3 Controlling values and defers
+\ 
+
+\ behavior ( defer-xt -- contents-xt )
+\ defined in bootstrap.fs
+
+\ b(to) ( new-value -- )
+\   FCode for setting values and defers. Followed by FCode#.
+
+: b(to)
+  fcode# fcode>xt 
+  1 handle-lit
+  ['] (to)
+  state @ if 
+    ,
+  else
+    execute
+  then
+  ; immediate
+
+
+
+\ 
+\ 5.3.3.4 Control flow
+\ 
+
+
+\ offset16 ( -- )
+\   Makes subsequent FCode-offsets use 16-bit (not 8-bit) form.
+
+: offset16
+  true to ?fcode-offset16
+  ;
+
+
+\ bbranch ( -- )
+\   Unconditional branch FCode. Followed by FCode-offset.
+  
+: bbranch
+  fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
+    ['] dobranch ,
+    resolve-dest
+    execute-tmp-comp
+  else
+    setup-tmp-comp ['] dobranch ,
+    here 0
+    0 ,
+    2swap
+  then
+  ; immediate
+
+
+\ b?branch ( continue? -- )
+\   Conditional branch FCode. Followed by FCode-offset.
+
+: b?branch
+  fcode-offset 0< if \ if we jump backwards, we can forsee where it goes
+    ['] do?branch ,
+    resolve-dest
+    execute-tmp-comp
+  else
+    setup-tmp-comp ['] do?branch ,
+    here 0
+    0 ,
+  then 
+  ; immediate
+
+  
+\ b(<mark) ( -- )
+\   Target of backward branches.
+
+: b(<mark)
+  setup-tmp-comp
+  here 1
+  ; immediate
+
+  
+\ b(>resolve) ( -- )
+\   Target of forward branches.
+
+: b(>resolve)
+  resolve-orig
+  execute-tmp-comp
+  ; immediate
+
+  
+\ b(loop) ( -- )
+\   End FCode do..loop. Followed by FCode-offset.
+
+: b(loop)
+  fcode-offset drop
+  postpone loop
+  ; immediate
+
+  
+\ b(+loop) ( delta -- )
+\   End FCode do..+loop. Followed by FCode-offset.
+
+: b(+loop)
+  fcode-offset drop
+  postpone +loop
+  ; immediate
+
+  
+\ b(do) ( limit start -- )
+\   Begin FCode do..loop. Followed by FCode-offset.
+
+: b(do)
+  fcode-offset drop
+  postpone do
+  ; immediate
+
+  
+\ b(?do) ( limit start -- )
+\   Begin FCode ?do..loop. Followed by FCode-offset.
+
+: b(?do)
+  fcode-offset drop
+  postpone ?do
+  ; immediate
+
+  
+\ b(leave) ( -- )
+\   Exit from a do..loop.
+  
+: b(leave)
+  postpone leave
+  ; immediate
+
+  
+\ b(case) ( sel -- sel )
+\   Begin a case (multiple selection) statement.
+
+: b(case)
+  postpone case
+  ; immediate
+
+  
+\ b(endcase) ( sel | <nothing> -- )
+\   End a case (multiple selection) statement.
+
+: b(endcase)
+  postpone endcase
+  ; immediate
+  
+
+\ b(of) ( sel of-val -- sel | <nothing> )
+\   FCode for of in case statement. Followed by FCode-offset.
+
+: b(of)
+  fcode-offset drop
+  postpone of
+  ; immediate
+
+\ b(endof) ( -- )
+\   FCode for endof in case statement. Followed by FCode-offset.
+
+: b(endof)
+  fcode-offset drop
+  postpone endof
+  ; immediate
diff --git a/qemu/roms/openbios/forth/device/feval.fs b/qemu/roms/openbios/forth/device/feval.fs
new file mode 100644
index 000000000..9e2773db2
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/feval.fs
@@ -0,0 +1,100 @@
+\ tag: FCode evaluator
+\ 
+\ this code implements an fcode evaluator 
+\ as described in IEEE 1275-1994
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+defer init-fcode-table
+
+: alloc-fcode-table 
+  4096 cells alloc-mem to fcode-table
+  ?fcode-verbose if
+    ." fcode-table at 0x" fcode-table . cr
+  then
+  init-fcode-table
+  ;
+ 
+: free-fcode-table
+  fcode-table 4096 cells free-mem
+  0 to fcode-table
+  ;
+
+: (debug-feval) ( fcode# -- fcode# )
+  \ Address
+  fcode-stream 1 - . ." : "
+
+  \ Indicate if word is compiled
+  state @ 0<> if
+    ." (compile) "
+  then
+  dup fcode>xt cell - lfa2name type
+  dup ."  [ 0x" . ." ]" cr
+  ;
+
+: (feval) ( -- ?? )
+  begin
+    fcode#
+    ?fcode-verbose if
+      (debug-feval)
+    then
+    fcode>xt
+    dup flags? 0<> state @ 0= or if
+      execute
+    else
+      ,
+    then
+  fcode-end @ until
+
+  \ If we've executed incorrect FCode we may have reached the end of the FCode
+  \ program but still be in compile mode. Make sure that if this has happened
+  \ then we switch back to immediate mode to prevent internal OpenBIOS errors.
+  tmp-comp-depth @ -1 <> if
+    -1 tmp-comp-depth !
+    tmp-comp-buf @ @ here!
+    0 state !
+  then
+;
+
+: byte-load ( addr xt -- )
+  ?fcode-verbose if
+    cr ." byte-load: evaluating fcode at 0x" over . cr
+  then
+
+  \ save state
+  >r >r fcode-push-state r> r>
+
+  \ set fcode-c@ defer
+  dup 1 = if drop ['] c@ then      \ FIXME: uses c@ rather than rb@ for now...
+  to fcode-c@
+  dup to fcode-stream-start
+  to fcode-stream
+  1 to fcode-spread
+  false to ?fcode-offset16 
+  alloc-fcode-table
+  false fcode-end !
+  
+  \ protect against stack overflow/underflow
+  0 0 0 0 0 0 depth >r
+  
+  ['] (feval) catch if
+    cr ." byte-load: exception caught!" cr
+  then
+
+  s" fcode-debug?" evaluate if
+    depth r@ <> if
+      cr ." byte-load: warning stack overflow, diff " depth r@ - . cr
+    then
+  then
+
+  r> depth! 3drop 3drop
+
+  free-fcode-table
+
+  \ restore state
+  fcode-pop-state
+;
diff --git a/qemu/roms/openbios/forth/device/font.fs b/qemu/roms/openbios/forth/device/font.fs
new file mode 100644
index 000000000..7b742fac4
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/font.fs
@@ -0,0 +1,17 @@
+\ tag: 8x16 bitmap font
+\ 
+\ Terminus font 
+\ 
+\ The Terminus Font is developed by and is a property 
+\ of Dimitar Toshkov Zhekov <jimmy@is-vn.bg>
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+0 value (romfont)
+0 value (romfont-width)
+0 value (romfont-height)
+
+\ encode-file romfont.bin
+\ drop value (romfont-8x16)
diff --git a/qemu/roms/openbios/forth/device/logo.fs b/qemu/roms/openbios/forth/device/logo.fs
new file mode 100644
index 000000000..4db31ef54
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/logo.fs
@@ -0,0 +1,98 @@
+\ tag: monochrome logo
+\ 
+\ simple monochrome logo
+\ as described in IEEE 1275-1994
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+
+\ FIXME : This is currently just a test file, it contains
+\ a Pi symbol of size 64x64, not really nicely streched.
+
+\ To use an XBM (X Bitmap), the bits in the bitmap array
+\ have to be reversed, i.e. like this:
+\ 
+\ int main(void)
+\ {
+\ 	int i,j; unsigned char bit, bitnew;
+\ 	for (i=0; i<512; i++) {
+\ 		bit=openbios_bits[i]; bitnew=0;
+\ 		for (j=0; j<8; j++)
+\ 			if (bit & (1<<j)) bitnew |= (1<<(7-j));
+\ 		 printf("%02x c, ", bitnew); if(i%8 == 7) printf("\n");
+\ 	}
+\ 	return 0;
+\ }
+
+here
+
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+07 c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+07 c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+07 c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+07 c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+7f c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+7f c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+7f c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+7f c, ff c, ff c, ff c, ff c, ff c, ff c, e0 c, 
+7f c, df c, ff c, ff c, 7f c, ff c, ff c, 90 c, 
+78 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+78 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+78 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+70 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 00 c, 00 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 01 c, 80 c, 
+00 c, 03 c, fe c, 00 c, 07 c, f8 c, 01 c, e0 c, 
+00 c, 03 c, fe c, 00 c, 07 c, f8 c, 01 c, e0 c, 
+00 c, 03 c, fe c, 00 c, 07 c, fc c, 03 c, e0 c, 
+00 c, 07 c, fe c, 00 c, 07 c, fc c, 07 c, e0 c, 
+00 c, 3f c, fe c, 00 c, 07 c, ff c, ff c, e0 c, 
+00 c, 3f c, fe c, 00 c, 07 c, ff c, ff c, e0 c, 
+00 c, 3f c, fe c, 00 c, 07 c, ff c, ff c, e0 c, 
+00 c, 3f c, fc c, 00 c, 07 c, ff c, ff c, c0 c, 
+00 c, 3f c, f8 c, 00 c, 07 c, ff c, ff c, 80 c, 
+00 c, 7f c, e0 c, 00 c, 0f c, ff c, fe c, 00 c, 
+00 c, 3f c, e0 c, 00 c, 07 c, ff c, fe c, 00 c, 
+00 c, 3f c, c0 c, 00 c, 07 c, ff c, fc c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 00 c, 
+
+value (romlogo-64x64)
diff --git a/qemu/roms/openbios/forth/device/missing b/qemu/roms/openbios/forth/device/missing
new file mode 100644
index 000000000..8ea954ed7
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/missing
@@ -0,0 +1,38 @@
+5.3.3.1
+
+ * (is-user-word)
+
+5.3.4 Package access
+
+5.3.6 Display
+ * default-font
+ * set-font
+ * >font
+ * is-install
+ * is-remove
+ * is-selftest
+
+5.3.7 Other
+ * cpeek
+ * wpeek
+ * lpeek
+ * cpoke
+ * wpoke
+ * lpoke
+ * rb@
+ * rw@
+ * rl@
+ * rb!
+ * rw!
+ * rl!
+ * get-msecs
+ * ms
+ * alarm
+ * user-abort
+ * mac-address
+ * display-status
+ * memory-test-suite
+ * mask
+ * diagnostic-mode?
+ * suspend-fcode
+ * set-args
diff --git a/qemu/roms/openbios/forth/device/other.fs b/qemu/roms/openbios/forth/device/other.fs
new file mode 100644
index 000000000..b39007301
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/other.fs
@@ -0,0 +1,233 @@
+\ tag: Other FCode functions
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.7
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ The current diagnostic setting
+defer _diag-switch?
+
+
+\ 
+\ 5.3.7 Other FCode functions
+\ 
+
+hex
+
+\ 5.3.7.1 Peek/poke 
+
+defer (peek)
+:noname
+  execute true
+; to (peek)
+
+: cpeek    ( addr -- false | byte true )
+  ['] c@ (peek)
+  ;
+
+: wpeek    ( waddr -- false | w true )
+  ['] w@ (peek)
+  ;
+
+: lpeek    ( qaddr -- false | quad true )
+  ['] l@ (peek)
+  ;
+  
+defer (poke)
+:noname
+  execute true
+; to (poke)
+
+: cpoke    ( byte addr -- okay? )
+  ['] c! (poke)
+  ;
+  
+: wpoke    ( w waddr -- okay? )
+  ['] w! (poke)
+  ;
+  
+: lpoke    ( quad qaddr -- okay? )
+  ['] l! (poke)
+  ;
+
+
+\ 5.3.7.2 Device-register access
+
+: rb@    ( addr -- byte )
+  ;
+  
+: rw@    ( waddr -- w )
+  ;
+  
+: rl@    ( qaddr -- quad )
+  ;
+  
+: rb!    ( byte addr -- )
+  ;
+  
+: rw!    ( w waddr -- )
+  ;
+  
+: rl!    ( quad qaddr -- )
+  ;
+
+: rx@ ( oaddr - o )
+  state @ if
+    h# 22e get-token if , else execute then
+  else
+    h# 22e get-token drop execute
+  then
+  ; immediate
+
+: rx! ( o oaddr -- )
+  state @ if
+    h# 22f get-token if , else execute then
+  else
+    h# 22f get-token drop execute
+  then
+  ; immediate
+ 
+\ 5.3.7.3 Time
+
+\ Pointer to OBP tick value updated by timer interrupt
+variable obp-ticks
+
+\ Dummy implementation for platforms without a timer interrupt
+0 value dummy-msecs
+
+: get-msecs    ( -- n )
+  \ If obp-ticks pointer is set, use it. Otherwise fall back to
+  \ dummy implementation
+  obp-ticks @ 0<> if
+    obp-ticks @
+  else
+    dummy-msecs dup 1+ to dummy-msecs
+  then
+  ;
+
+: ms    ( n -- )
+  get-msecs +
+  begin dup get-msecs < until
+  drop
+  ;
+  
+: alarm    ( xt n -- )
+  2drop
+  ;
+  
+: user-abort    ( ... -- )  ( R: ... -- )
+  ;
+
+
+\ 5.3.7.4 System information
+0003.0000 value fcode-revision    ( -- n )
+  
+: mac-address    ( -- mac-str mac-len )
+  ;
+
+
+\ 5.3.7.5 FCode self-test
+: display-status    ( n -- )
+  ;
+  
+: memory-test-suite ( addr len -- fail? )
+  ;
+  
+: mask    ( -- a-addr )
+  ;
+  
+: diagnostic-mode?     ( -- diag? )
+  \ Return the NVRAM diag-switch? setting
+  _diag-switch?
+  ;
+  
+\ 5.3.7.6 Start and end.
+
+\ Begin program with spread 0 followed by FCode-header.
+: start0 ( -- )
+  0 fcode-spread !
+  offset16
+  fcode-header 
+  ;
+
+\ Begin program with spread 1 followed by FCode-header.  
+: start1 ( -- )
+  1 to fcode-spread
+  offset16
+  fcode-header 
+  ;
+  
+\ Begin program with spread 2 followed by FCode-header.
+: start2 ( -- )
+  2 to fcode-spread
+  offset16
+  fcode-header 
+  ;
+
+\ Begin program with spread 4 followed by FCode-header.
+: start4 ( -- )
+  4 to fcode-spread
+  offset16
+  fcode-header 
+  ;
+ 
+\ Begin program with spread 1 followed by FCode-header. 
+: version1 ( -- )
+  1 to fcode-spread
+  fcode-header 
+  ;
+
+\ Cease evaluating this FCode program.
+: end0 ( -- )
+  true fcode-end !  
+  ; immediate
+
+\ Cease evaluating this FCode program.
+: end1 ( -- )
+  end0 
+  ;
+
+\ Standard FCode number for undefined FCode functions.
+: ferror ( -- )
+  ." undefined fcode# encountered." cr 
+  true fcode-end !
+  ;
+
+\ Pause FCode evaluation if desired; can resume later.
+: suspend-fcode ( -- )
+  \ NOT YET IMPLEMENTED.
+  ;
+
+
+\ Evaluate FCode beginning at location addr.
+
+\ : byte-load ( addr xt -- )
+\   \ this word is implemented in feval.fs
+\   ;
+
+\ Set address and arguments of new device node.
+: set-args ( arg-str arg-len unit-str unit-len -- ) 
+  ?my-self drop
+
+  depth 1- >r
+  " decode-unit" ['] $call-parent catch if
+    2drop 2drop
+  then
+  
+  my-self ihandle>phandle >dn.probe-addr \ offset
+  begin depth r@ > while
+    dup na1+ >r ! r>
+  repeat
+  r> 2drop
+
+  my-self >in.arguments 2@ free-mem
+  strdup my-self >in.arguments 2!
+;
+
+: dma-alloc
+  s" dma-alloc" $call-parent
+  ;
diff --git a/qemu/roms/openbios/forth/device/package.fs b/qemu/roms/openbios/forth/device/package.fs
new file mode 100644
index 000000000..d5b52c3eb
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/package.fs
@@ -0,0 +1,287 @@
+\ tag: Package access.
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.4
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ variable last-package 0 last-package !
+\ 0 value active-package
+: current-device active-package ;
+  
+\ 
+\ 5.3.4.1 Open/Close packages (part 1)
+\ 
+
+\ 0 value my-self ( -- ihandle )
+: ?my-self
+  my-self dup 0= abort" no current instance."
+  ;
+
+: my-parent ( -- ihandle )
+  ?my-self >in.my-parent @
+;
+
+: ihandle>non-interposed-phandle ( ihandle -- phandle )
+  begin dup >in.interposed @ while
+    >in.my-parent @
+  repeat
+  >in.device-node @
+;
+
+: ihandle>phandle ( ihandle -- phandle )
+  >in.device-node @
+;
+
+
+\ next-property
+\ defined in property.c
+
+: peer ( phandle -- phandle.sibling )
+  ?dup if
+    >dn.peer @
+  else
+    device-tree @
+  then
+;
+
+: child ( phandle.parent -- phandle.child )
+  \ Assume phandle == 0 indicates root node (not documented but similar
+  \ behaviour to "peer"). Used by some versions of Solaris (e.g. 9).
+  ?dup if else device-tree @ then
+
+  >dn.child @
+;
+  
+
+\ 
+\ 5.3.4.2 Call methods from other packages
+\ 
+
+: find-method ( method-str method-len phandle -- false | xt true )
+  \ should we search the private wordlist too? I don't think so...
+  >dn.methods @ find-wordlist if
+    true
+  else
+    2drop false
+  then
+;
+
+: call-package ( ... xt ihandle -- ??? )
+  my-self >r 
+  to my-self
+  execute
+  r> to my-self
+;
+
+
+: $call-method  ( ... method-str method-len ihandle -- ??? )
+  dup >r >in.device-node @ find-method if
+    r> call-package
+  else
+    -21 throw
+  then
+;
+
+: $call-parent  ( ... method-str method-len -- ??? )
+  my-parent $call-method
+;
+
+
+\ 
+\ 5.3.4.1 Open/Close packages (part 2)
+\ 
+
+\ find-dev ( dev-str dev-len -- false | phandle true )
+\ find-rel-dev ( dev-str dev-len phandle -- false | phandle true )
+\ 
+\ These function works just like find-device but without
+\ any side effects (or exceptions).
+\ 
+defer find-dev
+
+: find-rel-dev ( dev-str dev-len phandle -- false | phandle true )
+  active-package >r active-package!
+  find-dev
+  r> active-package!
+;
+
+: find-package  ( name-str name-len -- false | phandle true )
+\ Locate the support package named by name string.
+\ If the package can be located, return its phandle and true; otherwise, 
+\ return false.
+\ Interpret the name in name string relative to the "packages" device node.
+\ If there are multiple packages with the same name (within the "packages" 
+\ node), return the phandle for the most recently created one.
+
+  \ This does the full path resolution stuff (including
+  \ alias expansion. If we don't want that, then we should just
+  \ iterade the children of /packages.
+  " /packages" find-dev 0= if 2drop false exit then
+  find-rel-dev 0= if false exit then
+
+  true
+;
+
+: open-package  ( arg-str arg-len phandle -- ihandle | 0 )
+\ Open the package indicated by phandle.
+\ Create an instance of the package identified by phandle, save in that 
+\ instance the instance-argument specified by arg-string and invoke the 
+\ package's open method.
+\ Return the instance handle ihandle of the new instance, or 0 if the package
+\ could not be opened. This could occur either because that package has no
+\ open method, or because its open method returned false, indicating an error.
+\ The parent instance of the new instance is the instance that invoked
+\ open-package. The current instance is not changed.
+
+  create-instance dup 0= if
+    3drop 0 exit
+  then
+  >r
+
+  \ clone arg-str
+  strdup r@ >in.arguments 2!
+
+  \ open the package
+  " open" r@ ['] $call-method catch if 3drop false then
+  if
+    r>
+  else
+    r> destroy-instance false
+  then
+;
+
+
+: $open-package ( arg-str arg-len name-str name-len -- ihandle | 0 )
+  \ Open the support package named by name string.
+  find-package if
+    open-package
+  else 
+    2drop false 
+  then
+;
+
+
+: close-package ( ihandle -- )
+\  Close the instance identified by ihandle by calling the package's close
+\  method and then destroying the instance.
+  dup " close" rot ['] $call-method catch if 3drop then
+  destroy-instance
+;
+
+\ 
+\ 5.3.4.3 Get local arguments
+\ 
+
+: my-address ( -- phys.lo ... )
+  ?my-self >in.device-node @
+  >dn.probe-addr
+  my-#acells tuck /l* + swap 1- 0
+  ?do
+    /l - dup l@ swap
+  loop
+  drop
+  ;
+  
+: my-space ( -- phys.hi )
+  ?my-self >in.device-node @
+  >dn.probe-addr @
+  ;
+  
+: my-unit ( -- phys.lo ... phys.hi )
+  ?my-self >in.my-unit
+  my-#acells tuck /l* + swap 0 ?do
+    /l - dup l@ swap
+  loop
+  drop
+  ;
+
+: my-args ( -- arg-str arg-len )
+  ?my-self >in.arguments 2@
+  ;
+
+\ char is not included. If char is not found, then R-len is zero
+: left-parse-string ( str len char -- R-str R-len L-str L-len )
+  left-split
+;
+
+\ parse ints "hi,...,lo" separated by comma
+: parse-ints ( str len num -- val.lo .. val.hi )
+  -rot 2 pick -rot
+  begin
+    rot 1- -rot 2 pick 0>=
+  while
+    ( num n str len )
+    2dup ascii , strchr ?dup if
+      ( num n str len p )
+      1+ -rot
+      2 pick 2 pick -    ( num n p str len len1+1 )
+      dup -rot -         ( num n p str len1+1 len2 )
+      -rot 1-            ( num n p len2 str len1 )
+    else
+      0 0 2swap
+    then
+    $number if 0 then >r
+  repeat
+  3drop
+
+  ( num ) 
+  begin 1- dup 0>= while r> swap repeat
+  drop
+;
+ 
+: parse-2int ( str len -- val.lo val.hi )
+  2 parse-ints
+;
+
+  
+\ 
+\ 5.3.4.4 Mapping tools
+\ 
+
+: map-low ( phys.lo ... size -- virt )
+  my-space swap s" map-in" $call-parent
+  ;
+
+: free-virtual ( virt size -- )
+  over s" address" get-my-property 0= if
+    decode-int -rot 2drop = if
+      s" address" delete-property
+    then
+  else
+    drop
+  then
+  s" map-out" $call-parent
+  ;
+
+
+\ Deprecated functions (required for compatibility with older loaders)
+
+variable package-stack-pos 0 package-stack-pos !
+create package-stack 8 cells allot
+
+: push-package    ( phandle -- )
+  \ Throw an error if we attempt to push a full stack
+  package-stack-pos @ 8 >= if
+    ." cannot push-package onto full stack" cr
+    -99 throw
+  then
+  active-package
+  package-stack-pos @ /n * package-stack + !
+  package-stack-pos @ 1 + package-stack-pos !
+  active-package!
+  ;
+
+: pop-package    ( -- )
+  \ Throw an error if we attempt to pop an empty stack
+  package-stack-pos @ 0 = if
+    ." cannot pop-package from empty stack" cr
+    -99 throw
+  then
+  package-stack-pos @ 1 - package-stack-pos !
+  package-stack-pos @ /n * package-stack + @
+  active-package!
+  ;
diff --git a/qemu/roms/openbios/forth/device/pathres.fs b/qemu/roms/openbios/forth/device/pathres.fs
new file mode 100644
index 000000000..a185b95a1
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/pathres.fs
@@ -0,0 +1,522 @@
+\ tag: Path resolution
+\ 
+\ this code implements IEEE 1275-1994 path resolution
+\ 
+\ Copyright (C) 2003 Samuel Rydh
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+0 value interpose-ph
+0 0 create interpose-args , ,
+
+: expand-alias ( alias-addr alias-len -- exp-addr exp-len expanded? )
+  2dup
+  " /aliases" find-dev 0= if 2drop false exit then
+  get-package-property if
+    false
+  else
+    2swap 2drop 
+    \ drop trailing 0 from string
+    dup if 1- then
+    true
+  then
+;
+
+\ 
+\ 4.3.1 Resolve aliases
+\ 
+
+\ the returned string is allocated with alloc-mem
+: pathres-resolve-aliases ( path-addr path-len -- path-addr path-len )
+  over c@ 2f <> if
+    200 here + >r                \ abuse dictionary for temporary storage
+
+    \ If the pathname does not begin with "/", and its first node name 
+    \ component is an alias, replace the alias with its expansion.
+    ascii / split-before         \ (PATH_NAME, "/")  -> (TAIL HEAD)
+    ascii : split-before         \ (HEAD, ":")  ->  (ALIAS_ARGS AL_NAME)
+    expand-alias                 ( TAIL ALIAS_ARGS EXP_ALIAS_NAME expanded? )
+    if
+      2 pick 0<> if              \ If ALIAS_ARGS is not empty
+        ascii / split-after      \ (ALIAS_NAME, "/") -> (AL_TAIL AL_HEAD/)
+        2swap                    ( TAIL AL_HEAD/ AL_TAIL )
+        ascii : split-before     \ (AL_TAIL, ":") -> (DEAD_ARGS AL_TAIL)
+        2swap 2drop              ( TAIL AL_ARGS AL_HEAD ALIAS_TAIL )
+        2swap                    ( TAIL AL_ARGS AL_TAIL AL_HEAD )
+        r> tmpstrcat tmpstrcat >r
+      else
+        2swap 2drop              \ drop ALIAS_ARGS
+      then
+      r> tmpstrcat drop
+    else
+      \ put thing back together again
+      r> tmpstrcat tmpstrcat drop
+    then
+  then  
+
+  strdup
+  ( path-addr path-len )
+;
+
+\ 
+\ search struct
+\ 
+
+struct ( search information )
+  2 cells field >si.path
+  2 cells field >si.arguments
+  2 cells field >si.unit_addr
+  2 cells field >si.node_name
+  2 cells field >si.free_me
+  4 cells field >si.unit_phys
+  /n field >si.unit_phys_len
+  /n field >si.save-ihandle
+  /n field >si.save-phandle
+  /n field >si.top-ihandle
+  /n field >si.top-opened        \ set after successful open
+  /n field >si.child            \ node to match
+constant sinfo.size
+
+
+\ 
+\ 4.3.6 node name match criteria
+\ 
+
+: match-nodename ( childname len sinfo -- match? )
+  >r
+  2dup r@ >si.node_name 2@
+  ( [childname] [childname] [nodename] )
+  strcmp 0= if r> 3drop true exit then
+
+  \ does NODE_NAME contain a comma?
+  r@ >si.node_name 2@ ascii , strchr
+  if r> 3drop false exit then
+
+  ( [childname] )
+  ascii , left-split 2drop r@ >si.node_name 2@
+  r> drop
+  strcmp if false else true then
+;
+
+
+\ 
+\ 4.3.4 exact match child node
+\ 
+
+\ If NODE_NAME is not empty, make sure it matches the name property
+: common-match ( sinfo -- )
+  >r
+  \ a) NODE_NAME nonempty
+  r@ >si.node_name 2@ nip if
+    " name" r@ >si.child @ get-package-property if -1 throw then
+    \ name is supposed to be null-terminated
+    dup 0> if 1- then
+    \ exit if NODE_NAME does not match
+    r@ match-nodename 0= if -2 throw then
+  then
+  r> drop
+;
+  
+: (exact-match) ( sinfo -- )
+  >r
+  \ a) If NODE_NAME is not empty, make sure it matches the name property
+  r@ common-match
+
+  \ b) UNIT_PHYS nonempty?
+  r@ >si.unit_phys_len @ /l* ?dup if
+    \ check if unit_phys matches
+    " reg" r@ >si.child @ get-package-property if -3 throw then
+    ( unitbytes propaddr proplen )
+    rot r@ >si.unit_phys -rot
+    ( propaddr unit_phys proplen unitbytes )
+    swap over < if -4 throw then
+    comp if -5 throw then
+  else
+    \ c) both NODE_NAME and UNIT_PHYS empty?
+    r@ >si.node_name 2@ nip 0= if -6 throw then
+  then
+
+  r> drop
+;
+
+: exact-match ( sinfo -- match? )
+  ['] (exact-match) catch if drop false exit then
+  true
+;
+
+\ 
+\ 4.3.5 wildcard match child node
+\ 
+
+: (wildcard-match) ( sinfo -- match? )
+  >r
+  \ a) If NODE_NAME is not empty, make sure it matches the name property
+  r@ common-match
+
+  \ b) Fail if "reg" property exist
+  " reg" r@ >si.child @ get-package-property 0= if -7 throw then
+
+  \ c) Fail if both NODE_NAME and UNIT_ADDR are both empty
+  r@ >si.unit_phys_len @
+  r@ >si.node_name 2@ nip
+  or 0= if -1 throw then
+
+  \ SUCCESS
+  r> drop
+;
+
+: wildcard-match ( sinfo -- match? )
+  ['] (wildcard-match) catch if drop false exit then
+  true
+;
+
+
+\ 
+\ 4.3.3 match child node
+\ 
+
+\ used if package lacks a decode-unit method
+: def-decode-unit ( str len -- unitaddr ... )
+  parse-hex
+;
+
+: get-decode-unit-xt ( phandle -- xt )
+  " decode-unit" rot find-method
+  0= if ['] def-decode-unit then
+;
+
+: find-child ( sinfo -- phandle )
+  >r
+  \ decode unit address string
+  r@ >si.unit_addr 2@ dup if
+    ( str len )
+    active-package get-decode-unit-xt
+    depth 3 - >r execute depth r@ - r> swap
+    ( ... a_lo ... a_hi olddepth n )
+    4 min 0 max
+    dup r@ >si.unit_phys_len !
+    ( ... a_lo ... a_hi olddepth n )
+    r@ >si.unit_phys >r
+    begin 1- dup 0>= while
+      rot r> dup la1+ >r l!-be
+    repeat
+    r> 2drop
+    depth!
+  else
+    2drop
+    \ clear unit_phys
+    0 r@ >si.unit_phys_len !
+    \ r@ >si.unit_phys 4 cells 0 fill
+  then
+
+  ( R: sinfo )
+  ['] exact-match
+  begin dup while
+    active-package >dn.child @
+    begin ?dup while
+      dup r@ >si.child !
+      ( xt phandle R: sinfo )
+      r@ 2 pick execute if 2drop r> >si.child @ exit then
+      >dn.peer @
+    repeat
+    ['] exact-match = if ['] wildcard-match else 0 then
+  repeat
+
+  -99 throw  
+;
+
+
+\ 
+\ 4.3.2 Create new linked instance procedure
+\ 
+
+: link-one ( sinfo -- )
+  >r
+  active-package create-instance
+  dup 0= if -99 throw then
+
+  \ change instance parent
+  r@ >si.top-ihandle @ over >in.my-parent !
+  dup r@ >si.top-ihandle !
+  to my-self
+
+  \ b) set my-args field
+  r@ >si.arguments 2@ strdup my-self >in.arguments 2!
+  
+  \ e) set my-unit field
+  r@ >si.unit_addr 2@ nip if
+    \ copy UNIT_PHYS to the my-unit field
+    r@ >si.unit_phys my-self >in.my-unit 4 cells move
+  else
+    \ set unit-addr from reg property
+    " reg" active-package get-package-property 0= if
+      \ ( ihandle prop proplen )
+      \ copy address to my-unit
+      4 cells min my-self >in.my-unit swap move
+    else
+      \ clear my-unit
+      my-self >in.my-unit 4 cells 0 fill
+    then
+  then
+
+  \ top instance has not been opened (yet)
+  false r> >si.top-opened !
+;
+
+: invoke-open ( sinfo -- )
+  " open" my-self ['] $call-method
+  catch if 3drop false then
+  0= if -99 throw then
+    
+  true swap >si.top-opened !
+;
+
+\ 
+\ 4.3.7 Handle interposers procedure (supplement)
+\ 
+
+: handle-interposers ( sinfo -- )
+  >r
+  begin
+    interpose-ph ?dup 
+  while
+    0 to interpose-ph
+    active-package swap active-package!
+
+    \ clear unit address and set arguments
+    0 0 r@ >si.unit_addr 2!
+    interpose-args 2@ r@ >si.arguments 2!
+    r@ link-one
+    true my-self >in.interposed !
+    interpose-args 2@ free-mem
+    r@ invoke-open
+
+    active-package!
+  repeat
+
+  r> drop
+;
+
+\ 
+\ 4.3.1 Path resolution procedure
+\ 
+
+\ close-dev ( ihandle -- )
+\ 
+: close-dev 
+  begin
+    dup 
+  while
+    dup >in.my-parent @
+    swap close-package
+  repeat
+  drop
+;
+
+: path-res-cleanup ( sinfo close? )
+
+  \ tear down all instances if close? is set
+  if
+    dup >si.top-opened @ if
+      dup >si.top-ihandle @
+      ?dup if close-dev then
+    else
+      dup >si.top-ihandle @ dup
+      ( sinfo ihandle ihandle )
+      dup if >in.my-parent @ swap then
+      ( sinfo parent ihandle )
+      ?dup if destroy-instance then
+      ?dup if close-dev then
+    then
+  then
+
+  \ restore active-package and my-self
+  dup >si.save-ihandle @ to my-self
+  dup >si.save-phandle @ active-package!
+
+  \ free any allocated memory
+  dup >si.free_me 2@ free-mem
+  sinfo.size free-mem
+;
+
+: (path-resolution) ( context sinfo -- )
+  >r r@ >si.path 2@
+  ( context pathstr pathlen )
+
+  \ this allocates a copy of the string
+  pathres-resolve-aliases
+  2dup r@ >si.free_me 2!
+
+  \ If the pathname, after possible alias expansion, begins with "/",
+  \ begin the search at the root node. Otherwise, begin at the active
+  \ package.
+
+  dup if                    \ make sure string is not empty
+    over c@ 2f = if
+      swap char+ swap /c -  \ Remove the "/" from PATH_NAME.
+      \ Set the active package to the root node.
+      device-tree @ active-package!
+    then
+  then
+
+  r@ >si.path 2!
+  0 0 r@ >si.unit_addr 2!
+  0 0 r@ >si.arguments 2!
+  0 r@ >si.top-ihandle !
+
+  \ If there is no active package, exit this procedure, returning false.
+  ( context )
+  active-package 0= if -99 throw then
+
+  \ Begin the creation of an instance chain.
+  \ NOTE--If, at this step, the active package is not the root node and 
+  \ we are in open-dev or execute-device-method contexts, the instance 
+  \ chain that results from the path resolution process may be incomplete.
+
+  active-package swap
+  ( virt-active-node context )
+  begin
+    r@ >si.path 2@ nip          \ nonzero path?
+  while
+    \ ( active-node context )
+    \ is this open-dev or execute-device-method context?
+    dup if
+      r@ link-one
+      over active-package <> my-self >in.interposed !
+      r@ invoke-open
+      r@ handle-interposers
+    then
+    over active-package!
+
+    r@ >si.path 2@              ( PATH )
+    
+    ascii / left-split          ( PATH COMPONENT )
+    ascii : left-split          ( PATH ARGS NODE_ADDR )
+    ascii @ left-split          ( PATH ARGS UNIT_ADDR NODE_NAME )
+
+    r@ >si.node_name 2!
+    r@ >si.unit_addr 2!
+    r@ >si.arguments 2!
+    r@ >si.path 2!
+
+    ( virt-active-node context )
+
+    \ 4.3.1 i) pathname has a leading %?
+    r@ >si.node_name 2@ 2dup 2dup ascii % strchr nip = if
+      1- swap 1+ swap r@ >si.node_name 2!
+      " /packages" find-dev drop active-package!
+      r@ find-child
+    else
+      2drop
+      nip r@ find-child swap over
+      ( new-node context new-node )
+    then
+
+    \ (optional: open any nodes between parent and child )
+
+    active-package!
+  repeat
+
+  ( virt-active-node type )
+  dup if r@ link-one then
+  1 = if
+    dup active-package <> my-self >in.interposed !
+    r@ invoke-open 
+    r@ handle-interposers
+  then
+  active-package!
+
+  r> drop
+;
+
+: path-resolution ( context path-addr path-len -- sinfo true | false )
+  \ allocate and clear the search block
+  sinfo.size alloc-mem >r      
+  r@ sinfo.size 0 fill
+
+  \ store path
+  r@ >si.path 2!
+
+  \ save ihandle and phandle
+  my-self r@ >si.save-ihandle !
+  active-package r@ >si.save-phandle !
+  
+  \ save context (if we take an exception)
+  dup
+
+  r@ ['] (path-resolution)
+  catch ?dup if
+    ( context xxx xxx error )
+    r> true path-res-cleanup
+
+    \ rethrow everything except our "cleanup throw"
+    dup -99 <> if throw then
+    3drop
+
+    \ ( context ) throw an exception if this is find-device context
+    if false else -22 throw then
+    exit
+  then
+
+  \ ( context )
+  drop r> true
+  ( sinfo true )
+;
+
+
+: open-dev ( dev-str dev-len -- ihandle | 0 )
+  1 -rot path-resolution 0= if false exit then
+
+  ( sinfo )
+  my-self swap
+  false path-res-cleanup
+
+  ( ihandle )
+;
+
+: execute-device-method
+( ... dev-str dev-len met-str met-len -- ... false | ?? true )
+  2swap
+  2 -rot path-resolution 0= if 2drop false exit then
+  ( method-str method-len sinfo )
+  >r
+  my-self ['] $call-method catch
+  if 3drop false else true then
+  r> true path-res-cleanup
+;
+
+: find-device ( dev-str dev-len -- )
+  2dup " .." strcmp 0= if
+    2drop
+    active-package dup if >dn.parent @ then
+    \ ".." in root note?
+    dup 0= if -22 throw then
+    active-package!
+    exit
+  then
+  0 -rot path-resolution 0= if false exit then
+  ( sinfo )
+  active-package swap
+  true path-res-cleanup
+  active-package!
+;
+
+\ find-device, but without side effects
+: (find-dev) ( dev-str dev-len -- phandle true | false )
+  active-package -rot
+  ['] find-device catch if 3drop false exit then
+  active-package swap active-package! true
+;
+
+\ Tuck on a node at the end of the chain being created.
+\ This implementation follows the interpose recommended practice
+\ (v0.2 draft).
+
+: interpose ( arg-str arg-len phandle -- )
+  to interpose-ph
+  strdup interpose-args 2!
+;
+
+['] (find-dev) to find-dev
diff --git a/qemu/roms/openbios/forth/device/preof.fs b/qemu/roms/openbios/forth/device/preof.fs
new file mode 100644
index 000000000..131beacd3
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/preof.fs
@@ -0,0 +1,49 @@
+\ tag: historical and pre open firmware fcode functions
+\ 
+\ this code implements IEEE 1275-1994 ch. H.2.2 and 5.3.1.1.1
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ H.2.2 Non-implemented FCodes
+\ Pre-Open Firmware systems assigned the following FCode numbers,
+\ but the functions were not supported. These FCode numbers stay 
+\ reserved to avoid confusion.
+
+: non-implemented 
+  ." Non-implemented historical or pre-Open Firmware FCode occured." cr 
+  end0
+  ;
+
+: adr-mask		non-implemented ;
+: b(code)		non-implemented ;
+: 4-byte-id		non-implemented ;
+: convert		non-implemented ;
+: frame-buffer-busy?	non-implemented ;
+: poll-packet		non-implemented ;
+: return-buffer		non-implemented ;
+: set-token-table	non-implemented ;
+: set-table		non-implemented ;
+: xmit-packet		non-implemented ;
+
+\ historical fcode words defined by 5.3.1.1.1
+
+30000 constant fcode-version    \ this opcode is considered obsolete
+30000 constant firmware-version \ this opcode is considered obsolete
+
+\ historical - Returns the type of processor.
+\ 0x5 indicates SPARC, other values are not used.
+\ ?? this could be set by the kernel during bootstrap.
+deadbeef constant processor-type ( -- processor-type )
+
+: memmap		non-implemented ;
+: >physical		non-implemented ;
+: my-params 		non-implemented ;
+: intr			non-implemented ;
+: driver		non-implemented ;
+: group-code		non-implemented ;
+: probe 		non-implemented ;
+: probe-virtual 	non-implemented ;
diff --git a/qemu/roms/openbios/forth/device/property.fs b/qemu/roms/openbios/forth/device/property.fs
new file mode 100644
index 000000000..1d54e3ec3
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/property.fs
@@ -0,0 +1,335 @@
+\ tag: Property management
+\ 
+\ this code implements IEEE 1275-1994 ch. 5.3.5
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ small helpers.. these should go elsewhere.
+: bigendian?
+  10 here ! here c@ 10 <>
+  ;
+
+: l!-be ( val addr )
+  3 bounds swap do
+    dup ff and i c! 
+    8 rshift
+  -1 +loop
+  drop
+  ;
+
+: l@-be ( addr )
+  0 swap 4 bounds do
+    i c@ swap 8 << or
+  loop
+  ;
+
+\ allocate n bytes for device tree information
+\ until I know where to put this, I put it in the
+\ dictionary.
+
+: alloc-tree ( n -- addr )
+  dup >r           \ save len
+  here swap allot
+  dup r> 0 fill    \ clear memory
+  ;
+
+: align-tree ( -- )
+  null-align
+  ;
+
+: no-active true abort" no active package." ;
+
+\ 
+\ 5.3.5 Property management
+\ 
+
+\ Helper function
+: find-property ( name len phandle -- &&prop|0 )
+  >dn.properties
+  begin
+    dup @
+  while
+    dup @ >prop.name @  ( name len prop propname )
+    2over comp0         ( name len prop equal? )
+    0= if nip nip exit then
+    >prop.next @
+  repeat
+  ( name len false )
+  3drop false
+  ;
+
+\ From package (5.3.4.1)
+: next-property 
+( previous-str previous-len phandle -- false | name-str name-len true )
+  >r
+  2dup 0= swap 0= or if
+    2drop r> >dn.properties @
+  else
+    r> find-property dup if @ then
+    dup if >prop.next @ then
+  then
+
+  ?dup if
+    >prop.name @ dup cstrlen true
+    ( phandle name-str name-len true )
+  else
+    false
+  then
+;
+
+
+\ 
+\ 5.3.5.4 Property value access
+\ 
+
+\ Return value for name string property in package phandle.
+: get-package-property
+  ( name-str name-len phandle -- true | prop-addr prop-len false )
+  find-property ?dup if
+    @ dup >prop.addr @
+    swap >prop.len  @
+    false
+  else
+    true
+  then
+  ;
+
+\ Return value for given property in the current instance or its parents.
+: get-inherited-property 
+  ( name-str name-len -- true | prop-addr prop-len false )
+  my-self 
+  begin
+    ?dup
+  while
+    dup >in.device-node @   ( str len ihandle phandle )
+    2over rot find-property ?dup if
+      @
+      ( str len ihandle prop )
+      nip nip nip ( prop )
+      dup >prop.addr @ swap >prop.len @
+      false 
+      exit
+    then
+    ( str len ihandle )
+    >in.my-parent @
+  repeat
+  2drop
+  true
+  ;
+
+\ Return value for given property in this package.
+: get-my-property ( name-str name-len -- true | prop-addr prop-len false )
+  my-self >in.device-node @  ( -- phandle )
+  get-package-property
+  ;
+
+
+\   
+\ 5.3.5.2 Property array decoding
+\ 
+
+: decode-int ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 n )
+  dup 0> if
+    dup 4 min >r     ( addr1 len1 R:minlen )
+    over r@ + swap   ( addr1 addr2 len1 R:minlen )
+    r> -             ( addr1 addr2 len2 )
+    rot l@-be
+  else
+    0
+  then
+  ;
+
+\ HELPER: get #address-cell value (from parent)
+\ Legal values are 1..4 (we may optionally support longer addresses)
+: my-#acells ( -- #address-cells )
+  my-self ?dup if >in.device-node @ else active-package then
+  ?dup if >dn.parent @ then
+  ?dup if
+    " #address-cells" rot get-package-property if 2 exit then
+    \ we don't have to support more than 4 (and 0 is illegal)
+    decode-int nip nip 4 min 1 max
+  else
+    2
+  then
+;
+
+\ HELPER: get #size-cells value (from parent)
+: my-#scells ( -- #size-cells )
+  my-self ?dup if >in.device-node @ else active-package then
+  ?dup if >dn.parent @ then
+  ?dup if
+    " #size-cells" rot get-package-property if 1 exit then
+    decode-int nip nip
+  else
+    1
+  then
+;
+
+: decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
+  dup 0> if
+    2dup bounds \ check property for 0 bytes
+    0 -rot      \ initial string len is 0
+    do
+      i c@ 0= if
+        leave
+      then
+      1+
+    loop              ( prop-addr1 prop-len1 len )
+    1+ rot >r         ( prop-len1 len R: prop-addr1 )
+    over min 2dup -   ( prop-len1 nlen prop-len2 R: prop-addr1 )
+    r@ 2 pick +       ( prop-len1 nlen prop-len2 prop-addr2 )
+    >r >r >r          ( R: prop-addr1 prop-addr2 prop-len2 nlen )
+    drop
+    r> r> r>          ( nlen prop-len2 prop-addr2 )
+    -rot swap 1-      ( prop-addr2 prop-len2 nlen )
+    r> swap           ( prop-addr2 prop-len2 str len )
+  else
+    0 0
+  then
+  ;
+
+: decode-bytes  ( addr1 len1 #bytes -- addr len2 addr1 #bytes )
+  tuck -  ( addr1 #bytes len2 )
+  r> 2dup +  ( addr1 #bytes addr2 ) ( R: len2 )
+  r> 2swap
+  ;
+  
+: decode-phys 
+  ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 phys.lo ...  phys.hi )
+  my-#acells 0 ?do
+    decode-int r> r> rot >r >r >r
+  loop
+  my-#acells 0 ?do
+    r> r> r> -rot >r >r 
+  loop
+  ;
+
+  
+\ 
+\ 5.3.5.1 Property array encoding
+\ 
+
+: encode-int    ( n -- prop-addr prop-len )
+  /l alloc-tree tuck l!-be /l
+  ;
+
+: encode-string ( str len -- prop-addr prop-len )
+  \ we trust len here. should probably check string?
+  tuck char+ alloc-tree ( len str prop-addr )
+  tuck 3 pick move      ( len prop-addr )
+  swap 1+
+  ;
+
+: encode-bytes ( data-addr data-len -- prop-addr prop-len )
+  tuck alloc-tree ( len str prop-addr )
+  tuck 3 pick move
+  swap
+  ;
+
+: encode+ ( prop-addr1 prop-len1 prop-addr2 prop-len2 -- prop-addr3 prop-len3 )
+  nip +
+  ;
+
+: encode-phys ( phys.lo ... phys.hi -- prop-addr prop-len )
+  encode-int my-#acells 1- 0 ?do
+    rot encode-int encode+
+  loop
+  ;
+
+defer sbus-intr>cpu ( sbus-intr# -- cpu-intr# )
+: (sbus-intr>cpu) ." No SBUS present on this machine." cr ;
+['] (sbus-intr>cpu) to sbus-intr>cpu
+
+
+\ 
+\ 5.3.5.3 Property declaration
+\ 
+
+: (property) ( prop-addr prop-len name-str name-len dnode -- )
+  >r 2dup r@
+  align-tree
+  find-property ?dup if 
+    \ If a property with that property name already exists in the 
+    \ package in which the property would be created, replace its
+    \ value with the new value.
+    @ r> drop        \ don't need the device node anymore.
+    -rot 2drop tuck  \ drop property name 
+    >prop.len  !     \ overwrite old values
+    >prop.addr !
+    exit
+  then
+
+  ( prop-addr prop-len name-str name-len R: dn )
+  prop-node.size alloc-tree
+  dup >prop.next off
+  
+  dup r> >dn.properties
+  begin dup @ while @ >prop.next repeat !
+  >r
+  
+  ( prop-addr prop-len name-str name-len R: prop )
+  
+  \ create copy of property name
+  dup char+ alloc-tree 
+  dup >r swap move r>
+  ( prop-addr prop-len new-name R: prop )
+  r@ >prop.name !
+  r@ >prop.len  !
+  r> >prop.addr !
+  align-tree 
+  ;
+
+: property ( prop-addr prop-len name-str name-len -- )
+  my-self ?dup if
+    >in.device-node @
+  else
+    active-package
+  then
+  dup if
+    (property)
+  else
+    no-active
+  then
+  ;
+
+: (delete-property) ( name len dnode -- )
+  find-property ?dup if
+    dup @ >prop.next @ swap !
+    \ maybe we should try to reclaim the space?
+  then
+;
+  
+: delete-property ( name-str name-len -- )
+  active-package ?dup if
+    (delete-property)
+  else
+    2drop
+  then
+  ;
+
+\ Create the "name"  property; value is indicated string.
+: device-name    ( str len -- )
+  encode-string  " name"  property
+  ;
+
+\ Create "device_type" property, value is indicated string.
+: device-type    ( str len -- )
+  encode-string  " device_type"  property
+  ;
+
+\ Create the "reg" property with the given values.
+: reg ( phys.lo ... phys.hi size -- )
+  >r  ( phys.lo ... phys.hi ) encode-phys  ( addr len )
+  r>  ( addr1 len1 size )     encode-int   ( addr1 len1 addr2 len2 )
+  encode+  ( addr len )
+  " reg"  property
+  ;
+
+\ Create the "model" property; value is indicated string.
+: model    ( str len -- )
+  encode-string  " model"  property
+  ;
diff --git a/qemu/roms/openbios/forth/device/romfont.bin b/qemu/roms/openbios/forth/device/romfont.bin
new file mode 100644
index 000000000..0b60b6fb4
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/romfont.bin
diff --git a/qemu/roms/openbios/forth/device/structures.fs b/qemu/roms/openbios/forth/device/structures.fs
new file mode 100644
index 000000000..14dd881e5
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/structures.fs
@@ -0,0 +1,54 @@
+\ tag: device interface structures
+\ 
+\ this code implements data structures used by the
+\ IEEE 1275-1994 Open Firmware Device Interface.
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+\ this file contains the struct definitions for the following 
+\ device tree structures:
+\   device-node
+\   active-package
+\   property
+\   instance
+
+
+struct ( instance )
+  /n field >in.instance-data            \ must go first
+  /n field >in.alloced-size							\ alloced size
+  /n field >in.device-node
+  /n field >in.my-parent
+  /n field >in.interposed
+  4 cells field >in.my-unit
+  2 cells field >in.arguments
+  \ instance-data should be null during packet initialization
+  \ this diverts access to instance variables to the dictionary
+constant inst-node.size
+
+struct ( device node )
+  /n field >dn.isize                    \ instance size (must go first)
+  /n field >dn.parent
+  /n field >dn.child
+  /n field >dn.peer
+  /n field >dn.properties
+  /n field >dn.methods
+  /n field >dn.priv-methods
+  /n field >dn.#acells
+  /n field >dn.probe-addr
+  inst-node.size field >dn.itemplate
+constant dev-node.size
+
+struct ( property )
+  /n field >prop.next
+  /n field >prop.name
+  /n field >prop.addr
+  /n field >prop.len
+constant prop-node.size
+
+struct ( active package )
+  /n field >ap.device-str
+constant active-package.size
diff --git a/qemu/roms/openbios/forth/device/table.fs b/qemu/roms/openbios/forth/device/table.fs
new file mode 100644
index 000000000..5c58f2d9d
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/table.fs
@@ -0,0 +1,462 @@
+\ tag: FCode table setup
+\ 
+\ this code implements an fcode evaluator 
+\ as described in IEEE 1275-1994
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+hex
+
+: undefined-fcode ." undefined fcode word." cr ;
+: reserved-fcode  ." reserved fcode word."  cr ;
+
+: ['], ( <word> -- )
+  ' ,
+;
+
+: n['], ( n <word> -- )
+  ' swap 0 do
+    dup ,
+  loop
+  drop
+;
+
+\ the table used 
+create fcode-master-table
+  ['], end0
+  f n['], reserved-fcode
+  ['], b(lit)
+  ['], b(')
+  ['], b(")
+  ['], bbranch
+  ['], b?branch
+  ['], b(loop)
+  ['], b(+loop)
+  ['], b(do)
+  ['], b(?do)
+  ['], i
+  ['], j
+  ['], b(leave)
+  ['], b(of)
+  ['], execute
+  ['], +
+  ['], -
+  ['], *
+  ['], /
+  ['], mod
+  ['], and
+  ['], or
+  ['], xor
+  ['], invert
+  ['], lshift
+  ['], rshift
+  ['], >>a
+  ['], /mod
+  ['], u/mod
+  ['], negate
+  ['], abs
+  ['], min
+  ['], max
+  ['], >r
+  ['], r>
+  ['], r@
+  ['], exit
+  ['], 0=
+  ['], 0<>
+  ['], 0<
+  ['], 0<=
+  ['], 0>
+  ['], 0>=
+  ['], <
+  ['], >
+  ['], =
+  ['], <>
+  ['], u>
+  ['], u<=
+  ['], u<
+  ['], u>=
+  ['], >=
+  ['], <=
+  ['], between
+  ['], within
+  ['], drop
+  ['], dup
+  ['], over
+  ['], swap
+  ['], rot
+  ['], -rot
+  ['], tuck
+  ['], nip
+  ['], pick
+  ['], roll
+  ['], ?dup
+  ['], depth
+  ['], 2drop
+  ['], 2dup
+  ['], 2over
+  ['], 2swap
+  ['], 2rot
+  ['], 2/
+  ['], u2/
+  ['], 2*
+  ['], /c
+  ['], /w
+  ['], /l
+  ['], /n
+  ['], ca+
+  ['], wa+
+  ['], la+
+  ['], na+
+  ['], char+
+  ['], wa1+
+  ['], la1+
+  ['], cell+
+  ['], chars
+  ['], /w*
+  ['], /l*
+  ['], cells
+  ['], on
+  ['], off
+  ['], +!
+  ['], @
+  ['], l@
+  ['], w@
+  ['], <w@
+  ['], c@
+  ['], !
+  ['], l!
+  ['], w!
+  ['], c!
+  ['], 2@
+  ['], 2!
+  ['], move
+  ['], fill
+  ['], comp
+  ['], noop
+  ['], lwsplit
+  ['], wljoin
+  ['], lbsplit
+  ['], bljoin
+  ['], wbflip
+  ['], upc
+  ['], lcc
+  ['], pack
+  ['], count
+  ['], body>
+  ['], >body
+  ['], fcode-revision
+  ['], span
+  ['], unloop
+  ['], expect
+  ['], alloc-mem
+  ['], free-mem
+  ['], key?
+  ['], key
+  ['], emit
+  ['], type
+  ['], (cr
+  ['], cr
+  ['], #out
+  ['], #line
+  ['], hold
+  ['], <#
+  ['], u#>
+  ['], sign
+  ['], u#
+  ['], u#s
+  ['], u.
+  ['], u.r
+  ['], .
+  ['], .r
+  ['], .s
+  ['], base
+  ['], convert                  \ reserved (compatibility)
+  ['], $number
+  ['], digit
+  ['], -1
+  ['], 0
+  ['], 1
+  ['], 2
+  ['], 3
+  ['], bl
+  ['], bs
+  ['], bell
+  ['], bounds
+  ['], here
+  ['], aligned
+  ['], wbsplit
+  ['], bwjoin
+  ['], b(<mark)
+  ['], b(>resolve)
+  ['], set-token-table
+  ['], set-table
+  ['], new-token
+  ['], named-token
+  ['], b(:)
+  ['], b(value)
+  ['], b(variable)
+  ['], b(constant)
+  ['], b(create)
+  ['], b(defer)
+  ['], b(buffer:)
+  ['], b(field)
+  ['], b(code)
+  ['], instance
+  ['], reserved-fcode
+  ['], b(;)
+  ['], b(to)
+  ['], b(case)
+  ['], b(endcase)
+  ['], b(endof)
+  ['], #
+  ['], #s
+  ['], #>
+  ['], external-token
+  ['], $find
+  ['], offset16
+  ['], evaluate
+  ['], reserved-fcode
+  ['], reserved-fcode
+  ['], c,
+  ['], w,
+  ['], l,
+  ['], ,
+  ['], um*
+  ['], um/mod
+  ['], reserved-fcode
+  ['], reserved-fcode
+  ['], d+
+  ['], d-
+  ['], get-token
+  ['], set-token
+  ['], state
+  ['], compile,
+  ['], behavior
+  11 n['], reserved-fcode
+  ['], start0
+  ['], start1
+  ['], start2
+  ['], start4
+  8 n['], reserved-fcode
+  ['], ferror
+  ['], version1
+  ['], 4-byte-id
+  ['], end1
+  ['], reserved-fcode
+  ['], dma-alloc
+  ['], my-address
+  ['], my-space
+  ['], memmap
+  ['], free-virtual
+  ['], >physical
+  8 n['], reserved-fcode
+  ['], my-params
+  ['], property
+  ['], encode-int
+  ['], encode+
+  ['], encode-phys
+  ['], encode-string
+  ['], encode-bytes
+  ['], reg
+  ['], intr
+  ['], driver
+  ['], model
+  ['], device-type
+  ['], parse-2int
+  ['], is-install
+  ['], is-remove
+  ['], is-selftest
+  ['], new-device
+  ['], diagnostic-mode?
+  ['], display-status
+  ['], memory-test-suite
+  ['], group-code
+  ['], mask
+  ['], get-msecs
+  ['], ms
+  ['], finish-device
+  ['], decode-phys           \ 128
+  ['], push-package
+  ['], pop-package
+  ['], interpose             \ extension (recommended practice)
+  4 n['], reserved-fcode
+  ['], map-low
+  ['], sbus-intr>cpu
+  1e n['], reserved-fcode
+  ['], #lines
+  ['], #columns
+  ['], line#
+  ['], column#
+  ['], inverse?
+  ['], inverse-screen?
+  ['], frame-buffer-busy?
+  ['], draw-character
+  ['], reset-screen
+  ['], toggle-cursor
+  ['], erase-screen
+  ['], blink-screen
+  ['], invert-screen
+  ['], insert-characters
+  ['], delete-characters
+  ['], insert-lines
+  ['], delete-lines
+  ['], draw-logo
+  ['], frame-buffer-adr
+  ['], screen-height
+  ['], screen-width
+  ['], window-top
+  ['], window-left
+  3 n['], reserved-fcode
+  ['], default-font
+  ['], set-font
+  ['], char-height
+  ['], char-width
+  ['], >font
+  ['], fontbytes
+  10 n['], reserved-fcode             \ fb1 words
+  ['], fb8-draw-character
+  ['], fb8-reset-screen
+  ['], fb8-toggle-cursor
+  ['], fb8-erase-screen
+  ['], fb8-blink-screen
+  ['], fb8-invert-screen
+  ['], fb8-insert-characters
+  ['], fb8-delete-characters
+  ['], fb8-insert-lines
+  ['], fb8-delete-lines
+  ['], fb8-draw-logo
+  ['], fb8-install
+  4 n['], reserved-fcode           \ reserved
+  7 n['], reserved-fcode           \ VME-bus support
+  9 n['], reserved-fcode           \ reserved
+  ['], return-buffer
+  ['], xmit-packet
+  ['], poll-packet
+  ['], reserved-fcode
+  ['], mac-address
+  5c n['], reserved-fcode          \ 1a5-200 reserved
+  ['], device-name
+  ['], my-args
+  ['], my-self
+  ['], find-package
+  ['], open-package
+  ['], close-package
+  ['], find-method
+  ['], call-package
+  ['], $call-parent
+  ['], my-parent
+  ['], ihandle>phandle
+  ['], reserved-fcode
+  ['], my-unit
+  ['], $call-method
+  ['], $open-package
+  ['], processor-type
+  ['], firmware-version
+  ['], fcode-version
+  ['], alarm
+  ['], (is-user-word)
+  ['], suspend-fcode
+  ['], abort
+  ['], catch
+  ['], throw
+  ['], user-abort
+  ['], get-my-property
+  ['], decode-int
+  ['], decode-string
+  ['], get-inherited-property
+  ['], delete-property
+  ['], get-package-property
+  ['], cpeek
+  ['], wpeek
+  ['], lpeek
+  ['], cpoke
+  ['], wpoke
+  ['], lpoke
+  ['], lwflip
+  ['], lbflip
+  ['], lbflips
+  ['], adr-mask
+  4 n['], reserved-fcode       \ 22a-22d
+64bit? [IF]
+  ['], (rx@)
+  ['], (rx!)
+[ELSE]
+   2 n['], reserved-fcode       \ 22e-22f 
+[THEN]
+  ['], rb@
+  ['], rb!
+  ['], rw@
+  ['], rw!
+  ['], rl@
+  ['], rl!
+  ['], wbflips
+  ['], lwflips
+  ['], probe
+  ['], probe-virtual
+  ['], reserved-fcode
+  ['], child
+  ['], peer
+  ['], next-property
+  ['], byte-load
+  ['], set-args
+  ['], left-parse-string        \ 240
+64bit? [IF]
+  ['], bxjoin
+  ['], <l@
+  ['], lxjoin
+  ['], wxjoin
+  ['], x,
+  ['], x@
+  ['], x!
+  ['], /x
+  ['], /x*
+\   ['], /xa+
+\   ['], /xa1+
+  ['], xbflip
+  ['], xbflips
+  ['], xbsplit
+  ['], xlflip
+  ['], xlflips
+  ['], xlsplit
+  ['], xwflip
+  ['], xwflips
+  ['], xwsplit
+[ELSE]
+  7 n['], reserved-fcode	\ 241-247 (Part of IEEE1275 64-bit draft standard)
+  ['], /x
+  c n['], reserved-fcode	\ 249-254 (Part of IEEE1275 64-bit draft standard)
+[THEN]
+
+
+here fcode-master-table - constant fcode-master-table-size
+
+
+: nreserved ( fcode-table-ptr first last xt -- )
+  -rot 1+ swap do
+    2dup swap i cells + !
+  loop
+  2drop 
+;
+
+:noname
+  800 cells alloc-mem to fcode-sys-table
+
+  fcode-sys-table
+  dup 0 5ff ['] reserved-fcode nreserved        \ built-in fcodes
+  dup 600 7ff ['] undefined-fcode nreserved     \ vendor fcodes
+  
+  \ copy built-in fcodes
+  fcode-master-table swap fcode-master-table-size move
+; initializer
+
+: (init-fcode-table) ( -- )
+  fcode-sys-table fcode-table 800 cells move
+  \ clear local fcodes
+  fcode-table 800 fff ['] undefined-fcode nreserved
+;
+
+['] (init-fcode-table) to init-fcode-table
diff --git a/qemu/roms/openbios/forth/device/terminal.fs b/qemu/roms/openbios/forth/device/terminal.fs
new file mode 100644
index 000000000..24b2d10c9
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/terminal.fs
@@ -0,0 +1,302 @@
+\ tag: terminal emulation
+\ 
+\ this code implements IEEE 1275-1994 ANNEX B
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+0 value (escseq)
+10 buffer: (sequence)
+
+: (match-number) ( x y [1|2] [1|2] -- x [z] )
+  2dup = if \ 1 1 | 2 2
+    drop exit
+  then
+  2dup > if
+    2drop drop 1 exit
+  then
+  2drop 0
+  ;
+
+: (esc-number) ( maxchar -- ?? ?? num )
+  >r depth >r  ( R: depth maxchar )
+  0 (sequence) 2+ (escseq) 2- ( 0 seq+2 seqlen-2 )
+  \ if numerical, scan until non-numerical
+  0 ?do
+    ( 0 seq+2 )
+    dup i + c@ a
+    digit if
+      ( 0 ptr  n )
+      rot a * + ( ptr val )
+      swap 
+    else
+      ( 0 ptr asc )
+      ascii ; = if
+        0 swap
+      else
+        drop leave
+      then
+    then
+    
+  loop
+  depth r> - r>
+  0 to (escseq)
+  (match-number) 
+  ;
+  
+: (match-seq)
+  (escseq) 1- (sequence) + c@  \ get last character in sequence
+  \ dup draw-character
+  case
+    ascii A of \ CUU - cursor up
+      1 (esc-number) 
+      0> if 
+        1 max
+      else 
+        1
+      then
+      negate line# + 
+      0 max to line#
+    endof
+    ascii B of \ CUD - cursor down
+      1 (esc-number) 
+      0> if 
+        1 max
+	line# + 
+        #lines 1- min to line#
+      then
+    endof
+    ascii C of \ CUF - cursor forward
+      1 (esc-number) 
+      0> if 
+        1 max
+	column# + 
+        #columns 1- min to column#
+      then
+    endof
+    ascii D of \ CUB - cursor backward
+      1 (esc-number) 
+      0> if 
+        1 max
+	negate column# + 
+	0 max to column#
+      then
+    endof
+    ascii E of \ Cursor next line (CNL) 
+      \ FIXME - check agains ANSI3.64
+      1 (esc-number) 
+      0> if 
+        1 max
+	line# + 
+        #lines 1- min to line#
+      then
+      0 to column#
+    endof
+    ascii f of
+      2 (esc-number) 
+      case
+        2 of
+          1- #columns 1- min to column#
+          1- #lines 1- min to line#
+        endof
+        1 of
+          0 to column#
+          1- #lines 1- min to line#
+        endof
+        0 of
+          0 to column#
+          0 to line#
+          drop
+        endof
+      endcase
+    endof
+    ascii H of
+      2 (esc-number)
+      case
+        2 of
+          1- #columns 1- min to column#
+          1- #lines 1- min to line#
+        endof
+        1 of
+          0 to column#
+          1- #lines 1- min to line#
+        endof
+        0 of
+          0 to column#
+          0 to line#
+          drop
+        endof
+      endcase
+    endof
+    ascii J of
+      0 to (escseq)
+      #columns column# - delete-characters
+      #lines line# - delete-lines
+    endof
+    ascii K of
+      0 to (escseq)
+      #columns column# - delete-characters
+    endof
+    ascii L of
+      1 (esc-number) 
+      0> if
+        1 max
+        insert-lines
+      then
+    endof
+    ascii M of
+      1 (esc-number) 
+      1 = if
+        1 max
+        delete-lines
+      then
+    endof
+    ascii @ of
+      1 (esc-number) 
+      1 = if
+        1 max
+        insert-characters 
+      then
+    endof
+    ascii P of
+      1 (esc-number) 
+      1 = if
+	1 max
+        delete-characters
+      then
+    endof
+    ascii m of
+      1 (esc-number)
+      1 = if
+        7 = if 
+          true to inverse?
+        else
+          false to inverse?
+        then
+      then
+    endof
+    ascii p of \ normal text colors
+      0 to (escseq)
+      inverse-screen? if
+        false to inverse-screen?
+	inverse? 0= to inverse?
+	invert-screen
+      then
+    endof
+    ascii q of \ inverse text colors
+      0 to (escseq)
+      inverse-screen? not if
+        true to inverse-screen?
+	inverse? 0= to inverse?
+	invert-screen
+      then
+    endof
+    ascii s of
+      \ Resets the display device associated with the terminal emulator.
+      0 to (escseq)
+      reset-screen
+    endof
+  endcase
+  ;
+
+: (term-emit) ( char -- )
+  toggle-cursor
+  
+  (escseq) 0> if
+    (escseq) 10 = if
+      0 to (escseq)
+      ." overflow in esc" cr
+      drop
+    then
+    (escseq) 1 = if 
+      dup ascii [ = if    \ not a [
+        (sequence) 1+ c!
+	2 to (escseq)
+      else
+        0 to (escseq)      \ break out of ESC sequence
+	." out of ESC" cr
+	drop               \ don't print breakout character
+      then
+      toggle-cursor exit
+    else
+      (sequence) (escseq) + c! 
+      (escseq) 1+ to (escseq)
+      (match-seq)
+      toggle-cursor exit
+    then  
+  then
+  
+  case
+  0 of \ NULL
+    toggle-cursor exit
+  endof
+  7 of \ BEL
+    blink-screen
+    s" /screen" s" ring-bell" 
+    execute-device-method
+  endof
+  8 of \ BS
+    column# 0<> if
+      column# 1- to column#
+      toggle-cursor exit
+    then
+  endof
+  9 of \ TAB
+    column# dup #columns = if 
+      drop
+    else
+      8 + -8 and ff and to column#
+    then
+    toggle-cursor exit
+  endof
+  a of \ LF
+    line# 1+ to line#
+    0 to column#
+    line# #lines >= if
+      0 to line#
+      1 delete-lines
+      #lines 1- to line#
+      toggle-cursor exit
+    then
+  endof
+  b of \ VT
+    line# 0<> if
+      line# 1- to line#
+    then
+    toggle-cursor exit
+  endof
+  c of \ FF
+    0 to column# 0 to line#
+    erase-screen
+  endof
+  d of \ CR
+    0 to column#
+    toggle-cursor exit
+  endof
+  1b of \ ESC
+    1b (sequence) c!
+    1 to (escseq)
+  endof
+
+  \ draw character and advance position
+  column# #columns >= if
+    0 to column#
+    line# 1+ to line#
+    line# #lines >= if
+      0 to line#
+      1 delete-lines
+      #lines 1- to line#
+    then
+  then
+
+  dup draw-character
+  column# 1+ to column#
+
+  endcase
+  toggle-cursor
+  ;
+
+['] (term-emit) to fb-emit
diff --git a/qemu/roms/openbios/forth/device/tree.fs b/qemu/roms/openbios/forth/device/tree.fs
new file mode 100644
index 000000000..04f85b5c1
--- /dev/null
+++ b/qemu/roms/openbios/forth/device/tree.fs
@@ -0,0 +1,59 @@
+\ tag: Device Tree
+\ 
+\ this code implements IEEE 1275-1994 ch. 3.5
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+
+\ root node
+new-device
+  " OpenBiosTeam,OpenBIOS" device-name
+  1 encode-int " #address-cells" property
+  : open true ;
+  : close ;
+  : decode-unit parse-hex ;
+  : encode-unit ( addr -- str len )
+    pocket tohexstr
+  ;
+
+new-device
+  " aliases" device-name
+  : open true ;
+  : close ;
+finish-device
+  
+new-device
+  " openprom" device-name
+  " BootROM"  device-type
+  " OpenFirmware 3" model
+  0 0 " relative-addressing"  property
+  0 0 " supports-bootinfo"    property
+  1 encode-int " boot-syntax" property
+  
+  : selftest
+    ." OpenBIOS selftest... succeded" cr
+    true
+  ;
+  : open true ;
+  : close ;
+
+finish-device
+  
+new-device
+  " options" device-name
+finish-device
+
+new-device
+  " chosen" device-name
+  0 encode-int " stdin" property
+  0 encode-int " stdout" property
+  \ " hda1:/boot/vmunix" encode-string " bootpath" property
+  \ " -as" encode-string " bootargs" property
+finish-device
+  
+\ END
+finish-device