Add qemu 2.4.0

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

95 files changed, 15755 insertions, 0 deletions

diff --git a/qemu/roms/SLOF/slof/fs/accept.fs b/qemu/roms/SLOF/slof/fs/accept.fs
new file mode 100644
index 000000000..7e8e2717e
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/accept.fs
@@ -0,0 +1,410 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Implementation of ACCEPT.  Using ECMA-48 for terminal control.
+
+: beep  bell emit ;
+
+: TABLE-EXECUTE
+  CREATE DOES> swap cells+ @ ?dup IF execute ELSE beep THEN ;
+
+0 VALUE accept-adr
+0 VALUE accept-max
+0 VALUE accept-len
+0 VALUE accept-cur
+
+: esc  1b emit ;
+: csi  esc 5b emit ;
+
+: move-cursor ( -- )
+   esc ." 8" accept-cur IF
+      csi base @ decimal accept-cur 0 .r base ! ." C"
+   THEN
+;
+
+: redraw-line ( -- )
+   accept-cur accept-len = IF EXIT THEN
+   move-cursor
+   accept-adr accept-len accept-cur /string type
+   csi ." K" move-cursor
+;
+
+: full-redraw-line ( -- )
+   accept-cur 0 to accept-cur move-cursor
+   accept-adr accept-len type
+   csi ." K" to accept-cur move-cursor
+;
+
+: redraw-prompt ( -- )
+   cr depth . [char] > emit
+;
+
+: insert-char ( char -- )
+   accept-len accept-max = IF drop beep EXIT THEN
+   accept-cur accept-len <> IF csi ." @" dup emit
+   accept-adr accept-cur + dup 1+ accept-len accept-cur - move
+   ELSE dup emit THEN
+   accept-adr accept-cur + c!
+   accept-cur 1+ to accept-cur
+   accept-len 1+ to accept-len redraw-line
+;
+
+: delete-char ( -- )
+   accept-cur accept-len = IF beep EXIT THEN
+   accept-len 1- to accept-len
+   accept-adr accept-cur + dup 1+ swap accept-len accept-cur - move
+   csi ." P" redraw-line
+;
+
+\ *
+\ * History handling
+\ *
+
+STRUCT
+cell FIELD his>next
+cell FIELD his>prev
+cell FIELD his>len
+   0 FIELD his>buf
+CONSTANT /his
+0 VALUE his-head
+0 VALUE his-tail
+0 VALUE his-cur
+
+: add-history ( -- )
+   accept-len 0= IF EXIT THEN
+   /his accept-len + alloc-mem
+   his-tail IF dup his-tail his>next ! ELSE dup to his-head THEN
+   his-tail over his>prev !  0 over his>next !  dup to his-tail
+   accept-len over his>len !  accept-adr swap his>buf accept-len move
+;
+
+: history  ( -- )
+   his-head BEGIN dup WHILE
+   cr dup his>buf over his>len @ type
+   his>next @ REPEAT drop
+;
+
+: select-history ( his -- )
+   dup to his-cur dup IF
+   dup his>len @ accept-max min dup to accept-len to accept-cur
+   his>buf accept-adr accept-len move ELSE
+   drop 0 to accept-len 0 to accept-cur THEN
+   full-redraw-line
+;
+
+
+\
+\ tab completion
+\
+
+\ tab completion state variables
+0 value ?tab-pressed
+0 value tab-last-adr
+0 value tab-last-len
+
+\ compares two strings and returns the longest equal substring.
+: $same-string ( addr-1 len-1 addr-2 len-2 -- addr-1 len-1' )
+   dup 0= IF    \ The second parameter is not a string.
+      2drop EXIT \ bail out
+   THEN
+   rot min 0 0 -rot ( addr1 addr2 0 len' 0 )
+   DO ( addr1 addr2 len-1' )
+      2 pick i + c@ lcc
+      2 pick i + c@ lcc
+      = IF 1 + ELSE leave THEN
+   LOOP
+   nip
+;
+
+: $tab-sift-words    ( text-addr text-len -- sift-count )
+   sift-compl-only >r true to sift-compl-only \ save sifting mode
+
+   last BEGIN @ ?dup WHILE \ loop over all words
+      $inner-sift IF \ any completions possible?
+         \ convert to lower case for user interface sanity
+         2dup bounds DO I c@ lcc I c! LOOP
+         ?tab-pressed IF 2dup type space THEN  \ <tab><tab> prints possibilities
+         tab-last-adr tab-last-len $same-string \ find matching substring ...
+         to tab-last-len to tab-last-adr       \ ... and save it
+      THEN
+   repeat
+   2drop
+
+   #sift-count 0 to #sift-count	\ how many words were found?
+   r> to sift-compl-only		\ restore sifting completion mode
+;
+
+\ 8< node sifting for tab completion on device tree nodes below this line 8<
+
+#include <stack.fs>
+
+10 new-stack device-stack
+
+: (next-dev) ( node -- node' addr len )
+   device-stack
+   dup (node>path) rot
+   dup child IF dup push child -rot EXIT THEN
+   dup peer IF peer -rot EXIT THEN
+   drop
+   BEGIN
+      stack-depth
+   WHILE
+      pop peer ?dup IF -rot EXIT THEN
+   REPEAT
+   0 -rot
+;
+
+: $inner-sift-nodes ( text-addr text-len node -- ... path-addr path-len true | false )
+   (next-dev) ( text-addr text-len node' path-addr path-len )
+   dup 0= IF drop false EXIT THEN
+   2dup 6 pick 6 pick find-isubstr ( text-addr text-len node' path-addr path-len pos )
+   0= IF
+      #sift-count 1+ to #sift-count \ count completions
+      true
+   ELSE
+      2drop false
+   THEN
+;
+
+\
+\ test function for (next-dev)
+: .nodes ( -- )
+   s" /" find-node BEGIN dup WHILE
+      (next-dev)
+      type cr
+   REPEAT
+   drop
+   reset-stack
+;
+
+\ node sifting wants its own pockets
+create sift-node-buffer 1000 allot
+0 value sift-node-num
+: sift-node-buffer
+   sift-node-buffer sift-node-num 100 * +
+   sift-node-num 1+ dup 10 = IF drop 0 THEN
+   to sift-node-num
+;
+
+: $tab-sift-nodes    ( text-addr text-len -- sift-count )
+   s" /" find-node BEGIN dup WHILE
+      $inner-sift-nodes IF \ any completions possible?
+         sift-node-buffer swap 2>r 2r@ move 2r> \ make an almost permanent copy without strdup
+         ?tab-pressed IF 2dup type space THEN  \ <tab><tab> prints possibilities
+         tab-last-adr tab-last-len $same-string \ find matching substring ...
+         to tab-last-len to tab-last-adr       \ ... and save it
+      THEN
+   REPEAT
+   2drop drop
+   #sift-count 0 to #sift-count	\ how many words were found?
+   reset-stack
+;
+
+: $tab-sift    ( text-addr text-len -- sift-count )
+   ?tab-pressed IF beep space THEN \ cosmetical fix for <tab><tab>
+
+   dup IF bl rsplit dup IF 2swap THEN ELSE 0 0 THEN >r >r
+
+   0 dup to tab-last-len to tab-last-adr	\ reset last possible match
+   current-node @ IF			\ if we are in a node?
+      2dup 2>r				\ save text
+      $tab-sift-words to #sift-count	\ search in current node first
+      2r>				\ fetch text to complete, again
+   THEN
+   2dup 2>r
+   current-node @ >r 0 set-node		\ now search in global words
+   $tab-sift-words to #sift-count
+   r> set-node
+   2r> $tab-sift-nodes
+   \ concatenate previous commands
+   r> r> dup IF s"  " $cat THEN tab-last-adr tab-last-len $cat
+   to tab-last-len to tab-last-adr  \ ... and save the whole string
+;
+
+\ 8< node sifting for tab completion on device tree nodes above this line 8<
+
+: handle-^A
+   0 to accept-cur move-cursor ;
+: handle-^B
+   accept-cur ?dup IF 1- to accept-cur ( csi ." D" ) move-cursor THEN ;
+: handle-^D
+   delete-char ( redraw-line ) ;
+: handle-^E
+   accept-len to accept-cur move-cursor ;
+: handle-^F
+   accept-cur accept-len <> IF accept-cur 1+ to accept-cur csi ." C" THEN ;
+: handle-^H
+   accept-cur 0= IF beep EXIT THEN
+   handle-^B delete-char
+;
+: handle-^I
+   accept-adr accept-len
+   $tab-sift 0 > IF
+      ?tab-pressed IF
+         redraw-prompt full-redraw-line
+         false to ?tab-pressed
+      ELSE
+         tab-last-adr accept-adr tab-last-len move    \ copy matching substring
+         tab-last-len dup to accept-len to accept-cur \ len and cursor position
+         full-redraw-line		\ redraw new string
+         true to ?tab-pressed	\ second tab will print possible matches
+      THEN
+   THEN
+;
+
+: handle-^K
+   BEGIN accept-cur accept-len <> WHILE delete-char REPEAT ;
+: handle-^L
+   history redraw-prompt full-redraw-line ;
+: handle-^N
+   his-cur IF his-cur his>next @ ELSE his-head THEN
+   dup to his-cur select-history
+;
+: handle-^P
+   his-cur IF his-cur his>prev @ ELSE his-tail THEN
+   dup to his-cur select-history
+;
+: handle-^Q  \ Does not handle terminal formatting yet.
+   key insert-char ;
+: handle-^R
+   full-redraw-line ;
+: handle-^U
+   0 to accept-len 0 to accept-cur full-redraw-line ;
+
+: handle-fn
+   key drop beep
+;
+
+TABLE-EXECUTE handle-CSI
+0 , ' handle-^P , ' handle-^N , ' handle-^F ,
+' handle-^B , 0 , 0 , 0 ,
+' handle-^A , 0 , 0 , ' handle-^E ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+
+TABLE-EXECUTE handle-meta
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , ' handle-fn ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , 0 ,
+0 , 0 , 0 , ' handle-CSI ,
+0 , 0 , 0 , 0 ,
+
+: handle-ESC-O
+   key
+   dup 48 = IF
+      handle-^A
+   ELSE
+      dup 46 = IF
+         handle-^E
+      THEN
+   THEN drop
+;
+
+: handle-ESC-5b
+   key
+   dup 31 = IF \ HOME
+      key drop ( drops closing 7e ) handle-^A
+   ELSE
+      dup 33 = IF \ DEL
+         key drop handle-^D
+      ELSE
+         dup 34 = IF \ END
+            key drop handle-^E
+         ELSE
+            dup 1f and handle-CSI
+         THEN
+      THEN
+   THEN drop
+;
+
+: handle-ESC
+   key
+   dup 5b = IF
+      handle-ESC-5b
+   ELSE
+      dup 4f = IF
+         handle-ESC-O
+      ELSE
+         dup 1f and handle-meta
+      THEN
+   THEN drop
+;
+
+TABLE-EXECUTE handle-control
+0 , \ ^@:
+' handle-^A ,
+' handle-^B ,
+0 , \ ^C:
+' handle-^D ,
+' handle-^E ,
+' handle-^F ,
+0 , \ ^G:
+' handle-^H ,
+' handle-^I , \ tab
+0 , \ ^J:
+' handle-^K ,
+' handle-^L ,
+0 , \ ^M: enter: handled in main loop
+' handle-^N ,
+0 , \ ^O:
+' handle-^P ,
+' handle-^Q ,
+' handle-^R ,
+0 , \ ^S:
+0 , \ ^T:
+' handle-^U ,
+0 , \ ^V:
+0 , \ ^W:
+0 , \ ^X:
+0 , \ ^Y: insert save buffer
+0 , \ ^Z:
+' handle-ESC ,
+0 , \ ^\:
+0 , \ ^]:
+0 , \ ^^:
+0 , \ ^_:
+
+: (accept) ( adr len -- len' )
+   cursor-on
+   to accept-max to accept-adr
+   0 to accept-len 0 to accept-cur
+   0 to his-cur
+   1b emit 37 emit
+   BEGIN
+      key dup 0d <>
+   WHILE
+      dup 9 <> IF 0 to ?tab-pressed THEN \ reset state machine
+      dup 7f = IF drop 8 THEN \ Handle DEL as if it was BS. ??? bogus
+      dup bl < IF handle-control ELSE
+         dup 80 and IF
+            dup a0 < IF 7f and handle-meta ELSE drop beep THEN
+         ELSE
+            insert-char
+	 THEN
+      THEN
+   REPEAT
+   drop add-history
+   accept-len to accept-cur
+   move-cursor space
+   accept-len
+   cursor-off
+;
+
+' (accept) to accept
+
diff --git a/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs b/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs
new file mode 100644
index 000000000..d4ca70bbd
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs
@@ -0,0 +1,116 @@
+\ *****************************************************************************
+\ * Copyright (c) 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\ * Dynamic memory allocation/de-allocation debug functions
+\ *****************************************************************************
+
+
+\ Uncomment the following code for debugging bad write accesses beyond
+\ the end of the allocated block:
+\ Store magic value past the end of the block during alloc-mem and
+\ check for this magic value when free-mem has been called.
+#if 1
+: alloc-mem  ( len -- addr )
+   dup /n + alloc-mem    ( len addr )
+   2dup + 3141592653589793 swap ! nip
+;
+
+: free-mem  ( addr len -- )
+   2dup + @ 3141592653589793 <> IF
+      cr ." Detected memory corrupt during free-mem of "
+      swap . . cr EXIT
+   THEN
+   /n + free-mem
+;
+#endif
+
+
+\ Never ever assume that allocated memory is pre-initialized with 0 ...
+: alloc-mem  ( len -- addr )
+   dup alloc-mem  swap 2dup ff fill drop
+;
+
+\ Make sure that memory block do not contain "valid" data after free-mem:
+: free-mem  ( addr len -- )
+   2dup ff fill  free-mem
+;
+
+
+\ The following definitions are used for debugging the parameters of free-mem:
+\ Store block address and size of allocated blocks
+\ in an array, then check for right values on free-mem.
+
+1000 CONSTANT max-malloced-blocks
+CREATE malloced-blocks max-malloced-blocks 2 * cells allot
+malloced-blocks max-malloced-blocks 2 * cells erase
+
+
+: alloc-mem  ( len -- addr )
+   dup alloc-mem dup 0= IF
+      cr ." alloc-mem returned 0 for size " swap . cr EXIT
+   THEN                                        ( len addr )
+   malloced-blocks max-malloced-blocks 0 DO    ( len addr m-blocks-ptr )
+      dup @ 0= IF                              ( len addr m-blocks-ptr )
+         \ Found a free entry: store addr and len
+         over >r dup >r !
+         r> cell+ !
+         r> UNLOOP EXIT
+      THEN
+      cell+ cell+                              ( len addr next-m-blocks-ptr )
+   LOOP
+   ." Please increase max-malloced-blocks." cr ( len addr next-m-blocks-ptr )
+   drop nip
+;
+
+
+: free-mem  ( addr len -- )
+   malloced-blocks max-malloced-blocks 0 DO    ( addr len m-blocks-ptr )
+      dup @ ?dup IF
+         ( addr len m-blocks-ptr s-addr )
+         3 pick = IF
+            ( addr len m-blocks-ptr )
+            dup cell+ @     ( addr len m-blocks-ptr s-len )
+            2 pick = IF     ( addr len m-blocks-ptr )
+               \ All right, addr and len matched,
+               \ clear entry and call original free-mem.
+               dup cell+ 0 swap !
+               0 swap !
+               free-mem 
+            ELSE
+               >r swap cr
+               ." free-mem called for block " . ." with wrong size=" . cr
+               ." ( correct size should be: " r> cell+ @ . ." )" cr
+            THEN
+            UNLOOP EXIT
+         THEN                 ( addr len m-blocks-ptr )
+      THEN
+      cell+ cell+             ( addr len next-m-blocks-ptr )
+   LOOP
+   drop swap cr
+   ." free-mem called for block " .
+   ." ( size=" .
+   ." ) which has never been allocated before!" cr
+;
+
+
+\ Enable these for verbose debug messages:
+#if 0
+: alloc-mem
+   cr ." alloc-mem with len=" dup .
+   alloc-mem
+   ."  returned addr=" dup . cr
+;
+
+: free-mem
+   cr ." free mem addr=" over . ."  len=" dup . cr
+   free-mem
+;
+#endif
diff --git a/qemu/roms/SLOF/slof/fs/alloc-mem.fs b/qemu/roms/SLOF/slof/fs/alloc-mem.fs
new file mode 100644
index 000000000..59381a72b
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/alloc-mem.fs
@@ -0,0 +1,75 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+#include <claim.fs>
+\ Memory "heap" (de-)allocation.
+
+\ Keep a linked list of free blocks per power-of-two size.
+\ Never coalesce entries when freed; split blocks when needed while allocating.
+
+\ 3f CONSTANT (max-heads#)
+heap-end heap-start - log2 1+ CONSTANT (max-heads#)
+
+CREATE heads (max-heads#) cells allot
+heads (max-heads#) cells erase
+
+
+: size>head  ( size -- headptr )  log2 3 max cells heads + ;
+
+
+\ Allocate a memory block
+: alloc-mem  ( len -- a-addr )
+   dup 0= IF EXIT THEN
+   1 over log2 3 max                   ( len 1 log_len )
+   dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN
+   lshift >r                           ( len  R: 1<<log_len )
+   size>head dup @ IF
+      dup @ dup >r @ swap ! r> r> drop EXIT
+   THEN                                ( headptr  R: 1<<log_len)
+   r@ 2* recurse dup                   ( headptr a-addr2 a-addr2  R: 1<<log_len)
+   dup 0= IF r> 2drop 2drop 0 EXIT THEN
+   r> + >r 0 over ! swap ! r>
+;
+
+
+\ Free a memory block
+
+: free-mem  ( a-addr len -- )
+   dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! !
+;
+
+
+: #links  ( a -- n )
+   @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip
+;
+
+
+: .free  ( -- )
+   0 (max-heads#) 0 DO
+      heads i cells + #links dup IF
+         cr dup . ." * " 1 i lshift dup . ." = " * dup .
+      THEN
+      +
+   LOOP
+   cr ." Total " .
+;
+
+
+\ Start with just one free block.
+heap-start heap-end heap-start - free-mem
+
+
+\ : free-mem  ( a-addr len -- ) 2drop ;
+
+\ Uncomment the following line for debugging:
+\ #include <alloc-mem-debug.fs>
+
diff --git a/qemu/roms/SLOF/slof/fs/archsupport.fs b/qemu/roms/SLOF/slof/fs/archsupport.fs
new file mode 100644
index 000000000..cc4668769
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/archsupport.fs
@@ -0,0 +1,38 @@
+\ *****************************************************************************
+\ * Copyright (c) 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Qemu supports max 256cpus, 32K will be able to accomodate the fdt changes if
+\ needed.
+8000 VALUE size
+: ibm,client-architecture-support         ( vec -- err? )
+    \ Store require parameters in nvram
+    \ to come back to right boot device
+    \ Allocate memory for H_CALL
+    size alloc-mem                        ( vec memaddr )
+    swap over size                        ( memaddr vec memaddr size )
+    \ make h_call to hypervisor
+    hv-cas 0= IF                          ( memaddr )
+	dup l@ 1 >= IF                    \ Version number >= 1
+	    \ Make required changes
+	    " /" find-node set-node
+	    dup 4 + fdt-init
+	    fdt-check-header
+	    fdt-struct fdt-fix-cas-node
+	    fdt-fix-cas-success NOT
+	ELSE
+	    FALSE
+	THEN
+    ELSE
+	TRUE
+    THEN
+    >r size free-mem r>
+;
diff --git a/qemu/roms/SLOF/slof/fs/available.fs b/qemu/roms/SLOF/slof/fs/available.fs
new file mode 100644
index 000000000..5eb8fa93a
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/available.fs
@@ -0,0 +1,72 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+VARIABLE chosen-memory-ih 0 chosen-memory-ih !
+
+\ +
+\ Maintain "available" property.
+\ Sun has a single memory node with "available" property
+\ and separate memory controller nodes.
+\ We corespond memory nodes with their respective memory controllers
+\ and use /chosen/memory as default memory node to hold the "available" map
+\ NOTE -> /chosen/memory is expected 2B initialized before using claim/release
+\ +
+
+: (chosen-memory-ph) ( -- phandle )
+	chosen-memory-ih @ ?dup 0= IF
+		s" memory" get-chosen IF
+			decode-int nip nip dup chosen-memory-ih !
+			ihandle>phandle
+		ELSE 0 THEN
+	ELSE ihandle>phandle THEN
+;
+
+: (set-available-prop) ( prop plen -- )
+	s" available"
+	(chosen-memory-ph) ?dup 0<> IF set-property ELSE
+		cr ." Can't find chosen memory node - "
+		." no available property created" cr
+		2dup 2dup
+	THEN
+;
+
+: update-available-property ( available-ptr -- )
+	dup >r available>size@
+	0= r@ available AVAILABLE-SIZE /available * + >= or IF
+		available r> available - encode-bytes (set-available-prop)
+	ELSE
+		r> /available + RECURSE
+	THEN
+;
+
+: update-available-property available update-available-property ;
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ +
+\ IEEE 1275 implementation:
+\	claim
+\ Claim the region with given start address and size (if align parameter is 0);
+\ alternatively claim any region of given alignment
+\ +
+\ Throw an exception if failed
+\ +
+: claim ( [ addr ] len align -- base ) claim update-available-property ;
+
+\ +
+\ IEEE 1275 implementation:
+\	release
+\ Free the region with given start address and size
+\ +
+: release ( addr len -- ) release update-available-property ;
+
+update-available-property
+
diff --git a/qemu/roms/SLOF/slof/fs/banner.fs b/qemu/roms/SLOF/slof/fs/banner.fs
new file mode 100644
index 000000000..efdba0c5a
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/banner.fs
@@ -0,0 +1,23 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: banner
+   cr ."   Type 'boot'  and press return  to  continue  booting  the system."
+   s" /packages/sms" find-node IF
+      cr ."   Type 'sms-start' and press return to enter the configuration menu."
+   THEN
+   cr ."   Type 'reset-all'  and  press  return  to   reboot   the   system."
+   cr cr
+;
+
+: .banner banner console-clean-fifo ;
+
diff --git a/qemu/roms/SLOF/slof/fs/base.fs b/qemu/roms/SLOF/slof/fs/base.fs
new file mode 100644
index 000000000..e71e087eb
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/base.fs
@@ -0,0 +1,611 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Hash for faster lookup
+#include <find-hash.fs>
+
+: >name ( xt -- nfa ) \ note: still has the "immediate" field!
+   BEGIN char- dup c@ UNTIL ( @lastchar )
+   dup dup aligned - cell+ char- ( @lastchar lenmodcell )
+   dup >r -
+   BEGIN dup c@ r@ <> WHILE
+      cell- r> cell+ >r
+   REPEAT
+   r> drop char-
+;
+
+\ Words missing in *.in files
+VARIABLE mask -1 mask !
+
+VARIABLE huge-tftp-load 1 huge-tftp-load !
+\ Default implementation for sms-get-tftp-blocksize that return 1432 (decimal)
+: sms-get-tftp-blocksize 598 ;
+
+: default-hw-exception s" Exception #" type . ;
+
+' default-hw-exception to hw-exception-handler
+
+: diagnostic-mode? false ;	\ 2B DOTICK'D later in envvar.fs
+
+: memory-test-suite ( addr len -- fail? )
+	diagnostic-mode? IF
+		." Memory test mask value: " mask @ . cr
+		." No memory test suite currently implemented! " cr
+	THEN
+	false
+;
+
+: 0.r  0 swap <# 0 ?DO # LOOP #> type ;
+
+\ count the number of bits equal 1
+\ the idea is to clear in each step the least significant bit
+\ v&(v-1) does exactly this, so count the steps until v == 0
+: cnt-bits  ( 64-bit-value -- #bits=1 )
+	dup IF
+		41 1 DO dup 1- and dup 0= IF drop i LEAVE THEN LOOP
+	THEN
+;
+
+: bcd-to-bin  ( bcd -- bin )
+   dup f and swap 4 rshift a * +
+;
+
+\ calcs the exponent of the highest power of 2 not greater than n
+: 2log ( n -- lb{n} )
+   8 cells 0 DO 1 rshift dup 0= IF drop i LEAVE THEN LOOP
+;
+
+\ calcs the exponent of the lowest power of 2 not less than n
+: log2  ( n -- log2-n )
+   1- 2log 1+
+;
+
+
+CREATE $catpad 400 allot
+: $cat ( str1 len1 str2 len2 -- str3 len3 )
+   >r >r dup >r $catpad swap move
+   r> dup $catpad + r> swap r@ move
+   r> + $catpad swap ;
+
+\ WARNING: The following two ($cat-comm & $cat-space) are dirty in a sense
+\ that they add 1 or 2 characters to str1 before executing $cat
+\ The ASSUMPTION is that str1 buffer provides that extra space and it is
+\ responsibility of the code owner to ensure that
+: $cat-comma ( str2 len2 str1 len1 -- "str1, str2" len1+len2+2 )
+	2dup + s" , " rot swap move 2+ 2swap $cat
+;
+
+: $cat-space ( str2 len2 str1 len1 -- "str1 str2" len1+len2+1 )
+	2dup + bl swap c! 1+ 2swap $cat
+;
+: $cathex ( str len val -- str len' )
+   (u.) $cat
+;
+
+
+: 2CONSTANT    CREATE , , DOES> [ here ] 2@ ;
+
+\ Save XT of 2CONSTANT, put on the stack by "[ here ]" :
+CONSTANT <2constant>
+
+: $2CONSTANT  $CREATE , , DOES> 2@ ;
+
+: 2VARIABLE    CREATE 0 , 0 ,  DOES> ;
+
+
+: (is-user-word) ( name-str name-len xt -- ) -rot $CREATE , DOES> @ execute ;
+
+: zplace ( str len buf -- )  2dup + 0 swap c! swap move ;
+: rzplace ( str len buf -- )  2dup + 0 swap rb! swap rmove ;
+
+: strdup ( str len -- dupstr len ) here over allot swap 2dup 2>r move 2r> ;
+
+: str= ( str1 len1 str2 len2 -- equal? )
+  rot over <> IF 3drop false ELSE comp 0= THEN ;
+
+: test-string ( param len -- true | false )
+   0 ?DO
+      dup i + c@                     \ Get character / byte at current index
+      dup 20 <  swap 7e >  OR IF     \ Is it out of range 32 to 126 (=ASCII)
+         drop FALSE UNLOOP EXIT      \ FALSE means: No ASCII string
+      THEN
+   LOOP
+   drop TRUE    \ Only ASCII found --> it is a string
+;
+
+: #aligned ( adr alignment -- adr' ) negate swap negate and negate ;
+: #join  ( lo hi #bits -- x )  lshift or ;
+: #split ( x #bits -- lo hi )  2dup rshift dup >r swap lshift xor r> ;
+
+: /string ( str len u -- str' len' )
+  >r swap r@ chars + swap r> - ;
+: skip ( str len c -- str' len' )
+  >r BEGIN dup WHILE over c@ r@ = WHILE 1 /string REPEAT THEN r> drop ;
+: scan ( str len c -- str' len' )
+  >r BEGIN dup WHILE over c@ r@ <> WHILE 1 /string REPEAT THEN r> drop ;
+: split ( str len char -- left len right len )
+  >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
+\ reverse findchar -- search from the end of the string
+: rfindchar ( str len char -- offs true | false )
+   swap 1 - 0 swap do
+      over i + c@
+      over dup bl = if <= else = then if
+         2drop i dup dup leave
+      then
+   -1 +loop =
+;
+\ reverse split -- split at the last occurrence of char
+: rsplit ( str len char -- left len right len )
+  >r 2dup r> rfindchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
+
+: left-parse-string ( str len char -- R-str R-len L-str L-len )
+  split 2swap ;
+: replace-char ( str len chout chin -- )
+  >r -rot BEGIN 2dup 4 pick findchar WHILE tuck - -rot + r@ over c! swap REPEAT
+  r> 2drop 2drop
+;
+\ Duplicate string and replace \ with /
+: \-to-/ ( str len -- str' len ) strdup 2dup [char] \ [char] / replace-char ;
+
+: isdigit ( char -- true | false )
+   30 39 between
+;
+
+: ishexdigit ( char -- true | false )
+   30 39 between 41 46 between OR 61 66 between OR
+;
+
+\ Variant of $number that defaults to decimal unless "0x" is
+\ a prefix
+: $dh-number ( addr len -- true | number false )
+   base @ >r
+   decimal
+   dup 2 > IF
+       over dup c@ [char] 0 =
+       over 1 + c@ 20 or [char] x =
+       AND IF hex 2 + swap 2 - rot THEN drop
+   THEN
+   $number
+   r> base !
+;
+
+: //  dup >r 1- + r> / ; \ division, round up
+
+: c@+ ( adr -- c adr' )  dup c@ swap char+ ;
+: 2c@ ( adr -- c1 c2 )  c@+ c@ ;
+: 4c@ ( adr -- c1 c2 c3 c4 )  c@+ c@+ c@+ c@ ;
+: 8c@ ( adr -- c1 c2 c3 c4 c5 c6 c7 c8 )  c@+ c@+ c@+ c@+ c@+ c@+ c@+ c@ ;
+
+
+: 4dup  ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 )  2over 2over ;
+: 4drop  ( n1 n2 n3 n4 -- )  2drop 2drop ;
+
+\ yes sometimes even something like this is needed
+: 5dup  ( 1 2 3 4 5 -- 1 2 3 4 5 1 2 3 4 5 )
+   4 pick 4 pick 4 pick 4 pick 4 pick ;
+: 5drop 4drop drop ;
+: 5nip
+  nip nip nip nip nip ;
+
+: 6dup  ( 1 2 3 4 5 6 -- 1 2 3 4 5 6 1 2 3 4 5 6 )
+   5 pick 5 pick 5 pick 5 pick 5 pick 5 pick ;
+
+\ convert a 32 bit signed into a 64 signed
+\ ( propagate bit 31 to all bits 32:63 )
+: signed ( n1 -- n2 ) dup 80000000 and IF FFFFFFFF00000000 or THEN ;
+
+: <l@ ( addr -- x ) l@ signed ;
+
+: -leading  BEGIN dup WHILE over c@ bl <= WHILE 1 /string REPEAT THEN ;
+: (parse-line)  skipws 0 parse ;
+
+
+\ Append two character to hex byte, if possible
+
+: hex-byte ( char0 char1 -- value true|false )
+   10 digit IF
+      swap 10 digit IF
+	 4 lshift or true EXIT
+      ELSE
+	 2drop 0
+      THEN
+   ELSE
+      drop
+   THEN
+   false EXIT
+;
+
+\ Parse hex string within brackets
+
+: parse-hexstring ( dst-adr -- dst-adr' )
+   [char] ) parse cr                 ( dst-adr str len )
+   bounds ?DO                        ( dst-adr )
+      i c@ i 1+ c@ hex-byte IF       ( dst-adr hex-byte )
+	 >r dup r> swap c! 1+ 2      ( dst-adr+1 2 )
+      ELSE
+	 drop 1                      ( dst-adr 1 )
+      THEN
+   +LOOP
+;
+
+\ Add special character to string
+
+: add-specialchar ( dst-adr special -- dst-adr' )
+   over c! 1+                        ( dst-adr' )
+   1 >in +!                          \ advance input-index
+;
+
+\ Parse up to next "
+
+: parse-" ( dst-adr -- dst-adr' )
+   [char] " parse dup 3 pick + >r    ( dst-adr str len R: dst-adr' )
+   >r swap r> move r>                ( dst-adr' )
+;
+
+: (") ( dst-adr -- dst-adr' )
+   begin                             ( dst-adr )
+      parse-"                        ( dst-adr' )
+      >in @ dup span @ >= IF         ( dst-adr' >in-@ )
+         drop
+         EXIT
+      THEN
+
+      ib + c@
+      CASE
+         [char] ( OF parse-hexstring ENDOF
+         [char] " OF [char] " add-specialchar ENDOF
+         dup      OF EXIT ENDOF
+      ENDCASE
+   again
+;
+
+CREATE "pad 100 allot
+
+\ String with embedded hex strings
+\ Example: " ba"( 12 34,4567)ab" -> >x62x61x12x34x45x67x61x62<
+
+: " ( [text<">< >] -- text-str text-len )
+   state @ IF                        \ compile sliteral, pstr into dict
+      "pad dup (") over -            ( str len )
+      ['] sliteral compile, dup c,   ( str len )
+      bounds ?DO i c@ c, LOOP
+      align ['] count compile,
+   ELSE
+      pocket dup (") over -          \ Interpretation, put string
+   THEN                              \ in temp buffer
+; immediate
+
+
+\ Output the carriage-return character
+: (cr carret emit ;
+
+
+\ Remove command old-name and all subsequent definitions
+
+: $forget ( str len -- )
+   2dup last @            ( str len str len last-bc )
+   BEGIN
+      dup >r             ( str len str len last-bc R: last-bc )
+      cell+ char+ count  ( str len str len found-str found-len R: last-bc )
+      string=ci IF       ( str len R: last-bc )
+         r> @ last ! 2drop clean-hash EXIT ( -- )
+      THEN
+      2dup r> @ dup 0=   ( str len str len next-bc next-bc )
+   UNTIL
+   drop 2drop 2drop            \ clean hash table
+;
+
+: forget ( "old-name<>" -- )
+    parse-word $forget
+;
+
+#include <search.fs>
+
+\ The following constants are required in some parts
+\ of the code, mainly instance variables and see. Having to reverse
+\ engineer our own CFAs seems somewhat weird, but we gained a bit speed.
+
+\ Each colon definition is surrounded by colon and semicolon
+\ constant below contain address of their xt
+
+: (function) ;
+defer (defer)
+0 value (value)
+0 constant (constant)
+variable (variable)
+create (create)
+alias (alias) (function)
+cell buffer: (buffer:)
+
+' (function) @        \ ( <colon> )
+' (function) cell + @ \ ( ... <semicolon> )
+' (defer) @           \ ( ... <defer> )
+' (value) @           \ ( ... <value> )
+' (constant) @	      \ ( ... <constant> )
+' (variable) @        \ ( ... <variable> )
+' (create) @          \ ( ... <create> )
+' (alias) @           \ ( ... <alias> )
+' (buffer:) @         \ ( ... <buffer:> )
+
+\ now clean up the test functions
+forget (function)
+
+\ and remember the constants
+constant <buffer:>
+constant <alias>
+constant <create>
+constant <variable>
+constant <constant>
+constant <value>
+constant <defer>
+constant <semicolon>
+constant <colon>
+
+' lit      constant <lit>
+' sliteral constant <sliteral>
+' 0branch  constant <0branch>
+' branch   constant <branch>
+' doloop   constant <doloop>
+' dotick   constant <dotick>
+' doto     constant <doto>
+' do?do    constant <do?do>
+' do+loop  constant <do+loop>
+' do       constant <do>
+' exit     constant <exit>
+' doleave  constant <doleave>
+' do?leave  constant <do?leave>
+
+
+\ provide the memory management words
+\ #include <claim.fs>
+\ #include "memory.fs"
+#include <alloc-mem.fs>
+
+#include <node.fs>
+
+: find-substr ( basestr-ptr basestr-len substr-ptr substr-len -- pos )
+  \ if substr-len == 0 ?
+  dup 0 = IF
+    \ return 0
+    2drop 2drop 0 exit THEN
+  \ if substr-len <= basestr-len ?
+  dup 3 pick <= IF
+    \ run J from 0 to "basestr-len"-"substr-len" and I from 0 to "substr-len"-1
+    2 pick over - 1+ 0 DO dup 0 DO
+      \ substr-ptr[i] == basestr-ptr[j+i] ?
+      over i + c@ 4 pick j + i + c@ = IF
+        \ (I+1) == substr-len ?
+        dup i 1+ = IF
+          \ return J
+          2drop 2drop j unloop unloop exit THEN
+      ELSE leave THEN
+    LOOP LOOP
+  THEN
+  \ if there is no match then exit with basestr-len as return value
+  2drop nip
+;
+
+: find-isubstr ( basestr-ptr basestr-len substr-ptr substr-len -- pos )
+  \ if substr-len == 0 ?
+  dup 0 = IF
+    \ return 0
+    2drop 2drop 0 exit THEN
+  \ if substr-len <= basestr-len ?
+  dup 3 pick <= IF
+    \ run J from 0 to "basestr-len"-"substr-len" and I from 0 to "substr-len"-1
+    2 pick over - 1+ 0 DO dup 0 DO
+      \ substr-ptr[i] == basestr-ptr[j+i] ?
+      over i + c@ lcc 4 pick j + i + c@ lcc = IF
+        \ (I+1) == substr-len ?
+        dup i 1+ = IF
+          \ return J
+          2drop 2drop j unloop unloop exit THEN
+      ELSE leave THEN
+    LOOP LOOP
+  THEN
+  \ if there is no match then exit with basestr-len as return value
+  2drop nip
+;
+
+: find-nextline ( str-ptr str-len -- pos )
+  \ run I from 0 to "str-len"-1 and check str-ptr[i]
+  dup 0 ?DO over i + c@ CASE
+    \ 0x0a (=LF) found ?
+    0a OF
+      \ if current cursor is at end position (I == "str-len"-1) ?
+      dup 1- i = IF
+        \ return I+1
+        2drop i 1+ unloop exit THEN
+        \ if str-ptr[I+1] == 0x0d (=CR) ?
+      over i 1+ + c@ 0d = IF
+        \ return I+2
+        2drop i 2+ ELSE
+        \ else return I+1
+        2drop i 1+ THEN
+      unloop exit
+    ENDOF
+    \ 0x0d (=CR) found ?
+    0d OF
+      \ if current cursor is at end position (I == "str-len"-1) ?
+      dup 1- i = IF
+        \ return I+1
+        2drop i 1+ unloop exit THEN
+      \ str-ptr[I+1] == 0x0a (=LF) ?
+      over i 1+ + c@ 0a = IF
+        \ return I+2
+        2drop i 2+ ELSE
+        \ return I+1
+        2drop i 1+ THEN
+      unloop exit
+    ENDOF
+  ENDCASE LOOP nip
+;
+
+: string-at ( str1-ptr str1-len pos -- str2-ptr str2-len )
+  -rot 2 pick - -rot swap chars + swap
+;
+
+\ appends the string beginning at addr2 to the end of the string
+\ beginning at addr1
+\ !!! THERE MUST BE SUFFICIENT MEMORY RESERVED FOR THE STRING !!!
+\ !!!        BEGINNING AT ADDR1 (cp. 'strcat' in 'C' )        !!!
+
+: string-cat ( addr1 len1 addr2 len2 -- addr1 len1+len2 )
+  \ len1 := len1+len2
+  rot dup >r over + -rot
+  ( addr1 len1+len2 dest-ptr src-ptr len2 )
+  3 pick r> chars + -rot
+  ( ... dest-ptr src-ptr )
+  0 ?DO
+    2dup c@ swap c!
+    char+ swap char+ swap
+  LOOP 2drop
+;
+
+\ appends a character to the end of the string beginning at addr
+\ !!! THERE MUST BE SUFFICIENT MEMORY RESERVED FOR THE STRING !!!
+\ !!!        BEGINNING AT ADDR1 (cp. 'strcat' in 'C' )        !!!
+
+: char-cat ( addr len character -- addr len+1 )
+  -rot 2dup >r >r 1+ rot r> r> chars + c!
+;
+
+\ Returns true if source and destination overlap
+: overlap ( src dest size -- true|false )
+	3dup over + within IF 3drop true ELSE rot tuck + within THEN
+;
+
+: parse-2int ( str len -- val.lo val.hi )
+\ ." parse-2int ( " 2dup swap . . ." -- "
+	[char] , split ?dup IF eval ELSE drop 0 THEN
+	-rot ?dup IF eval ELSE drop 0 THEN
+\ 2dup swap . . ." )" cr
+;
+
+\ peek/poke minimal implementation, just to support FCode drivers
+\ Any implmentation with full error detection will be platform specific
+: cpeek ( addr -- false | byte true ) c@ true ;
+: cpoke ( byte addr -- success? ) c! true ;
+: wpeek ( addr -- false | word true ) w@ true ;
+: wpoke ( word addr -- success? ) w! true ;
+: lpeek ( addr -- false | lword true ) l@ true ;
+: lpoke ( lword addr -- success? ) l! true ;
+
+defer reboot ( -- )
+defer halt ( -- )
+defer disable-watchdog ( -- )
+defer reset-watchdog ( -- )
+defer set-watchdog ( +n -- )
+defer set-led ( type instance state -- status )
+defer get-flashside ( -- side )
+defer set-flashside ( side -- status )
+defer read-bootlist ( -- )
+defer furnish-boot-file ( -- adr len )
+defer set-boot-file ( adr len -- )
+defer mfg-mode? ( -- flag )
+defer of-prompt? ( -- flag )
+defer debug-boot? ( -- flag )
+defer bmc-version ( -- adr len )
+defer cursor-on ( -- )
+defer cursor-off ( -- )
+
+: nop-reboot ( -- ) ." reboot not available" abort ;
+: nop-halt ( -- ) ." halt not available" abort ;
+: nop-disable-watchdog ( -- )  ;
+: nop-reset-watchdog ( -- )  ;
+: nop-set-watchdog ( +n -- ) drop ;
+: nop-set-led ( type instance state -- status ) drop drop drop ;
+: nop-get-flashside ( -- side ) ." Cannot get flashside" cr ABORT ;
+: nop-set-flashside ( side -- status ) ." Cannot set flashside" cr ABORT ;
+: nop-read-bootlist ( -- ) ;
+: nop-furnish-bootfile ( -- adr len ) s" net:" ;
+: nop-set-boot-file ( adr len -- ) 2drop ;
+: nop-mfg-mode? ( -- flag ) false ;
+: nop-of-prompt? ( -- flag ) false ;
+: nop-debug-boot? ( -- flag ) false ;
+: nop-bmc-version ( -- adr len ) s" XXXXX" ;
+: nop-cursor-on ( -- ) ;
+: nop-cursor-off ( -- ) ;
+
+' nop-reboot to reboot
+' nop-halt to halt
+' nop-disable-watchdog to disable-watchdog
+' nop-reset-watchdog   to reset-watchdog
+' nop-set-watchdog     to set-watchdog
+' nop-set-led          to set-led
+' nop-get-flashside    to get-flashside
+' nop-set-flashside    to set-flashside
+' nop-read-bootlist    to read-bootlist
+' nop-furnish-bootfile to furnish-boot-file
+' nop-set-boot-file    to set-boot-file
+' nop-mfg-mode?        to mfg-mode?
+' nop-of-prompt?       to of-prompt?
+' nop-debug-boot?      to debug-boot?
+' nop-bmc-version      to bmc-version
+' nop-cursor-on        to cursor-on
+' nop-cursor-off       to cursor-off
+
+: reset-all reboot ;
+
+\ load-base is an env. variable now, but it can
+\ be overriden temporarily provided users use
+\ get-load-base rather than load-base directly
+\
+\ default-load-base is set here and can be
+\ overriden by the board code. It will be used
+\ to set the default value of the envvar "load-base"
+\ when booting without a valid nvram
+
+10000000 VALUE default-load-base
+2000000 VALUE flash-load-base
+0 VALUE load-base-override
+
+: get-load-base
+  load-base-override 0<> IF load-base-override ELSE
+    " load-base" evaluate 
+  THEN
+;
+
+\ provide first level debug support
+#include "debug.fs"
+\ provide 7.5.3.1 Dictionary search
+#include "dictionary.fs"
+\ block data access for IO devices - ought to be implemented in engine
+#include "rmove.fs"
+\ provide a simple run time preprocessor
+#include <preprocessor.fs>
+
+: $dnumber base @ >r decimal $number r> base ! ;
+: (.d) base @ >r decimal (.) r> base ! ;
+
+\ IP address conversion
+
+: (ipaddr) ( "a.b.c.d" -- FALSE | n1 n2 n3 n4 TRUE )
+   base @ >r decimal
+   over s" 000.000.000.000" comp 0= IF 2drop false r> base ! EXIT THEN
+   [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
+   [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
+   [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
+   $number IF false r> base ! EXIT THEN
+   true r> base !
+;
+
+: (ipformat)  ( n1 n2 n3 n4 -- str len )
+   base @ >r decimal
+   0 <# # # # [char] . hold drop # # # [char] . hold
+   drop # # # [char] . hold drop # # #s #>
+   r> base !
+;
+
+: ipformat  ( n1 n2 n3 n4 -- ) (ipformat) type ;
+
+
diff --git a/qemu/roms/SLOF/slof/fs/boot.fs b/qemu/roms/SLOF/slof/fs/boot.fs
new file mode 100644
index 000000000..9a0ded0c2
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/boot.fs
@@ -0,0 +1,300 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+0 VALUE load-size
+0 VALUE go-entry
+VARIABLE state-valid false state-valid !
+CREATE go-args 2 cells allot go-args 2 cells erase
+
+\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
+
+: $bootargs
+   bootargs 2@ ?dup IF
+   ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate
+   ELSE s" boot-file" evaluate THEN THEN
+;
+
+: $bootdev ( -- device-name len )
+   bootdevice 2@ dup IF s"  " $cat THEN
+   s" diagnostic-mode?" evaluate IF
+      s" diag-device" evaluate
+   ELSE
+      s" boot-device" evaluate
+   THEN
+   $cat \ prepend bootdevice setting from vpd-bootlist
+   strdup
+   ?dup 0= IF
+      disable-watchdog
+      drop true ABORT" No boot device!"
+   THEN
+;
+
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ *
+\ *
+: set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ;
+
+: (set-boot-device) ( str len -- )
+   ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2!
+;
+
+' (set-boot-device) to set-boot-device
+
+: (add-boot-device) ( str len -- )	\ Concatenate " str" to "bootdevice"
+   bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device
+;
+
+' (add-boot-device) to add-boot-device
+
+0 value claim-list
+
+: no-go ( -- ) -64 boot-exception-handler ABORT ;
+
+defer go ( -- )
+
+: go-32 ( -- )
+   state-valid @ IF
+      0 ciregs >r3 ! 0 ciregs >r4 !
+      go-args 2@ go-entry start-elf client-data
+      claim-list elf-release 0 to claim-list
+   THEN
+   -6d boot-exception-handler ABORT
+;
+
+: go-64 ( args len entry r2 -- )
+    0 ciregs >r3 ! 0 ciregs >r4 !
+    start-elf64 client-data
+    claim-list elf-release 0 to claim-list
+;
+
+: set-le ( -- )
+    1 ciregs >r13 !
+;
+
+: set-be ( -- )
+    0 ciregs >r13 !
+;
+
+: go-64-be ( -- )
+    state-valid @ IF
+	set-be
+	go-args 2@
+	go-entry @
+	go-entry 8 + @
+	go-64
+    THEN
+    -6d boot-exception-handler ABORT
+;
+
+
+: go-32-be
+    set-be
+    go-32
+;
+
+: go-32-lev1
+    set-le
+    go-32
+;
+
+: go-64-lev1
+    state-valid @ IF
+	go-args 2@
+	go-entry @ xbflip
+	go-entry 8 + @ xbflip
+	set-le
+	go-64
+    THEN
+    -6d boot-exception-handler ABORT
+;
+
+: go-64-lev2
+    state-valid @ IF
+	go-args 2@
+	go-entry 0
+	set-le
+	go-64
+    THEN
+    -6d boot-exception-handler ABORT
+;
+
+: load-elf-init ( arg len file-addr -- success )
+   false state-valid !                            \ Not valid anymore ...
+   claim-list IF                                    \ Release claimed mem
+      claim-list elf-release 0 to claim-list        \ from last load
+   THEN
+
+   true swap -1                       ( arg len true file-addr -1 )
+   elf-load-claim                     ( arg len true claim-list entry elftype )
+
+   ( arg len true claim-list entry elftype )
+   CASE
+      1  OF ['] go-32-be   ENDOF           ( arg len true claim-list entry go )
+      2  OF ['] go-64-be   ENDOF           ( arg len true claim-list entry go )
+      3  OF ['] go-64-lev1 ENDOF           ( arg len true claim-list entry go )
+      4  OF ['] go-64-lev2 ENDOF           ( arg len true claim-list entry go )
+      5  OF ['] go-32-lev1 ENDOF           ( arg len true claim-list entry go )
+      dup OF ['] no-go to go
+         2drop 3drop false EXIT   ENDOF                   ( false )
+   ENDCASE
+
+   to go to go-entry to claim-list
+   dup state-valid ! -rot
+
+   2 pick IF
+      go-args 2!
+   ELSE
+      2drop
+   THEN
+;
+
+: init-program ( -- )
+   $bootargs get-load-base ['] load-elf-init CATCH ?dup IF
+      boot-exception-handler
+      2drop 2drop false          \ Could not claim
+   ELSE IF
+         0 ciregs 2dup >r3 ! >r4 !  \ Valid (ELF ) Image
+      THEN
+   THEN
+;
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ Generic device load method:
+\ *
+
+: do-load ( devstr len -- img-size )	\ Device method wrapper
+   use-load-watchdog? IF
+      \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP
+      \ needs 1 second per try and add 1 min to avoid race conditions
+      \ with watchdog timeout.
+      4ec set-watchdog
+   THEN
+   my-self >r current-node @ >r         \ Save my-self
+   ." Trying to load: " $bootargs type ."  from: " 2dup type ."  ... "
+   2dup open-dev dup IF
+      dup to my-self
+      dup ihandle>phandle set-node
+      -rot                              ( ihandle devstr len )
+      my-args nip 0= IF
+	 2dup 1- + c@ [char] : <> IF    \ Add : to device path if missing
+	    1+ strdup 2dup 1- + [char] : swap c!
+	 THEN
+      THEN
+      encode-string s" bootpath" set-chosen
+      $bootargs encode-string s" bootargs" set-chosen
+      get-load-base s" load" 3 pick ['] $call-method CATCH IF
+	-67 boot-exception-handler 3drop drop false
+      ELSE
+	 dup 0> IF
+	    init-program
+	 ELSE
+	    false state-valid !
+	    drop 0                                     \ Could not load
+	 THEN
+      THEN
+      swap close-dev device-end dup to load-size
+   ELSE -68 boot-exception-handler 3drop false THEN
+   r> set-node r> to my-self                           \ Restore my-self
+;
+
+: parse-load ( "{devlist}" -- success )	\ Parse-execute boot-device list
+   cr BEGIN parse-word dup WHILE
+	 ( de-alias ) do-load dup 0< IF drop 0 THEN IF
+	    state-valid @ IF ."   Successfully loaded" cr THEN
+	    true 0d parse strdup load-list 2! EXIT
+	 THEN
+   REPEAT 2drop 0 0 load-list 2! false
+;
+
+: load ( "{params}<eol>"} -- success )	\ Client interface to load
+   parse-word 0d parse -leading 2swap ?dup IF
+      de-alias
+      set-boot-device
+   ELSE
+      drop
+   THEN
+   set-boot-args s" parse-load " $bootdev $cat strdup evaluate
+;
+
+: load-next ( -- success )	\ Continue after go failed
+   load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
+   ELSE drop false THEN
+;
+
+\ \\\\\\\\\\\\\\\\\\\\\\\\\\
+\ load/go utilities
+\ -> Should be in loaders.fs
+
+: noload false ;
+
+' no-go to go
+
+: (go-and-catch)  ( -- )
+   \ Recommended Practice: Forth Source Support (scripts starting with comment)
+   get-load-base c@ 5c =  get-load-base 1+ c@ 20 = AND IF
+      load-size alloc-mem            ( allocated-addr )
+      ?dup 0= IF ." alloc-mem failed." cr EXIT THEN
+      load-size >r >r                ( R: allocate-addr load-size )
+      get-load-base r@ load-size move    \ Move away from load-base
+      r@ load-size evaluate          \ Run the script
+      r> r> free-mem
+      EXIT
+   THEN
+   \ Assume it's a normal executable, use "go" to run it:
+   ['] go behavior CATCH IF -69 boot-exception-handler THEN
+;
+
+
+\ if the board does not get the bootlist from the nvram
+\ then this word is supposed to be overloaded with the
+\ word to get the bootlist from VPD (or from wheresoever)
+read-bootlist
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ IEEE 1275 : load (user interface)
+\ *
+: boot
+   load 0= IF -65 boot-exception-handler EXIT THEN
+   disable-watchdog (go-and-catch)
+   BEGIN load-next WHILE
+      disable-watchdog (go-and-catch)
+   REPEAT
+
+   \ When we return from boot print the banner again.
+   .banner
+;
+
+: load load 0= IF -65 boot-exception-handler THEN ;
+
+\ \\\\ Temporary hacks for backwards compatibility
+: yaboot ." Use 'boot disk' instead " ;
+
+: netboot ( -- rc ) ." Use 'boot net' instead " ;
+
+: netboot-arg ( arg-string -- rc )
+   s" boot net " 2swap $cat (parse-line) $cat
+   evaluate
+;
+
+: netload ( -- rc ) (parse-line)
+   load-base-override >r flash-load-base to load-base-override
+   s" load net:" strdup 2swap $cat strdup evaluate
+   r> to load-base-override
+   load-size
+;
+
+: neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;
+
diff --git a/qemu/roms/SLOF/slof/fs/bootmsg.fs b/qemu/roms/SLOF/slof/fs/bootmsg.fs
new file mode 100644
index 000000000..524d46908
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/bootmsg.fs
@@ -0,0 +1,74 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+create debugstr 255 allot
+0 VALUE debuglen
+\ tbl@ d# 1000 * 196e6aa / VALUE TIME1
+\ 0 VALUE TIME2
+
+\ Usage: 42 cp
+: cp ( checkpoint -- )
+  \ cr depth 2 0.r s"  : " type .s cr  \ DEBUG
+  \ cr ." time: " tbl@ d# 1000 * 196e6aa / dup TIME1 - dup . cr TIME2 + TO TIME2 TO TIME1
+  bootmsg-cp ;
+
+: (warning) ( id level ptr len -- )
+  dup TO debuglen
+  debugstr swap move           \ copy into buffer
+  0 debuglen debugstr + c!     \ terminate '\0'
+  debugstr bootmsg-warning
+;
+
+\ Usage: 42 0 warning" warning-txt"
+: warning" ( id level [text<">] -- )
+  postpone s" state @
+  IF
+    ['] (warning) compile,
+  ELSE
+    (warning)
+  THEN
+; immediate
+
+: (debug-cp) ( id level ptr len -- )
+  dup TO debuglen
+  debugstr swap move           \ copy into buffer
+  0 debuglen debugstr + c!     \ terminate '\0'
+  debugstr bootmsg-debugcp
+;
+
+\ Usage: 42 0 debug-cp" debug-cp-txt"
+: debug-cp" ( id level [text<">] -- )
+  postpone s" state @
+  IF
+    ['] (debug-cp) compile,
+  ELSE
+    (debug-cp)
+  THEN
+; immediate
+
+: (error) ( id ptr len -- )
+  dup TO debuglen
+  debugstr swap move           \ copy into buffer
+  0 debuglen debugstr + c!     \ terminate '\0'
+  debugstr bootmsg-error
+;
+
+\ Usage: 42 error" error-txt"
+: error" ( id level [text<">] -- )
+  postpone s" state @
+  IF
+    ['] (error) compile,
+  ELSE
+    (error)
+  THEN
+; immediate
+
+bootmsg-nvupdate
diff --git a/qemu/roms/SLOF/slof/fs/claim.fs b/qemu/roms/SLOF/slof/fs/claim.fs
new file mode 100644
index 000000000..d012d3db8
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/claim.fs
@@ -0,0 +1,415 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ \\\\\\\\\\\\\\ Constants
+500 CONSTANT AVAILABLE-SIZE
+4000 CONSTANT MIN-RAM-RESERVE \ prevent from using first pages
+
+: MIN-RAM-SIZE         \ Initially available memory size
+   epapr-ima-size IF
+      epapr-ima-size
+   ELSE
+      20000000         \ assumed minimal memory size
+   THEN
+;
+MIN-RAM-SIZE CONSTANT MIN-RAM-SIZE
+
+\ \\\\\\\\\\\\\\ Structures
+\ +
+\ The available element size depends strictly on the address/size
+\ value formats and will be different for various device types
+\ +
+STRUCT
+	cell field available>address
+	cell field available>size
+CONSTANT /available
+
+
+\ \\\\\\\\\\\\\\ Global Data
+CREATE available AVAILABLE-SIZE /available * allot available AVAILABLE-SIZE /available * erase
+VARIABLE mem-pre-released 0 mem-pre-released !
+
+\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
+: available>size@	available>size @ ;
+: available>address@	available>address @ ;
+: available>size!	available>size ! ;
+: available>address!	available>address ! ;
+
+: available! ( addr size available-ptr -- )
+	dup -rot available>size! available>address!
+;
+
+: available@ ( available-ptr -- addr size )
+	dup available>address@ swap available>size@
+;
+
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ +
+\ Warning: They are not yet really independent from available formatting
+\ +
+
+\ +
+\ Find position in the "available" where given range exists or can be inserted,
+\ return pointer and logical found/notfound value
+\ If error, return NULL pointer in addition to notfound code
+\ +
+: (?available-segment<) ( start1 end1 start2 end2 -- true/false ) drop < nip ;
+
+: (?available-segment>) ( start1 end1 start2 end2 -- true/false ) -rot 2drop > ;
+
+\ start1 to end1 is the area that should be claimed
+\ start2 to end2 is the available segment
+\ return true if it can not be claimed, false if it can be claimed
+: (?available-segment-#) ( start1 end1 start2 end2 -- true/false )
+	2dup 5 roll -rot                ( e1 s2 e2 s1 s2 e2 )
+	between >r between r> and not
+;
+
+: (find-available) ( addr addr+size-1 a-ptr a-size -- a-ptr' found )
+	?dup 0= IF -rot 2drop false EXIT THEN	\ Not Found
+
+	2dup 2/ dup >r /available * +
+	( addr addr+size-1 a-ptr a-size a-ptr'  R: a-size' )
+	dup available>size@ 0= IF 2drop r> RECURSE EXIT THEN
+
+	( addr addr+size-1 a-ptr a-size a-ptr'  R: a-size' )
+	dup >r available@
+	( addr addr+size-1 a-ptr a-size addr' size'  R: a-size' a-ptr' )
+	over + 1- 2>r 2swap
+	( a-ptr a-size addr addr+size-1 )
+	( R: a-size' a-ptr' addr' addr'+size'-1 )
+
+	2dup 2r@ (?available-segment>) IF
+		2swap 2r> 2drop r>
+		/available + -rot r> - 1- nip RECURSE EXIT	\ Look Right
+	THEN
+	2dup 2r@ (?available-segment<) IF
+		2swap 2r> 2drop r>
+		2drop r> RECURSE EXIT	\ Look Left
+	THEN
+	2dup 2r@ (?available-segment-#) IF	\ Conflict - segments overlap
+		2r> 2r> 3drop 3drop 2drop
+		1212 throw
+	THEN
+	2r> 3drop 3drop r> r> drop	( a-ptr' -- )
+	dup available>size@ 0<>		( a-ptr' found -- )
+;
+
+: (find-available) ( addr size -- seg-ptr found )
+	over + 1- available AVAILABLE-SIZE ['] (find-available) catch IF
+		2drop 2drop 0 false
+	THEN
+;
+
+
+: dump-available ( available-ptr -- )
+	cr
+	dup available - /available / AVAILABLE-SIZE swap - 0 ?DO
+		dup available@ ?dup 0= IF
+			2drop UNLOOP EXIT
+		THEN
+		swap . . cr
+		/available +
+	LOOP
+	dup
+;
+
+: .available available dump-available ;
+
+\ +
+\ release utils:
+\ +
+
+\ +
+\ (drop-available) just blindly compresses space of available map
+\ +
+: (drop-available) ( available-ptr -- )
+	dup available - /available /	\ current element index
+	AVAILABLE-SIZE swap -		\ # of remaining elements
+
+	( first nelements ) 1- 0 ?DO
+		dup /available + dup available@
+
+		( current next next>address next>size ) ?dup 0= IF
+			2drop LEAVE \ NULL element - goto last copy
+		THEN
+		3 roll available!		( next )
+	LOOP
+
+	\ Last element : just zero it out
+	0 0 rot available!
+;
+
+\ +
+\ (stick-to-previous-available) merge the segment on stack
+\ with the previous one, if possible, and modified segment parameters if merged
+\ Return success code
+\ +
+: (stick-to-previous-available) ( addr size available-ptr -- naddr nsize nptr success )
+	dup available = IF
+		false EXIT		\ This was the first available segment
+	THEN
+
+	dup /available - dup available@
+	+ 4 pick = IF
+		nip	\ Drop available-ptr since we are going to previous one
+		rot drop	\ Drop start addr, we take the previous one
+
+		dup available@ 3 roll + rot true
+		( prev-addr prev-size+size prev-ptr true )
+	ELSE
+		drop false
+		( addr size available-ptr false )
+	THEN
+;
+
+\ +
+\ (insert-available) just blindly makes space for another element on given
+\ position
+\ +
+\ insert-available should also check adjacent elements and merge if new
+\ region is contiguos w. others
+\ +
+: (insert-available) ( available-ptr -- available-ptr )
+	dup				\ current element
+	dup available - /available /	\ current element index
+	AVAILABLE-SIZE swap -		\ # of remaining elements
+
+	dup 0<= 3 pick available>size@ 0= or IF
+		\ End of "available" or came to an empty element - Exit
+		drop drop EXIT
+	THEN
+
+	over available@ rot
+
+	( first	first/=current/ first>address first>size nelements ) 1- 0 ?DO
+		2>r
+		( first current R: current>address current>size )
+
+		/available + dup available@
+		( first current+1/=next/ next>address next>size )
+		( R: current>address current>size )
+
+		2r> 4 pick available! dup 0= IF
+			\ NULL element - last copy
+			rot /available + available!
+			UNLOOP EXIT
+		THEN
+	LOOP
+
+	( first next/=last/ last[0]>address last[0]>size ) ?dup 0<> IF
+		cr ." release error: available map overflow"
+		cr ." Dumping available property"
+		.available
+		cr ." No space for one before last entry:" cr swap . .
+		cr ." Dying ..." cr 123 throw
+	THEN
+
+	2drop
+;
+
+: insert-available ( addr size available-ptr -- addr size available-ptr )
+	dup available>address@ 0<> IF
+		\ Not empty :
+		dup available>address@ rot dup -rot -
+
+		( addr available-ptr size available>address@-size )
+
+		3 pick = IF	\ if (available>address@ - size == addr)
+			\ Merge w. next segment - no insert needed
+
+			over available>size@ + swap
+			( addr size+available>size@ available-ptr )
+
+			(stick-to-previous-available) IF
+				\ Merged w. prev & next one : discard extra seg
+				dup /available + (drop-available)
+			THEN
+		ELSE
+			\ shift the rest of "available" to make space
+
+			swap (stick-to-previous-available)
+			not IF (insert-available) THEN
+		THEN
+	ELSE
+		(stick-to-previous-available) drop
+	THEN
+;
+
+defer release
+
+\ +
+\ claim utils:
+\ +
+: drop-available ( addr size available-ptr -- addr )
+	dup >r available@
+	( req_addr req_size segment_addr segment_size	R: available-ptr )
+
+	over 4 pick swap - ?dup 0<> IF
+		\ Segment starts before requested address : free the head space
+		dup 3 roll swap r> available! -
+
+		( req_addr req_size segment_size-segment_addr+req_addr )
+		over - ?dup 0= IF
+			\ That's it - remainder of segment is what we claim
+			drop
+		ELSE
+			\ Both head and tail of segment remain unclaimed :
+			\ need an extra available element
+			swap 2 pick + swap release
+		THEN
+	ELSE
+		nip ( req_addr req_size segment_size )
+		over - ?dup 0= IF
+			\ Exact match : drop the whole available segment
+			drop r> (drop-available)
+		ELSE
+			\ We claimed the head, need to leave the tail available
+			-rot over + rot r> available!
+		THEN
+	THEN
+	( base	R: -- )
+;
+
+: pwr2roundup ( value -- pwr2value )
+	dup CASE
+		0 OF EXIT ENDOF
+		1 OF EXIT ENDOF
+	ENDCASE
+	dup 1 DO drop i dup +LOOP
+	dup +
+;
+
+: (claim-best-fit) ( len align -- len base )
+	pwr2roundup 1- -1 -1
+	( len align-1 best-fit-residue/=-1/ best-fit-base/=-1/ )
+
+	available AVAILABLE-SIZE /available * + available DO
+		i		\ Must be saved now, before we use Return stack
+		-rot >r >r swap >r
+
+		( len i		R: best-fit-base best-fit-residue align-1 )
+
+		available@ ?dup 0= IF drop r> r> r> LEAVE THEN		\ EOL
+
+		2 pick - dup 0< IF
+			2drop			\ Can't Fit: Too Small
+		ELSE
+			dup 2 pick r@ and - 0< IF
+				2drop		\ Can't Fit When Aligned
+			ELSE
+				( len i>address i>size-len )
+				( R: best-fit-base best-fit-residue align-1 )
+				r> -rot dup r@ U< IF
+					\ Best Fit so far: drop the old one
+					2r> 2drop
+
+					( len align-1 nu-base nu-residue   R: )
+					\ Now align new base and push to R:
+					swap 2 pick + 2 pick invert and >r >r >r
+				ELSE
+					2drop >r
+				THEN
+			THEN
+		THEN
+		r> r> r>
+	/available +LOOP
+
+	-rot 2drop	( len best-fit-base/or -1 if none found/ )
+;
+
+: (adjust-release0) ( 0 size -- addr' size' )
+	\ segment 0 already pre-relased in early phase: adjust
+	2dup MIN-RAM-SIZE dup 3 roll + -rot -
+	dup 0< IF 2drop ELSE
+		2swap 2drop 0 mem-pre-released !
+	THEN
+;
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ +
+\ IEEE 1275 implementation:
+\ 	claim
+\ Claim the region with given start address and size (if align parameter is 0);
+\ alternatively claim any region of given alignment
+\ +
+\ Throw an exception if failed
+\ +
+: claim ( [ addr ] len align -- base )
+	?dup 0<> IF
+		(claim-best-fit) dup -1 = IF
+			2drop cr ." claim error : aligned allocation failed" cr
+			." available:" cr .available
+			321 throw EXIT
+		THEN
+		swap
+	THEN
+
+	2dup (find-available) not IF
+		drop
+\ 		cr ." claim error : requested " . ." bytes of memory at " .
+\ 		." not available" cr
+\ 		." available:" cr .available
+		2drop
+		321 throw EXIT
+	THEN
+	( req_addr req_size available-ptr ) drop-available
+
+	( req_addr )
+;
+
+
+\ +
+\ IEEE 1275 implementation:
+\ 	release
+\ Free the region with given start address and size
+\ +
+: .release ( addr len -- )
+	over 0= mem-pre-released @ and IF (adjust-release0) THEN
+
+	2dup (find-available) IF
+		drop swap
+		cr ." release error: region " . ." , " . ." already released" cr
+	ELSE
+		?dup 0= IF
+			swap 
+			cr ." release error: Bad/conflicting region " . ." , " .
+			." or available list full " cr
+		ELSE
+			( addr size available-ptr ) insert-available
+
+			\ NOTE: insert did not change the stack layout
+			\ 	but it may have changed any of the three values
+			\ 	in order to implement merge of free regions
+			\ 	We do not interpret these values any more
+			\ 	just blindly copy it in
+
+			( addr size available-ptr ) available!
+		THEN
+	THEN
+;
+
+' .release to release
+
+
+\ pre-release minimal memory size
+0 MIN-RAM-SIZE release 1 mem-pre-released !
+
+\ claim first pages used for PPC exception vectors
+0 MIN-RAM-RESERVE 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop
+
+\ claim region used by firmware (assume 31 MiB size right now)
+paflof-start ffff not and 1f00000 0 ' claim CATCH IF
+   ." claim failed!" cr 2drop
+THEN drop
diff --git a/qemu/roms/SLOF/slof/fs/client.fs b/qemu/roms/SLOF/slof/fs/client.fs
new file mode 100644
index 000000000..1b2bb0326
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/client.fs
@@ -0,0 +1,299 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Client interface.
+
+0 VALUE debug-client-interface?
+
+\ First, the machinery.
+
+VOCABULARY client-voc \ We store all client-interface callable words here.
+
+6789  CONSTANT  sc-exit
+4711  CONSTANT  sc-yield
+
+VARIABLE  client-callback \ Address of client's callback function
+
+: client-data  ciregs >r3 @ ;
+: nargs  client-data la1+ l@ ;
+: nrets  client-data la1+ la1+ l@ ;
+: client-data-to-stack
+  client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ;
+: stack-to-client-data
+  client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ;
+
+: call-client ( args len client-entry -- )
+  \ (args, len) describe the argument string, client-entry is the address of
+  \ the client's .entry symbol, i.e. where we eventually branch to.
+  \ ciregs is a variable that describes the register set of the host processor,
+  \ see slof/fs/exception.fs for details
+  \ client-entry-point maps to client_entry_point in slof/entry.S which is
+  \ the SLOF entry point when calling a SLOF client interface word from the
+  \ client.
+  \ We pass the arguments for the client in R6 and R7, the client interface
+  \ entry point address is passed in R5.
+  >r  ciregs >r7 !  ciregs >r6 !  client-entry-point @ ciregs >r5 !
+  \ Initialise client-stack-pointer
+  cistack ciregs >r1 !
+  \ jump-client maps to call_client in slof/entry.S
+  \ When jump-client returns, R3 holds the address of a NUL-terminated string
+  \ that holds the client interface word the client wants to call, R4 holds
+  \ the return address.
+  r> jump-client drop
+  BEGIN
+    client-data-to-stack
+    \ Now create a Forth-style string, look it up in the client dictionary and
+    \ execute it, guarded by CATCH. Result of xt == 0 is stored on the return
+    \ stack
+    client-data l@ zcount
+    \ XXX: Should only look in client-voc...
+    ALSO client-voc $find PREVIOUS
+    dup 0= >r IF 
+      CATCH
+      \ If a client interface word needs some special treatment, like exit and
+      \ yield, then the implementation needs to use THROW to indicate its needs
+      ?dup IF
+        dup CASE
+          sc-exit OF drop r> drop EXIT ENDOF
+          sc-yield OF drop r> drop EXIT ENDOF
+        ENDCASE
+        \ Some special call was made but we don't know that to do with it...
+        THROW
+      THEN
+      stack-to-client-data
+    ELSE
+      cr type ."  NOT FOUND"
+    THEN
+    \ Return to the client
+    r> ciregs >r3 !  ciregs >r4 @ jump-client 
+  UNTIL ;
+
+: flip-stack ( a1 ... an n -- an ... a1 )  ?dup IF 1 ?DO i roll LOOP THEN ;
+
+: (callback) ( "service-name<>" "arguments<cr>" -- )
+  client-callback @  \ client-callback points to the function prolog
+  dup 8 + @ ciregs >r2 !  \ Set up the TOC pointer (???)
+  @ call-client ;  \ Resolve the function's address from the prolog
+' (callback) to callback
+
+: (continue-client)
+  s" "  \ make call-client happy, client won't use the string anyways.
+  ciregs >r4 @ call-client ;
+' (continue-client) to continue-client
+
+\ Utility.
+: string-to-buffer ( str len buf len -- len' )
+  2dup erase rot min dup >r move r> ;
+
+\ Now come the actual client interface words.
+
+ALSO client-voc DEFINITIONS
+
+: exit  sc-exit THROW ;
+
+: yield  sc-yield THROW ;
+
+: test ( zstr -- missing? )
+   \ XXX: Should only look in client-voc...
+   zcount
+   debug-client-interface? IF
+      ." ci: test " 2dup type cr
+   THEN
+   ALSO client-voc $find PREVIOUS IF
+      drop FALSE
+   ELSE
+      2drop TRUE
+   THEN 
+;
+
+: finddevice ( zstr -- phandle )
+   zcount
+   debug-client-interface? IF
+      ." ci: finddevice " 2dup type cr
+   THEN
+   2dup " /memory" str= IF
+     \ Workaround: grub passes /memory instead of /memory@0
+     2drop
+     " /memory@0"
+   THEN
+   find-node dup 0= IF drop -1 THEN
+;
+
+: getprop ( phandle zstr buf len -- len' )
+   >r >r zcount rot                     ( str-adr str-len phandle   R: len buf )
+   debug-client-interface? IF
+      ." ci: getprop " 3dup . ." '" type ." '"
+   THEN
+   get-property
+   debug-client-interface? IF
+      dup IF ."  ** not found **" THEN
+      cr
+   THEN
+   0= IF
+      r> swap dup r> min swap >r move r>
+   ELSE
+      r> r> 2drop -1
+   THEN
+;
+
+: getproplen ( phandle zstr -- len )
+  zcount rot get-property 0= IF nip ELSE -1 THEN ;
+
+: setprop ( phandle zstr buf len -- size|-1 )
+   dup >r            \ save len
+   encode-bytes      ( phandle zstr prop-addr prop-len )
+   2swap zcount rot  ( prop-addr prop-len name-addr name-len phandle )
+   current-node @ >r \ save current node
+   set-node          \ change to specified node
+   property          \ set property
+   r> set-node       \ restore original node
+   r>                \ always return size, because we can not fail.
+;
+
+\ VERY HACKISH
+: canon ( zstr buf len -- len' )
+   2dup erase
+   >r >r zcount
+   >r dup c@ [char] / = IF
+      r> r> swap r> over >r min move r>
+   ELSE
+      r> find-alias ?dup 0= IF
+         r> r> 2drop -1
+      ELSE
+         dup -rot r> swap r> min move
+      THEN
+   THEN
+;
+
+: nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok
+  >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ; 
+
+: open ( zstr -- ihandle )
+   zcount
+   debug-client-interface? IF
+      ." ci: open " 2dup type cr
+   THEN
+   open-dev
+;
+
+: close ( ihandle -- )
+    debug-client-interface? IF
+	." ci: close " dup . cr
+    THEN
+    s" stdin" get-chosen IF
+	decode-int nip nip over = IF
+	    \ End of life of SLOF now, call platform quiesce as quiesce
+	    \ is an undocumented extension and not everybody supports it
+	    close-dev
+	    quiesce
+	ELSE
+	    close-dev
+	THEN
+    ELSE
+	close-dev
+    THEN
+;
+
+\ Now implemented: should return -1 if no such method exists in that node
+: write ( ihandle str len -- len' )      rot s" write" rot
+	['] $call-method CATCH IF 2drop 3drop -1 THEN ;
+: read  ( ihandle str len -- len' )      rot s" read"  rot
+	['] $call-method CATCH IF 2drop 3drop -1 THEN ;
+: seek  ( ihandle hi lo -- status  ) swap rot s" seek" rot
+	['] $call-method CATCH IF 2drop 3drop -1 THEN ;
+
+\ A real claim implementation: 3.2% memory fat :-)
+: claim  ( addr len align -- base )
+   debug-client-interface? IF
+      ." ci: claim " .s cr
+   THEN
+   dup  IF  rot drop
+      ['] claim CATCH  IF  2drop -1  THEN
+   ELSE
+      ['] claim CATCH  IF  3drop -1  THEN
+   THEN
+;
+
+: release ( addr len -- )
+   debug-client-interface? IF
+      ." ci: release " .s cr
+   THEN
+   release
+;
+
+: instance-to-package ( ihandle -- phandle )
+  ihandle>phandle ;
+
+: package-to-path ( phandle buf len -- len' )
+  2>r node>path 2r> string-to-buffer ;
+: instance-to-path ( ihandle buf len -- len' )
+  2>r instance>path 2r> string-to-buffer ;
+: instance-to-interposed-path ( ihandle buf len -- len' )
+  2>r instance>qpath 2r> string-to-buffer ;
+
+: call-method ( str ihandle arg ... arg -- result return ... return )
+  nargs flip-stack zcount
+  debug-client-interface? IF
+     ." ci: call-method " 2dup type cr
+  THEN
+  rot ['] $call-method CATCH
+  nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result
+     dup IF nrets 1 ?DO -444 LOOP THEN
+     nrets flip-stack 
+  THEN
+;
+
+\ From the PAPR.
+: test-method ( phandle str -- missing? )
+   zcount
+   debug-client-interface? IF
+      ." ci: test-method " 2dup type cr
+   THEN
+   rot find-method dup IF nip THEN 0=
+;
+
+: milliseconds  milliseconds ;
+
+: start-cpu ( phandle addr r3 -- )
+  >r >r 
+  s" reg" rot get-property 0= IF drop l@ 
+    ELSE true ABORT" start-cpu called with invalid phandle" THEN 
+  r> r> of-start-cpu drop
+;
+
+\ Quiesce firmware and assert that all hardware is in a sane state
+\ (e.g. assert that no background DMA is running anymore)
+: quiesce  ( -- )
+   debug-client-interface? IF
+      ." ci: quiesce" cr
+   THEN
+   \ The main quiesce call is defined in quiesce.fs
+   quiesce
+;
+
+\
+\ User Interface, defined in 6.3.2.6
+\
+: interpret ( ... zstr -- result ... )
+   zcount
+   debug-client-interface? IF
+      ." ci: interpret " 2dup type cr
+   THEN
+   ['] evaluate CATCH
+;
+
+\ Allow the client to register a callback
+: set-callback ( newfunc -- oldfunc )
+  client-callback @ swap client-callback ! ;
+
+PREVIOUS DEFINITIONS
diff --git a/qemu/roms/SLOF/slof/fs/debug.fs b/qemu/roms/SLOF/slof/fs/debug.fs
new file mode 100644
index 000000000..e54f729fe
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/debug.fs
@@ -0,0 +1,422 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Get the name of Forth command whose execution token is xt
+
+: xt>name ( xt -- str len )
+    BEGIN
+	cell - dup c@ 0 2 within IF
+	    dup 2+ swap 1+ c@ exit
+	THEN
+    AGAIN
+;
+
+cell -1 * CONSTANT -cell
+: cell- ( n -- n-cell-size )
+   [ cell -1 * ] LITERAL +
+;
+
+\ Search for xt of given address
+: find-xt-addr ( addr -- xt )
+   BEGIN
+      dup @ <colon> = IF
+	 EXIT
+      THEN
+      cell-
+   AGAIN
+;
+
+: (.immediate) ( xt -- )
+   \ is it immediate?
+   xt>name drop 2 - c@ \ skip len and flags
+   immediate? IF
+     ."  IMMEDIATE"
+   THEN
+;
+
+: (.xt) ( xt -- )
+   xt>name type
+;
+
+\ Trace back on current return stack.
+\ Start at 1, since 0 is return of trace-back itself
+
+: trace-back (  )
+   1
+   BEGIN
+      cr dup dup . ."  : " rpick dup . ."  : "
+      ['] tib here within IF
+	  dup rpick find-xt-addr (.xt)
+      THEN
+      1+ dup rdepth 5 - >= IF cr drop EXIT THEN
+   AGAIN
+;
+
+VARIABLE see-my-type-column
+
+: (see-my-type) ( indent limit xt str len -- indent limit xt )
+   dup see-my-type-column @ + dup 50 >= IF
+      -rot over "  " comp 0= IF
+         \ blank causes overflow: just enforce new line with next call
+         2drop see-my-type-column !
+      ELSE
+         rot drop                     ( indent limit xt str len )
+         \ Need to copy string since we use (u.) again (kills internal buffer):
+         pocket swap 2dup >r >r       ( indent limit xt str pk len  R: len pk )
+         move r> r>                   ( indent limit xt pk len )
+         2 pick (u.) dup -rot
+         cr type                      ( indent limit xt pk len xt-len )
+         " :" type 1+                 ( indent limit xt pk len prefix-len )
+         5 pick dup spaces +          ( indent limit xt pk len prefix-len )
+         over + see-my-type-column !  ( indent limit xt pk len )
+         type
+      THEN                            ( indent limit xt )
+   ELSE
+      see-my-type-column ! type       ( indent limit xt )
+   THEN
+;
+
+: (see-my-type-init) ( -- )
+   ffff see-my-type-column !        \ just enforce a new line
+;
+
+: (see-colon-body) ( indent limit xt -- indent limit xt )
+   (see-my-type-init)                              \ enforce new line
+   BEGIN                                           ( indent limit xt )
+      cell+ 2dup <>
+      over @
+      dup <semicolon> <>
+      rot and			                   ( indent limit xt @xt flag )
+   WHILE                                           ( indent limit xt @xt )
+      xt>name (see-my-type) "  " (see-my-type)
+      dup @                                        ( indent limit xt @xt)
+      CASE
+	 <0branch>  OF cell+ dup @
+                    over + cell+ dup >r
+                    (u.) (see-my-type) r>          ( indent limit xt target)
+                    2dup < IF
+                       over 4 pick 3 + -rot recurse
+                       nip nip nip cell-           ( indent limit xt )
+                    ELSE
+                       drop                        ( indent limit xt )
+                    THEN
+                    (see-my-type-init) ENDOF       \ enforce new line
+	 <branch>   OF cell+ dup @ over + cell+ (u.)
+                    (see-my-type) "  " (see-my-type) ENDOF
+	 <do?do>    OF cell+ dup @ (u.) (see-my-type)
+                    "  " (see-my-type) ENDOF
+	 <lit>      OF cell+ dup @ (u.) (see-my-type)
+                    "  " (see-my-type) ENDOF
+	 <dotick>   OF cell+ dup @ xt>name (see-my-type)
+                    "  " (see-my-type) ENDOF
+	 <doloop>   OF cell+ dup @ (u.) (see-my-type)
+                    "  " (see-my-type) ENDOF
+	 <do+loop>  OF cell+ dup @ (u.) (see-my-type)
+                    "  " (see-my-type) ENDOF
+	 <doleave>  OF cell+ dup @ over + cell+ (u.)
+                    (see-my-type) "  " (see-my-type) ENDOF
+	 <do?leave> OF cell+ dup @ over + cell+ (u.)
+                    (see-my-type) "  " (see-my-type) ENDOF
+	 <sliteral> OF cell+ " """ (see-my-type) dup count dup >r
+                    (see-my-type) " """ (see-my-type)
+                    "  " (see-my-type)
+                    r> -cell and + ENDOF
+      ENDCASE
+   REPEAT
+   drop
+;
+
+: (see-colon) ( xt -- )
+   (see-my-type-init)
+   1 swap 0 swap                                    ( indent limit xt )
+   " : " (see-my-type) dup xt>name (see-my-type)
+   rot drop 4 -rot (see-colon-body)                 ( indent limit xt )
+   rot drop 1 -rot (see-my-type-init) " ;" (see-my-type)
+   3drop 
+;
+
+\ Create words are a bit tricky. We find out where their code points.
+\ If this code is part of SLOF, it is not a user generated CREATE.
+
+: (see-create) ( xt -- )
+   dup cell+ @
+   CASE
+      <2constant> OF
+         dup cell+ cell+ dup @ swap cell+ @ . .  ." 2CONSTANT "
+      ENDOF
+
+      <instancevalue> OF
+         dup cell+ cell+ @ . ." INSTANCE VALUE "
+      ENDOF
+
+      <instancevariable> OF
+         ." INSTANCE VARIABLE "
+      ENDOF
+
+      dup OF
+         ." CREATE "
+      ENDOF
+   ENDCASE
+   (.xt)
+;
+
+\ Decompile Forth command whose execution token is xt
+
+: (see) ( xt -- )
+   cr dup dup @
+   CASE
+      <variable> OF ." VARIABLE " (.xt) ENDOF
+      <value>    OF dup execute . ." VALUE " (.xt) ENDOF
+      <constant> OF dup execute . ." CONSTANT " (.xt) ENDOF
+      <defer>    OF dup cell+ @ swap ." DEFER " (.xt) ."  is " (.xt) ENDOF
+      <alias>    OF dup cell+ @ swap ." ALIAS " (.xt) ."  " (.xt) ENDOF
+      <buffer:>  OF ." BUFFER: " (.xt) ENDOF
+      <create>   OF (see-create) ENDOF
+      <colon>    OF (see-colon)  ENDOF
+      dup        OF ." ??? PRIM " (.xt) ENDOF
+   ENDCASE
+   (.immediate) cr
+  ;
+
+\ Decompile Forth command old-name
+
+: see ( "old-name<>" -- )
+   ' (see)
+;
+
+\ Work in progress...
+
+0    value forth-ip
+true value trace>stepping?
+true value trace>print?
+true value trace>up?
+0    value trace>depth
+0    value trace>rdepth
+0    value trace>recurse
+: trace-depth+ ( -- ) trace>depth 1+ to trace>depth ;
+: trace-depth- ( -- ) trace>depth 1- to trace>depth ;
+
+: stepping ( -- )
+    true to trace>stepping?
+;
+
+: tracing ( -- )
+    false to trace>stepping?
+;
+
+: trace-print-on ( -- )
+    true to trace>print?
+;
+
+: trace-print-off ( -- )
+    false to trace>print?
+;
+
+
+\ Add n to ip
+
+: fip-add ( n -- )
+   forth-ip + to forth-ip
+;
+
+\ Save execution token address and content
+
+0 value debug-last-xt
+0 value debug-last-xt-content
+
+: trace-print ( -- )
+   forth-ip cr u. ." : "
+   forth-ip @ 
+   dup ['] breakpoint = IF drop debug-last-xt-content THEN
+   xt>name type ."  "
+   ."     ( " .s  ."  )  | "
+;
+
+: trace-interpret ( -- )
+   rdepth 1- to trace>rdepth
+   BEGIN
+      depth . [char] > dup emit emit space
+      source expect                        ( str len )
+      ['] interpret catch print-status
+   AGAIN
+;
+
+\ Main trace routine, trace a colon definition
+
+: trace-xt ( xt -- )
+    trace>recurse IF
+       r> drop                                \ Drop return of 'trace-xt call
+       cell+                                  \ Step over ":"
+    ELSE
+       debug-last-xt-content <colon> = IF
+          \ debug colon-definition
+          ['] breakpoint @ debug-last-xt !    \ Re-arm break point
+          r> drop                             \ Drop return of 'trace-xt call
+          cell+                               \ Step over ":"
+       ELSE
+          ['] breakpoint debug-last-xt !      \ Re-arm break point
+          2r> 2drop
+       THEN
+    THEN
+
+    to forth-ip
+    true to trace>print?
+    BEGIN
+       trace>print? IF trace-print THEN
+
+       forth-ip                                              ( ip )
+       trace>stepping? IF
+	  BEGIN
+             key
+             CASE
+		[char] d OF dup @ @ <colon> = IF             \ recurse only into colon definitions
+			                         trace-depth+
+                                                 1 to trace>recurse
+                                                 dup >r @ recurse
+		                              THEN true ENDOF
+	        [char] u OF trace>depth IF tracing trace-print-off true ELSE false THEN ENDOF
+	        [char] f OF drop cr trace-interpret ENDOF	\ quit trace and start interpreter FIXME rstack
+	        [char] c OF tracing true ENDOF
+		[char] t OF trace-back false ENDOF
+		[char] q OF drop cr quit ENDOF
+	        20       OF true ENDOF
+		dup      OF cr ." Press d:       Down into current word" cr
+		            ." Press u:       Up to caller" cr
+		            ." Press f:       Switch to forth interpreter, 'resume' will continue tracing" cr
+                            ." Press c:       Switch to tracing" cr
+		            ." Press <space>: Execute current word" cr
+		            ." Press q:       Abort execution, switch to interpreter" cr
+		            false ENDOF
+	     ENDCASE
+	  UNTIL
+       THEN	                                              ( ip' )
+       dup to forth-ip @                                      ( xt )
+       dup ['] breakpoint = IF drop debug-last-xt-content THEN
+       dup                                                    ( xt xt )
+
+       CASE
+	    <sliteral>  OF drop forth-ip cell+ dup dup c@ + -cell and to forth-ip ENDOF
+	    <dotick>    OF drop forth-ip cell+ @ cell fip-add ENDOF
+	    <lit>       OF drop forth-ip cell+ @ cell fip-add ENDOF
+	    <doto>      OF drop forth-ip cell+ @ cell+ ! cell fip-add ENDOF
+	    <(doito)>   OF drop forth-ip cell+ @ cell+ cell+ @ >instance ! cell fip-add ENDOF
+	    <0branch>   OF drop IF
+		                    cell fip-add
+		                ELSE
+				    forth-ip cell+ @ cell+ fip-add THEN
+			ENDOF
+            <do?do>     OF drop 2dup <> IF
+				           swap >r >r cell fip-add
+		                        ELSE
+					   forth-ip cell+ @ cell+ fip-add 2drop THEN
+		        ENDOF
+	    <branch>    OF drop forth-ip cell+ @ cell+ fip-add ENDOF
+	    <doleave>   OF drop r> r> 2drop forth-ip cell+ @ cell+ fip-add ENDOF		
+	    <do?leave>  OF drop IF
+		                   r> r> 2drop forth-ip cell+ @ cell+ fip-add
+		                ELSE
+		                   cell fip-add
+		                THEN
+		        ENDOF		
+	    <doloop>    OF drop r> 1+ r> 2dup = IF
+		                                   2drop cell fip-add
+		                                ELSE >r >r
+						    forth-ip cell+ @ cell+ fip-add THEN
+			ENDOF
+	    <do+loop>   OF drop r> + r> 2dup >= IF
+		                                   2drop cell fip-add
+		                                ELSE >r >r
+						    forth-ip cell+ @ cell+ fip-add THEN
+			ENDOF
+
+	    <semicolon> OF trace>depth 0> IF
+		                             trace-depth- 1 to trace>recurse
+                                             stepping drop r> recurse
+		                          ELSE
+		                             drop exit THEN
+			ENDOF
+            <exit>      OF trace>depth 0> IF
+		                             trace-depth- stepping drop r> recurse
+		                          ELSE
+				             drop exit THEN
+			ENDOF
+	    dup         OF execute ENDOF
+	ENDCASE
+	forth-ip cell+ to forth-ip
+    AGAIN
+;
+
+\ Resume execution from tracer
+: resume ( -- )
+    trace>rdepth rdepth!
+    forth-ip cell - trace-xt
+;
+
+\ Turn debug off, by erasing breakpoint
+
+: debug-off ( -- )
+    debug-last-xt IF
+	debug-last-xt-content debug-last-xt !  \ Restore overwritten token
+	0 to debug-last-xt
+    THEN
+;
+
+
+
+\ Entry point for debug
+
+: (break-entry) ( -- )
+   debug-last-xt dup @ ['] breakpoint <> swap  ( debug-addr? debug-last-xt )
+   debug-last-xt-content swap !                \ Restore overwritten token
+   r> drop                                     \ Don't return to bp, but to caller
+   debug-last-xt-content <colon> <> and IF     \ Execute non colon definition
+      debug-last-xt cr u. ." : "
+      debug-last-xt xt>name type ."  "
+      ."     ( " .s  ."  )  | "
+      key drop
+      debug-last-xt execute
+   ELSE
+      debug-last-xt 0 to trace>depth 0 to trace>recurse trace-xt   \ Trace colon definition
+   THEN
+;
+
+\ Put entry point bp defer
+' (break-entry) to BP
+
+\ Mark an address for debugging
+
+: debug-address ( addr --  )
+   debug-off                       ( xt )  \ Remove active breakpoint
+   dup to debug-last-xt            ( xt )  \ Save token for later debug
+   dup @ to debug-last-xt-content  ( xt )  \ Save old value
+   ['] breakpoint swap !
+;
+
+\ Mark the command indicated by xt for debugging
+
+: (debug ( xt --  )
+   debug-off                       ( xt )  \ Remove active breakpoint
+   dup to debug-last-xt            ( xt )  \ Save token for later debug
+   dup @ to debug-last-xt-content  ( xt )  \ Save old value
+   ['] breakpoint @ swap !
+;
+
+\ Mark the command indicated by xt for debugging
+
+: debug ( "old-name<>" -- )
+    parse-word $find IF                       \ Get xt for old-name
+       (debug
+    ELSE
+       ." undefined word " type cr
+    THEN
+;
diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs b/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs
new file mode 100644
index 000000000..271420f03
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs
@@ -0,0 +1,37 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+s" network [ " type my-space pci-class-name type s"  ]" type
+
+my-space pci-device-generic-setup
+my-space pci-alias-net
+
+s" network" device-type
+
+cr
+
+INSTANCE VARIABLE obp-tftp-package
+: open  ( -- okay? )
+   open IF           \ enables PCI mem, io and Bus master and returns TRUE
+      my-args s" obp-tftp" $open-package obp-tftp-package ! true
+   ELSE
+       false
+   THEN ;
+
+: close  ( -- )
+    obp-tftp-package @ close-package
+    close ;         \ disables PCI mem, io and Bus master
+
+: load  ( addr -- len )
+    s" load" obp-tftp-package @ $call-method  ;
+
+: ping  ( -- )  s" ping" obp-tftp-package @ $call-method  ;
diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs b/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs
new file mode 100644
index 000000000..39453fbc0
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs
@@ -0,0 +1,71 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+s" serial bus [ " type my-space pci-class-name type s"  ]" type cr
+
+my-space pci-device-generic-setup
+
+STRUCT
+    /n FIELD hcd>base
+    /n FIELD hcd>type
+    /n FIELD hcd>num
+    /n FIELD hcd>ops
+    /n FIELD hcd>priv
+    /n FIELD hcd>nextaddr
+CONSTANT /hci-dev
+
+: usb-setup-hcidev ( num hci-dev -- )
+    >r
+    10 config-l@ F AND case
+	0 OF 10 config-l@ translate-my-address ENDOF       \ 32-bit memory space
+	4 OF                                               \ 64-bit memory space
+	    14 config-l@ 20 lshift                         \ Read two bars
+	    10 config-l@ OR translate-my-address
+	ENDOF
+    ENDCASE
+    F not AND
+    ( io-base ) r@ hcd>base !
+    08 config-l@ 8 rshift  0000000F0 AND 4 rshift
+    ( usb-type ) r@ hcd>type !
+    ( usb-num )  r@ hcd>num !
+    r> drop
+;
+
+\ Handle USB OHCI controllers:
+: handle-usb-class  ( -- )
+   \ set Memory Write and Invalidate Enable, SERR# Enable
+   \ (see PCI 3.0 Spec Chapter 6.2.2 device control):
+   4 config-w@ 110 or 4 config-w!
+   pci-master-enable               \ set PCI Bus master bit and
+   pci-mem-enable                  \ memory space enable for USB scan
+;
+
+\ Check PCI sub-class and interface type of Serial Bus Controller
+\ to include the appropriate driver:
+: handle-sbc-subclass  ( -- )
+    my-space pci-class@ ffff and CASE         \ get PCI sub-class and interface
+	0310 OF                      \ OHCI controller
+	    handle-usb-class
+	    set-ohci-alias
+	ENDOF
+	0320 OF                      \ EHCI controller
+	    handle-usb-class
+	    set-ehci-alias
+	ENDOF
+	0330 OF                      \ XHCI controller
+	    handle-usb-class
+	    set-xhci-alias
+	ENDOF
+   ENDCASE
+;
+
+handle-sbc-subclass
diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs b/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs
new file mode 100644
index 000000000..bb3b83516
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs
@@ -0,0 +1,49 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+my-space pci-class-name type
+
+my-space pci-device-generic-setup
+
+pci-io-enable
+pci-mem-enable
+
+30 config-l@  pci-find-fcode execute-rom-fcode
+
+: check-display ( nodepath len -- true|false ) \ true if display found and "screen" alias set
+\ check if display available, set screen alias
+2dup find-node \ ( path len phandle|0 ) find node
+?dup IF
+   \ node found, get "display-type" property
+   s" display-type" rot get-property ( path len true|propaddr proplen 0 )
+   0= IF
+      ( path len propaddr proplen ) \ property found, check if the value is not "NONE"
+      s" NONE" 0 char-cat ( path len propaddr proplen str strlen ) \ null-terminated NONE string
+      str= 0= IF
+         ( path len ) \ "display-type" property is not "NONE" so we can set "screen" alias
+         s" screen" 2swap set-alias 
+         true ( true ) \  return true
+      ELSE
+         2drop false ( false ) \ return false
+      THEN
+   THEN
+THEN
+;
+
+get-node node>path s" /NVDA,DISPLAY-A" $cat check-display
+0= IF
+   \ no display found on DISPLAY-A ... check DISPLAY-B
+   get-node node>path s" /NVDA,DISPLAY-B" $cat check-display
+   drop \ drop result 
+THEN
+
+s" name" get-my-property drop s"  ( " type type s"  ) " type cr
diff --git a/qemu/roms/SLOF/slof/fs/dictionary.fs b/qemu/roms/SLOF/slof/fs/dictionary.fs
new file mode 100644
index 000000000..3e5b29332
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/dictionary.fs
@@ -0,0 +1,74 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: words
+   last @
+   BEGIN ?dup WHILE
+     dup cell+ char+ count type space @
+   REPEAT
+;
+
+: .calls    ( xt -- )
+   current-node @ >r 0 set-node    \ only search commands, according too IEEE1275
+
+   last BEGIN @ ?dup WHILE    ( xt currxt )
+      dup cell+ char+         ( xt currxt name* )
+      dup dup c@ + 1+ aligned ( xt currxt name* CFA )
+      dup @ <colon> = IF      ( xt currxt name* CFA )
+         BEGIN
+            cell+ dup @ ['] semicolon <>
+         WHILE		      ( xt currxt *name pos )
+            dup @ 4 pick = IF ( xt currxt *name pos )
+	       over count type space
+	       BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurrences
+            THEN
+         REPEAT
+      THEN
+      2drop ( xt currxt )
+   REPEAT
+   drop
+
+   r> set-node		   \ restore node
+;
+
+0 value #sift-count
+false value sift-compl-only
+
+: $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false )
+   dup cell+ char+ count           \ get word name
+   2dup 6 pick 6 pick find-isubstr \ is there a partly match?
+   \ in tab completion mode the substring has to be at the beginning
+   sift-compl-only IF 0= ELSE over < THEN
+   IF
+      #sift-count 1+ to #sift-count \ count completions
+      true
+   ELSE
+      2drop false
+   THEN
+;
+
+: $sift    ( text-addr text-len -- )
+   current-node @ >r 0 set-node	\ only search commands, according too IEEE1275
+   sift-compl-only >r false to sift-compl-only \ all substrings, not only compl.
+   last BEGIN @ ?dup WHILE	\ walk the whole dictionary
+      $inner-sift IF type space THEN
+   REPEAT
+   2drop
+   0 to #sift-count	   \ we don't need completions here.
+   r> to sift-compl-only    \ restore previous sifting mode
+   r> set-node		   \ restore node
+;
+
+: sifting    ( "text< >" -- )
+   parse-word $sift
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/display.fs b/qemu/roms/SLOF/slof/fs/display.fs
new file mode 100644
index 000000000..5bb8797a2
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/display.fs
@@ -0,0 +1,123 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+0 VALUE char-height
+0 VALUE char-width
+0 VALUE fontbytes
+
+CREATE display-emit-buffer 20 allot
+
+\ \\\\\\\\\\\\\\ Global Data
+
+\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ *
+\ *
+defer dis-old-emit
+' emit behavior to dis-old-emit
+
+: display-write terminal-write ;
+: display-emit dup dis-old-emit display-emit-buffer tuck c! 1 terminal-write drop ;
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ Generic device methods:
+\ *
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ IEEE 1275 : display device driver initialization
+\ *
+: is-install ( 'open -- )
+	s" defer vendor-open to vendor-open" eval
+	s" : open deadbeef vendor-open dup deadbeef = IF drop true ELSE nip THEN ;" eval
+	s" defer write ' display-write to write" eval
+	s" : draw-logo ['] draw-logo CATCH IF 2drop 2drop THEN ;" eval
+	s" : reset-screen ['] reset-screen CATCH drop ;" eval
+;
+
+: is-remove ( 'close -- )
+	s" defer close to close" eval
+;
+
+: is-selftest ( 'selftest -- )
+	s" defer selftest to selftest" eval
+;
+
+
+STRUCT
+	cell FIELD font>addr
+	cell FIELD font>width
+	cell FIELD font>height
+	cell FIELD font>advance
+	cell FIELD font>min-char
+	cell FIELD font>#glyphs
+CONSTANT /font
+
+CREATE default-font-ctrblk /font allot default-font-ctrblk
+	dup font>addr 0 swap !
+	dup font>width 8 swap !
+	dup font>height -10 swap !
+	dup font>advance 1 swap !
+	dup font>min-char 20 swap !
+	font>#glyphs 7f swap !
+
+: display-default-font ( str len -- )
+   romfs-lookup dup 0= IF drop EXIT THEN
+   600 <> IF ." Only support 60x8x16 fonts ! " drop EXIT THEN
+   default-font-ctrblk font>addr !
+;
+
+s" default-font.bin" display-default-font
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ *
+\ *
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ Generic device methods:
+\ *
+: .scan-lines ( height -- scanlines ) dup 0>= IF 1- ELSE negate THEN ;
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ *
+
+: set-font ( addr width height advance min-char #glyphs -- )
+   default-font-ctrblk /font + /font 0
+   DO
+      1 cells - dup >r ! r> 1 cells
+   +LOOP drop
+   default-font-ctrblk dup font>height @ abs to char-height
+   dup font>width @ to char-width font>advance @ to fontbytes
+;
+
+: >font ( char -- addr )
+   dup default-font-ctrblk dup >r font>min-char @ dup r@ font>#glyphs + within
+   IF
+      r@ font>min-char @ -
+      r@ font>advance @ * r@ font>height @ .scan-lines *
+      r> font>addr @ +
+   ELSE
+      drop r> font>addr @
+   THEN
+;
+
+: default-font ( -- addr width height advance min-char #glyphs )
+    default-font-ctrblk /font 0 DO dup cell+ >r @ r> 1 cells +LOOP drop
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/dma-function.fs b/qemu/roms/SLOF/slof/fs/dma-function.fs
new file mode 100644
index 000000000..c1c8716ca
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/dma-function.fs
@@ -0,0 +1,36 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2014 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ DMA memory allocation functions
+: dma-alloc ( size -- virt )
+   my-phandle TO calling-child
+   s" dma-alloc" my-phandle parent $call-static
+   0 TO calling-child
+;
+
+: dma-free ( virt size -- )
+   my-phandle TO calling-child
+   s" dma-free" my-phandle parent $call-static
+   0 TO calling-child
+;
+
+: dma-map-in ( virt size cacheable? -- devaddr )
+   my-phandle TO calling-child
+   s" dma-map-in" my-phandle parent $call-static
+   0 TO calling-child
+;
+
+: dma-map-out ( virt devaddr size -- )
+   my-phandle TO calling-child
+   s" dma-map-out" my-phandle parent $call-static
+   0 TO calling-child
+;
diff --git a/qemu/roms/SLOF/slof/fs/dump.fs b/qemu/roms/SLOF/slof/fs/dump.fs
new file mode 100644
index 000000000..90d60c412
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/dump.fs
@@ -0,0 +1,42 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Hex dump facilities.
+
+1 VALUE /dump
+' c@ VALUE 'dump
+0 VALUE dump-first
+0 VALUE dump-last
+0 VALUE dump-cur
+: .char ( c -- )  dup bl 7f within 0= IF drop [char] . THEN emit ;
+: dump-line ( -- )
+  cr dump-cur dup 8 0.r [char] : emit 10 /dump / 0 DO
+  space dump-cur dump-first dump-last within IF
+  dump-cur 'dump execute /dump 2* 0.r ELSE
+  /dump 2* spaces THEN dump-cur /dump + to dump-cur LOOP
+  /dump 1 <> IF drop EXIT THEN
+  to dump-cur 2 spaces
+  10 0 DO dump-cur dump-first dump-last within IF
+  dump-cur 'dump execute .char ELSE space THEN dump-cur 1+ to dump-cur LOOP ;
+: (dump) ( addr len reader size -- )
+  to /dump to 'dump bounds /dump negate and to dump-first to dump-last
+  dump-first f invert and to dump-cur
+  base @ hex BEGIN dump-line dump-cur dump-last >= UNTIL base ! ;
+: du ( -- )  dump-last 100 'dump /dump (dump) ;
+: dump     ['] c@      1 (dump) ;
+: wdump    ['] w@      2 (dump) ;
+: ldump    ['] l@      4 (dump) ;
+: xdump    ['] x@      8 (dump) ;
+: rdump    ['] rb@     1 (dump) ;
+\ : iodump   ['] io-c@   1 (dump) ;
+\ : siodump  ['] siocfg@ 1 (dump) ;
diff --git a/qemu/roms/SLOF/slof/fs/elf.fs b/qemu/roms/SLOF/slof/fs/elf.fs
new file mode 100644
index 000000000..5a80c78d5
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/elf.fs
@@ -0,0 +1,71 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Claim memory for segment
+\ Abort, if no memory available
+
+false value elf-claim?
+0     value last-claim
+
+\ cur-brk is set by elf loader to end of data segment
+0 VALUE cur-brk
+
+
+: elf-claim-segment ( addr size -- errorcode )
+   2dup
+   elf-claim? IF
+      >r
+      here last-claim , to last-claim                \ Setup ptr to last claim
+      \ Put addr and size in the data space
+      dup , r> dup , ( addr size )
+      0 ['] claim CATCH IF
+         ." Memory for ELF file is already in use!" cr
+         true ABORT" Memory for ELF file already in use "
+      THEN
+      drop
+   ELSE
+      2drop
+   THEN
+   + to cur-brk
+   0 
+;
+
+
+\ Load ELF file and claim the corresponding memory regions.
+\ A destination address can be specified. If the parameter is -1 then
+\ the file is loaded to the ddress that is specified in its header.
+: elf-load-claim ( file-addr destaddr -- claim-list entry imagetype )
+   true to elf-claim?
+   0 to last-claim
+   dup -1 = IF             \ If destaddr == -1 then load to addr from ELF header
+      drop ['] elf-load-file CATCH IF false to elf-claim? ABORT THEN
+   ELSE
+      ['] elf-load-file-to-addr CATCH IF false to elf-claim? ABORT THEN
+   THEN
+   >r
+   last-claim swap
+   false to elf-claim?
+   r>
+;
+
+
+\ Release memory claimed before
+
+: elf-release ( claim-list -- )
+   BEGIN
+      dup cell+                   ( claim-list claim-list-addr )
+      dup @ swap cell+ @          ( claim-list claim-list-addr claim-list-sz )
+      release                     ( claim-list )
+      @ dup 0=                    ( Next-element )
+   UNTIL
+   drop
+;
diff --git a/qemu/roms/SLOF/slof/fs/envvar.fs b/qemu/roms/SLOF/slof/fs/envvar.fs
new file mode 100644
index 000000000..33643130c
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/envvar.fs
@@ -0,0 +1,412 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2012 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ configuration variables
+
+wordlist CONSTANT envvars
+
+\ list the names in  envvars
+: listenv  ( -- )
+   get-current envvars set-current  words  set-current
+;
+
+\ create a definition in  envvars
+: create-env ( "name" -- )
+   get-current  envvars set-current  CREATE  set-current
+;
+
+\ lay out the data for the separate envvar types
+: env-int     ( n -- )  1 c, align , DOES> char+ aligned @ ;
+: env-bytes   ( a len -- )
+   2 c, align dup , here swap dup allot move
+   DOES> char+ aligned dup @ >r cell+ r>
+;
+: env-string  ( str len -- )  3 c, align dup , here over allot swap move DOES> char+ aligned dup @ >r cell+ r> ;
+: env-flag    ( f -- )  4 c, c, DOES> char+ c@ 0<> ;
+: env-secmode ( sm -- )  5 c, c, DOES> char+ c@ ;
+
+\ create default envvars
+: default-int     ( n "name" -- )      create-env env-int ;
+: default-bytes   ( a len "name" -- )  create-env env-bytes ;
+: default-string  ( a len "name" -- )  create-env env-string ;
+: default-flag    ( f "name" -- )      create-env env-flag ;
+: default-secmode ( sm "name" -- )     create-env env-secmode ;
+
+: set-option ( option-name len option len -- )
+   2swap encode-string
+   2swap s" /options" find-node dup IF set-property ELSE drop 2drop 2drop THEN
+;
+
+\ find an envvar's current and default value, and its type
+: findenv ( name len -- adr def-adr type | 0 )
+   2dup envvars voc-find dup 0<> IF ( ABORT" not a configuration variable" )
+      link> >body char+ >r (find-order) link> >body dup char+ swap c@ r> swap
+   ELSE
+      nip nip
+   THEN
+;
+
+
+: test-flag ( param len -- true | false )
+   2dup s" true" string=ci -rot s" false" string=ci or
+;
+
+: test-secmode ( param len -- true | false )
+   2dup s" none" string=ci -rot 2dup s" command" string=ci -rot s" full"
+   string=ci or or
+;
+
+: test-int ( param len -- true | false )
+  $dh-number IF false ELSE drop true THEN
+;
+
+: findtype ( param len name len -- param len name len type )
+   2dup findenv                         \ try to find type of envvar
+   dup IF                               \ found a type?
+      nip nip
+      EXIT
+   THEN
+
+   \ No type found yet, try to auto-detect:
+   drop 2swap
+   2dup test-flag IF
+      4 -rot                         \ boolean type
+   ELSE
+      2dup test-secmode IF
+         5 -rot                      \ secmode type
+      ELSE
+         2dup test-int IF
+            1 -rot                   \ integer type
+         ELSE
+            2dup test-string
+            IF 3 ELSE 2 THEN         \ 3 = string, 2 = default to bytes
+            -rot
+         THEN
+      THEN
+   THEN
+   rot
+   >r 2swap r>
+;
+
+\ set an envvar
+: $setenv ( param len name len -- )
+   4dup set-option
+   findtype
+   -rot $CREATE
+   CASE
+      1 OF $dh-number IF 0 THEN env-int ENDOF \ XXX: wants decimal and 0x...
+      2 OF env-bytes ENDOF
+      3 OF env-string ENDOF
+      4 OF evaluate env-flag ENDOF
+      5 OF evaluate env-secmode ENDOF \ XXX: recognize none, command, full
+   ENDCASE
+;
+
+\ print an envvar
+: (printenv) ( adr type -- )
+   CASE
+   1 OF aligned @ . ENDOF
+   2 OF aligned dup cell+ swap @ swap . . ENDOF
+   3 OF aligned dup @ >r cell+ r> type ENDOF
+   4 OF c@ IF ." true" ELSE ." false" THEN ENDOF
+   5 OF c@ . ENDOF \ XXX: print symbolically
+   ENDCASE
+;
+
+: .printenv-header ( -- )
+   cr
+   s" ---environment variable--------current value-------------default value------"
+   type cr
+;
+
+DEFER old-emit
+0 VALUE emit-counter
+
+: emit-and-count emit-counter 1 + to emit-counter old-emit ;
+
+: .enable-emit-counter
+   0 to emit-counter
+   ['] emit behavior to old-emit
+   ['] emit-and-count to emit
+;
+
+: .disable-emit-counter
+   ['] old-emit behavior to emit
+;
+
+: .spaces ( number-of-spaces -- )
+   dup 0 > IF
+      spaces
+   ELSE
+      drop space
+   THEN
+;
+
+: .print-one-env ( name len -- )
+   3 .spaces
+   2dup dup -rot type 1c swap - .spaces
+   findenv rot over
+   .enable-emit-counter
+   (printenv) .disable-emit-counter
+   1a emit-counter - .spaces
+   (printenv)
+;
+
+: .print-all-env
+   .printenv-header
+   envvars cell+
+   BEGIN
+      @ dup
+   WHILE
+      dup link> >name
+      name>string .print-one-env cr
+   REPEAT
+   drop
+;
+
+: printenv
+   parse-word dup 0= IF
+      2drop .print-all-env
+   ELSE
+      findenv dup 0= ABORT" not a configuration variable"
+      rot over cr ." Current: " (printenv)
+      cr ." Default: " (printenv)
+   THEN
+;
+
+\ set envvar(s) to default value
+: (set-default)  ( def-xt -- )
+   dup >name name>string $CREATE dup >body c@ >r execute r> CASE
+   1 OF env-int ENDOF
+   2 OF env-bytes ENDOF
+   3 OF env-string ENDOF
+   4 OF env-flag ENDOF
+   5 OF env-secmode ENDOF ENDCASE
+;
+
+\ Environment variables might be board specific
+
+#include <envvar_defaults.fs>
+
+VARIABLE nvoff \ offset in envvar partition
+
+: (nvupdate-one) ( adr type -- "value" )
+   CASE
+   1 OF aligned @ (.d) ENDOF
+   2 OF drop 0 0 ENDOF
+   3 OF aligned dup @ >r cell+ r> ENDOF
+   4 OF c@ IF s" true" ELSE s" false" THEN ENDOF
+   5 OF c@ (.) ENDOF \ XXX: print symbolically
+   ENDCASE
+;
+
+: nvupdate-one   ( def-xt -- )
+   >r nvram-partition-type-common get-nvram-partition       ( part.addr part.len FALSE|TRUE R: def-xt )
+   ABORT" No valid NVRAM." r>      ( part.addr part.len def-xt )
+   >name name>string               ( part.addr part.len var.a var.l )
+   2dup findenv nip (nvupdate-one)
+   ( part.addr part.len var.addr var.len val.addr val.len )
+   internal-add-env
+   drop
+;
+
+: (nvupdate) ( -- )
+   nvram-partition-type-common get-nvram-partition ABORT" No valid NVRAM."
+   erase-nvram-partition drop
+   envvars cell+
+   BEGIN @ dup WHILE dup link> nvupdate-one REPEAT
+   drop
+;
+
+: nvupdate ( -- )
+   ." nvupdate is obsolete." cr
+;
+
+: set-default
+   parse-word envvars voc-find
+   dup 0= ABORT" not a configuration variable" link> (set-default)
+;
+
+: (set-defaults)
+   envvars cell+
+   BEGIN @ dup WHILE dup link> (set-default) REPEAT
+   drop
+;
+
+\ Preset nvram variables in RAM, but do not overwrite them in NVRAM
+(set-defaults)
+
+: set-defaults
+   (set-defaults) (nvupdate)
+;
+
+: setenv  parse-word ( skipws ) 0d parse -leading 2swap $setenv (nvupdate) ;
+
+: get-nv  ( -- )
+   nvram-partition-type-common get-nvram-partition ( addr offset not-found | not-found ) \ find partition header
+   IF
+      ." No NVRAM common partition, re-initializing..." cr
+      internal-reset-nvram
+      (nvupdate)
+      nvram-partition-type-common get-nvram-partition IF ." NVRAM seems to be broken." cr EXIT THEN
+   THEN
+   \ partition header found: read data from nvram
+   drop ( addr )           \ throw away offset
+   BEGIN
+      dup rzcount  dup     \ make string from offset and make condition
+   WHILE                   ( offset offset length )
+      2dup [char] = split  \ Split string at equal sign (=)
+                           ( offset offset length name len param len )
+      2swap                ( offset offset length param len name len )
+      $setenv              \ Set envvar
+      nip                  \ throw away old string begin
+      + 1+                 \ calc new offset
+   REPEAT
+   2drop drop              \ cleanup
+;
+
+get-nv
+
+: check-for-nvramrc  ( -- )
+   use-nvramrc?  IF
+      s" Executing following code from nvramrc: "
+      s" nvramrc" evaluate $cat
+      nvramlog-write-string-cr
+      s" (!) Executing code specified in nvramrc" type
+      cr s"  SLOF Setup = " type
+      \ to remove the string from the console if the nvramrc is broken
+      \ we need to know how many chars are printed
+      .enable-emit-counter
+      s" nvramrc" evaluate ['] evaluate  CATCH  IF
+         \ dropping the rest of the nvram string
+         2drop
+         \ delete the chars we do not want to see
+         emit-counter 0  DO  8 emit  LOOP
+         s" (!) Code in nvramrc triggered exception. "
+         2dup nvramlog-write-string
+         type cr 12 spaces s" Aborting nvramrc execution" 2dup
+         nvramlog-write-string-cr type cr
+         s"  SLOF Setup = " type
+      THEN
+      .disable-emit-counter
+   THEN
+;
+
+
+: (nv-findalias) ( alias-ptr alias-len -- pos )
+   \ create a temporary empty string
+   here 0
+   \ append "devalias " to the temporary string
+   s" devalias " string-cat
+   \ append "<name-str>" to the temporary string
+   3 pick 3 pick string-cat
+   \ append a SPACE character to the temporary string
+   s"  " string-cat
+   \ get nvramrc
+   s" nvramrc" evaluate
+   \ get position of the temporary string inside of nvramrc
+   2swap find-substr
+   nip nip
+;
+
+: (nv-build-real-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
+   \ create a temporary empty string
+   2swap here 0
+   \ append "devalias " to the temporary string
+   s" devalias " string-cat
+   \ append "<name-ptr>" to the temporary string
+   2swap string-cat
+   \ append a SPACE character to the temporary string
+   s"  " string-cat
+   \ append "<dev-ptr> to the temporary string
+   2swap string-cat
+   \ append a CR character to the temporary string
+   0d char-cat
+   \ append a LF character to the temporary string
+   0a char-cat
+;
+
+: (nv-build-null-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
+   4drop here 0
+;
+
+: (nv-build-nvramrc) ( name-str name-len dev-str dev-len xt-build-entry -- )
+   \ *** PART 1: check if there is still an alias definition available ***
+   ( alias-ptr alias-len path-ptr path-ptr call-build-entry alias-pos )
+   4 pick 4 pick (nv-findalias)
+   \ if our alias definition is a new one
+   dup s" nvramrc" evaluate nip >= IF
+      \ call-build-entry
+      drop execute
+      \ append content of "nvramrc" to the temporary string
+      s" nvramrc" evaluate string-cat
+      \ Allocate the temporary string
+      dup allot
+      \ write the string into nvramrc
+      s" nvramrc" $setenv
+   ELSE  \ if our alias is still defined in nvramrc
+      \ *** PART 2: calculate the memory size for the new content of nvramrc ***
+      \ add number of bytes needed for nvramrc-prefix to number of bytes needed
+      \ for the new entry
+      5 pick 5 pick 5 pick 5 pick 5 pick execute nip over +
+      ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos tmp-len )
+      \ add number of bytes needed for nvramrc-postfix
+      s" nvramrc" evaluate 3 pick string-at
+      2dup find-nextline string-at nip +
+      \ *** PART 3: build the new content ***
+      \ allocate enough memory for new content
+      alloc-mem 0
+      ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos mem len )
+      \ add nvramrc-prefix
+      s" nvramrc" evaluate drop 3 pick string-cat
+      \ add new entry
+      rot >r >r >r execute r> r> 2swap string-cat
+      ( mem, len ) ( R: alias-pos )
+      \ add nvramrc-postfix
+      s" nvramrc" evaluate r> string-at
+      2dup find-nextline string-at string-cat
+      ( mem len )
+      \ write the temporary string into nvramrc and clean up memory
+      2dup s" nvramrc" $setenv free-mem
+   THEN
+;
+
+: $nvalias ( name-str name-len dev-str dev-len -- )
+   4dup ['] (nv-build-real-entry) (nv-build-nvramrc)
+   set-alias
+   s" true" s" use-nvramrc?" $setenv
+   (nvupdate)
+;
+
+: nvalias ( "alias-name< >device-specifier<eol>" -- )
+   parse-word parse-word dup 0<> IF
+      $nvalias
+   ELSE
+      2drop 2drop
+      cr
+      "    Usage: nvalias (""alias-name< >device-specifier<eol>"" -- )" type
+      cr
+   THEN    
+;
+
+: $nvunalias ( name-str name-len -- )
+   s" " ['] (nv-build-null-entry) (nv-build-nvramrc)
+   (nvupdate)
+;
+
+: nvunalias ( "alias-name< >" -- )
+   parse-word $nvunalias
+;
+
+: diagnostic-mode? ( -- diag-switch? ) diag-switch? ;
+
diff --git a/qemu/roms/SLOF/slof/fs/envvar_defaults.fs b/qemu/roms/SLOF/slof/fs/envvar_defaults.fs
new file mode 100644
index 000000000..86716eff0
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/envvar_defaults.fs
@@ -0,0 +1,44 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ the defaults
+\ some of those are platform dependent, and should e.g. be
+\ created from VPD values
+true default-flag auto-boot?
+s" " default-string boot-device
+s" " default-string boot-file
+s" boot" default-string boot-command
+s" " default-string diag-device
+s" " default-string diag-file
+false default-flag diag-switch?
+true default-flag fcode-debug?
+s" " default-string input-device
+s" " default-string nvramrc
+s" " default-string oem-banner
+false default-flag oem-banner?
+0 0 default-bytes oem-logo
+false default-flag oem-logo?
+s" " default-string output-device
+200 default-int screen-#columns
+200 default-int screen-#rows
+0 default-int security-#badlogins
+0 default-secmode security-mode
+s" " default-string security-password
+0 default-int selftest-#megs
+false default-flag use-nvramrc?
+false default-flag direct-serial?
+true default-flag real-mode?
+default-load-base default-int load-base
+#ifdef BIOSEMU
+true default-flag use-biosemu?
+0 default-int biosemu-debug
+#endif
diff --git a/qemu/roms/SLOF/slof/fs/exception.fs b/qemu/roms/SLOF/slof/fs/exception.fs
new file mode 100644
index 000000000..dbf11fb46
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/exception.fs
@@ -0,0 +1,154 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+STRUCT
+   cell FIELD >r0   cell FIELD >r1   cell FIELD >r2   cell FIELD >r3
+   cell FIELD >r4   cell FIELD >r5   cell FIELD >r6   cell FIELD >r7
+   cell FIELD >r8   cell FIELD >r9   cell FIELD >r10  cell FIELD >r11
+   cell FIELD >r12  cell FIELD >r13  cell FIELD >r14  cell FIELD >r15
+   cell FIELD >r16  cell FIELD >r17  cell FIELD >r18  cell FIELD >r19
+   cell FIELD >r20  cell FIELD >r21  cell FIELD >r22  cell FIELD >r23
+   cell FIELD >r24  cell FIELD >r25  cell FIELD >r26  cell FIELD >r27
+   cell FIELD >r28  cell FIELD >r29  cell FIELD >r30  cell FIELD >r31
+   cell FIELD >cr   cell FIELD >xer  cell FIELD >lr   cell FIELD >ctr
+   cell FIELD >srr0 cell FIELD >srr1 cell FIELD >dar  cell FIELD >dsisr
+CONSTANT ciregs-size
+
+
+
+: .16  10 0.r 3 spaces ;
+: .8   8 spaces 8 0.r 3 spaces ;
+: .4regs  cr 4 0 DO dup @ .16 8 cells+ LOOP drop ;
+: .fixed-regs
+   cr ."     R0 .. R7           R8 .. R15         R16 .. R23         R24 .. R31"
+   dup 8 0 DO dup .4regs cell+ LOOP drop
+;
+
+: .special-regs
+   cr ."     CR / XER           LR / CTR          SRR0 / SRR1        DAR / DSISR"
+   cr dup >cr  @ .8   dup >lr  @ .16  dup >srr0 @ .16  dup >dar @ .16
+   cr dup >xer @ .16  dup >ctr @ .16  dup >srr1 @ .16    >dsisr @ .8
+;
+
+: .regs
+   cr .fixed-regs
+   cr .special-regs
+   cr cr
+;
+
+: .hw-exception ( reason-code exception-nr -- )
+   ." ( " dup . ." ) "
+   CASE
+      200 OF ." Machine Check" ENDOF
+      300 OF ." Data Storage" ENDOF
+      380 OF ." Data Segment" ENDOF
+      400 OF ." Instruction Storage" ENDOF
+      480 OF ." Instruction Segment" ENDOF
+      500 OF ." External" ENDOF
+      600 OF ." Alignment" ENDOF
+      700 OF ." Program" ENDOF
+      800 OF ." Floating-point unavailable" ENDOF
+      900 OF ." Decrementer" ENDOF
+      980 OF ." Hypervisor Decrementer" ENDOF
+      C00 OF ." System Call" ENDOF
+      D00 OF ." Trace" ENDOF
+      F00 OF ." Performance Monitor" ENDOF
+      F20 OF ." VMX Unavailable" ENDOF
+      1200 OF ." System Error" ENDOF
+      1600 OF ." Maintenance" ENDOF
+      1800 OF ." Thermal" ENDOF
+      dup OF ." Unknown" ENDOF
+   ENDCASE
+   ."  Exception [ " . ." ]"
+;
+
+: .sw-exception ( exception-nr -- )
+   ."  Exception [ " . ." ] triggered by boot firmware."
+;
+
+\ this word gets also called for non-hardware exceptions.
+: be-hw-exception ( [reason-code] exception-nr -- )
+   cr cr
+   dup 0> IF .hw-exception ELSE .sw-exception THEN
+   cr eregs .regs
+;
+' be-hw-exception to hw-exception-handler
+
+: (boot-exception-handler) ( x1...xn exception-nr -- x1...xn)
+   dup IF
+      dup 0 > IF
+	 negate cp 9 emit ." : " type
+      ELSE
+	 CASE
+	    -6d OF cr ." W3411: Client application returned." cr ENDOF
+	    -6c OF cr ." E3400: It was not possible to boot from any device "
+		." specified in the VPD." cr
+	    ENDOF
+	    -6b OF cr ." E3410: Boot list successfully read from VPD "
+		." but no useful information received." cr
+	    ENDOF
+	    -6a OF cr ." E3420: Boot list could not be read from VPD." cr
+	    ENDOF
+	    -69 OF
+	        cr ." E3406: Client application returned an error"
+		abort"-str @ count dup IF
+		   ." :    " type cr
+		ELSE
+		   ." ." cr
+		   2drop
+		THEN
+	    ENDOF
+	    -68 OF cr ." E3405: No such device" cr ENDOF
+	    -67 OF cr ." E3404: Not a bootable device!" cr ENDOF
+	    -66 OF cr ." E3408: Failed to claim memory for the executable" cr
+	    ENDOF
+	    -65 OF cr ." E3407: Load failed" cr ENDOF
+	    -64 OF cr ." E3403: Bad executable:   " abort"-str @ count type cr
+	    ENDOF
+	    -63 OF cr ." E3409: Unknown FORTH Word" cr ENDOF
+	    -2 OF cr ." E3401: Aborting boot,  " abort"-str @ count type cr
+	    ENDOF
+	    dup OF ." E3402: Aborting boot, internal error" cr ENDOF
+	 ENDCASE
+      THEN
+   ELSE
+      drop
+   THEN
+;
+
+' (boot-exception-handler) to boot-exception-handler
+
+: throw-error ( error-code "error-string" -- )
+   skipws 0a parse rot throw
+;
+
+\ Enable external interrupt in msr
+
+: enable-ext-int ( -- )
+   msr@ 8000 or msr!
+;
+
+\ Disable external interrupt in msr
+
+: disable-ext-int ( -- )
+   msr@ 8000 not and msr!
+;
+
+\ Generate external interrupt through Internal Interrupt Controller of BE
+
+: gen-ext-int ( -- )
+   7fffffff dec!               \ Reset decrementer
+   enable-ext-int              \ Enable interrupt
+   FF 20000508418 rx!          \ Interrupt priority mask
+   10 20000508410 rx!          \ Interrupt priority
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/fbuffer.fs b/qemu/roms/SLOF/slof/fs/fbuffer.fs
new file mode 100644
index 000000000..756f05a95
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fbuffer.fs
@@ -0,0 +1,264 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+#include "terminal.fs"
+#include "display.fs"
+
+\ \\\\\\\\\\\\\\ Global Data
+
+0 VALUE frame-buffer-adr
+0 VALUE screen-height
+0 VALUE screen-width
+0 VALUE screen-depth
+0 VALUE window-top
+0 VALUE window-left
+
+0 VALUE .sc
+
+: screen-#rows  ( -- rows )
+   .sc IF
+      screen-height char-height /
+    ELSE
+      true to .sc
+      s" screen-#rows" eval
+      false to .sc
+    THEN
+;
+
+: screen-#columns ( -- columns )
+   .sc IF
+      screen-width char-width /
+   ELSE
+      true to .sc
+      s" screen-#columns" eval
+      false to .sc
+   THEN
+;
+
+\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
+
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ *
+\ *
+
+: fb8-background inverse? ;
+: fb8-foreground inverse? invert ;
+
+: fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-width * screen-depth * ;
+: fb8-columns2bytes ( #columns -- #bytes ) char-width * screen-depth * ;
+: fb8-line2addr ( line# -- addr )
+	char-height * window-top + screen-width * screen-depth *
+	frame-buffer-adr + window-left screen-depth * +
+;
+
+: fb8-erase-block ( addr len ) fb8-background rfill ;
+
+
+0 VALUE .ab
+CREATE bitmap-buffer 400 4 * allot
+
+: active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE
+		char-width to .ab ?dup 0= IF recurse THEN
+	THEN ;
+
+: fb8-char2bitmap ( font-height font-addr -- bitmap-buffer )
+	bitmap-buffer >r
+	char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN
+
+	r> -rot char-width to .ab
+	( fb-addr font-addr font-height )
+	fontbytes * bounds ?DO
+		i c@ active-bits 0 ?DO
+			dup 80 and IF fb8-foreground ELSE fb8-background THEN
+			( fb-addr fbyte colr ) 2 pick ! 1 lshift
+			swap screen-depth + swap
+		LOOP drop
+	LOOP drop
+	bitmap-buffer
+;
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ * IEEE 1275: Frame buffer support routines
+\ *
+
+: fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ."  )" cr
+	2drop 2drop
+;
+
+: fb8-toggle-cursor ( -- )
+	line# fb8-line2addr column# fb8-columns2bytes +
+	char-height 0 ?DO
+		char-width screen-depth * 0 ?DO dup dup rb@ -1 xor swap rb! 1+ LOOP
+		screen-width screen-depth * + char-width screen-depth * -
+	LOOP drop
+;
+
+: fb8-draw-character ( char -- )
+    >r default-font over + r@ -rot between IF
+	2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf )
+	line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr )
+	char-height 0 ?DO
+		2dup char-width screen-depth * mrmove
+		screen-width screen-depth * + >r char-width screen-depth * + r>
+	LOOP 2drop
+    ELSE 2drop r> 3drop THEN
+;
+
+: fb8-insert-lines ( n -- )
+	fb8-lines2bytes >r line# fb8-line2addr dup dup r@ +
+	#lines line# - fb8-lines2bytes r@ - rmove
+	r> fb8-erase-block
+;
+
+: fb8-delete-lines ( n -- )
+	fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap
+	#lines fb8-lines2bytes r@ - dup >r rmove
+	r> + r> fb8-erase-block
+;
+
+: fb8-insert-characters ( n -- )
+	line# fb8-line2addr column# fb8-columns2bytes + >r
+	#columns column# - 2dup >= IF
+		nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
+	ELSE
+		fb8-columns2bytes swap fb8-columns2bytes tuck -
+		over r@ tuck + rot char-height 0 ?DO
+			3dup rmove
+			-rot screen-width screen-depth * tuck + -rot + swap rot
+		LOOP
+		3drop r>
+	THEN
+	char-height 0 ?DO
+		dup 2 pick fb8-erase-block screen-width screen-depth * +
+	LOOP
+	2drop
+;
+
+: fb8-delete-characters ( n -- )
+	line# fb8-line2addr column# fb8-columns2bytes + >r
+	#columns column# - 2dup >= IF
+		nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
+	ELSE
+		fb8-columns2bytes swap fb8-columns2bytes tuck -
+		over r@ + 2dup + r> swap >r rot char-height 0 ?DO
+			3dup rmove
+			-rot screen-width screen-depth * tuck + -rot + swap rot
+		LOOP
+		3drop r> over -
+	THEN
+	char-height 0 ?DO
+		dup 2 pick fb8-erase-block screen-width screen-depth * +
+	LOOP
+	2drop
+;
+
+: fb8-reset-screen ( -- ) ( Left as no-op by design ) ;
+
+: fb8-erase-screen ( -- )
+	frame-buffer-adr screen-height screen-width * screen-depth * fb8-erase-block
+;
+
+: fb8-invert-screen ( -- )
+	frame-buffer-adr screen-height screen-width * screen-depth * 2dup /x / 0 ?DO
+		dup rx@ -1 xor over rx! xa1+
+	LOOP 3drop
+;
+
+: fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ;
+
+: fb8-install ( width height #columns #lines -- )
+	1 to screen-depth
+	2swap  to screen-height  to screen-width
+	screen-#rows min to #lines
+	screen-#columns min to #columns
+	screen-height char-height #lines * - 2/ to window-top
+	screen-width char-width #columns * - 2/ to window-left
+	['] fb8-toggle-cursor to toggle-cursor
+	['] fb8-draw-character to draw-character
+	['] fb8-insert-lines to insert-lines
+	['] fb8-delete-lines to delete-lines
+	['] fb8-insert-characters to insert-characters
+	['] fb8-delete-characters to delete-characters
+	['] fb8-erase-screen to erase-screen
+	['] fb8-blink-screen to blink-screen
+	['] fb8-invert-screen to invert-screen
+	['] fb8-reset-screen to reset-screen
+	['] fb8-draw-logo to draw-logo
+;
+
+: fb-install  ( width height #columns #lines depth -- )
+	>r
+	fb8-install
+	r> to screen-depth
+;
+
+
+\ Install display related FCODE evaluator tokens
+: fb8-set-tokens  ( -- )
+	['] is-install        0 11C set-token
+	['] is-remove         0 11D set-token
+	['] is-selftest       0 11E set-token
+
+	['] #lines            0 150 set-token
+	['] #columns          0 151 set-token
+	['] line#             0 152 set-token
+	['] column#           0 153 set-token
+	['] inverse?          0 154 set-token
+	['] inverse-screen?   0 155 set-token
+	['] draw-character    0 157 set-token
+	['] reset-screen      0 158 set-token
+	['] toggle-cursor     0 159 set-token
+	['] erase-screen      0 15A set-token
+	['] blink-screen      0 15B set-token
+	['] invert-screen     0 15C set-token
+	['] insert-characters 0 15D set-token
+	['] delete-characters 0 15E set-token
+	['] insert-lines      0 15F set-token
+	['] delete-lines      0 160 set-token
+	['] draw-logo         0 161 set-token
+	['] frame-buffer-adr  0 162 set-token
+	['] screen-height     0 163 set-token
+	['] screen-width      0 164 set-token
+	['] window-top        0 165 set-token
+	['] window-left       0 166 set-token
+	\ ['] foreground-color  0 168 set-token  \ 16-color extension - n/a
+	\ ['] background-color  0 169 set-token  \ 16-color extension - n/a
+	['] default-font      0 16A set-token
+	['] set-font          0 16B set-token
+	['] char-height       0 16C set-token
+	['] char-width        0 16D set-token
+	['] >font             0 16E set-token
+	['] fontbytes         0 16F set-token
+
+	['] fb8-draw-character    0 180 set-token
+	['] fb8-reset-screen      0 181 set-token
+	['] fb8-toggle-cursor     0 182 set-token
+	['] fb8-erase-screen      0 183 set-token
+	['] fb8-blink-screen      0 184 set-token
+	['] fb8-invert-screen     0 185 set-token
+	['] fb8-insert-characters 0 186 set-token
+	['] fb8-delete-characters 0 187 set-token
+	['] fb8-insert-lines      0 188 set-token
+	['] fb8-delete-lines      0 189 set-token
+	['] fb8-draw-logo         0 18A set-token
+	['] fb8-install           0 18B set-token
+;
+fb8-set-tokens
+
+
+\ \\\\\\\\\\\\ Debug Stuff \\\\\\\\\\\\\\\\
+
+: fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ;
+
+: fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/1275.fs b/qemu/roms/SLOF/slof/fs/fcode/1275.fs
new file mode 100644
index 000000000..c2a67bcc9
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/1275.fs
@@ -0,0 +1,465 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+: fcode-revision ( -- n )
+  00030000 \ major * 65536 + minor
+  ;
+
+: b(lit) ( -- n )
+  next-ip read-fcode-num32
+  ?compile-mode IF literal, THEN
+  ;
+
+: b(")
+  next-ip read-fcode-string
+  ?compile-mode IF fc-string, align postpone count THEN
+  ;
+
+: b(')
+  next-ip read-fcode# get-token drop ?compile-mode IF literal, THEN
+  ;
+
+: ?jump-direction ( n -- )
+   dup 8000 >= IF
+      10000 -           \ Create cell-sized negative value
+   THEN
+   fcode-offset -       \ IP is already behind offset, so subtract offset size
+;
+
+: ?negative
+  8000 and
+  ;
+
+: dest-on-top
+  0 >r BEGIN dup @ 0= WHILE >r REPEAT
+       BEGIN r> dup WHILE swap REPEAT
+  drop
+  ;
+
+: read-fcode-offset
+   next-ip
+   ?offset16 IF
+      read-fcode-num16
+   ELSE
+      read-byte
+      dup 80 and IF FF00 or THEN       \ Fake 16-bit signed offset
+   THEN
+;
+
+: b?branch ( flag -- )
+   ?compile-mode IF
+      read-fcode-offset ?negative IF
+         dest-on-top postpone until
+      ELSE
+         postpone if
+      THEN
+   ELSE
+      ( flag ) IF
+         fcode-offset jump-n-ip       \ Skip over offset value
+      ELSE
+         read-fcode-offset
+         ?jump-direction jump-n-ip
+      THEN
+   THEN
+; immediate
+
+: bbranch ( -- )
+   ?compile-mode IF
+      read-fcode-offset
+      ?negative IF
+         dest-on-top postpone again
+      ELSE
+         postpone else
+         get-ip next-ip fcode@ B2 = IF
+            drop
+         ELSE
+            set-ip
+         THEN
+      THEN
+   ELSE
+      read-fcode-offset ?jump-direction jump-n-ip
+   THEN
+; immediate
+
+: b(<mark) ( -- )
+  ?compile-mode IF postpone begin THEN
+  ; immediate
+
+: b(>resolve) ( -- )
+  ?compile-mode IF postpone then THEN
+  ; immediate
+
+: b(;)
+   <semicolon> compile, reveal
+   postpone [
+; immediate
+
+: b(:) ( -- )
+  <colon> compile, ]
+  ; immediate
+
+: b(case) ( sel -- sel )
+  postpone case
+  ; immediate
+
+: b(endcase)
+  postpone endcase
+  ; immediate
+
+: b(of)
+  postpone of
+  read-fcode-offset drop   \ read and discard offset
+  ; immediate
+
+: b(endof)
+  postpone endof
+  read-fcode-offset drop
+  ; immediate
+
+: b(do)
+  postpone do
+  read-fcode-offset drop
+  ; immediate
+
+: b(?do)
+  postpone ?do
+  read-fcode-offset drop
+  ; immediate
+
+: b(loop)
+  postpone loop
+  read-fcode-offset drop
+  ; immediate
+
+: b(+loop)
+  postpone +loop
+  read-fcode-offset drop
+  ; immediate
+
+: b(leave)
+  postpone leave
+  ; immediate
+
+
+0 VALUE fc-instance?
+: fc-instance  ( -- )   \ Mark next defining word as instance-specific.
+   TRUE TO fc-instance?
+;
+
+: new-token  \ unnamed local fcode function
+  align here next-ip read-fcode# 0 swap set-token
+  ;
+
+: external-token ( -- )  \ named local fcode function
+  next-ip read-fcode-string
+  \ fc-instance? IF cr ." ext instance token: " 2dup type ."  in " pwd cr THEN
+  header         ( str len -- )  \ create a header in the current dictionary entry
+  new-token
+  ;
+
+: new-token
+   eva-debug? IF
+      s" x" get-ip >r next-ip read-fcode# r> set-ip (u.) $cat strdup
+      header
+   THEN
+   new-token
+;
+
+\ decide wether or not to give a new token an own name in the dictionary
+: named-token
+   fcode-debug? IF
+      external-token
+   ELSE
+      next-ip read-fcode-string 2drop       \ Forget about the name
+      new-token
+   THEN
+;
+
+: b(to) ( val -- )
+   next-ip read-fcode#
+   get-token drop                           ( val xt )
+   dup @                                    ( val xt @xt )
+   dup <value> =  over <defer> = OR IF
+      \ Destination is value or defer
+      drop
+      >body cell -
+      ( val addr )
+      ?compile-mode IF
+         literal, postpone !
+      ELSE
+         !
+      THEN
+   ELSE
+      <create> <> IF                         ( val xt )
+         TRUE ABORT" Invalid destination for FCODE b(to)"
+      THEN
+      dup cell+ @                           ( val xt @xt+1cell )
+      dup <instancevalue> <>  swap <instancedefer> <> AND IF
+         TRUE ABORT" Invalid destination for FCODE b(to)"
+      THEN
+      \ Destination is instance-value or instance-defer
+      >body @                               ( val instance-offset )
+      ?compile-mode IF
+         literal,  postpone >instance  postpone !
+      ELSE
+         >instance !
+      THEN
+      ELSE
+   THEN
+; immediate
+
+: b(value)
+   fc-instance? IF
+      <create> ,                \ Needed for "(instance?)" for example
+      <instancevalue> ,
+      (create-instance-var)
+      FALSE TO fc-instance?
+   ELSE
+      <value> , ,
+   THEN
+   reveal
+;
+
+: b(variable)
+   fc-instance? IF
+      <create> ,                \ Needed for "(instance?)"
+      <instancevariable> ,
+      0 (create-instance-var)
+      FALSE TO fc-instance?
+   ELSE
+      <variable> , 0 ,
+   THEN
+   reveal
+;
+
+: b(constant)
+  <constant> , , reveal
+  ;
+
+: undefined-defer
+  cr cr ." Uninitialized defer word has been executed!" cr cr
+  true fcode-end !
+  ;
+
+: b(defer)
+   fc-instance? IF
+      <create> ,                \ Needed for "(instance?)"
+      <instancedefer> ,
+      ['] undefined-defer (create-instance-var)
+      reveal
+      FALSE TO fc-instance?
+   ELSE
+      <defer> , reveal
+      postpone undefined-defer
+   THEN
+;
+
+: b(create)
+  <variable> ,
+  postpone noop reveal
+  ;
+
+: b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size )
+   <colon> , over literal,
+   postpone +
+   <semicolon> compile,
+   reveal
+   +
+;
+
+: b(buffer:) ( E: -- a-addr) ( F: size -- )
+   fc-instance? IF
+      <create> ,                \ Needed for "(instance?)"
+      <instancebuffer> ,
+      (create-instance-buf)
+      FALSE TO fc-instance?
+   ELSE
+      <buffer:> , allot
+   THEN
+   reveal
+;
+
+: suspend-fcode ( -- )
+  noop        \ has to be implemented more efficiently ;-)
+  ;
+
+: offset16 ( -- )
+  2 to fcode-offset
+  ;
+
+: version1 ( -- )
+  1 to fcode-spread
+  1 to fcode-offset
+  read-header
+  ;
+
+: start0 ( -- )
+  0 to fcode-spread
+  offset16
+  read-header
+  ;
+
+: start1 ( -- )
+  1 to fcode-spread
+  offset16
+  read-header
+  ;
+
+: start2 ( -- )
+  2 to fcode-spread
+  offset16
+  read-header
+  ;
+
+: start4 ( -- )
+  4 to fcode-spread
+  offset16
+  read-header
+  ;
+
+: end0 ( -- )
+  true fcode-end !
+  ;
+
+: end1 ( -- )
+  end0
+  ;
+
+: ferror ( -- )
+  clear end0
+  cr ." FCode# " fcode-num @ . ." not assigned!"
+  cr ." FCode evaluation aborted." cr
+  ." ( -- S:" depth . ." R:" rdepth . ." ) " .s cr
+  abort
+  ;
+
+: reset-local-fcodes
+  FFF 800 DO ['] ferror 0 i set-token LOOP
+  ;
+
+: byte-load ( addr xt -- )
+  >r >r
+  save-evaluator-state
+  r> r>
+  reset-fcode-end
+  1 to fcode-spread
+  dup 1 = IF drop ['] rb@ THEN to fcode-rb@
+  set-ip
+  reset-local-fcodes
+  depth >r
+  evaluate-fcode
+  r> depth 1- <> IF
+      clear end0
+      cr ." Ambiguous stack depth after byte-load!"
+      cr ." FCode evaluation aborted." cr cr
+  ELSE
+      restore-evaluator-state
+  THEN
+  ['] c@ to fcode-rb@
+;
+
+\ Functions for accessing memory ... since some FCODE programs use the normal
+\ memory access functions for accessing MMIO memory, too, we got to use a little
+\ hack to support them: When address is bigger than MIN-RAM-SIZE, assume the
+\ FCODE is trying to access MMIO memory and use the register based access
+\ functions instead!
+: fc-c@   ( addr -- byte )   dup MIN-RAM-SIZE > IF rb@ ELSE c@ THEN ;
+: fc-w@   ( addr -- word )   dup MIN-RAM-SIZE > IF rw@ ELSE w@ THEN ;
+: fc-<w@  ( addr -- word )   fc-w@ dup 8000 >= IF 10000 - THEN ;
+: fc-l@   ( addr -- long )   dup MIN-RAM-SIZE > IF rl@ ELSE l@ THEN ;
+: fc-<l@  ( addr -- long )   fc-l@ signed ;
+: fc-x@   ( addr -- dlong )  dup MIN-RAM-SIZE > IF rx@ ELSE x@ THEN ;
+: fc-c!   ( byte addr -- )   dup MIN-RAM-SIZE > IF rb! ELSE c! THEN ;
+: fc-w!   ( word addr -- )   dup MIN-RAM-SIZE > IF rw! ELSE w! THEN ;
+: fc-l!   ( long addr -- )   dup MIN-RAM-SIZE > IF rl! ELSE l! THEN ;
+: fc-x!   ( dlong addr -- )  dup MIN-RAM-SIZE > IF rx! ELSE x! THEN ;
+
+: fc-fill ( add len byte -- )  2 pick MIN-RAM-SIZE > IF rfill ELSE fill THEN ;
+: fc-move ( src dst len -- )
+   2 pick MIN-RAM-SIZE >        \ Check src
+   2 pick MIN-RAM-SIZE >        \ Check dst
+   OR IF rmove ELSE move THEN
+;
+
+\ Destroy virtual mapping (should maybe also update "address" property here?)
+: free-virtual  ( virt size -- )
+   s" map-out" $call-parent
+;
+
+\ Map the specified region, return virtual address
+: map-low  ( phys.lo ... size -- virt )
+    my-space swap s" map-in" $call-parent
+;
+
+\ Get MAC address
+: mac-address  ( -- mac-str mac-len )
+   s" local-mac-address" get-my-property IF
+      0 0
+   THEN
+;
+
+\ Output line and column number - not used yet
+VARIABLE #line
+0 #line !
+VARIABLE #out
+0 #out !
+
+\ Display device status
+: display-status  ( n -- )
+   ." Device status: " . cr
+;
+
+\ Obsolete variables:
+VARIABLE group-code
+0 group-code !
+
+\ Obsolete: Allocate memory for DMA
+: dma-alloc  ( byte -- virtual )
+   s" dma-alloc" $call-parent
+;
+
+\ Obsolete: Get params property
+: my-params  ( -- addr len )
+   s" params" get-my-property IF
+      0 0
+   THEN
+;
+
+\ Obsolete: Convert SBus interrupt level to CPU interrupt level
+: sbus-intr>cpu  ( sbus-intr# -- cpu-intr# )
+;
+
+\ Obsolete: Set "intr" property
+: intr  ( interrupt# vector -- )
+   >r sbus-intr>cpu encode-int r> encode-int+ s" intr" property
+;
+
+\ Obsolete: Create the "name" property
+: driver  ( addr len -- )
+   encode-string s" name" property
+;
+
+\ Obsolete: Return type of CPU
+: processor-type  ( -- cpu-type )
+   0
+;
+
+\ Obsolete: Return firmware version
+: firmware-version  ( -- n )
+   10000                          \ Just a dummy value
+;
+
+\ Obsolete: Return fcode-version
+: fcode-version  ( -- n )
+   fcode-revision
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/core.fs b/qemu/roms/SLOF/slof/fs/fcode/core.fs
new file mode 100644
index 000000000..8fd98ec19
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/core.fs
@@ -0,0 +1,173 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: ?offset16 ( -- true|false )
+  fcode-offset 2 =
+  ;
+
+: ?arch64 ( -- true|false )
+  cell 8 =
+  ;
+
+: ?bigendian ( -- true|false )
+  deadbeef fcode-num !
+  fcode-num ?arch64 IF 4 + THEN
+  c@ de =
+  ;
+
+: reset-fcode-end ( -- )
+  false fcode-end !
+  ;
+
+: get-ip ( -- n )
+  ip @
+  ;
+
+: set-ip ( n -- )
+  ip !
+  ;
+
+: next-ip ( -- )
+  get-ip 1+ set-ip
+  ;
+
+: jump-n-ip ( n -- )
+  get-ip + set-ip
+  ;
+
+: read-byte ( -- n )
+  get-ip fcode-rb@
+  ;
+
+: ?compile-mode ( -- on|off )
+  state @
+  ;
+
+: save-evaluator-state
+  get-ip               eva-debug? IF ." saved ip "           dup . cr THEN
+  fcode-end @          eva-debug? IF ." saved fcode-end "    dup . cr THEN
+  fcode-offset         eva-debug? IF ." saved fcode-offset " dup . cr THEN
+\ local fcodes are currently NOT saved!
+  fcode-spread         eva-debug? IF ." saved fcode-spread " dup . cr THEN
+  ['] fcode@ behavior  eva-debug? IF ." saved fcode@ "       dup . cr THEN
+  ;
+
+: restore-evaluator-state
+  eva-debug? IF ." restored fcode@ "       dup . cr THEN  to fcode@
+  eva-debug? IF ." restored fcode-spread " dup . cr THEN  to fcode-spread
+\ local fcodes are currently NOT restored!
+  eva-debug? IF ." restored fcode-offset " dup . cr THEN  to fcode-offset
+  eva-debug? IF ." restored fcode-end "    dup . cr THEN  fcode-end !
+  eva-debug? IF ." restored ip "           dup . cr THEN  set-ip
+  ;
+
+: token-table-index ( fcode# -- addr )
+  cells token-table +
+  ;
+
+: join-immediate ( xt immediate? addr -- xt+immediate? addr )
+  -rot + swap
+  ;
+
+: split-immediate ( xt+immediate? -- xt immediate? )
+  dup 1 and 2dup - rot drop swap
+  ;
+
+: literal, ( n -- )
+  postpone literal
+  ;
+
+: fc-string,
+  postpone sliteral
+  dup c, bounds ?do i c@ c, loop
+  ;
+
+: set-token ( xt immediate? fcode# -- )
+  token-table-index join-immediate !
+  ;
+
+: get-token ( fcode# -- xt immediate? )
+  token-table-index @ split-immediate
+  ;
+
+( ---------------------------------------------------- )
+
+#include "little-big.fs"
+
+( ---------------------------------------------------- )
+
+: read-fcode# ( -- FCode# )
+  read-byte
+  dup 01 0F between IF drop read-fcode-num16 THEN
+  ;
+
+: read-header ( adr -- )
+  next-ip read-byte        drop
+  next-ip read-fcode-num16 drop
+  next-ip read-fcode-num32 drop
+  ;
+
+: read-fcode-string ( -- str len )
+  read-byte            \ get string length ( -- len )
+  next-ip get-ip       \ get string addr   ( -- len str )
+  swap                 \ type needs the parameters swapped ( -- str len )
+  dup 1- jump-n-ip     \ jump to the end of the string in FCode
+  ;
+
+
+-1 VALUE break-fcode-addr
+0 VALUE break-fcode-steps
+
+: evaluate-fcode ( -- )
+   BEGIN
+      get-ip break-fcode-addr = IF
+         TRUE fcode-end !
+      THEN
+      fcode-end @ 0=
+   WHILE
+      fcode@                               ( fcode# )
+      eva-debug? IF
+         dup
+         get-ip 8 u.r ." : "
+         ." [" 3 u.r ." ] "
+      THEN
+      \ When it is not immediate and in compile-mode, then compile
+      get-token 0= ?compile-mode AND IF    ( xt )
+         compile,
+      ELSE                                 \ immediate or "interpretation" mode
+         eva-debug? IF dup xt>name type space THEN
+         execute
+      THEN
+      eva-debug? IF .s cr THEN
+      break-fcode-steps IF
+         break-fcode-steps 1- TO break-fcode-steps
+         break-fcode-steps 0= IF
+            TRUE fcode-end !
+         THEN
+      THEN
+      next-ip
+   REPEAT
+;
+
+\ Run FCODE for n steps
+: steps-fcode  ( n -- )
+   to break-fcode-steps
+   break-fcode-addr >r -1 to break-fcode-addr
+   reset-fcode-end
+   evaluate-fcode
+   r> to break-fcode-addr
+;
+
+\ Step through one FCODE instruction
+: step-fcode  ( -- )
+   1 steps-fcode
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs b/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs
new file mode 100644
index 000000000..8f0bae527
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs
@@ -0,0 +1,119 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+variable ip
+variable fcode-end 
+variable fcode-num
+ 1 value fcode-spread
+ 2 value fcode-offset
+false value eva-debug?
+true value fcode-debug?
+defer fcode-rb@
+defer fcode@
+
+' c@ to fcode-rb@
+
+create token-table 2000 cells allot    \ 1000h = 4096d
+
+#include "core.fs"
+#include "1275.fs"
+#include "tokens.fs"
+#include "locals.fs"
+
+0 value buff
+0 value buff-size
+
+' read-fcode# to fcode@
+
+( ---------------------------------------------------- )
+
+: execute-rom-fcode ( addr len | false -- )
+   reset-fcode-end
+   ?dup IF
+      diagnostic-mode? IF ." , executing ..." cr THEN
+      dup >r r@ alloc-mem dup >r swap rmove
+      r@ set-ip evaluate-fcode
+      diagnostic-mode? IF ." Done." cr THEN
+      r> r> free-mem
+   THEN
+;
+
+: rom-code-ignored  ( image-addr name len -- image-addr )
+   diagnostic-mode? IF
+      type ."  code found in image " dup .  ." , ignoring ..." cr
+   ELSE
+      2drop
+   THEN
+;
+
+: pci-find-rom ( baseaddr -- addr )
+   dup IF
+      dup rw@-le aa55 = IF
+         diagnostic-mode? IF ." Device ROM header found at " dup . cr THEN
+      ELSE
+         drop 0
+      THEN
+   THEN
+;
+
+: pci-find-fcode ( baseaddr -- addr len | false )
+   BEGIN
+      1ff NOT and                       \ Image must start at 512 byte boundary
+      pci-find-rom dup
+   WHILE
+      dup 18 + rw@-le +              ( pcir-addr )
+      \ Check for PCIR magic ... since pcir-addr might not be
+      \ 4-byte aligned, we've got to use two reads here:
+      dup rw@-le 4350 ( 'PC' ) <>    ( pcir-addr hasPC? )
+      over 2+ rw@-le 5249 ( 'IR' ) <> OR IF
+         diagnostic-mode? IF
+            ." Invalid PCI Data structure, ignoring ROM contents" cr
+         THEN
+         drop false EXIT
+      THEN                           ( pcir-addr )
+      dup 14 + rb@ CASE              \ Get image code type
+         0 OF s" Intel x86 BIOS" rom-code-ignored ENDOF
+         1 OF
+            diagnostic-mode? IF
+               ." Open Firmware FCode found in image at " dup . cr
+            THEN
+            dup 1ff NOT AND          \ Back to the ROM image header
+            dup 2+ rw@-le +          \ Pointer to FCODE (PCI bus binding ch.9)
+            swap 10 + rw@-le 200 *   \ Image length
+            EXIT
+         ENDOF
+         2 OF s" HP PA RISC" rom-code-ignored ENDOF
+         3 OF s" EFI" rom-code-ignored ENDOF
+         dup OF s" Unknown type" rom-code-ignored ENDOF
+      ENDCASE
+      dup 15 + rb@ 80 and IF         \ End of last image?
+         drop false EXIT
+      THEN
+      dup 10 + rw@-le  200 * +       \ Next image start
+   REPEAT
+;
+
+
+\ Prepare and run a FCODE program from a PCI Option ROM.
+: pci-execute-fcode  ( baseaddr -- )
+   pci-find-fcode dup 0= IF
+      2drop EXIT
+   THEN                                 ( addr len )
+   fc-set-pci-mmio-tokens               \ Prepare PCI access functions
+   \ Now run the FCODE:
+   ['] execute-rom-fcode CATCH IF
+      cr ." FCODE failed!" cr
+      2drop
+   THEN
+   fc-set-normal-mmio-tokens            \ Restore normal MMIO access functions
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/little-big.fs b/qemu/roms/SLOF/slof/fs/fcode/little-big.fs
new file mode 100644
index 000000000..309c626a9
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/little-big.fs
@@ -0,0 +1,96 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ little- and big-endian FCODE IP access functions
+
+
+?bigendian [IF]                       \ Big endian access functions first
+
+
+: read-fcode-num16 ( -- n )
+   0 fcode-num !
+   ?arch64 IF
+      read-byte fcode-num 6 + C!
+      next-ip
+      read-byte fcode-num 7 + C!
+   ELSE
+      read-byte fcode-num 2 + C!
+      next-ip
+      read-byte fcode-num 3 + C!
+   THEN
+   fcode-num @
+;
+
+: read-fcode-num32 ( -- n )
+   0 fcode-num !
+   ?arch64 IF
+      read-byte fcode-num 4 + C!
+      next-ip
+      read-byte fcode-num 5 + C!
+      next-ip
+      read-byte fcode-num 6 + C!
+      next-ip
+      read-byte fcode-num 7 + C!
+   ELSE
+      read-byte fcode-num 0 + C!
+      next-ip
+      read-byte fcode-num 1 + C!
+      next-ip
+      read-byte fcode-num 2 + C!
+      next-ip
+      read-byte fcode-num 3 + C!
+   THEN
+   fcode-num @
+;
+
+
+[ELSE]                                \ Now the little endian access functions
+
+
+: read-fcode-num16 ( -- n )
+   0 fcode-num !
+   ?arch64 IF
+      read-byte fcode-num 7 + C!
+      next-ip
+      read-byte fcode-num 6 + C!
+   ELSE
+      read-byte fcode-num 1 + C!
+      next-ip
+      read-byte fcode-num 0 + C!
+   THEN
+   fcode-num @
+;
+
+: read-fcode-num32 ( adr -- n )
+   0 fcode-num !
+   ?arch64 IF
+      read-byte fcode-num 7 + C!
+      next-ip
+      read-byte fcode-num 6 + C!
+      next-ip
+      read-byte fcode-num 5 + C!
+      next-ip
+      read-byte fcode-num 4 + C!
+   ELSE
+      read-byte fcode-num 3 + C!
+      next-ip
+      read-byte fcode-num 2 + C!
+      next-ip
+      read-byte fcode-num 1 + C!
+      next-ip
+      read-byte fcode-num 0 + C!
+   THEN
+   fcode-num @
+;
+
+
+[THEN]
diff --git a/qemu/roms/SLOF/slof/fs/fcode/locals.fs b/qemu/roms/SLOF/slof/fs/fcode/locals.fs
new file mode 100644
index 000000000..5381df058
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/locals.fs
@@ -0,0 +1,155 @@
+\ *****************************************************************************
+\ * Copyright (c) 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\ *
+\ * Support for old-fashioned local values in FCODE.
+\ *
+\ * There is one old FCODE tokenizer that uses the FCODE opcodes in the range
+\ * of 0x407 to 0x41f for supporting Forth local values. Each locals stack
+\ * frame contains 8 variables. The opcodes from 0x407 to 0x40f are used to
+\ * push 0 up to 8 values from the normal data stack into the current locals
+\ * stack frame. All other variables in the current stack frame are not
+\ * pre-initialized.
+\ * The opcodes from 0x410 to 0x417 can be used for reading the first, second,
+\ * ... eighth value out of the locals stack frame, and the opcode from 0x418
+\ * to 0x41f can be used to set the first, second, ... eighth value in the
+\ * stack frame respectively.
+\ *
+
+80 cells CONSTANT LOCALS-STACK-SIZE
+
+LOCALS-STACK-SIZE BUFFER: localsstackbuf
+
+localsstackbuf VALUE localsstack
+
+
+: fc-local@  ( n -- val )
+   cells localsstack swap - @
+;
+
+: fc-local-1-@  1 fc-local@ ;
+: fc-local-2-@  2 fc-local@ ;
+: fc-local-3-@  3 fc-local@ ;
+: fc-local-4-@  4 fc-local@ ;
+: fc-local-5-@  5 fc-local@ ;
+: fc-local-6-@  6 fc-local@ ;
+: fc-local-7-@  7 fc-local@ ;
+: fc-local-8-@  8 fc-local@ ;
+
+
+: fc-local!  ( val n -- )
+   cells localsstack swap - !
+;
+
+: fc-local-1-!  1 fc-local! ;
+: fc-local-2-!  2 fc-local! ;
+: fc-local-3-!  3 fc-local! ;
+: fc-local-4-!  4 fc-local! ;
+: fc-local-5-!  5 fc-local! ;
+: fc-local-6-!  6 fc-local! ;
+: fc-local-7-!  7 fc-local! ;
+: fc-local-8-!  8 fc-local! ;
+
+
+0 VALUE uses-locals?
+
+\ Create space for the current function on the locals stack.
+\ Pre-initialized the n first locals with the n top-most data stack items.
+\ Note: Each function can use up to 8 (initialized or uninitialized) locals.
+: (fc-push-locals)  ( ... n -- )
+   \ cr ." pushing " dup . ." locals" cr
+   8 cells localsstack + TO localsstack
+   localsstack localsstackbuf -
+   LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!"
+   ?dup IF
+      ( ... n ) 1 swap DO
+         i fc-local!              \ Store pre-initialized locals
+      -1 +LOOP
+   THEN
+;
+
+: fc-push-locals  ( n -- )
+   \ cr ." compiling push for " dup . ." locals" cr
+   uses-locals? ABORT" Definition pushes locals multiple times!"
+   true TO uses-locals?
+   ( n ) ['] literal execute
+   ['] (fc-push-locals) compile,
+;
+
+: fc-push-0-locals  0 fc-push-locals ;
+: fc-push-1-locals  1 fc-push-locals ;
+: fc-push-2-locals  2 fc-push-locals ;
+: fc-push-3-locals  3 fc-push-locals ;
+: fc-push-4-locals  4 fc-push-locals ;
+: fc-push-5-locals  5 fc-push-locals ;
+: fc-push-6-locals  6 fc-push-locals ;
+: fc-push-7-locals  7 fc-push-locals ;
+: fc-push-8-locals  8 fc-push-locals ;
+
+
+: fc-pop-locals  ( -- )
+   \ ." popping locals" cr
+   localsstack 8 cells - TO localsstack
+   localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!"
+;
+
+
+: fc-locals-exit
+   uses-locals? IF
+      \ ." compiling pop-locals for exit" cr
+      ['] fc-pop-locals compile,
+   THEN
+   ['] exit compile,
+;
+
+: fc-locals-b(;)
+   uses-locals? IF
+      \ ." compiling pop-locals for b(;)" cr
+      ['] fc-pop-locals compile,
+   THEN
+   false TO uses-locals?
+   ['] b(;) execute
+;
+
+
+: fc-set-locals-tokens  ( -- )
+   ['] fc-push-0-locals 1 407 set-token
+   ['] fc-push-1-locals 1 408 set-token
+   ['] fc-push-2-locals 1 409 set-token
+   ['] fc-push-3-locals 1 40a set-token
+   ['] fc-push-4-locals 1 40b set-token
+   ['] fc-push-5-locals 1 40c set-token
+   ['] fc-push-6-locals 1 40d set-token
+   ['] fc-push-7-locals 1 40e set-token
+   ['] fc-push-8-locals 1 40f set-token
+
+   ['] fc-local-1-@ 0 410 set-token
+   ['] fc-local-2-@ 0 411 set-token
+   ['] fc-local-3-@ 0 412 set-token
+   ['] fc-local-4-@ 0 413 set-token
+   ['] fc-local-5-@ 0 414 set-token
+   ['] fc-local-6-@ 0 415 set-token
+   ['] fc-local-7-@ 0 416 set-token
+   ['] fc-local-8-@ 0 417 set-token
+
+   ['] fc-local-1-! 0 418 set-token
+   ['] fc-local-2-! 0 419 set-token
+   ['] fc-local-3-! 0 41a set-token
+   ['] fc-local-4-! 0 41b set-token
+   ['] fc-local-5-! 0 41c set-token
+   ['] fc-local-6-! 0 41d set-token
+   ['] fc-local-7-! 0 41e set-token
+   ['] fc-local-8-! 0 41f set-token
+
+   ['] fc-locals-exit 1 33 set-token
+   ['] fc-locals-b(;) 1 c2 set-token
+;
+fc-set-locals-tokens
diff --git a/qemu/roms/SLOF/slof/fs/fcode/tokens.fs b/qemu/roms/SLOF/slof/fs/fcode/tokens.fs
new file mode 100644
index 000000000..3efc17e06
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/tokens.fs
@@ -0,0 +1,480 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: fc-abort ." FCode called abort: IP " get-ip . ( ." STACK: " .s ) depth dup 0< IF abort THEN . rdepth . cr  abort ;
+: fc-0 ." 0(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 0 ;
+: fc-1 ." 1(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 1 ;
+
+: parse-1hex 1 hex-decode-unit ;
+
+\ Adjust functions for accessing MMIO registers. According to IEEE 1275,
+\ a bus device can substitute bus-specific implementations of r*@ and r*!
+\ for use by its children, e.g. with respect to byte-order. Since PCI is
+\ little endian by default, we've got to use the little endian accessor
+\ functions for the PCI bus (some FCODE programs are expecting this behavior).
+: fc-set-pci-mmio-tokens  ( -- )
+   ['] rw@-le  0 232 set-token
+   ['] rw!-le  0 233 set-token
+   ['] rl@-le  0 234 set-token
+   ['] rl!-le  0 235 set-token
+   ['] rx@-le  0 22E set-token
+   ['] rx!-le  0 22F set-token
+;
+
+\ Set normal MMIO access token behavior:
+: fc-set-normal-mmio-tokens  ( -- )
+   ['] rw@  0 232 set-token
+   ['] rw!  0 233 set-token
+   ['] rl@  0 234 set-token
+   ['] rl!  0 235 set-token
+   ['] rx@  0 22E set-token
+   ['] rx!  0 22F set-token
+;
+
+: reset-token-table
+  FFF 0 DO ['] ferror 0 i set-token LOOP
+  ;
+
+reset-token-table
+
+' end0 0        00 set-token
+
+\ 01...0F beginning code of 2-byte FCode sequences
+
+' b(lit)      1 10 set-token
+
+' b(')        1 11 set-token
+' b(")        1 12 set-token
+' bbranch     1 13 set-token
+' b?branch    1 14 set-token
+' b(loop)     1 15 set-token
+' b(+loop)    1 16 set-token
+' b(do)       1 17 set-token
+' b(?do)      1 18 set-token
+' i           0 19 set-token
+' j           0 1A set-token
+' b(leave)    1 1B set-token
+' b(of)       1 1C set-token
+' execute     0 1D set-token
+' +           0 1E set-token
+' -           0 1F set-token
+' *           0 20 set-token
+' /           0 21 set-token
+' mod         0 22 set-token 
+' and         0 23 set-token 
+' or          0 24 set-token 
+' xor         0 25 set-token 
+' invert      0 26 set-token 
+' lshift      0 27 set-token 
+' rshift      0 28 set-token 
+' >>a         0 29 set-token 
+' /mod        0 2A set-token 
+' u/mod       0 2B set-token
+' negate      0 2C set-token 
+' abs         0 2D set-token 
+' min         0 2E set-token 
+' max         0 2F set-token 
+' >r          0 30 set-token 
+' r>          0 31 set-token 
+' r@          0 32 set-token 
+' exit        0 33 set-token 
+' 0=          0 34 set-token 
+' 0<>         0 35 set-token 
+' 0<          0 36 set-token 
+' 0<=         0 37 set-token 
+' 0>          0 38 set-token 
+' 0>=         0 39 set-token 
+' <           0 3A set-token
+' >           0 3B set-token
+' =           0 3C set-token
+' <>          0 3D set-token
+' u>          0 3E set-token
+' u<=         0 3F set-token 
+' u<          0 40 set-token 
+' u>=         0 41 set-token 
+' >=          0 42 set-token 
+' <=          0 43 set-token 
+' between     0 44 set-token 
+' within      0 45 set-token 
+' DROP        0 46 set-token
+' DUP         0 47 set-token
+' OVER        0 48 set-token
+' SWAP        0 49 set-token
+' ROT         0 4A set-token
+' -ROT        0 4B set-token
+' TUCK        0 4C set-token
+' nip         0 4D set-token 
+' pick        0 4E set-token 
+' roll        0 4F set-token 
+' ?dup        0 50 set-token 
+' depth       0 51 set-token 
+' 2drop       0 52 set-token 
+' 2dup        0 53 set-token 
+' 2over       0 54 set-token 
+' 2swap       0 55 set-token 
+' 2rot        0 56 set-token 
+' 2/          0 57 set-token 
+' u2/         0 58 set-token 
+' 2*          0 59 set-token 
+' /c          0 5A set-token
+' /w          0 5B set-token 
+' /l          0 5C set-token 
+' /n          0 5D set-token 
+' ca+         0 5E set-token 
+' wa+         0 5F set-token 
+' la+         0 60 set-token 
+' na+         0 61 set-token 
+' char+       0 62 set-token 
+' wa1+        0 63 set-token 
+' la1+        0 64 set-token 
+' cell+       0 65 set-token 
+' chars       0 66 set-token 
+' /w*         0 67 set-token 
+' /l*         0 68 set-token 
+' cells       0 69 set-token 
+' on          0 6A set-token 
+' off         0 6B set-token 
+' +!          0 6C set-token 
+' @           0 6D set-token 
+' fc-l@       0 6E set-token 
+' fc-w@       0 6F set-token 
+' fc-<w@      0 70 set-token 
+' fc-c@       0 71 set-token 
+' !           0 72 set-token 
+' fc-l!       0 73 set-token 
+' fc-w!       0 74 set-token 
+' fc-c!       0 75 set-token 
+' 2@          0 76 set-token 
+' 2!          0 77 set-token 
+' fc-move     0 78 set-token 
+' fc-fill     0 79 set-token 
+' comp        0 7A set-token 
+' noop        0 7B set-token
+' lwsplit     0 7C set-token 
+' wljoin      0 7D set-token 
+' lbsplit     0 7E set-token 
+' bljoin      0 7F set-token 
+' wbflip      0 80 set-token 
+' upc         0 81 set-token 
+' lcc         0 82 set-token 
+' pack        0 83 set-token 
+' count       0 84 set-token 
+' body>       0 85 set-token 
+' >body       0 86 set-token 
+' fcode-revision 0 87 set-token 
+' span        0 88 set-token 
+' unloop      0 89 set-token 
+' expect      0 8A set-token 
+' alloc-mem   0 8B set-token
+' free-mem    0 8C set-token
+' key?        0 8D set-token 
+' key         0 8E set-token 
+' emit        0 8F set-token 
+' type        0 90 set-token 
+' (cr         0 91 set-token
+' cr          0 92 set-token 
+' #out        0 93 set-token
+' #line       0 94 set-token
+' hold        0 95 set-token 
+' <#          0 96 set-token 
+' u#>         0 97 set-token 
+' sign        0 98 set-token 
+' u#          0 99 set-token 
+' u#s         0 9A set-token 
+' u.          0 9B set-token 
+' u.r         0 9C set-token 
+' .           0 9D set-token 
+' .r          0 9E set-token 
+' .s          0 9F set-token 
+' base        0 A0 set-token 
+\ ' convert   0 A1 set-token            \ historical, not supported
+' $number     0 A2 set-token 
+' digit       0 A3 set-token 
+' -1          0 A4 set-token
+'  0          0 A5 set-token
+'  1          0 A6 set-token
+'  2          0 A7 set-token
+'  3          0 A8 set-token
+' bl          0 A9 set-token
+' bs          0 AA set-token 
+' bell        0 AB set-token 
+' bounds      0 AC set-token 
+' here        0 AD set-token 
+' aligned     0 AE set-token 
+' wbsplit     0 AF set-token 
+' bwjoin      0 B0 set-token 
+' b(<mark)    1 B1 set-token
+' b(>resolve) 1 B2 set-token
+\ ' set-token-table   0 B3 set-token    \ historical, not supported
+\ ' set-table 0 B4 set-token            \ historical, not supported
+' new-token   0 B5 set-token 
+' named-token 0 B6 set-token
+' b(:)        1 B7 set-token
+' b(value)    1 B8 set-token 
+' b(variable) 1 B9 set-token 
+' b(constant) 1 BA set-token 
+' b(create)   1 BB set-token 
+' b(defer)    1 BC set-token 
+' b(buffer:)  1 BD set-token 
+' b(field)    1 BE set-token 
+\ ' b(code)   0 BF set-token            \ historical, not supported
+' fc-instance 1 C0 set-token 
+\ ' ferror    0 C1 set-token            \ Reserved
+' b(;)        1 C2 set-token
+' b(to)       1 C3 set-token 
+' b(case)     1 C4 set-token
+' b(endcase)  1 C5 set-token
+' b(endof)    1 C6 set-token
+' #           0 C7 set-token
+' #s          0 C8 set-token
+' #>          0 C9 set-token
+' external-token 0 CA set-token 
+' $find       0 CB set-token
+' offset16    0 CC set-token 
+' evaluate    0 CD set-token
+\             0  CE reserved
+\             0  CF reserved
+' c,          0  D0 set-token
+' w,          0  D1 set-token
+' l,          0  D2 set-token
+' ,           0  D3 set-token
+' um*         0  D4 set-token
+' um/mod      0  D5 set-token
+\             0  D6 reserved
+\             0  D7 reserved
+' d+          0  D8 set-token
+' d-          0  D9 set-token
+' get-token   0  DA set-token 
+' set-token   0  DB set-token 
+' state       0  DC set-token  \ possibly broken
+' compile,    0  DD set-token
+' behavior    0  DE set-token 
+
+\ Tokens 0xDF to 0xEF are reserved
+
+' start0            0  F0 set-token
+' start1            0  F1 set-token
+' start2            0  F2 set-token
+' start4            0  F3 set-token
+
+\ Tokens 0xF4 to 0xFB are reserved
+
+' ferror            0  FC set-token
+' version1          0  FD set-token
+
+\ ' 4-byte-id       0  FE set-token    \ Historical, not supported
+' end1              0  FF set-token
+
+\                   0 100 set-token    \ reserved
+' dma-alloc         0 101 set-token    \ Obsolete
+' my-address        0 102 set-token 
+' my-space          0 103 set-token
+\ ' memmap          0 104 set-token    \ Obsolete
+' free-virtual      0 105 set-token
+\ ' >physical       0 106 set-token    \ Obsolete
+
+\ Tokens 0x107 to 0x10e are reserved
+
+' my-params         0 10f set-token    \ Obsolete
+' property          0 110 set-token
+' encode-int        0 111 set-token
+' encode+           0 112 set-token
+' encode-phys       0 113 set-token
+' encode-string     0 114 set-token
+' encode-bytes      0 115 set-token
+' reg               0 116 set-token
+' intr              0 117 set-token    \ Obsolete
+' driver            0 118 set-token    \ Obsolete
+' model             0 119 set-token
+' device-type       0 11A set-token
+' parse-2int        0 11B set-token
+\ ' is-install      0 11C set-token    \ Will be set by framebuffer code
+\ ' is-remove       0 11D set-token    \ Will be set by framebuffer code
+\ ' is-selftest     0 11E set-token    \ Will be set by framebuffer code
+' new-device        0 11F set-token
+' diagnostic-mode?  0 120 set-token
+' display-status    0 121 set-token    \ Maybe obsolete
+' memory-test-suite 0 122 set-token
+' group-code        0 123 set-token    \ Obsolete
+' mask              0 124 set-token
+' get-msecs         0 125 set-token
+' ms                0 126 set-token
+' finish-device     0 127 set-token
+' decode-phys       0 128 set-token
+\ ' push-package    0 129 set-token    \ TODO - from proposal 215
+\ ' pop-package     0 12A set-token    \ TODO - from proposal 215
+' interpose         0 12B set-token    \ Recommended practice: Interposition
+
+\ Tokens 0x12C to 0x12F are reserved
+
+' map-low           0 130 set-token
+' sbus-intr>cpu     0 131 set-token    \ Obsolete
+
+\ Tokens 0x132 to 0x14f are reserved
+
+\ The following tokens will be set by the framebuffer code:
+\ ' #lines            0 150 set-token
+\ ' #columns          0 151 set-token
+\ ' line#             0 152 set-token
+\ ' column#           0 153 set-token
+\ ' inverse?          0 154 set-token
+\ ' inverse-screen?   0 155 set-token
+\ ' frame-buffer-busy 0 156 set-token  \ Historical, not supported
+\ ' draw-character    0 157 set-token
+\ ' reset-screen      0 158 set-token
+\ ' toggle-cursor     0 159 set-token
+\ ' erase-screen      0 15A set-token
+\ ' blink-screen      0 15B set-token
+\ ' invert-screen     0 15C set-token
+\ ' insert-characters 0 15D set-token
+\ ' delete-characters 0 15E set-token
+\ ' insert-lines      0 15F set-token
+\ ' delete-lines      0 160 set-token
+\ ' draw-logo         0 161 set-token
+\ ' frame-buffer-adr  0 162 set-token
+\ ' screen-height     0 163 set-token
+\ ' screen-width      0 164 set-token
+\ ' window-top        0 165 set-token
+\ ' window-left       0 166 set-token
+\ '                   0 167 set-token  \ Reserved
+\ ' foreground-color  0 168 set-token  \ From 16-color recommended practice
+\ ' background-color  0 169 set-token  \ From 16-color recommended practice
+\ ' default-font      0 16A set-token
+\ ' set-font          0 16B set-token
+\ ' char-height       0 16C set-token
+\ ' char-width        0 16D set-token
+\ ' >font             0 16E set-token
+\ ' fontbytes         0 16F set-token
+
+\ Tokens 0x170 to 0x17C are obsolete fb1 functions
+\ Tokens 0x17D to 0x17F are reserved
+
+\ The following tokens will be set by the framebuffer code, too:
+\ ' fb8-draw-character 0 180 set-token
+\ ' fb8-reset-screen   0 181 set-token
+\ ' fb8-toggle-cursor  0 182 set-token
+\ ' fb8-erase-screen   0 183 set-token
+\ ' fb8-blink-screen   0 184 set-token
+\ ' fb8-invert-screen  0 185 set-token
+\ ' fb8-insert-characters 0 186 set-token
+\ ' fb8-delete-characters 0 187 set-token
+\ ' fb8-insert-lines   0 188 set-token
+\ ' fb8-delete-lines   0 189 set-token
+\ ' fb8-draw-logo      0 18A set-token
+\ ' fb8-install        0 18B set-token
+
+\ Tokens 0x18C to 0x18F are reserved
+\ Tokens 0x190 to 0x196 are obsolete VMEbus tokens
+\ Tokens 0x197 to 0x19F are reserved
+
+\ ' return-buffer   0 1A0 set-token       \ Historical, not supported
+\ ' xmit-packet     0 1A1 set-token       \ Historical, not supported
+\ ' poll-packet     0 1A2 set-token       \ Historical, not supported
+\                   0 1A3 set-token       \ reserved
+' mac-address       0 1A4 set-token
+
+\ Tokens 0x1A5 to 0x200 are reserved
+
+' device-name       0 201 set-token
+' my-args           0 202 set-token
+' my-self           0 203 set-token
+' find-package      0 204 set-token
+' open-package      0 205 set-token
+' close-package     0 206 set-token
+' find-method       0 207 set-token
+' call-package      0 208 set-token
+' $call-parent      0 209 set-token
+' my-parent         0 20A set-token
+' ihandle>phandle   0 20B set-token
+\                   0 20C set-token       \ reserved
+' my-unit           0 20D set-token
+' $call-method      0 20E set-token
+' $open-package     0 20F set-token
+' processor-type    0 210 set-token       \ Obsolete
+' firmware-version  0 211 set-token       \ Obsolete
+' fcode-version     0 212 set-token       \ Obsolete
+\ ' alarm           0 213 set-token       \ TODO
+' (is-user-word)    0 214 set-token
+' suspend-fcode     0 215 set-token
+' fc-abort          0 216 set-token
+' catch             0 217 set-token
+' throw             0 218 set-token
+\ ' user-abort      0 219 set-token       \ TODO
+' get-my-property   0 21A set-token
+' decode-int        0 21B set-token
+' decode-string     0 21C set-token
+' get-inherited-property 0 21D set-token  
+' delete-property   0 21E set-token  
+' get-package-property 0 21F set-token
+' cpeek             0 220 set-token 
+' wpeek             0 221 set-token 
+' lpeek             0 222 set-token 
+' cpoke             0 223 set-token 
+' wpoke             0 224 set-token 
+' lpoke             0 225 set-token 
+' lwflip            0 226 set-token 
+' lbflip            0 227 set-token 
+' lbflips           0 228 set-token
+\ ' adr-mask        0 229 set-token       \ Historical, not supported
+
+\ Tokens 0x22A to 0x22F are reserved
+
+' rb@               0 230 set-token
+' rb!               0 231 set-token
+fc-set-normal-mmio-tokens                 \ Set rw@, rw!, rl@, rl!, rx@ and rx!
+
+' wbflips           0 236 set-token 
+' lwflips           0 237 set-token 
+\ ' probe           0 238 set-token       \ Obsolete
+\ ' probe-virtual   0 239 set-token       \ Obsolete
+\                   0 23A reserved
+' child             0 23B set-token
+' peer              0 23C set-token
+' next-property     0 23D set-token
+' byte-load         0 23E set-token
+' set-args          0 23F set-token
+' left-parse-string 0 240 set-token
+
+\ 64-bit extension tokens:
+' bxjoin            0 241 set-token
+' fc-<l@            0 242 set-token
+' lxjoin            0 243 set-token
+' wxjoin            0 244 set-token
+' x,                0 245 set-token
+' fc-x@             0 246 set-token
+' fc-x!             0 247 set-token
+' /x                0 248 set-token
+' /x*               0 249 set-token
+' xa+               0 24A set-token
+' xa1+              0 24B set-token
+' xbflip            0 24C set-token
+' xbflips           0 24D set-token
+' xbsplit           0 24E set-token
+' xlflip            0 24F set-token
+' xlflips           0 250 set-token
+' xlsplit           0 251 set-token
+' xwflip            0 252 set-token
+' xwflips           0 253 set-token
+' xwsplit           0 254 set-token
+
+\                    0 255 RESERVED FCODES 
+\                    ...
+\                    0 5FF RESERVED FCODES 
+
+\                    0 600 VENDOR FCODES 
+\                    ...
+\                    0 7FF VENDOR FCODES 
+
+\                    0 800 LOCAL FCODES 
+\                    ...
+\                    0 FFF LOCAL FCODES 
+
diff --git a/qemu/roms/SLOF/slof/fs/find-hash.fs b/qemu/roms/SLOF/slof/fs/find-hash.fs
new file mode 100644
index 000000000..a40ccbd4f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/find-hash.fs
@@ -0,0 +1,77 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+#ifdef HASH_DEBUG
+0 value from-hash
+0 value not-from-hash
+0 value hash-collisions
+#endif
+
+clean-hash
+
+: hash-find ( str len head -- 0 | link )
+   >r 2dup 2dup hash                  ( str len str len hash          R: head )
+   dup >r @ dup                       ( str len str len *hash *hash   R: head hash )
+   IF                                 ( str len str len *hash         R: head hash )
+      link>name name>string string=ci ( str len true|false            R: head hash )
+      dup 0=
+      IF
+#ifdef HASH_DEBUG
+         hash-collisions 1+
+         to hash-collisions
+#endif
+      THEN
+   ELSE
+      nip nip                         ( str len 0                     R: head hash )
+   THEN
+   IF                                 \ hash found
+      2drop r> @ r> drop              (  *hash                        R: )
+#ifdef HASH_DEBUG
+      from-hash 1+ to from-hash
+#endif
+      exit
+   THEN                               \ hash not found
+   r> r> swap >r ((find))             ( str len head                  R: hash=0 )
+   dup
+   IF
+#ifdef HASH_DEBUG
+      not-from-hash 1+
+      to not-from-hash
+#endif
+      dup r> !                        ( link                          R: )
+   ELSE
+      r> drop                         ( 0                             R: )
+   THEN
+;
+
+: hash-reveal  hash off ;
+
+' hash-reveal to (reveal)
+' hash-find to (find)
+
+#ifdef HASH_DEBUG
+\ print out all entries in the hash table
+: dump-hash-table  ( -- )
+   cr
+   hash-table hash-size 0  DO
+      dup @ dup 0<>  IF
+         over . s" : " type link>name name>string type cr
+      ELSE
+         drop
+      THEN
+      cell+
+   LOOP drop
+   s" hash-collisions: " type hash-collisions . cr
+   s" from-hash: " type from-hash . cr
+   s" not-from-hash: " type not-from-hash . cr
+;
+#endif
diff --git a/qemu/roms/SLOF/slof/fs/generic-disk.fs b/qemu/roms/SLOF/slof/fs/generic-disk.fs
new file mode 100644
index 000000000..0543c890e
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/generic-disk.fs
@@ -0,0 +1,68 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Generic disk support
+
+\ Input:
+\        name of device ( e.g. "disk", "cdrom", ... )
+\        dev# 
+
+\ Needs from parent in device tree:
+\        dev-read-blocks ( addr block# #blocks phys.lo ... phys.hi -- #read )
+\        block-size
+\        max-transfer
+
+\ Provides:
+\        open ( -- okay? )
+\        close ( -- )
+\        read ( addr len -- actual )
+\        seek ( pos.lo pos.hi -- status )
+\        read-blocks ( addr block# #blocks -- #read )
+\ Uses:
+\        disk-label package interpose for partition and file systems support
+\        deblocker package for byte read support
+
+( str len phys.lo ... phys.hi -- )
+new-device set-unit                                          ( str len )
+  2dup device-name 
+  s" 0 pci-alias-" 2swap $cat evaluate
+  s" block" device-type      
+
+\ Requiered interface for deblocker
+
+   s" block-size" $call-parent   CONSTANT block-size
+   s" max-transfer" $call-parent CONSTANT max-transfer 
+
+: read-blocks ( addr block# #blocks -- #read )
+   my-unit s" dev-read-blocks" $call-parent
+;    
+
+INSTANCE VARIABLE deblocker
+
+: open ( -- okay? )
+   0 0 s" deblocker" $open-package dup deblocker ! dup IF 
+      s" disk-label" find-package IF
+	 my-args rot interpose
+      THEN
+   THEN 0<> ;
+
+: close ( -- )
+   deblocker @ close-package ;
+
+: seek ( pos.lo pos.hi -- status )
+   s" seek" deblocker @ $call-method ;
+
+: read ( addr len -- actual )
+   s" read" deblocker @ $call-method ;
+
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/graphics.fs b/qemu/roms/SLOF/slof/fs/graphics.fs
new file mode 100644
index 000000000..7d5d9306d
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/graphics.fs
@@ -0,0 +1,87 @@
+\ *****************************************************************************
+\ * Copyright (c) 2015 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Provide some of the functions that are defined in the
+\ "OF Recommended Practice: 8bit Graphics Extension" document
+
+: draw-rectangle ( adr x y w h -- )
+   frame-buffer-adr 0= IF 4drop drop EXIT THEN
+   0 ?DO
+      4dup drop                              ( adr x y w adr x y )
+      \ calculate offset into framebuffer: ((y + i) * width + x) * depth
+      i + screen-width * + screen-depth *    ( adr x y w adr offs )
+      frame-buffer-adr +                     ( adr x y w adr fb_adr )
+      over 3 pick screen-depth * i * +       ( adr x y w adr fb_adr src )
+      swap 3 pick screen-depth *             ( adr x y w adr src fb_adr len )
+      rmove                                  \ copy line ( adr x y w adr )
+      drop                                   ( adr x y w )
+   LOOP
+   4drop
+;
+
+: fill-rectangle ( col x y w h -- )
+   frame-buffer-adr 0= IF 4drop drop EXIT THEN
+   0 ?DO
+      4dup drop                              ( col x y w col x y )
+      \ calculate offset into framebuffer: ((y + i) * width + x) * depth
+      i + screen-width * + screen-depth *    ( col x y w col offs )
+      frame-buffer-adr +                     ( col x y w col adr )
+      2 pick screen-depth * 2 pick           ( col x y w col adr len col )
+      rfill                                  \ draw line ( col x y w col )
+      drop                                   ( col x y w )
+   LOOP
+   4drop
+;
+
+: read-rectangle ( adr x y w h -- )
+   frame-buffer-adr 0= IF 4drop drop EXIT THEN
+   0 ?DO
+      4dup drop                              ( adr x y w adr x y )
+      \ calculate offset into framebuffer: ((y + i) * width + x) * depth
+      i + screen-width * + screen-depth *    ( adr x y w adr offs )
+      frame-buffer-adr +                     ( adr x y w adr fb_adr )
+      over 3 pick screen-depth * i * +       ( adr x y w adr fb_adr dst )
+      3 pick                                 ( adr x y w adr fb_adr dst w )
+      rmove                                  \ copy line ( adr x y w adr )
+      drop                                   ( adr x y w )
+   LOOP
+   4drop
+;
+
+: dimensions ( -- width height )
+   screen-width screen-height
+;
+
+\ Initialize a default palette (not a standard command, but useful anyway)
+: init-default-palette
+   \ Grayscale ramp for upper colors
+   100 10 DO
+     i i i i color!
+   LOOP
+   \ Standard colors from "16-color Text Extension" specification
+   00 00 00 0 color!
+   00 00 aa 1 color!
+   00 aa 00 2 color!
+   00 aa aa 3 color!
+   aa 00 00 4 color!
+   aa 00 aa 5 color!
+   aa 55 00 6 color!
+   aa aa aa 7 color!
+   55 55 55 8 color!
+   55 55 ff 9 color!
+   55 ff 55 a color!
+   55 ff ff b color!
+   ff 55 55 c color!
+   ff 55 ff d color!
+   ff ff 55 e color!
+   ff ff ff f color!
+;
diff --git a/qemu/roms/SLOF/slof/fs/history.fs b/qemu/roms/SLOF/slof/fs/history.fs
new file mode 100644
index 000000000..2c2c70fe0
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/history.fs
@@ -0,0 +1,107 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Create debug section in NVRAM
+: debug-init-nvram ( -- )
+   nvram-partition-type-debug get-nvram-partition IF
+      cr ." Could not find debug partition in NVRAM - "
+      nvram-partition-type-debug s" debug" d# 1024 new-nvram-partition
+      ABORT" Failed to create DEBUG NVRAM partition"
+      2dup erase-nvram-partition drop
+      ." created." cr
+   THEN
+   s" debug-nvram-partition" $2constant
+;
+
+debug-init-nvram
+
+: debug-add-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-add-env drop ;
+: debug-set-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-set-env drop ;
+: debug-get-env ( "name" -- "value" TRUE | FALSE) debug-nvram-partition 2swap internal-get-env ;
+
+: debug-get-history-enabled ( -- n )	s" history-enabled?" debug-get-env IF $number IF 0 THEN ELSE 0 THEN ;
+: debug-set-history-enabled ( n -- )	(.) s" history-enabled?" 2swap debug-set-env ;
+
+
+debug-get-history-enabled constant nvram-history?
+
+nvram-history? [IF]
+
+: history-init-nvram ( -- )
+   nvram-partition-type-history get-nvram-partition IF
+      cr ." Could not find history partition in NVRAM - "
+      nvram-partition-type-history s" history" d# 2048 new-nvram-partition
+      ABORT" Failed to create SMS NVRAM partition"
+      2dup erase-nvram-partition drop
+      ." created" cr
+   THEN
+   s" history-nvram-partition" $2constant
+;
+
+history-init-nvram
+
+0 value (history-len)
+0 value (history-adr)
+
+: (history-load-one) ( str len -- len )
+   \ 2dup ." loading " type cr
+   to (history-len) to (history-adr)
+   /his (history-len) + alloc-mem ( his )
+   his-tail 0= IF dup to his-tail THEN
+   his-head over his>next ! to his-head
+   his-head his>next @  his>prev his-head swap !
+   (history-len) his-head his>len !
+   (history-adr) his-head his>buf (history-len) move
+   (history-len) 1+
+;
+
+: history-load ( -- )
+   history-nvram-partition drop BEGIN dup WHILE
+      dup rzcount ( part str len )
+      dup IF
+         (history-load-one) +
+      ELSE
+         3drop 0
+      THEN
+   REPEAT
+   drop
+;
+
+: (history-store-one) ( pos len saddr slen -- FALSE | npos nlen TRUE )
+   dup 3 pick < IF \ enough space
+      dup >r rot >r
+      \ 2dup ." storing " type cr
+      bounds DO dup i c@ swap nvram-c! 1+ LOOP
+      dup 0 swap nvram-c! 1+
+      r> r> - 1- true
+   ELSE
+      2drop false
+   THEN
+;
+
+: history-store ( -- )
+   history-nvram-partition erase-nvram-partition drop
+   history-nvram-partition his-tail BEGIN dup WHILE
+      dup his>buf over his>len @
+      ( position len link saddr slen )
+      rot >r (history-store-one) r> 
+      swap IF his>prev @ ELSE drop 0 THEN
+   REPEAT
+   2drop drop
+;
+
+\ redefine "end of SLOF" words to safe history
+: reset-all history-store reset-all ;
+: reboot history-store reboot ;
+: boot history-store boot ;
+
+[THEN]
diff --git a/qemu/roms/SLOF/slof/fs/ide.fs b/qemu/roms/SLOF/slof/fs/ide.fs
new file mode 100644
index 000000000..d6f16edd0
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/ide.fs
@@ -0,0 +1,612 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\
+\ 26.06.2007  added: two devices (Master/Slave) per channel
+
+1 encode-int s" #address-cells" property
+0 encode-int s" #size-cells" property
+
+: decode-unit  1 hex-decode-unit ;
+: encode-unit  1 hex-encode-unit ;
+
+0 VALUE >ata                                 \ base address for command-block
+0 VALUE >ata1                                \ base address for control block
+
+true VALUE no-timeout                        \ flag that no timeout occurred
+
+0c  CONSTANT #cdb-bytes                      \ command descriptor block (12 bytes)
+800 CONSTANT atapi-size
+200 CONSTANT ata-size
+
+\ *****************************
+\ Some register access helpers.
+\ *****************************
+: ata-ctrl! 2 >ata1 + io-c! ;                      \ device control reg
+: ata-astat@ 2 >ata1 + io-c@ ;                     \ read alternate status
+                                                   
+: ata-data@ 0 >ata + io-w@ ;                       \ data reg
+: ata-data! 0 >ata + io-w! ;                       \ data reg
+: ata-err@  1 >ata + io-c@ ;                       \ error reg
+: ata-feat! 1 >ata + io-c! ;                       \ feature reg
+: ata-cnt@  2 >ata + io-c@ ;                       \ sector count reg
+: ata-cnt!  2 >ata + io-c! ;                       \ sector count reg
+: ata-lbal! 3 >ata + io-c! ;                       \ lba low reg
+: ata-lbal@ 3 >ata + io-c@ ;                       \ lba low reg
+: ata-lbam! 4 >ata + io-c! ;                       \ lba mid reg
+: ata-lbam@ 4 >ata + io-c@ ;                       \ lba mid reg
+: ata-lbah! 5 >ata + io-c! ;                       \ lba high reg
+: ata-lbah@ 5 >ata + io-c@ ;                       \ lba high reg
+: ata-dev!  6 >ata + io-c! ;                       \ device reg
+: ata-dev@  6 >ata + io-c@ ;                       \ device reg
+: ata-cmd!  7 >ata + io-c! ;                       \ command reg
+: ata-stat@ 7 >ata + io-c@ ;                       \ status reg
+
+\ **********************************************************************
+\ ATA / ATAPI Commands specifications:
+\ - AT Attachment 8 - ATA/ATAPI Command Set (ATA8-ACS)
+\ - ATA Packet Interface for CD-ROMs SFF-8020i
+\ - ATA/ATAPI Host Adapters Standard (T13/1510D)
+\ **********************************************************************
+00 CONSTANT cmd#nop                                \ ATA and ATAPI
+08 CONSTANT cmd#device-reset                       \ ATAPI only (mandatory)
+20 CONSTANT cmd#read-sector                        \ ATA and ATAPI
+90 CONSTANT cmd#execute-device-diagnostic          \ ATA and ATAPI
+a0 CONSTANT cmd#packet                             \ ATAPI only (mandatory)
+a1 CONSTANT cmd#identify-packet-device             \ ATAPI only (mandatory)
+ec CONSTANT cmd#identify-device                    \ ATA and ATAPI
+
+\ *****************************
+\ Setup Regs for ATA:
+\ BAR 0 & 1 : Device 0
+\ BAR 2 & 3 : Device 1
+\ *****************************
+: set-regs ( n -- )
+   dup
+   01 and                                    \ only Chan 0 or Chan 1 allowed
+   3 lshift dup 10 + config-l@ -4 and to >ata
+   14 + config-l@ -4 and to >ata1
+   02 ata-ctrl!                              \ disable interrupts
+   02 and
+   IF
+      10
+   ELSE
+      00
+   THEN
+   ata-dev!
+;
+
+ata-size VALUE block-size
+80000    VALUE max-transfer            \ Arbitrary, really
+
+CREATE sector d# 512 allot
+CREATE packet-cdb #cdb-bytes allot
+CREATE return-buffer atapi-size allot
+
+scsi-open                             \ add scsi functions
+
+\ ********************************
+\ show all ATAPI-registers
+\ data-register not read in order
+\ to not influence PIO mode
+\ ********************************
+: show-regs
+   cr
+   cr ." alt. Status: " ata-astat@ .
+   cr ." Status     : " ata-stat@ .
+   cr ." Device     : " ata-dev@ .
+   cr ." Error-Reg  : " ata-err@ .
+   cr ." Sect-Count : " ata-cnt@ .
+   cr ." LBA-Low    : " ata-lbal@ .
+   cr ." LBA-Med    : " ata-lbam@ .
+   cr ." LBA-High   : " ata-lbah@ .
+;
+
+\ ***************************************************
+\ reads ATAPI-Status and displays it if check-bit set
+\ ***************************************************
+: status-check               ( -- )
+   ata-stat@
+   dup   
+   01 and                                    \ is 'check' flag set ?
+   IF
+      cr
+      ."    - ATAPI-Status: " .
+      ata-err@                               \ retrieve sense code
+      dup
+      60 =                                   \ sense code = 6 ?
+      IF
+         ." ( media changed or reset )"      \ 'unit attention'
+         drop                                \ drop err-reg content
+      ELSE
+         dup
+         ." (Err : " .                       \ show err-reg content
+         space
+         rshift 4 .sense-text                \ show text string
+         29 emit
+      THEN
+      cr
+   ELSE
+      drop                                   \ remove unused status      
+   THEN      
+;
+
+\ *************************************
+\ Wait for interface ready condition
+\ Bit 7 of Status-Register is busy flag
+\ new version with abort after 5 sec.
+\ *************************************
+: wait-for-ready
+   get-msecs                                 \ start timer
+   BEGIN
+      ata-stat@ 80 and 0<>                   \ busy flag still set ?
+      no-timeout and
+      WHILE                                  \ yes
+         dup get-msecs swap
+         -                                   \ calculate timer difference
+         FFFF AND                            \ reduce to 65.5 seconds
+         d# 5000 >                           \ difference > 5 seconds ?
+         IF
+            false to no-timeout
+         THEN
+      REPEAT
+   drop
+;
+
+\ *************************************
+\ wait for specific status bits
+\ new version with abort after 5 sec.
+\ *************************************
+: wait-for-status          ( val mask -- )
+   get-msecs                                 \ initial timer value (start)
+   >r
+   BEGIN
+      2dup                                   \ val mask
+      ata-stat@ and <>                       \ expected status ?
+      no-timeout and                         \ and no timeout ?
+      WHILE      
+      get-msecs r@ -                         \ calculate timer difference
+      FFFF AND                               \ mask-off overflow bits
+      d# 5000 >                              \ 5 seconds exceeded ?
+      IF
+         false to no-timeout                 \ set global flag
+      THEN      
+   REPEAT                  
+   r>                                        \ clean return stack
+   3drop
+;
+
+\ *********************************    
+\ remove extra spaces from string end
+\ *********************************    
+: cut-string      ( saddr nul -- )
+   swap
+   over +
+   swap   
+   1 rshift                                  \ bytecount -> wordcount
+   0 do
+      /w -
+      dup               ( addr -- addr addr )
+      w@                ( addr addr -- addr nuw )
+      dup               ( addr nuw -- addr nuw nuw )
+      2020 =
+      IF
+         drop
+         0 
+      ELSE
+         LEAVE         
+      THEN
+      over         
+      w!
+   LOOP
+   drop
+   drop
+; 
+
+\ ****************************************************
+\ prints model-string received by identify device
+\ ****************************************************
+: show-model          ( dev# chan# -- )
+   2dup
+   ."    CH " .                  \ channel 0 / 1
+   0= IF ." / MA"                \ Master / Slave
+   ELSE  ." / SL"
+   THEN
+   swap
+   2 * + ."  (@" . ." ) : "      \ device number
+   sector 1 +
+   c@
+   80 AND 0=
+   IF
+      ." ATA-Drive    "
+   ELSE
+      ." ATAPI-Drive  "
+   THEN
+
+   22 emit                       \ start string display with "
+   sector d# 54 +                \ string starts 54 bytes from buffer start
+   dup
+   d# 40                         \ and is 40 chars long
+   cut-string                    \ remove all trailing spaces
+   
+   BEGIN
+      dup
+      w@
+      wbflip
+      wbsplit
+      dup 0<>                    \ first char
+      IF                   
+         emit
+         dup 0<>                 \ second char
+         IF
+            emit
+            wa1+                 \ increment address for next
+            false
+         ELSE                    \ second char = EndOfString
+            drop
+            true
+         THEN   
+      ELSE                       \ first char = EndOfString
+         drop
+         drop
+         true
+      THEN
+   UNTIL                         \ end of string detected
+   drop
+   22 emit                       \ end string display
+                                                  
+   sector c@                     \ get lower byte of first doublet
+   80 AND                        \ check bit 7
+   IF
+      ."  (removable media)"
+   THEN
+   
+   sector 1 +
+   c@
+   80 AND 0= IF                  \ is this an ATA drive ?
+      sector d# 120 +            \ get word 60 + 61
+      rl@-le                     \ read 32-bit as little endian value
+      d# 512                     \ standard ATA block-size
+      swap
+      .capacity-text ( block-size #blocks -- )
+   THEN
+   
+    sector d# 98 +               \ goto word 49
+    w@
+    wbflip
+    200 and 0= IF cr ."    ** LBA is not supported " THEN   
+
+   sector c@                     \ get lower byte of first doublet
+   03 AND 01 =                   \ we use 12-byte packet commands (=00b)
+   IF
+      cr ."    packet size = 16 ** not supported ! **"
+   THEN
+   no-timeout not                \ any timeout occurred so far ?
+   IF
+      cr   ."    ** timeout **"
+   THEN
+;
+
+\ ****************************
+\ ATA functions
+\ ****************************
+: pio-sector ( addr -- )  100 0 DO ata-data@
+   over w! wa1+ LOOP drop ;
+: pio-sector ( addr -- ) 
+  wait-for-ready pio-sector ;
+: pio-sectors ( n addr -- )  swap 0 ?DO dup pio-sector 200 + LOOP drop ;
+
+: lba!  lbsplit   
+   0f and 40 or                  \ always set LBA-mode + LBA (27..24)
+   ata-dev@ 10 and or            \ add current device-bit (DEV)
+   ata-dev!                      \ set LBA (27..24)
+   ata-lbah!                     \ set LBA (23..16)
+   ata-lbam!                     \ set LBA (15..8)
+   ata-lbal!                     \ set LBA (7..0)
+;
+
+: read-sectors ( lba count addr -- ) 
+  >r dup >r ata-cnt! lba! 20 ata-cmd! r> r> pio-sectors ;
+
+: read-sectors ( lba count addr dev-nr -- )
+    set-regs             ( lba count addr ) \ Set ata regs 
+    BEGIN >r dup 100 > WHILE
+       over 100 r@ read-sectors
+       >r 100 + r> 100 - r> 20000 + REPEAT
+    r> read-sectors
+;
+
+: ata-read-blocks                ( addr block# #blocks dev# -- #read )
+   swap dup >r swap >r rot r>    ( addr block# #blocks dev # R: #blocks )
+   read-sectors r>               ( R: #read )
+;    
+
+\ *******************************
+\ ATAPI functions
+\ preset LBA register with maximum
+\ allowed block-size (16-bits)
+\ *******************************
+: set-lba                              ( block-length -- )
+   lbsplit                             ( quad -- b1.lo b2 b3 b4.hi )
+   drop                                \ skip upper two bytes
+   drop
+   ata-lbah!
+   ata-lbam!
+;
+   
+\ *******************************************
+\ gets byte-count and reads a block of words
+\ from data-register to a buffer
+\ *******************************************
+: read-pio-block                        ( buff-addr -- buff-addr-new )
+   ata-lbah@ 8 lshift                  \ get block length High
+   ata-lbam@ or                        \ get block length Low
+   1 rshift                            \ bcount -> wcount
+   dup
+   0> IF                               \ any data to transfer?
+      0 DO                             \ words to read
+         dup                           \ buffer-address
+         ata-data@ swap w!             \ write 16-bits
+         wa1+                          \ address of next entry
+         LOOP
+      ELSE
+         drop                          ( buff-addr wcount -- buff-addr )
+      THEN
+   wait-for-ready
+;
+
+\ ********************************************
+\ ATAPI support
+\ Send a command block (12 bytes) in PIO mode
+\ read data if requested
+\ ********************************************
+: send-atapi-packet                    ( req-buffer -- )
+   >r                                  (   R: req-buffer )
+   atapi-size set-lba                  \ set regs to length limit
+   00 ata-feat!
+   cmd#packet ata-cmd!                 \ A0 = ATAPI packet command
+   48 C8  wait-for-status     ( val mask -- )  \ BSY:0 DRDY:1 DRQ:1
+   6 0  do
+      packet-cdb i 2 * +                \ transfer command block (12 bytes)
+      w@
+      ata-data!                        \ 6 doublets PIO transfer to device
+      loop                             \ copy packet to data-reg
+   status-check                        ( -- ) \ status err bit set ? -> display
+   wait-for-ready                      ( -- ) \ busy released ?
+   BEGIN
+   ata-stat@ 08 and 08 = WHILE         \ Data-Request-Bit set ?
+      r>                               \ get last target buffer address
+      read-pio-block                   \ only if from device requested
+      >r                               \ start of next block
+      REPEAT
+   r>                                  \ original value
+   drop                                \ return clean
+;   
+
+: atapi-packet-io                      ( -- )
+   return-buffer atapi-size erase      \ clear return buffer
+   return-buffer send-atapi-packet     \ send 'packet-cdb' , get 'return-buffer'
+;
+
+
+
+\ ********************************
+\ ATAPI packet commands
+\ ********************************
+
+\ Methods to access atapi disk
+
+: atapi-test ( -- true|false )
+   packet-cdb scsi-build-test-unit-ready     \ command-code: 00
+   atapi-packet-io                           ( )  \ send CDB, get return-buffer
+   ata-stat@ 1 and IF false ELSE true THEN
+;
+
+: atapi-sense ( -- ascq asc sense-key )
+   d# 252 packet-cdb scsi-build-request-sense ( alloc-len cdb -- )
+   atapi-packet-io                           ( )  \ send CDB, get return-buffer
+   return-buffer scsi-get-sense-data         ( cdb-addr -- ascq asc sense-key )
+;
+
+: atapi-read-blocks                    ( address block# #blocks dev# -- #read-blocks )
+   set-regs                            ( address block# #blocks )
+   dup >r                              ( address block# #blocks )
+   packet-cdb scsi-build-read-10       ( address block# #blocks cdb -- )
+   send-atapi-packet                   ( address -- )
+   r>                                  \ return requested number of blocks
+;
+
+\ ***************************************
+\ read capacity of drive medium
+\ use SCSI-Support Package
+\ ***************************************
+: atapi-read-capacity                        ( -- )
+   packet-cdb scsi-build-read-cap-10         \ fill block with command
+   atapi-packet-io                           ( )  \ send CDB, get return-buffer
+   return-buffer scsi-get-capacity-10        ( cdb -- block-size #blocks )
+   .capacity-text                            ( block-size #blocks -- )
+   status-check                              ( -- )
+;
+
+\ ***************************************
+\ read capacity of drive medium
+\ use SCSI-Support Package
+\ ***************************************
+: atapi-read-capacity-ext                    ( -- )
+   packet-cdb scsi-build-read-cap-16         \ fill block with command
+   atapi-packet-io                           ( )  \ send CDB, get return-buffer
+   return-buffer scsi-get-capacity-16        ( cdb -- block-size #blocks )
+   .capacity-text                            ( block-size #blocks -- )
+   status-check                              ( -- )
+;
+
+
+\ ***********************************************
+\ wait until media in drive is ready ( max 5 sec)
+\ ***********************************************
+: wait-for-media-ready                 ( -- true|false )
+   get-msecs                                 \ initial timer value (start)
+   >r
+   BEGIN
+      atapi-test                             \ unit ready? false if not      
+      not
+      no-timeout and
+      WHILE
+         atapi-sense  ( -- ascq asc sense-key )
+         02 =                                \ sense key 2 = media error
+         IF                                  \ check add. sense code
+            3A =                             \ asc: device not ready ?
+            IF
+               false to no-timeout
+               ."  empty (" . 29 emit        \ show asc qualifier
+            ELSE
+               drop                          \ discard asc qualifier
+            THEN                             \ medium not present, abort waiting
+         ELSE
+            drop                             \ discard asc
+            drop                             \ discard ascq
+         THEN
+         get-msecs r@ -                      \ calculate timer difference
+         FFFF AND                            \ mask-off overflow bits
+         d# 5000 >                           \ 5 seconds exceeded ?
+         IF
+            false to no-timeout              \ set global flag
+         THEN      
+   REPEAT
+   r>
+   drop
+   no-timeout
+;
+
+\ ******************************************************
+\ Method pointer for read-blocks methods
+\ controller implements 2 channels (primary / secondary)
+\ for 2 devices each (master / slasve)
+\ ******************************************************
+\ 2 channels (primary/secondary) per controller
+2 CONSTANT #chan 
+
+\ 2 devices (master/slave) per channel
+2 CONSTANT #dev
+
+\ results in a total of devices
+\ connected to a controller with
+\ two separate channels (4)
+: #totaldev #dev #chan * ;
+ 
+CREATE read-blocks-xt #totaldev cells allot read-blocks-xt #totaldev cells erase
+
+\ Execute read-blocks of device
+: dev-read-blocks  ( address block# #blocks dev# -- #read-blocks )
+   dup cells read-blocks-xt + @ execute
+;
+
+\ **********************************************************
+\ Read device type
+\ Signature      ATAPI             ATA
+\ ---------------------------------------------
+\ Sector Count    01h              01h
+\ Sector Number   01h              01h
+\ Cylinder Low    14h              00h
+\ Cylinder High   EBh              00h
+\ Device/Head     00h or 10h       00h or 01h
+\ see also ATA/ATAPI errata at:
+\ http://suif.stanford.edu/~csapuntz/blackmagic.html
+\ **********************************************************
+: read-ident  ( -- true|false )
+   false
+   00 ata-lbal!                              \ clear previous signature
+   00 ata-lbam!
+   00 ata-lbah!
+   cmd#identify-device ata-cmd! wait-for-ready \ first try ATA, ATAPI aborts command
+   ata-stat@ CF and 48 =
+   IF
+      drop true                                          \ cmd accepted, this is a ATA
+      d# 512 set-lba                                     \ set LBA to sector-length
+   ELSE                                                  \ ATAPI sends signature instead
+      ata-lbam@ 14 = IF                                  \ cylinder low  = 14 ?
+         ata-lbah@ EB = IF                               \ cylinder high = EB ?
+            cmd#device-reset ata-cmd! wait-for-ready     \ only supported by ATAPI
+            cmd#identify-packet-device ata-cmd! wait-for-ready                     \ first try ata
+            ata-stat@ CF and 48 = IF               
+               drop true                                 \ replace flag
+               THEN
+            THEN
+         THEN
+      THEN
+   dup IF
+      ata-stat@ 8 AND IF                        \ data requested (as expected) ?      
+         sector read-pio-block 
+         drop                                   \ discard address end 
+         ELSE
+         drop false
+         THEN
+      THEN
+   
+   no-timeout not IF                            \ check without any timeout ?
+      drop
+      false                                     \ no, detection discarded
+      THEN
+;
+
+scsi-close                             \ remove scsi commands from word list
+
+
+\ *************************************************
+\ Init controller ( chan 0 and 1 )
+\ device 0 (= master) and device 1 ( = slave)
+\  #dev  #chan   Dev-ID
+\ ----------------------
+\   0      0        0          Master of Channel 0
+\   0      1        1          Master of Channel 1
+\   1      0        2          Slave  of Channel 0
+\   1      1        3          Slave  of Channel 1
+\ *************************************************
+: find-disks      ( -- )   
+   #chan 0 DO                                      \ check 2 channels (primary & secondary)
+      #dev 0 DO                                    \ check 2 devices per channel (master / slave)
+         i 2 * j +
+         set-regs                                  \ set base address and dev-register for register access
+         ata-stat@ 7f and 7f <>                    \ Check, if device is connected
+         IF
+            true to no-timeout                     \ preset timeout-flag
+            read-ident        ( -- true|false )
+            IF
+               i j show-model                      \ print manufacturer + device string
+               sector 1+ c@ C0 and 80 =            \ Check for ata or atapi
+               IF
+                  wait-for-media-ready             \ wait up to 5 sec if not ready
+                  no-timeout and
+                  IF
+                     atapi-read-capacity
+                     atapi-size to block-size      \ ATAPI: 2048 bytes
+                     80000 to max-transfer
+                     ['] atapi-read-blocks i 2 * j + cells read-blocks-xt + !
+                     s" cdrom" strdup i 2 * j + s" generic-disk.fs" included
+                  ELSE
+                     ."  -"                        \ show hint for not registered
+                  THEN    
+               ELSE
+                  ata-size to block-size           \ ATA: 512 bytes
+                  80000 to max-transfer
+                  ['] ata-read-blocks i 2 * j + cells read-blocks-xt + !
+                  s" disk" strdup i 2 * j + s" generic-disk.fs" included
+               THEN
+            cr
+            THEN    
+         THEN
+         i 2 * j + 200 + cp
+      LOOP
+   LOOP
+;
+
+find-disks
+
diff --git a/qemu/roms/SLOF/slof/fs/instance.fs b/qemu/roms/SLOF/slof/fs/instance.fs
new file mode 100644
index 000000000..9e5c9215e
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/instance.fs
@@ -0,0 +1,193 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Support for device node instances.
+
+0 VALUE my-self
+
+400 CONSTANT max-instance-size
+
+STRUCT
+   /n FIELD instance>node
+   /n FIELD instance>parent
+   /n FIELD instance>args
+   /n FIELD instance>args-len
+   /n FIELD instance>size
+   /n FIELD instance>#units
+   /n FIELD instance>unit1          \ For instance-specific "my-unit"
+   /n FIELD instance>unit2
+   /n FIELD instance>unit3
+   /n FIELD instance>unit4
+CONSTANT /instance-header
+
+: >instance  ( offset -- myself+offset )
+   my-self 0= ABORT" No instance!"
+   dup my-self instance>size @ >= ABORT" Instance access out of bounds!"
+   my-self +
+;
+
+: (create-instance-var) ( initial-value -- )
+   get-node
+   dup node>instance-size @ cell+ max-instance-size
+   >= ABORT" Instance is bigger than max-instance-size!"
+   dup node>instance-template @      ( iv phandle tmp-ih )
+   swap node>instance-size dup @     ( iv tmp-ih *instance-size instance-size )
+   dup ,                             \ compile current instance ptr
+   swap 1 cells swap +!              ( iv tmp-ih instance-size )
+   + !
+;
+
+: create-instance-var ( "name" initial-value -- )
+   CREATE (create-instance-var) PREVIOUS
+;
+
+: (create-instance-buf) ( buffersize -- )
+   aligned                               \ align size to multiples of cells
+   dup get-node node>instance-size @ +   ( buffersize' newinstancesize )
+   max-instance-size > ABORT" Instance is bigger than max-instance-size!"
+   get-node node>instance-template @  get-node node>instance-size @ +
+   over erase                            \ clear according to IEEE 1275
+   get-node node>instance-size @         ( buffersize' old-instance-size )
+   dup ,                                 \ compile current instance ptr
+   + get-node node>instance-size !       \ store new size
+;
+
+: create-instance-buf ( "name" buffersize -- )
+   CREATE (create-instance-buf) PREVIOUS
+;
+
+VOCABULARY instance-words  ALSO instance-words DEFINITIONS
+
+: VARIABLE  0 create-instance-var DOES> [ here ] @ >instance ;
+: VALUE       create-instance-var DOES> [ here ] @ >instance @ ;
+: DEFER     0 create-instance-var DOES> [ here ] @ >instance @ execute ;
+: BUFFER:     create-instance-buf DOES> [ here ] @ >instance ;
+
+PREVIOUS DEFINITIONS
+
+\ Save XTs of the above instance-words (put on the stack with "[ here ]")
+CONSTANT <instancebuffer>
+CONSTANT <instancedefer>
+CONSTANT <instancevalue>
+CONSTANT <instancevariable>
+
+\ check whether a value or a defer word is an
+\ instance word: It must be a CREATE word and
+\ the DOES> part must do >instance as first thing
+
+: (instance?) ( xt -- xt true|false )
+   dup @ <create> = IF
+      dup cell+ @ cell+ @ ['] >instance =
+   ELSE
+      false
+   THEN
+;
+
+\ This word does instance values in compile mode.
+\ It corresponds to DOTO from engine.in
+: (doito) ( value R:*CFA -- )
+   r> cell+ dup >r
+   @ cell+ cell+ @ >instance !
+;
+' (doito) CONSTANT <(doito)>
+
+: to ( value wordname<> -- )
+   ' (instance?)
+   state @ IF
+      \ compile mode handling normal or instance value
+      IF ['] (doito) ELSE ['] DOTO THEN
+      , , EXIT
+   THEN
+   IF
+      cell+ cell+ @ >instance ! \ interp mode instance value
+   ELSE
+      cell+ !                   \ interp mode normal value
+   THEN
+; IMMEDIATE
+
+: behavior  ( defer-xt -- contents-xt )
+   dup cell+ @ <instancedefer> = IF   \ Is defer-xt an INSTANCE DEFER ?
+      2 cells + @ >instance @
+   ELSE
+      behavior
+   THEN
+;
+
+: INSTANCE  ALSO instance-words ;
+
+: my-parent  my-self instance>parent @ ;
+: my-args    my-self instance>args 2@ swap ;
+
+\ copy args from original instance to new created
+: set-my-args   ( old-addr len -- )
+   dup IF                             \ IF len > 0                    ( old-addr len )
+      dup alloc-mem                   \ | allocate space for new args ( old-addr len new-addr )
+      2dup my-self instance>args 2!   \ | write into instance struct  ( old-addr len new-addr )
+      swap move                       \ | and copy the args           ( )
+   ELSE                               \ ELSE                          ( old-addr len )
+      my-self instance>args 2!        \ | set new args to zero, too   ( )
+   THEN                               \ FI
+;
+
+\ Current node has already been set, when this is called.
+: create-instance-data ( -- instance )
+   get-node dup node>instance-template @    ( phandle instance-template )
+   swap node>instance-size @                ( instance-template instance-size )
+   dup >r
+   dup alloc-mem dup >r swap move r>        ( instance )
+   dup instance>size r> swap !              \ Store size for destroy-instance
+   dup instance>#units 0 swap !             \ Use node unit by default
+;
+: create-instance ( -- )
+   my-self create-instance-data
+   dup to my-self instance>parent !
+   get-node my-self instance>node !
+;
+
+: destroy-instance ( instance -- )
+   dup instance>args @ ?dup IF               \ Free instance args?
+      over instance>args-len @  free-mem
+   THEN
+   dup instance>size @  free-mem
+;
+
+: ihandle>phandle ( ihandle -- phandle )
+   dup 0= ABORT" no current instance" instance>node @
+;
+
+: push-my-self ( ihandle -- )  r> my-self >r >r to my-self ;
+: pop-my-self ( -- )  r> r> to my-self >r ;
+: call-package  push-my-self execute pop-my-self ;
+: $call-static ( ... str len node -- ??? )
+\  cr ." call for " 3dup -rot type ."  on node " .
+   find-method IF execute ELSE -1 throw THEN
+;
+
+: $call-my-method  ( str len -- )
+   my-self ihandle>phandle $call-static
+;
+
+: $call-method  ( str len ihandle -- )
+   push-my-self
+   ['] $call-my-method CATCH ?dup IF
+      pop-my-self THROW
+   THEN
+   pop-my-self
+;
+
+0 VALUE calling-child
+
+: $call-parent
+   my-self ihandle>phandle TO calling-child
+   my-parent $call-method
+   0 TO calling-child
+;
diff --git a/qemu/roms/SLOF/slof/fs/little-endian.fs b/qemu/roms/SLOF/slof/fs/little-endian.fs
new file mode 100644
index 000000000..f2e4e8d42
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/little-endian.fs
@@ -0,0 +1,77 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+deadbeef here l!
+here c@ de = CONSTANT ?bigendian
+here c@ ef = CONSTANT ?littleendian
+
+
+?bigendian [IF]
+
+: l!-le  >r lbflip r> l! ;
+: l@-le  l@ lbflip ;
+
+: w!-le  >r wbflip r> w! ;
+: w@-le  w@ wbflip ;
+
+: rx!-le  >r xbflip r> rx! ;
+: rx@-le  rx@ xbflip ;
+
+: rl!-le  >r lbflip r> rl! ;
+: rl@-le  rl@ lbflip ;
+
+: rw!-le  >r wbflip r> rw! ;
+: rw@-le  rw@ wbflip ;
+
+: l!-be  l! ;
+: l@-be  l@ ;
+
+: w!-be  w! ;
+: w@-be  w@ ;
+
+: rl!-be  rl! ;
+: rl@-be  rl@ ;
+
+: rw!-be  rw! ;
+: rw@-be  rw@ ;
+
+
+[ELSE]
+
+: l!-le  l! ;
+: l@-le  l@ ;
+
+: w!-le  w! ;
+: w@-le  w@ ;
+
+: rx!-le  rx! ;
+: rx@-le  rx@ ;
+
+: rl!-le  rl! ;
+: rl@-le  rl@ ;
+
+: rw!-le  rw! ;
+: rw@-le  rw@ ;
+
+: l!-be  >r lbflip r> l! ;
+: l@-be  l@ lbflip ;
+
+: w!-be  >r wbflip r> w! ;
+: w@-be  w@ wbflip ;
+
+: rl!-be  >r lbflip r> rl! ;
+: rl@-be  rl@ lbflip ;
+
+: rw!-be  >r wbflip r> rw! ;
+: rw@-be  rw@ wbflip ;
+
+[THEN]
diff --git a/qemu/roms/SLOF/slof/fs/loaders.fs b/qemu/roms/SLOF/slof/fs/loaders.fs
new file mode 100644
index 000000000..276ba6bca
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/loaders.fs
@@ -0,0 +1,94 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ \\\\\\\\\\\\\\ Global Data
+CREATE bootdevice 2 cells allot bootdevice 2 cells erase
+CREATE bootargs 2 cells allot bootargs 2 cells erase
+CREATE load-list 2 cells allot load-list 2 cells erase
+
+: start-elf ( arg len entry -- )
+   msr@ 7fffffffffffffff and 2000 or ciregs >srr1 ! call-client
+;
+
+: start-elf64 ( arg len entry r2 -- )
+    msr@ 2000 or ciregs >srr1 !
+    ciregs >r2  !
+    call-client \ entry point is pointer to .opd
+;
+
+: set-bootpath
+   s" disk" find-alias
+   dup IF ELSE drop s" boot-device" evaluate find-alias THEN
+   dup IF strdup ELSE 0 THEN
+   encode-string s" bootpath" set-chosen
+;
+
+: set-netbootpath
+   s" net" find-alias
+   ?dup IF strdup encode-string s" bootpath" set-chosen THEN
+;
+
+: set-bootargs
+   skipws 0 parse dup 0= IF
+      2drop s" boot-file" evaluate
+   THEN
+   encode-string s" bootargs" set-chosen
+;
+
+: .(client-exec) ( arg len -- rc )
+   s" snk" romfs-lookup 0<> IF
+      \ Load SNK client 15 MiB after Paflof... FIXME: Hard-coded offset is ugly!
+      paflof-start f00000 +
+      elf-load-file-to-addr drop \ FIXME - check this for LE, currently its BE only
+      dup @ swap 8 + @         \ populate entry r2
+      start-elf64 client-data
+   ELSE
+      2drop false
+   THEN
+;
+' .(client-exec) to (client-exec)
+
+: .client-exec ( arg len -- rc ) set-bootargs (client-exec) ;
+' .client-exec to client-exec
+
+: netflash ( -- rc ) s" netflash 2000000 " (parse-line) $cat set-netbootpath
+   client-exec
+;
+
+: netsave  ( "addr len {filename}[,params]" -- rc )
+   (parse-line) dup 0> IF
+      s" netsave " 2swap $cat set-netbootpath client-exec
+   ELSE
+      cr
+      ." Usage: netsave addr len [bootp|dhcp,]filename[,siaddr][,ciaddr][,giaddr][,bootp-retries][,tftp-retries][,use_ci]"
+      cr 2drop
+   THEN
+;
+
+: ping  ( "{device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]}" -- )
+   my-self >r current-node @ >r  \ Save my-self
+   (parse-line) open-dev dup  IF
+      dup to my-self dup ihandle>phandle set-node
+      dup
+      s" ping" rot ['] $call-method CATCH  IF
+         cr
+         ." Not a pingable device"
+         cr 3drop
+      THEN
+      swap close-dev
+   ELSE
+      cr
+      ." Usage: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]"
+      cr drop
+   THEN
+   r> set-node r> to my-self  \ Restore my-self
+;
diff --git a/qemu/roms/SLOF/slof/fs/logging.fs b/qemu/roms/SLOF/slof/fs/logging.fs
new file mode 100644
index 000000000..002c48091
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/logging.fs
@@ -0,0 +1,45 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Words to write to nvram log
+
+defer nvramlog-write-byte
+
+: .nvramlog-write-byte ( byte -- )
+#if defined(DISABLE_NVRAM) || defined(RTAS_NVRAM)
+        drop
+#else
+        0 1 asm-cout
+#endif
+;
+
+' .nvramlog-write-byte to nvramlog-write-byte
+
+: nvramlog-write-string ( str len -- )
+   dup 0> IF
+      0 DO dup c@ 
+      nvramlog-write-byte char+ LOOP
+   ELSE
+      drop
+   THEN drop ;
+
+: nvramlog-write-number ( number format -- )
+  0 swap <# 0 ?DO # LOOP #> 
+  nvramlog-write-string ;
+
+: nvramlog-write-string-cr ( str len -- )
+  nvramlog-write-string
+  a nvramlog-write-byte d nvramlog-write-byte ;
+
+\ as long as dual-emit is enabled
+\ the string is written into NVRAM as well!!
+: log-string ( str len -- ) type ;
diff --git a/qemu/roms/SLOF/slof/fs/node.fs b/qemu/roms/SLOF/slof/fs/node.fs
new file mode 100644
index 000000000..22bf77b6f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/node.fs
@@ -0,0 +1,766 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Device nodes.
+
+false VALUE debug-find-component?
+
+VARIABLE device-tree
+VARIABLE current-node
+: get-node  current-node @ dup 0= ABORT" No active device tree node" ;
+
+STRUCT
+  cell FIELD node>peer
+  cell FIELD node>parent
+  cell FIELD node>child
+  cell FIELD node>properties
+  cell FIELD node>words
+  cell FIELD node>instance-template
+  cell FIELD node>instance-size
+  cell FIELD node>space?
+  cell FIELD node>space
+  cell FIELD node>addr1
+  cell FIELD node>addr2
+  cell FIELD node>addr3
+END-STRUCT
+
+: find-method ( str len phandle -- false | xt true )
+  node>words @ voc-find dup IF link> true THEN ;
+
+\ Instances.
+#include "instance.fs"
+
+: create-node ( parent -- new )
+   max-instance-size alloc-mem        ( parent instance-mem )
+   dup max-instance-size erase >r     ( parent  R: instance-mem )
+   align wordlist >r wordlist >r      ( parent  R: instance-mem wl wl )
+   here                               ( parent new  R: instance-mem wl wl )
+   0 , swap , 0 ,                     \ Set node>peer, node>parent & node>child
+   r> , r> ,                          \ Set node>properties & node>words to wl
+   r> , /instance-header ,            \ Set instance-template & instance-size
+   FALSE , 0 ,                        \ Set node>space? and node>space
+   0 , 0 , 0 ,                        \ Set node>addr*
+;
+
+: peer    node>peer   @ ;
+: parent  node>parent @ ;
+: child   node>child  @ ;
+: peer  dup IF peer ELSE drop device-tree @ THEN ;
+
+
+: link ( new head -- ) \ link a new node at the end of a linked list
+  BEGIN dup @ WHILE @ REPEAT ! ;
+: link-node ( parent child -- )
+  swap dup IF node>child link ELSE drop device-tree ! THEN ;
+
+\ Set a node as active node.
+: set-node ( phandle -- )
+  current-node @ IF previous THEN
+  dup current-node !
+  ?dup IF node>words @ also context ! THEN
+  definitions ;
+: get-parent  get-node parent ;
+
+
+: new-node ( -- phandle ) \ active node becomes new node's parent;
+                          \ new node becomes active node
+\ XXX: change to get-node, handle root node creation specially
+  current-node @ dup create-node
+  tuck link-node dup set-node ;
+
+: finish-node ( -- )
+   \ TODO: maybe resize the instance template buffer here (or in finish-device)?
+   get-node parent set-node
+;
+
+: device-end ( -- )  0 set-node ;
+
+\ Properties.
+CREATE $indent 100 allot  VARIABLE indent 0 indent !
+#include "property.fs"
+
+\ Unit address.
+: #address-cells  s" #address-cells" rot parent get-property
+   ABORT" parent doesn't have a #address-cells property!"
+   decode-int nip nip
+;
+
+\ my-#address-cells returns the #address-cells property of the parent node.
+\ child-#address-cells returns the #address-cells property of the current node.
+
+\ This is confusing in several ways: Remember that a node's address is always
+\ described in the parent's address space, thus the parent's property is taken
+\ into regard, rather than the own.
+
+\ Also, an address-cell here is always a 32bit cell, no matter whether the
+\ "real" cell size is 32bit or 64bit.
+
+: my-#address-cells  ( -- #address-cells )
+   get-node #address-cells
+;
+
+: child-#address-cells  ( -- #address-cells )
+   s" #address-cells" get-node get-property
+   ABORT" node doesn't have a #address-cells property!"
+   decode-int nip nip
+;
+
+: child-#size-cells  ( -- #address-cells )
+   s" #size-cells" get-node get-property
+   ABORT" node doesn't have a #size-cells property!"
+   decode-int nip nip
+;
+
+: encode-phys  ( phys.hi ... phys.low -- prop len )
+   encode-first?  IF  encode-start  ELSE  here 0  THEN
+   my-#address-cells 0 ?DO rot encode-int+ LOOP
+;
+
+: encode-child-phys  ( phys.hi ... phys.low -- prop len )
+   encode-first?  IF  encode-start  ELSE  here 0  THEN
+   child-#address-cells 0 ?DO rot encode-int+ LOOP
+;
+
+: encode-child-size  ( size.hi ... size.low -- prop len )
+   encode-first? IF  encode-start  ELSE  here 0  THEN
+   child-#size-cells 0 ?DO rot encode-int+ LOOP
+;
+
+: decode-phys
+  my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT drop
+  my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ;
+: decode-phys-and-drop
+  my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT 3drop
+  my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ;
+: reg  >r encode-phys r> encode-int+ s" reg" property ;
+
+
+: >space    node>space @ ;
+: >space?   node>space? @ ;
+: >address  dup >r #address-cells dup 3 > IF r@ node>addr3 @ swap THEN
+                                  dup 2 > IF r@ node>addr2 @ swap THEN
+                                      1 > IF r@ node>addr1 @ THEN r> drop ;
+: >unit     dup >r >address r> >space ;
+
+: (my-phandle)  ( -- phandle )
+   my-self ?dup IF
+      ihandle>phandle
+   ELSE
+      get-node dup 0= ABORT" no active node"
+   THEN
+;
+
+: my-space ( -- phys.hi )
+   (my-phandle) >space
+;
+: my-address  (my-phandle) >address ;
+
+\ my-unit returns the unit address of the current _instance_ - that means
+\ it returns the same values as my-space and my-address together _or_ it
+\ returns a unit address that has been set manually while opening the node.
+: my-unit
+   my-self instance>#units @ IF
+      0 my-self instance>#units @ 1- DO
+         my-self instance>unit1 i cells + @
+      -1 +LOOP
+   ELSE
+      my-self ihandle>phandle >unit
+   THEN
+;
+
+\ Return lower 64 bit of address
+: my-unit-64 ( -- phys.lo+1|phys.lo )
+   my-unit                                ( phys.lo ... phys.hi )
+   (my-phandle) #address-cells            ( phys.lo ... phys.hi #ad-cells )
+   CASE
+      1   OF EXIT ENDOF
+      2   OF lxjoin EXIT ENDOF
+      3   OF drop lxjoin EXIT ENDOF
+      dup OF 2drop lxjoin EXIT ENDOF
+   ENDCASE
+;
+
+: set-space    get-node dup >r node>space ! true r> node>space? ! ;
+: set-address  my-#address-cells 1 ?DO
+               get-node node>space i cells + ! LOOP ;
+: set-unit     set-space set-address ;
+: set-unit-64 ( phys.lo|phys.hi -- )
+   my-#address-cells 2 <> IF
+      ." set-unit-64: #address-cells <> 2 " abort
+   THEN
+   xlsplit set-unit
+;
+
+\ Never ever use this in actual code, only when debugging interactively.
+\ Thank you.
+: set-args ( arg-str len unit-str len -- )
+   s" decode-unit" get-parent $call-static set-unit set-my-args
+;
+
+: $cat-unit
+   dup parent 0= IF drop EXIT THEN
+   dup >space? not IF drop EXIT THEN
+   dup >r >unit s" encode-unit" r> parent $call-static
+   dup IF
+      dup >r here swap move s" @" $cat here r> $cat
+   ELSE
+      2drop
+   THEN
+;
+
+: $cat-instance-unit
+   dup parent 0= IF drop EXIT THEN
+   \ No instance unit, use node unit
+   dup instance>#units @ 0= IF
+      ihandle>phandle $cat-unit
+      EXIT
+   THEN
+   dup >r push-my-self
+   ['] my-unit CATCH IF pop-my-self r> drop EXIT THEN
+   pop-my-self
+   s" encode-unit"
+   r> ihandle>phandle parent
+   $call-static
+   dup IF
+      dup >r here swap move s" @" $cat here r> $cat
+   ELSE
+      2drop
+   THEN
+;
+
+\ Getting basic info about a node.
+: node>name  dup >r s" name" rot get-property IF r> (u.) ELSE 1- r> drop THEN ;
+: node>qname dup node>name rot ['] $cat-unit CATCH IF drop THEN ;
+: node>path
+   here 0 rot
+   BEGIN dup WHILE dup parent REPEAT
+   2drop
+   dup 0= IF [char] / c, THEN
+   BEGIN
+      dup
+   WHILE
+      [char] / c, node>qname here over allot swap move
+   REPEAT
+   drop here 2dup - allot over -
+;
+
+: interposed? ( ihandle -- flag )
+  \ We cannot actually detect if an instance is interposed; instead, we look
+  \ if an instance is part of the "normal" chain that would be opened by
+  \ open-dev and friends, if there were no interposition.
+  dup instance>parent @ dup 0= IF 2drop false EXIT THEN
+  ihandle>phandle swap ihandle>phandle parent <> ;
+
+: instance>qname
+  dup >r interposed? IF s" %" ELSE 0 0 THEN
+  r@ dup ihandle>phandle node>name
+  rot ['] $cat-instance-unit CATCH IF drop THEN
+  $cat r> instance>args 2@ swap
+  dup IF 2>r s" :" $cat 2r> $cat ELSE 2drop THEN
+;
+
+: instance>qpath \ With interposed nodes.
+  here 0 rot BEGIN dup WHILE dup instance>parent @ REPEAT 2drop
+  dup 0= IF [char] / c, THEN
+  BEGIN dup WHILE [char] / c, instance>qname here over allot swap move
+  REPEAT drop here 2dup - allot over - ;
+: instance>path \ Without interposed nodes.
+  here 0 rot BEGIN dup WHILE
+  dup interposed? 0= IF dup THEN instance>parent @ REPEAT 2drop
+  dup 0= IF [char] / c, THEN
+  BEGIN dup WHILE [char] / c, instance>qname here over allot swap move
+  REPEAT drop here 2dup - allot over - ;
+
+: .node  node>path type ;
+: pwd  get-node .node ;
+
+: .instance instance>qpath type ;
+: .chain    dup instance>parent @ ?dup IF recurse THEN
+            cr dup . instance>qname type ;
+
+
+\ Alias helper
+defer find-node
+: set-alias ( alias-name len device-name len -- )
+    encode-string
+    2swap s" /aliases" find-node ?dup IF
+       set-property
+    ELSE
+       4drop
+    THEN
+;
+
+: find-alias ( alias-name len -- false | dev-path len )
+   s" /aliases" find-node dup IF
+      get-property 0= IF 1- dup 0= IF nip THEN ELSE false THEN
+   THEN
+;
+
+: .alias ( alias-name len -- )
+    find-alias dup IF type ELSE ." no alias available" THEN ;
+
+: (.print-alias) ( lfa -- )
+    link> dup >name name>string
+    \ Don't print name property
+    2dup s" name" string=ci IF 2drop drop
+    ELSE cr type space ." : " execute type
+    THEN ;
+
+: (.list-alias) ( phandle -- )
+    node>properties @ cell+ @ BEGIN dup WHILE dup (.print-alias) @ REPEAT drop ;
+
+: list-alias ( -- )
+    s" /aliases" find-node dup IF (.list-alias) THEN ;
+
+\ return next available name for aliasing or
+\ false if more than MAX-ALIAS aliases found
+8 CONSTANT MAX-ALIAS
+1 VALUE alias-ind
+: get-next-alias ( $alias-name -- $next-alias-name|FALSE )
+    2dup find-alias IF
+        drop
+        1 TO alias-ind
+        BEGIN
+            2dup alias-ind $cathex 2dup find-alias
+        WHILE
+            drop 2drop
+            alias-ind 1 + TO alias-ind
+            alias-ind MAX-ALIAS = IF
+                2drop FALSE EXIT
+            THEN
+        REPEAT
+        strdup 2swap 2drop
+    THEN
+;
+
+: devalias ( "{alias-name}<>{device-specifier}<cr>" -- )
+    parse-word parse-word dup IF set-alias
+    ELSE 2drop dup IF .alias
+    ELSE 2drop list-alias THEN THEN ;
+
+\ sub-alias does a single iteration of an alias at the beginning od dev path
+\ expression. de-alias will repeat this until all indirect alising is resolved
+: sub-alias ( arg-str arg-len -- arg' len' | false )
+   2dup
+   2dup [char] / findchar ?dup IF ELSE 2dup [char] : findchar THEN
+   ( a l a l [p] -1|0 ) IF nip dup ELSE 2drop 0 THEN >r
+   ( a l l p -- R:p | a l -- R:0 )
+   find-alias ?dup IF ( a l a' p' -- R:p | a' l' -- R:0 )
+      r@ IF
+         2swap r@ - swap r> + swap $cat strdup ( a" l-p+p' -- )
+      ELSE
+         ( a' l' -- R:0 ) r> drop ( a' l' -- )
+      THEN
+   ELSE
+      ( a l -- R:p | -- R:0 ) r> IF 2drop THEN
+      false ( 0 -- )
+   THEN
+;
+
+: de-alias ( arg-str arg-len -- arg' len' )
+   BEGIN
+      over c@ [char] / <> dup IF drop 2dup sub-alias ?dup THEN
+   WHILE
+      2swap 2drop
+   REPEAT
+;
+
+
+\ Display the device tree.
+: +indent ( not-last? -- )
+  IF s" |   " ELSE s"     " THEN $indent indent @ + swap move 4 indent +! ;
+: -indent ( -- )  -4 indent +! ;
+
+: ls-phandle ( node -- )  . ." :  " ;
+
+: ls-node ( node -- )
+   cr dup ls-phandle
+   $indent indent @ type
+   dup peer IF ." |-- " ELSE ." +-- " THEN
+   node>qname type
+;
+
+: (ls) ( node -- )
+  child BEGIN dup WHILE dup ls-node dup child IF
+  dup peer +indent dup recurse -indent THEN peer REPEAT drop ;
+
+: ls ( -- )
+   get-node cr
+   dup ls-phandle
+   dup node>path type
+   (ls)
+   0 indent !
+;
+
+: show-devs ( {device-specifier}<eol> -- )
+   skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN   ( str len )
+   find-node dup 0= ABORT" No such device path" (ls)
+;
+
+
+VARIABLE interpose-node
+2VARIABLE interpose-args
+: interpose ( arg len phandle -- )  interpose-node ! interpose-args 2! ;
+
+
+0 VALUE user-instance-#units
+CREATE user-instance-units 4 cells allot
+
+\ Copy the unit information (specified by the user) that we've found during
+\ "find-component" into the current instance data structure
+: copy-instance-unit  ( -- )
+   user-instance-#units IF
+      user-instance-#units my-self instance>#units !
+      user-instance-units my-self instance>unit1 user-instance-#units cells move
+      0 to user-instance-#units
+   THEN
+;
+
+
+: open-node ( arg len phandle -- ihandle|0 )
+   current-node @ >r  my-self >r            \ Save current node and instance
+   set-node create-instance set-my-args
+   copy-instance-unit
+   \ Execute "open" method if available, and assume default of
+   \ success (=TRUE) for nodes without open method:
+   s" open" get-node find-method IF execute ELSE TRUE THEN
+   0= IF
+      my-self destroy-instance 0 to my-self
+   THEN
+   my-self                                  ( ihandle|0 )
+   r> to my-self  r> set-node               \ Restore current node and instance
+   \ Handle interposition:
+   interpose-node @ IF
+      my-self >r to my-self
+      interpose-args 2@ interpose-node @
+      interpose-node off recurse
+      r> to my-self
+   THEN
+;
+
+: close-node ( ihandle -- )
+  my-self >r to my-self
+  s" close" ['] $call-my-method CATCH IF 2drop THEN
+  my-self destroy-instance r> to my-self ;
+
+: close-dev ( ihandle -- )
+  my-self >r to my-self
+  BEGIN my-self WHILE my-parent my-self close-node to my-self REPEAT
+  r> to my-self ;
+
+: new-device ( -- )
+   my-self new-node                     ( parent-ihandle phandle )
+   node>instance-template @             ( parent-ihandle ihandle )
+   dup to my-self                       ( parent-ihanlde ihandle )
+   instance>parent !
+   get-node my-self instance>node !
+   max-instance-size my-self instance>size !
+;
+
+: finish-device ( -- )
+   \ Set unit address to first entry of reg property if it has not been set yet
+   get-node >space? 0= IF
+      s" reg" get-node get-property 0= IF
+         decode-int set-space 2drop
+      THEN
+   THEN
+   finish-node my-parent to my-self
+;
+
+\ Set the instance template as current instance for extending it
+\ (i.e. to be able to declare new INSTANCE VARIABLEs etc. there)
+: extend-device  ( phandle -- )
+   my-self >r
+   dup set-node
+   node>instance-template @
+   dup to my-self
+   r> swap instance>parent !
+;
+
+: split ( str len char -- left len right len )
+  >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
+: generic-decode-unit ( str len ncells -- addr.lo ... addr.hi )
+  dup >r -rot BEGIN r@ WHILE r> 1- >r [char] , split 2swap
+  $number IF 0 THEN r> swap >r >r REPEAT r> 3drop
+  BEGIN dup WHILE 1- r> swap REPEAT drop ;
+: generic-encode-unit ( addr.lo ... addr.hi ncells -- str len )
+  0 0 rot ?dup IF 0 ?DO rot (u.) $cat s" ," $cat LOOP 1- THEN ;
+: hex-decode-unit ( str len ncells -- addr.lo ... addr.hi )
+  base @ >r hex generic-decode-unit r> base ! ;
+: hex-encode-unit ( addr.lo ... addr.hi ncells -- str len )
+  base @ >r hex generic-encode-unit r> base ! ;
+
+: hex64-decode-unit ( str len ncells -- addr.lo ... addr.hi )
+  dup 2 <> IF
+     hex-decode-unit
+  ELSE
+     drop
+     base @ >r hex
+     $number IF 0 0 ELSE xlsplit THEN
+     r> base !
+  THEN
+;
+
+: hex64-encode-unit ( addr.lo ... addr.hi ncells -- str len )
+  dup 2 <> IF
+     hex-encode-unit
+  ELSE
+     drop
+     base @ >r hex
+     lxjoin (u.)
+     r> base !
+  THEN
+;
+
+: handle-leading-/ ( path len -- path' len' )
+  dup IF over c@ [char] / = IF 1 /string device-tree @ set-node THEN THEN ;
+: match-name ( name len node -- match? )
+  over 0= IF 3drop true EXIT THEN
+  s" name" rot get-property IF 2drop false EXIT THEN
+  1- string=ci ; \ XXX should use decode-string
+
+0 VALUE #search-unit
+CREATE search-unit 4 cells allot
+
+: match-unit ( node -- match? )
+  \ A node with no space is a wildcard and will always match
+  dup >space? IF
+      node>space search-unit #search-unit 0 ?DO 2dup @ swap @ <> IF
+      2drop false UNLOOP EXIT THEN cell+ swap cell+ swap LOOP 2drop true
+  ELSE drop true THEN
+;
+: match-node ( name len node -- match? )
+  dup >r match-name r> match-unit and ; \ XXX e3d
+: find-kid ( name len -- node|0 )
+  dup -1 = IF \ are we supposed to stay in the same node? -> resolve-relatives
+    2drop get-node
+  ELSE
+    get-node child >r BEGIN r@ WHILE 2dup r@ match-node
+    IF 2drop r> EXIT THEN r> peer >r REPEAT
+    r> 3drop false
+  THEN ;
+
+: set-search-unit ( unit len -- )
+   0 to #search-unit
+   0 to user-instance-#units
+   dup 0= IF 2drop EXIT THEN
+   s" #address-cells" get-node get-property THROW
+   decode-int to #search-unit 2drop
+   s" decode-unit" get-node $call-static
+   #search-unit 0 ?DO search-unit i cells + ! LOOP
+;
+
+: resolve-relatives ( path len -- path' len' )
+  \ handle ..
+  2dup 2 = swap s" .." comp 0= and IF
+    get-node parent ?dup IF
+      set-node drop -1
+    ELSE
+      s" Already in root node." type
+    THEN
+  THEN
+  \ handle .
+  2dup 1 = swap c@ [CHAR] . = and IF
+    drop -1
+  THEN
+;
+
+\ XXX This is an old hack that allows wildcard nodes to work
+\     by not having a #address-cells in the parent and no
+\     decode unit. This should be removed.
+\     (It appears to be still used on js2x)
+: set-instance-unit  ( unitaddr len -- )
+   dup 0= IF 2drop  0 to user-instance-#units  EXIT THEN
+   2dup 0 -rot bounds ?DO
+      i c@ [char] , = IF 1+ THEN      \ Count the commas
+   LOOP
+   1+ dup to user-instance-#units
+   hex-decode-unit
+   user-instance-#units 0 ?DO
+      user-instance-units i cells + !
+   LOOP
+;
+
+: split-component  ( path. -- path'. args. name. unit. )
+   [char] / split 2swap     ( path'. component. )
+   [char] : split 2swap     ( path'. args. name@unit. )
+   [char] @ split           ( path'. args. name. unit. )
+;
+
+: find-component  ( path len -- path' len' args len node|0 )
+   debug-find-component? IF
+      ." find-component for " 2dup type cr
+   THEN
+   split-component           ( path'. args. name. unit. )
+   debug-find-component? IF
+      ." -> unit  =" 2dup type cr
+      ." -> stack =" .s cr
+   THEN
+   ['] set-search-unit CATCH IF
+      \ XXX: See comment in set-instance-unit
+      ." WARNING: Obsolete old wildcard hack " .s cr
+      set-instance-unit
+   THEN
+   resolve-relatives find-kid        ( path' len' args len node|0 )
+
+   \ If resolve returned a wildcard node, and we haven't hit
+   \ the above gross hack then copy the unit
+   dup IF dup >space? not #search-unit 0 > AND user-instance-#units 0= AND IF
+     #search-unit dup to user-instance-#units 0 ?DO
+        search-unit i cells + @ user-instance-units i cells + !
+     LOOP
+   THEN THEN
+
+   \ XXX This can go away with the old wildcard hack
+   dup IF dup >space? user-instance-#units 0 > AND IF
+      \ User supplied a unit value, but node also has different physical unit
+      cr ." find-component with unit mismatch!" .s cr
+      drop 0
+   THEN THEN
+;
+
+: .find-node ( path len -- phandle|0 )
+  current-node @ >r
+  handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN
+  BEGIN dup WHILE \ handle one component:
+  find-component ( path len args len node ) dup 0= IF
+  3drop 2drop r> set-node 0 EXIT THEN
+  set-node 2drop REPEAT 2drop
+  get-node r> set-node ;
+' .find-node to find-node
+: find-node ( path len -- phandle|0 ) de-alias find-node ;
+
+: delete-node ( phandle -- )
+   dup node>instance-template @ max-instance-size free-mem
+   dup node>parent @ node>child @ ( phandle 1st peer )
+   2dup = IF
+     node>peer @ swap node>parent @ node>child !
+     EXIT
+   THEN
+   dup node>peer @
+   BEGIN
+      2 pick 2dup <>
+   WHILE
+      drop
+      nip dup node>peer @
+      dup 0= IF 2drop drop unloop EXIT THEN
+   REPEAT
+   drop
+   node>peer @  swap node>peer !
+   drop
+;
+
+: open-dev ( path len -- ihandle|0 )
+   0 to user-instance-#units
+   de-alias current-node @ >r
+   handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN
+   my-self >r
+   0 to my-self
+   0 0 >r >r
+   BEGIN
+      dup
+   WHILE \ handle one component:
+     ( arg len ) r> r> get-node open-node to my-self
+     find-component ( path len args len node ) dup 0= IF
+        3drop 2drop my-self close-dev
+        r> to my-self
+        r> set-node
+        0 EXIT
+     THEN
+     set-node
+     >r >r
+  REPEAT
+  2drop
+  \ open final node
+  r> r> get-node open-node to my-self
+  my-self r> to my-self r> set-node
+;
+
+: select-dev  open-dev dup to my-self ihandle>phandle set-node ;
+: unselect-dev  my-self close-dev  0 to my-self  device-end ;
+
+: find-device ( str len -- ) \ set as active node
+  find-node dup 0= ABORT" No such device path" set-node ;
+: dev  parse-word find-device ;
+
+: (lsprop) ( node --)
+   dup cr $indent indent @ type ."     node: " node>qname type
+   false +indent (.properties) cr -indent
+;
+: (show-children) ( node -- )
+   child BEGIN
+      dup
+   WHILE
+      dup (lsprop) dup child IF false +indent dup recurse -indent THEN peer
+   REPEAT
+   drop
+;
+: lsprop ( {device-specifier}<eol> -- )
+   skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN
+   find-device get-node dup dup
+   cr ." node: " node>path type (.properties) cr (show-children)
+   0 indent !
+;
+
+
+\ node>path does not allot the memory, since it is internally only used
+\ for typing.
+\ The external variant needs to allot memory !
+
+: (node>path) node>path ;
+
+: node>path ( phandle -- str len )
+   node>path dup allot
+;
+
+\ Support for support packages.
+
+\ The /packages node.
+0 VALUE packages
+
+\ Find a support package (or arbitrary nodes when name is absolute)
+: find-package  ( name len -- false | phandle true )
+   dup 0 <= IF
+      2drop FALSE EXIT
+   THEN
+   \ According to IEEE 1275 Proposal 215 (Extensible Client Services Package),
+   \ the find-package method can be used to get the phandle of arbitrary nodes
+   \ (i.e. not only support packages) when the name starts with a slash.
+   \ Some FCODE programs depend on this behavior so let's support this, too!
+   over c@ [char] / = IF
+      find-node dup IF TRUE THEN EXIT
+   THEN
+   \ Ok, let's look for support packages instead. We can't use the standard
+   \ find-node stuff, as we are required to find the newest (i.e., last in our
+   \ tree) matching package, not just any.
+    0 >r packages child
+    BEGIN
+       dup
+    WHILE
+       dup >r node>name 2over string=ci r> swap IF
+          r> drop dup >r
+       THEN
+       peer
+    REPEAT
+    3drop
+    r> dup IF true THEN
+;
+
+: open-package ( arg len phandle -- ihandle | 0 )  open-node ;
+: close-package ( ihandle -- )  close-node ;
+: $open-package ( arg len name len -- ihandle | 0 )
+  find-package IF open-package ELSE 2drop false THEN ;
+
+
+\ device tree translate-address
+#include <translate.fs>
diff --git a/qemu/roms/SLOF/slof/fs/nvram.fs b/qemu/roms/SLOF/slof/fs/nvram.fs
new file mode 100644
index 000000000..5ea58d17f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/nvram.fs
@@ -0,0 +1,182 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2014 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+51 CONSTANT nvram-partition-type-cpulog
+\ types 53-55 are omitted because they have been used for
+\ storing binary tables in the past
+60 CONSTANT nvram-partition-type-sas
+61 CONSTANT nvram-partition-type-sms
+6e CONSTANT nvram-partition-type-debug
+6f CONSTANT nvram-partition-type-history
+70 CONSTANT nvram-partition-type-common
+7f CONSTANT nvram-partition-type-freespace
+a0 CONSTANT nvram-partition-type-linux
+
+: rztype ( str len -- ) \ stop at zero byte, read with nvram-c@
+   0 DO
+      dup i + nvram-c@ ?dup IF ( str char )
+         emit
+      ELSE                     ( str )
+         drop UNLOOP EXIT
+      THEN
+   LOOP
+;
+
+create tmpStr 500 allot
+: rzcount ( zstr -- str len )
+   dup tmpStr >r BEGIN
+      dup nvram-c@ dup r> dup 1+ >r c!
+   WHILE
+      char+
+   REPEAT
+   r> drop over - swap drop tmpStr swap
+;
+
+: calc-header-cksum ( offset -- cksum )
+   dup nvram-c@
+   10 2 DO
+      over I + nvram-c@ +
+   LOOP
+   wbsplit + nip
+;
+
+: bad-header? ( offset -- flag )
+   dup 2+ nvram-w@        ( offset length )
+   0= IF                  ( offset )
+      drop true EXIT      ( )
+   THEN
+   dup calc-header-cksum  ( offset checksum' )
+   swap 1+ nvram-c@       ( checksum ' checksum )
+   <>                     ( flag )
+;
+
+: .header ( offset -- )
+   cr                         ( offset )
+   dup bad-header? IF         ( offset )
+      ."   BAD HEADER -- trying to print it anyway" cr
+   THEN
+   space                      ( offset )
+   \ print type
+   dup nvram-c@ 2 0.r         ( offset )
+   space space                ( offset )
+   \ print length
+   dup 2+ nvram-w@ 10 * 5 .r  ( offset )
+   space space                ( offset )
+   \ print name
+   4 + 0c rztype              ( )
+;
+
+: .headers ( -- )
+   cr cr ." Type  Size  Name"
+   cr ." ========================"
+   0 BEGIN                      ( offset )
+      dup nvram-c@              ( offset type )
+   WHILE
+      dup .header               ( offset )
+      dup 2+ nvram-w@ 10 * +    ( offset offset' )
+      dup nvram-size < IF       ( offset )
+      ELSE
+	 drop EXIT              ( )
+      THEN
+   REPEAT
+   drop                         ( )
+   cr cr
+;
+
+: reset-nvram ( -- )
+   internal-reset-nvram
+;
+
+: dump-partition     ['] nvram-c@      1 (dump) ;
+
+: type-no-zero ( addr len -- )
+   0 DO
+      dup I + dup nvram-c@ 0= IF drop ELSE nvram-c@ emit THEN
+   LOOP
+   drop
+;
+
+: type-no-zero-part ( from-str cnt-str addr len )
+   0 DO
+      dup i + dup nvram-c@ 0= IF
+         drop
+      ELSE
+         ( from-str cnt-str addr addr+i )
+         ( from-str==0 AND cnt-str > 0 )
+         3 pick 0= 3 pick 0 > AND IF
+            dup 1 type-no-zero
+         THEN
+
+         nvram-c@ a = IF
+            2 pick 0= IF
+               over 1- 0 max
+               rot drop swap
+            THEN
+            2 pick 1- 0 max
+            3 roll drop rot rot
+            ( from-str-- cnt-str-- addr addr+i )
+         THEN
+      THEN
+   LOOP
+   drop
+;
+
+: (dmesg-prepare) ( base-addr -- base-addr' addr len act-off )
+   10 - \ go back to header
+   dup 14 + nvram-l@ dup >r
+   ( base-addr act-off ) ( R: act-off )
+   over over over + swap 10 + nvram-w@ + >r
+   ( base-addr act-off ) ( R:  act-off nvram-act-addr )
+   over 2 + nvram-w@ 10 * swap - over swap
+   ( base-addr base-addr start-size ) ( R:  act-off nvram-act-addr )
+   r> swap rot 10 + nvram-w@ - r>
+;
+
+: .dmesg ( base-addr -- )
+   (dmesg-prepare) >r
+   ( base-addr addr len )
+   cr type-no-zero
+   ( base-addr ) ( R: act-off )
+   dup 10 + nvram-w@ + r> type-no-zero
+;
+
+: .dmesg-part ( from-str cnt-str base-addr -- )
+   (dmesg-prepare) >r
+   ( from-str cnt-str base-addr addr len )
+   >r >r -rot r> r>
+   ( base-addr from-str cnt-str addr len )
+   cr type-no-zero-part rot
+   ( base-addr ) ( R: act-off )
+   dup 10 + nvram-w@ + r> type-no-zero-part
+;
+
+: dmesg-part ( from-str cnt-str -- left-from-str left-cnt-str )
+   2dup
+   s" ibm,CPU0log" get-named-nvram-partition IF
+      2drop EXIT
+   THEN
+   drop .dmesg-part nip nip
+;
+
+: dmesg2 ( -- )
+   s" ibm,CPU1log" get-named-nvram-partition IF
+      ." No log partition." cr EXIT
+   THEN
+   drop .dmesg
+;
+
+: dmesg ( -- )
+   s" ibm,CPU0log" get-named-nvram-partition IF
+      ." No log partition." cr EXIT
+   THEN
+   drop .dmesg
+;
diff --git a/qemu/roms/SLOF/slof/fs/packages.fs b/qemu/roms/SLOF/slof/fs/packages.fs
new file mode 100644
index 000000000..f640d8f61
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages.fs
@@ -0,0 +1,52 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2015 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ =============================================================================
+\                               SUPPORT PACKAGES
+\ =============================================================================
+
+
+s" packages" device-name
+get-node to packages
+
+\   new-device
+\   #include "packages/filler.fs"
+\   finish-device
+
+new-device
+#include "packages/deblocker.fs"
+finish-device
+
+new-device
+#include "packages/disk-label.fs"
+finish-device
+
+new-device
+#include "packages/fat-files.fs"
+finish-device
+
+new-device
+#include "packages/rom-files.fs"
+finish-device
+
+new-device
+#include "packages/ext2-files.fs"
+finish-device
+
+new-device
+#include "packages/obp-tftp.fs"
+finish-device
+
+new-device
+#include "packages/iso-9660.fs"
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/packages/deblocker.fs b/qemu/roms/SLOF/slof/fs/packages/deblocker.fs
new file mode 100644
index 000000000..83cd71278
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/deblocker.fs
@@ -0,0 +1,70 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ =============================================================================
+\ =============================================================================
+
+
+\ The deblocker.  Allows block devices to be used as a (seekable) byte device.
+
+s" deblocker" device-name
+
+INSTANCE VARIABLE offset
+INSTANCE VARIABLE block-size
+INSTANCE VARIABLE max-transfer
+INSTANCE VARIABLE my-block
+INSTANCE VARIABLE adr
+INSTANCE VARIABLE len
+INSTANCE VARIABLE fail-count
+
+: open
+  s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN
+  block-size !
+  s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN
+  max-transfer !
+  block-size @ alloc-mem my-block !
+  0 offset !
+  true ;
+: close  my-block @ block-size @ free-mem ;
+
+: seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying
+                           \      device would fail at this offset
+  lxjoin offset !  0 ;
+: block+remainder ( -- block# remainder )  offset @ block-size @ u/mod swap ;
+: read-blocks ( addr block# #blocks -- actual )  s" read-blocks" $call-parent ;
+: read ( addr len -- actual )
+  dup >r  len ! adr !
+  \ First, handle a partial block at the start.
+  block+remainder dup IF ( block# offset-in-block )
+  >r my-block @ swap 1 read-blocks drop
+  my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move
+  r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN
+
+  \ Now, in a loop read max. max-transfer sized runs of whole blocks.
+  0 fail-count !
+  BEGIN len @ block-size @ >= WHILE
+    adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks
+    dup 0= IF
+      1 fail-count +!
+      fail-count @ 5 >= IF r> drop EXIT THEN
+    ELSE
+      0 fail-count !
+    THEN
+    block-size @ * dup negate len +! dup adr +! offset +!
+  REPEAT
+
+  \ And lastly, handle a partial block at the end.
+  len @ IF my-block @ block+remainder drop 1 read-blocks drop
+  my-block @ adr @ len @ move THEN
+
+  r> ;
diff --git a/qemu/roms/SLOF/slof/fs/packages/disk-label.fs b/qemu/roms/SLOF/slof/fs/packages/disk-label.fs
new file mode 100644
index 000000000..fe1c25e7a
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/disk-label.fs
@@ -0,0 +1,660 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Set debug-disk-label? to true to get debug messages for the disk-label code.
+false VALUE debug-disk-label?
+
+\ This value defines the maximum number of blocks (512b) to load from a PREP
+\ partition. This is required to keep the load time in reasonable limits if the
+\ PREP partition becomes big.
+\ If we ever want to put a large kernel with initramfs from a PREP partition
+\ we might need to increase this value. The default value is 65536 blocks (32MB)
+d# 65536 value max-prep-partition-blocks
+
+s" disk-label" device-name
+
+0 INSTANCE VALUE partition
+0 INSTANCE VALUE part-offset
+0 INSTANCE VALUE disk-chrp-boot
+
+0 INSTANCE VALUE part-start
+0 INSTANCE VALUE lpart-start
+0 INSTANCE VALUE part-size
+0 INSTANCE VALUE dos-logical-partitions
+
+0 INSTANCE VALUE block-size
+0 INSTANCE VALUE block
+
+0 INSTANCE VALUE args
+0 INSTANCE VALUE args-len
+
+0 INSTANCE VALUE gpt-part-size
+0 INSTANCE VALUE seek-pos
+
+
+INSTANCE VARIABLE block#  \ variable to store logical sector#
+INSTANCE VARIABLE hit#    \ partition counter
+INSTANCE VARIABLE success-flag
+
+\ ISO9660 specific information
+0ff constant END-OF-DESC
+3 constant  PARTITION-ID
+48 constant VOL-PART-LOC
+
+
+\ DOS partition label (MBR) specific structures
+
+STRUCT
+       1b8 field mbr>boot-loader
+        /l field mbr>disk-signature
+        /w field mbr>null
+        40 field mbr>partition-table
+        /w field mbr>magic
+
+CONSTANT /mbr
+
+STRUCT
+        /c field part-entry>active
+        /c field part-entry>start-head
+        /c field part-entry>start-sect
+        /c field part-entry>start-cyl
+        /c field part-entry>id
+        /c field part-entry>end-head
+        /c field part-entry>end-sect
+        /c field part-entry>end-cyl
+        /l field part-entry>sector-offset
+        /l field part-entry>sector-count
+
+CONSTANT /partition-entry
+
+STRUCT
+        8 field gpt>signature
+        4 field gpt>revision
+        4 field gpt>header-size
+        4 field gpt>header-crc32
+        4 field gpt>reserved
+        8 field gpt>current-lba
+        8 field gpt>backup-lba
+        8 field gpt>first-lba
+        8 field gpt>last-lba
+       10 field gpt>disk-guid
+        8 field gpt>part-entry-lba
+        4 field gpt>num-part-entry
+        4 field gpt>part-entry-size
+        4 field gpt>part-array-crc32
+      1a4 field gpt>reserved
+
+CONSTANT /gpt-header
+
+STRUCT
+       10 field gpt-part-entry>part-type-guid
+       10 field gpt-part-entry>part-guid
+        8 field gpt-part-entry>first-lba
+        8 field gpt-part-entry>last-lba
+        8 field gpt-part-entry>attribute
+       48 field gpt-part-entry>part-name
+
+CONSTANT /gpt-part-entry
+
+\ Defined by IEEE 1275-1994 (3.8.1)
+
+: offset ( d.rel -- d.abs )
+   part-offset xlsplit d+
+;
+
+: seek  ( pos.lo pos.hi -- status )
+   offset
+   debug-disk-label? IF 2dup ." seek-parent: pos.hi=0x" u. ." pos.lo=0x" u. THEN
+   s" seek" $call-parent
+   debug-disk-label? IF dup ." status=" . cr THEN
+;
+
+: read ( addr len -- actual )
+   debug-disk-label? IF 2dup swap ." read-parent: addr=0x" u. ." len=" .d THEN
+   s" read" $call-parent
+   debug-disk-label? IF dup ." actual=" .d cr THEN
+;
+
+
+\ read sector to array "block"
+: read-sector ( sector-number -- )
+   \ block-size is 0x200 on disks, 0x800 on cdrom drives
+   block-size * 0 seek drop      \ seek to sector
+   block block-size read drop    \ read sector
+;
+
+: (.part-entry) ( part-entry )
+   cr ." part-entry>active:        " dup part-entry>active c@ .d
+   cr ." part-entry>start-head:    " dup part-entry>start-head c@ .d
+   cr ." part-entry>start-sect:    " dup part-entry>start-sect c@ .d
+   cr ." part-entry>start-cyl:     " dup part-entry>start-cyl  c@ .d
+   cr ." part-entry>id:            " dup part-entry>id c@ .d
+   cr ." part-entry>end-head:      " dup part-entry>end-head c@ .d
+   cr ." part-entry>end-sect:      " dup part-entry>end-sect c@ .d
+   cr ." part-entry>end-cyl:       " dup part-entry>end-cyl c@ .d
+   cr ." part-entry>sector-offset: " dup part-entry>sector-offset l@-le .d
+   cr ." part-entry>sector-count:  " dup part-entry>sector-count l@-le .d
+   cr
+;
+
+: (.name) r@ begin cell - dup @ <colon> = UNTIL xt>name cr type space ;
+
+: init-block ( -- )
+   s" block-size" ['] $call-parent CATCH IF ABORT" parent has no block-size." THEN
+   to block-size
+   d# 4096 alloc-mem
+   dup d# 4096 erase
+   to block
+   debug-disk-label? IF
+      ." init-block: block-size=" block-size .d ." block=0x" block u. cr
+   THEN
+;
+
+: partition>part-entry ( partition -- part-entry )
+   1- /partition-entry * block mbr>partition-table +
+;
+
+: partition>start-sector ( partition -- sector-offset )
+   partition>part-entry part-entry>sector-offset l@-le
+;
+
+\ This word returns true if the currently loaded block has _NO_ MBR magic
+: no-mbr? ( -- true|false )
+   0 read-sector
+   1 partition>part-entry part-entry>id c@ ee = IF TRUE EXIT THEN \ GPT partition found
+   block mbr>magic w@-le aa55 <>
+;
+
+\ This word returns true if the currently loaded block has _NO_ GPT partition id
+: no-gpt? ( -- true|false )
+   0 read-sector
+   1 partition>part-entry part-entry>id c@ ee <>
+;
+
+: pc-extended-partition? ( part-entry-addr -- true|false )
+   part-entry>id c@      ( id )
+   dup 5 = swap          ( true|false id )
+   dup f = swap          ( true|false true|false id )
+   85 =                  ( true|false true|false true|false )
+   or or                 ( true|false )
+;
+
+: count-dos-logical-partitions ( -- #logical-partitions )
+   no-mbr? IF 0 EXIT THEN
+   0 5 1 DO                                ( current )
+      i partition>part-entry               ( current part-entry )
+      dup pc-extended-partition? IF
+         part-entry>sector-offset l@-le    ( current sector )
+         dup to part-start to lpart-start  ( current )
+         BEGIN
+            part-start read-sector          \ read EBR
+            1 partition>start-sector IF
+               \ ." Logical Partition found at " part-start .d cr
+               1+
+            THEN \ another logical partition
+            2 partition>start-sector
+            ( current relative-sector )
+            ?dup IF lpart-start + to part-start false ELSE true THEN
+         UNTIL
+      ELSE
+         drop
+      THEN
+   LOOP
+;
+
+: (get-dos-partition-params) ( ext-part-start part-entry -- offset count active? id )
+   dup part-entry>sector-offset l@-le rot + swap ( offset part-entry )
+   dup part-entry>sector-count l@-le swap        ( offset count part-entry )
+   dup part-entry>active c@ 80 = swap            ( offset count active? part-entry )
+   part-entry>id c@                              ( offset count active? id )
+;
+
+: find-dos-partition ( partition# -- false | offset count active? id true )
+   to partition 0 to part-start 0 to part-offset
+
+   \ no negative partitions
+   partition 0<= IF 0 to partition false EXIT THEN
+
+   \ load MBR and check it
+   no-mbr? IF 0 to partition false EXIT THEN
+
+   partition 4 <= IF \ Is this a primary partition?
+      0 partition partition>part-entry
+      (get-dos-partition-params)
+      \ FIXME sanity checks?
+      true EXIT
+   ELSE
+      partition 4 - 0 5 1 DO                      ( logical-partition current )
+         i partition>part-entry                   ( log-part current part-entry )
+         dup pc-extended-partition? IF
+            part-entry>sector-offset l@-le        ( log-part current sector )
+            dup to part-start to lpart-start      ( log-part current )
+            BEGIN
+               part-start read-sector             \ read EBR
+               1 partition>start-sector IF        \ first partition entry
+                  1+ 2dup = IF                    ( log-part current )
+                     2drop
+                     part-start 1 partition>part-entry
+                     (get-dos-partition-params)
+                     true UNLOOP EXIT
+                  THEN
+                  2 partition>start-sector
+                  ( log-part current relative-sector )
+
+                  ?dup IF lpart-start + to part-start false ELSE true THEN
+               ELSE
+                  true
+               THEN
+            UNTIL
+         ELSE
+            drop
+         THEN
+      LOOP
+      2drop false
+   THEN
+;
+
+: try-dos-partition ( -- okay? )
+   \ Read partition table and check magic.
+   no-mbr? IF cr ." No DOS disk-label found." cr false EXIT THEN
+
+   count-dos-logical-partitions TO dos-logical-partitions
+
+   debug-disk-label? IF
+      ." Found " dos-logical-partitions .d ." logical partitions" cr
+      ." Partition = " partition .d cr
+   THEN
+
+   partition 1 5 dos-logical-partitions +
+   within 0= IF
+      cr ." Partition # not 1-" 4 dos-logical-partitions + . cr false EXIT
+   THEN
+
+   \ Could/should check for valid partition here...  the magic is not enough really.
+
+   \ Get the partition offset.
+
+   partition find-dos-partition IF
+     ( offset count active? id )
+     2drop
+     to part-size
+     block-size * to part-offset
+     true
+   ELSE
+     false
+   THEN
+;
+
+\ Check for an ISO-9660 filesystem on the disk
+\ : try-iso9660-partition ( -- true|false )
+\ implement me if you can ;-)
+\ ;
+
+
+\ Check for an ISO-9660 filesystem on the disk
+\ (cf. CHRP IEEE 1275 spec., chapter 11.1.2.3)
+: has-iso9660-filesystem  ( -- TRUE|FALSE )
+   \ Seek to the beginning of logical 2048-byte sector 16
+   \ refer to Chapter C.11.1 in PAPR 2.0 Spec
+   \ was: 10 read-sector, but this might cause trouble if you
+   \ try booting an ISO image from a device with 512b sectors.
+   10 800 * 0 seek drop      \ seek to sector
+   block 800 read drop       \ read sector
+   \ Check for CD-ROM volume magic:
+   block c@ 1 =
+   block 1+ 5 s" CD001"  str=
+   and
+   dup IF 800 to block-size THEN
+;
+
+
+\ Load from first active DOS boot partition.
+
+\ NOTE: block-size is always 512 bytes for DOS partition tables.
+
+: load-from-dos-boot-partition ( addr -- size )
+   no-mbr? IF drop FALSE EXIT THEN  \ read MBR and check for DOS disk-label magic
+
+   count-dos-logical-partitions TO dos-logical-partitions
+
+   debug-disk-label? IF
+      ." Found " dos-logical-partitions .d ." logical partitions" cr
+      ." Partition = " partition .d cr
+   THEN
+
+   \ Now walk through the partitions:
+   5 dos-logical-partitions + 1 DO
+      \ ." checking partition " i .
+      i find-dos-partition IF        ( addr offset count active? id )
+         41 = and                    ( addr offset count prep-boot-part? )
+         IF                          ( addr offset count )
+            max-prep-partition-blocks min  \ reduce load size
+            swap                     ( addr count offset )
+            block-size * to part-offset
+            0 0 seek drop            ( addr offset )
+            block-size * read        ( size )
+            UNLOOP EXIT
+         ELSE
+            2drop                    ( addr )
+         THEN
+      THEN
+   LOOP
+   drop 0
+;
+
+\ Check for GPT PReP partition GUID
+9E1A2D38     CONSTANT GPT-PREP-PARTITION-1
+C612         CONSTANT GPT-PREP-PARTITION-2
+4316         CONSTANT GPT-PREP-PARTITION-3
+AA26         CONSTANT GPT-PREP-PARTITION-4
+8B49521E5A8B CONSTANT GPT-PREP-PARTITION-5
+
+: gpt-prep-partition? ( -- true|false )
+   block gpt-part-entry>part-type-guid l@-le GPT-PREP-PARTITION-1 = IF
+      block gpt-part-entry>part-type-guid 4 + w@-le
+      GPT-PREP-PARTITION-2 = IF
+         block gpt-part-entry>part-type-guid 6 + w@-le
+         GPT-PREP-PARTITION-3 = IF
+            block gpt-part-entry>part-type-guid 8 + w@
+            GPT-PREP-PARTITION-4 = IF
+               block gpt-part-entry>part-type-guid a + w@
+               block gpt-part-entry>part-type-guid c + l@ swap lxjoin
+               GPT-PREP-PARTITION-5 = IF
+                   TRUE EXIT
+               THEN
+            THEN
+         THEN
+      THEN
+   THEN
+   FALSE
+;
+
+: load-from-gpt-prep-partition ( addr -- size )
+   no-gpt? IF drop FALSE EXIT THEN
+   debug-disk-label? IF
+      cr ." GPT partition found " cr
+   THEN
+   1 read-sector block gpt>part-entry-lba l@-le
+   block-size * to seek-pos
+   block gpt>part-entry-size l@-le to gpt-part-size
+   block gpt>num-part-entry l@-le dup 0= IF FALSE EXIT THEN
+   1+ 1 ?DO
+      seek-pos 0 seek drop
+      block gpt-part-size read drop gpt-prep-partition? IF
+         debug-disk-label? IF
+            ." GPT PReP partition found " cr
+         THEN
+         block gpt-part-entry>first-lba x@ xbflip
+         block gpt-part-entry>last-lba x@ xbflip
+         over - 1+                 ( addr offset len )
+         swap                      ( addr len offset )
+         block-size * to part-offset
+         0 0 seek drop             ( addr len )
+         block-size * read         ( size )
+         UNLOOP EXIT
+      THEN
+      seek-pos gpt-part-size i * + to seek-pos
+   LOOP
+   FALSE
+;
+
+\ Extract the boot loader path from a bootinfo.txt file
+\ In: address and length of buffer where the bootinfo.txt has been loaded to.
+\ Out: string address and length of the boot loader (within the input buffer)
+\      or a string with length = 0 when parsing failed.
+
+\ Here is a sample bootinfo file:
+\ <chrp-boot>
+\   <description>Linux Distribution</description>
+\   <os-name>Linux</os-name>
+\   <boot-script>boot &device;:1,\boot\yaboot.ibm</boot-script>
+\   <icon size=64,64 color-space=3,3,2>
+\     <bitmap>[..]</bitmap>
+\   </icon>
+\ </chrp-boot>
+
+: parse-bootinfo-txt  ( addr len -- str len )
+   2dup s" <boot-script>" find-substr       ( addr len pos1 )
+   2dup = IF
+      \ String not found
+      3drop 0 0 EXIT
+   THEN
+   dup >r - swap r> + swap                  ( addr1 len1 )
+
+   2dup s" &device;:" find-substr           ( addr1 len1 posdev )
+   2dup = IF
+      3drop 0 0 EXIT
+   THEN
+   9 +                                      \ Skip the "&device;:" string
+   dup >r - swap r> + swap                  ( addr2 len2 )
+   2dup s" </boot-script>" find-substr nip  ( addr2 len3 )
+
+   debug-disk-label? IF
+      ." Extracted boot loader from bootinfo.txt: '"
+      2dup type ." '" cr
+   THEN
+;
+
+\ Try to load \ppc\bootinfo.txt from the disk (used mainly on CD-ROMs), and if
+\ available, get the boot loader path from this file and load it.
+\ See the "CHRP system binding to IEEE 1275" specification for more information
+\ about bootinfo.txt. An example file can be found in the comment of
+\ parse-bootinfo-txt ( addr len -- str len )
+
+: load-chrp-boot-file ( addr -- size )
+   \ Create bootinfo.txt path name and load that file:
+   my-parent instance>path
+   disk-chrp-boot @ 1 = IF
+       s" :1,\ppc\bootinfo.txt" $cat strdup       ( addr str len )
+   ELSE
+       s" :\ppc\bootinfo.txt" $cat strdup       ( addr str len )
+   THEN
+   open-dev dup 0= IF 2drop 0 EXIT THEN
+   >r dup                                   ( addr addr R:ihandle )
+   dup s" load" r@ $call-method             ( addr addr size R:ihandle )
+   r> close-dev                             ( addr addr size )
+
+   \ Now parse the information from bootinfo.txt:
+   parse-bootinfo-txt                       ( addr fnstr fnlen )
+   dup 0= IF 3drop 0 EXIT THEN
+   \ Does the string contain parameters (i.e. a white space)?
+   2dup 20 findchar IF
+      ( addr fnstr fnlen offset )
+      >r 2dup r@ - 1- swap r@ + 1+ swap     ( addr fnstr fnlen pstr plen  R: offset )
+      encode-string s" bootargs" set-chosen
+      drop r>
+   THEN
+
+   \ Create the full path to the boot loader:
+   my-parent instance>path      ( addr fnstr fnlen nstr nlen )
+   s" :" $cat 2swap $cat strdup             ( addr str len )
+   \ Update the bootpath:
+   2dup encode-string s" bootpath" set-chosen
+   \ And finally load the boot loader itself:
+   open-dev dup 0= IF ." failed to load CHRP boot loader." 2drop 0 EXIT THEN
+   >r s" load" r@ $call-method              ( size R:ihandle )
+   r> close-dev                             ( size )
+;
+
+\ load from a bootable partition
+: load-from-boot-partition ( addr -- size )
+   debug-disk-label? IF ." Trying DOS boot " .s cr THEN
+   dup load-from-dos-boot-partition ?dup 0 <> IF nip EXIT THEN
+
+   debug-disk-label? IF ." Trying CHRP boot " .s cr THEN
+   1 disk-chrp-boot !
+   dup load-chrp-boot-file ?dup 0 <> IF .s cr nip EXIT THEN
+   0 disk-chrp-boot !
+
+   debug-disk-label? IF ." Trying GPT boot " .s cr THEN
+   load-from-gpt-prep-partition
+   \ More boot partition formats ...
+;
+
+\ parse partition number from my-args
+
+\ my-args has the following format
+\ [<partition>[,<path>]]
+
+\ | example my-args  | example boot command      |
+\ +------------------+---------------------------+
+\ | 1,\boot\vmlinuz  | boot disk:1,\boot\vmlinuz |
+\ | 2                | boot disk:2               |
+
+\ 0 means the whole disk, this is the same behavior
+\ as if no partition is specified (yaboot wants this).
+
+: parse-partition ( -- okay? )
+   0 to partition
+   0 to part-offset
+   0 to part-size
+
+   my-args to args-len to args
+
+   debug-disk-label? IF
+      cr ." disk-label parse-partition: my-args=" my-args type cr
+   THEN
+
+   \ Called without arguments?
+   args-len 0 = IF true EXIT THEN
+
+   \ Check for "full disk" arguments.
+   my-args [char] , findchar 0= IF \ no comma?
+      args c@ isdigit not IF       \ ... and not a partition number?
+         true EXIT                 \ ... then it's not a partition we can parse
+      THEN
+   ELSE
+      drop
+   THEN
+   my-args [char] , split to args-len to args
+   dup 0= IF 2drop true EXIT THEN \ no first argument
+
+   \ Check partition #.
+   base @ >r decimal $number r> base !
+   IF cr ." Not a partition #" false EXIT THEN
+
+   \ Store part #, done.
+   to partition
+   true
+;
+
+
+\ try-files and try-partitions
+
+: (interpose-filesystem) ( str len -- )
+   find-package IF args args-len rot interpose THEN
+;
+
+: try-dos-files ( -- found? )
+   no-mbr? IF false EXIT THEN
+
+   \ block 0 byte 0-2 is a jump instruction in all FAT
+   \ filesystems.
+   \ e9 and eb are jump instructions in x86 assembler.
+   block c@ e9 <> IF
+      block c@ eb <>
+      block 2+ c@ 90 <> or
+      IF false EXIT THEN
+   THEN
+   s" fat-files" (interpose-filesystem)
+   true
+;
+
+: try-ext2-files ( -- found? )
+   2 read-sector               \ read first superblock
+   block d# 56 + w@-le         \ fetch s_magic
+   ef53 <> IF false EXIT THEN  \ s_magic found?
+   s" ext2-files" (interpose-filesystem)
+   true
+;
+
+
+: try-iso9660-files
+   has-iso9660-filesystem 0= IF false exit THEN
+   s" iso-9660" (interpose-filesystem)
+   true
+;
+
+: try-files ( -- found? )
+   \ If no path, then full disk.
+   args-len 0= IF true EXIT THEN
+
+   try-dos-files IF true EXIT THEN
+   try-ext2-files IF true EXIT THEN
+   try-iso9660-files IF true EXIT THEN
+
+   \ ... more filesystem types here ...
+
+   false
+;
+
+: try-partitions ( -- found? )
+   try-dos-partition IF try-files EXIT THEN
+   \ try-iso9660-partition IF try-files EXIT THEN
+   \ ... more partition types here...
+   false
+;
+
+\ Interface functions for disk-label package
+\ as defined by IEEE 1275-1994 3.8.1
+
+: close ( -- )
+   debug-disk-label? IF ." Closing disk-label: block=0x" block u. ." block-size=" block-size .d cr THEN
+   block d# 4096 free-mem
+;
+
+
+: open ( -- true|false )
+   init-block
+
+   parse-partition 0= IF
+      close
+      false EXIT
+   THEN
+
+   partition IF
+       try-partitions
+   ELSE
+       try-files
+   THEN
+   dup 0= IF debug-disk-label? IF ." not found." cr THEN close THEN \ free memory again
+;
+
+
+\ Boot & Load w/o arguments is assumed to be boot from boot partition
+
+: load ( addr -- size )
+   debug-disk-label? IF
+      ." load: " dup u. cr
+   THEN
+
+   args-len IF
+      TRUE ABORT" Load done w/o filesystem"
+   ELSE
+      partition IF
+         0 0 seek drop
+         part-size IF
+            part-size max-prep-partition-blocks min   \ Load size
+         ELSE
+            max-prep-partition-blocks
+         THEN
+         200 *  read
+      ELSE
+         has-iso9660-filesystem IF
+             dup load-chrp-boot-file ?dup 0 > IF nip EXIT THEN
+         THEN
+         load-from-boot-partition
+	 dup 0= ABORT" No boot partition found"
+      THEN
+   THEN
+;
diff --git a/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs b/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs
new file mode 100644
index 000000000..262c64a34
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs
@@ -0,0 +1,188 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+s" ext2-files" device-name
+
+INSTANCE VARIABLE first-block
+INSTANCE VARIABLE inode-size
+INSTANCE VARIABLE block-size
+INSTANCE VARIABLE inodes/group
+
+INSTANCE VARIABLE group-desc-size
+INSTANCE VARIABLE group-descriptors
+
+: seek  s" seek" $call-parent ;
+: read  s" read" $call-parent ;
+
+INSTANCE VARIABLE data
+INSTANCE VARIABLE #data
+INSTANCE VARIABLE indirect-block
+INSTANCE VARIABLE dindirect-block
+
+: free-data
+  data @ ?dup IF #data @ free-mem  0 data ! THEN ;
+: read-data ( offset size -- )
+  free-data  dup #data ! alloc-mem data !
+  xlsplit seek            -2 and ABORT" ext2-files read-data: seek failed"
+  data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ;
+
+: read-block ( block# -- )
+  block-size @ * block-size @ read-data ;
+
+INSTANCE VARIABLE inode
+INSTANCE VARIABLE file-len
+INSTANCE VARIABLE blocks
+INSTANCE VARIABLE #blocks
+INSTANCE VARIABLE ^blocks
+INSTANCE VARIABLE #blocks-left
+: blocks-read ( n -- )  dup negate #blocks-left +! 4 * ^blocks +! ;
+: read-indirect-blocks ( indirect-block# -- )
+  read-block data @ data off
+  dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move
+  r> 2 rshift blocks-read block-size @ free-mem ;
+
+: read-double-indirect-blocks ( double-indirect-block# -- )
+   \ Resolve one level of indirection and call read-indirect-block
+   read-block data @ indirect-block ! data off
+   BEGIN
+      indirect-block @ l@-le dup 0 <>
+   WHILE
+      read-indirect-blocks
+      4 indirect-block +!       \ point to next indirect block
+   REPEAT
+   drop                         \ drop 0, the invalid block number
+;
+
+: read-triple-indirect-blocks ( triple-indirect-block# -- )
+   \ Resolve one level of indirection and call double-indirect-block
+   read-block data @ dindirect-block ! data off
+   BEGIN
+      dindirect-block @ l@-le dup 0 <>
+   WHILE
+      read-double-indirect-blocks
+      4 dindirect-block +!      \ point to next double indirect block
+   REPEAT
+   drop                         \ drop 0, the invalid block number
+;
+
+: read-block#s ( -- )
+  blocks @ ?dup IF #blocks @ 4 * free-mem THEN
+  inode @ 4 + l@-le file-len !
+  file-len @ block-size @ // #blocks !
+  #blocks @ 4 * alloc-mem blocks !
+  blocks @ ^blocks !  #blocks @ #blocks-left !
+  #blocks-left @ c min \ # direct blocks
+  inode @ 28 + over 4 * ^blocks @ swap move blocks-read
+  #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN
+  #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN
+  #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ;
+: read-inode ( inode# -- )
+  1- inodes/group @ u/mod \ # in group, group #
+  20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table
+  swap inode-size @ * + xlsplit seek drop  inode @ inode-size @ read drop
+;
+
+: .rwx ( bits last-char-if-special special? -- )
+  rot dup 4 and IF ." r" ELSE ." -" THEN
+      dup 2 and IF ." w" ELSE ." -" THEN
+  swap IF 1 and 0= IF upc THEN emit ELSE
+          1 and IF ." x" ELSE ." -" THEN drop THEN ;
+CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move
+: .mode ( mode -- )
+  dup c rshift f and mode-chars + c@ emit
+  dup 6 rshift 7 and over 800 and 73 swap .rwx
+  dup 3 rshift 7 and over 400 and 73 swap .rwx
+  dup          7 and swap 200 and 74 swap .rwx ;
+: .inode ( -- )
+  base @ >r decimal
+  inode @      w@-le .mode \ file mode
+  inode @ 1a + w@-le 5 .r \ link count
+  inode @ 02 + w@-le 9 .r \ uid
+  inode @ 18 + w@-le 9 .r \ gid
+  inode @ 04 + l@-le 9 .r \ size
+  r> base ! ;
+
+: do-super ( -- )
+  400 400 read-data
+  data @ 14 + l@-le first-block !
+  400 data @ 18 + l@-le lshift block-size !
+  data @ 28 + l@-le inodes/group !
+  \ Check revision level... in revision 0, the inode size is always 128
+  data @ 4c + l@-le 0= IF
+     80 inode-size !
+  ELSE
+     data @ 58 + w@-le inode-size !
+  THEN
+  data @ 20 + l@-le group-desc-size !
+
+  \ Read the group descriptor table:
+  first-block @ 1+ block-size @ *
+  group-desc-size @
+  read-data
+  data @ group-descriptors !
+
+  \ We keep the group-descriptor memory area, so clear data pointer:
+  data off
+;
+
+INSTANCE VARIABLE current-pos
+
+: read ( adr len -- actual )
+  file-len @ current-pos @ - min \ can't go past end of file
+  current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block
+  block-size @ over - rot min >r ( adr off r: len )
+  data @ + swap r@ move r> dup current-pos +! ;
+: read ( adr len -- actual )
+  ( check if a file is selected, first )
+  dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed"
+  /string REPEAT 2drop r> ;
+: seek ( lo hi -- status )
+  lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ;
+: load ( adr -- len )
+  file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ;
+
+: .name ( adr -- )  dup 8 + swap 6 + c@ type ;
+: read-dir ( inode# -- adr )
+  read-inode read-block#s file-len @ alloc-mem
+  0 0 seek ABORT" ext2-files read-dir: seek failed"
+  dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ;
+: .dir ( inode# -- )
+  read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE
+  cr dup 8 0.r space read-inode .inode space space dup .name
+  dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ;
+: (find-file) ( adr name len -- inode#|0 )
+  2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE
+  dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN
+  dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ;
+: find-file ( inode# name len -- inode#|0 )
+  2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ;
+: find-path ( inode# name len -- inode#|0 )
+  dup 0= IF 3drop 0 ."  empty name " EXIT THEN
+  over c@ [char] \ = IF 1 /string ."  slash " RECURSE EXIT THEN
+  [char] \ split 2>r find-file ?dup 0= IF
+  2r> 2drop false ."  not found " EXIT THEN
+  r@ 0<> IF 2r> ."  more... " RECURSE EXIT THEN
+  2r> 2drop ."  got it " ;
+
+: close
+   inode @ inode-size @ free-mem
+   group-descriptors @ group-desc-size @ free-mem
+   free-data
+   blocks @ ?dup IF #blocks @ 4 * free-mem THEN
+;
+
+: open
+  0 data ! 0 blocks ! 0 #blocks !
+  do-super
+  inode-size @ alloc-mem inode !
+  my-args nip 0= IF 0 0 ELSE
+  2 my-args find-path ?dup 0= IF close false EXIT THEN THEN
+  read-inode read-block#s 0 0 seek 0= ;
diff --git a/qemu/roms/SLOF/slof/fs/packages/fat-files.fs b/qemu/roms/SLOF/slof/fs/packages/fat-files.fs
new file mode 100644
index 000000000..0cec3664e
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/fat-files.fs
@@ -0,0 +1,188 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+s" fat-files" device-name
+
+INSTANCE VARIABLE bytes/sector
+INSTANCE VARIABLE sectors/cluster
+INSTANCE VARIABLE #reserved-sectors
+INSTANCE VARIABLE #fats
+INSTANCE VARIABLE #root-entries
+INSTANCE VARIABLE total-#sectors
+INSTANCE VARIABLE media-descriptor
+INSTANCE VARIABLE sectors/fat
+INSTANCE VARIABLE sectors/track
+INSTANCE VARIABLE #heads
+INSTANCE VARIABLE #hidden-sectors
+
+INSTANCE VARIABLE fat-type
+INSTANCE VARIABLE bytes/cluster
+INSTANCE VARIABLE fat-offset
+INSTANCE VARIABLE root-offset
+INSTANCE VARIABLE cluster-offset
+INSTANCE VARIABLE #clusters
+
+: seek  s" seek" $call-parent ;
+: read  s" read" $call-parent ;
+
+INSTANCE VARIABLE data
+INSTANCE VARIABLE #data
+
+: free-data
+  data @ ?dup IF #data @ free-mem  0 data ! THEN ;
+: read-data ( offset size -- )
+  free-data  dup #data ! alloc-mem data !
+  xlsplit seek            -2 and ABORT" fat-files read-data: seek failed"
+  data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ;
+
+CREATE fat-buf 8 allot
+: read-fat ( cluster# -- data )
+  fat-buf 8 erase
+  1 #split fat-type @ * 2/ 2/ fat-offset @ +
+  xlsplit seek -2 and ABORT" fat-files read-fat: seek failed"
+  fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed"
+  fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split
+  rot IF swap THEN drop ;
+  
+INSTANCE VARIABLE next-cluster
+
+: read-cluster ( cluster# -- )
+  dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data
+  read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ;
+: read-dir ( cluster# -- )
+  ?dup 0= IF root-offset @ #root-entries @ 20 * read-data 0 next-cluster !
+  ELSE read-cluster THEN ;
+
+: .time ( x -- )
+  base @ >r decimal
+  b #split 2 0.r [char] : emit  5 #split 2 0.r [char] : emit  2* 2 0.r
+  r> base ! ;
+: .date ( x -- )
+  base @ >r decimal
+  9 #split 7bc + 4 0.r [char] - emit  5 #split 2 0.r [char] - emit  2 0.r
+  r> base ! ;
+: .attr ( attr -- )
+  6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ;
+: .dir-entry ( adr -- )
+  dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file
+  dup c@ e5 = IF drop EXIT THEN \ deleted file
+  cr
+  dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster
+  dup 18 + 2c@ bwjoin .date space
+  dup 16 + 2c@ bwjoin .time space
+  dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes
+  dup 0b + c@ .attr space
+  dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type
+  dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF
+  [char] . emit type ELSE 2drop THEN
+  drop ;
+: .dir-entries ( adr n -- )
+  0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ;
+: .dir ( cluster# -- )
+  read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE
+  next-cluster @ read-cluster REPEAT ;
+
+: str-upper ( str len adr -- ) \ Copy string to adr, uppercase
+  -rot bounds ?DO i c@ upc over c! char+ LOOP drop ;
+CREATE dos-name b allot
+: make-dos-name ( str len -- )
+  dos-name b bl fill
+  2dup [char] . findchar IF
+  3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN
+  8 min dos-name str-upper ;
+
+: (find-file) ( -- cluster file-len is-dir? true | false )
+  data @ BEGIN dup data @ #data @ + < WHILE
+  dup dos-name b comp WHILE 20 + REPEAT
+  dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true
+  ELSE drop false THEN ;
+: find-file ( dir-cluster name len -- cluster file-len is-dir? true | false )
+  make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE
+  next-cluster @ read-cluster REPEAT false ELSE true THEN ;
+: find-path ( dir-cluster name len -- cluster file-len true | false )
+  dup 0= IF 3drop false ."  empty name " EXIT THEN
+  over c@ [char] \ = IF 1 /string  RECURSE EXIT THEN
+  [char] \ split 2>r find-file 0= IF 2r> 2drop false ."  not found " EXIT THEN
+  r@ 0<> <> IF 2drop 2r> 2drop false ."  no dir<->file match " EXIT THEN
+  r@ 0<> IF drop 2r> RECURSE EXIT THEN
+  2r> 2drop true ;
+  
+: do-super ( -- )
+  0 200 read-data
+  data @ 0b + 2c@ bwjoin bytes/sector !
+  data @ 0d + c@ sectors/cluster !
+  bytes/sector @ sectors/cluster @ * bytes/cluster !
+  data @ 0e + 2c@ bwjoin #reserved-sectors !
+  data @ 10 + c@ #fats !
+  data @ 11 + 2c@ bwjoin #root-entries !
+  data @ 13 + 2c@ bwjoin total-#sectors !
+  data @ 15 + c@ media-descriptor !
+  data @ 16 + 2c@ bwjoin sectors/fat !
+  data @ 18 + 2c@ bwjoin sectors/track !
+  data @ 1a + 2c@ bwjoin #heads !
+  data @ 1c + 2c@ bwjoin #hidden-sectors !
+
+  \ For FAT16 and FAT32:
+  total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN
+
+  \ For FAT32:
+  sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN
+
+  \ XXX add other FAT32 stuff (offsets 28, 2c, 30)
+
+  \ Compute the number of data clusters, decide what FAT type we are.
+  total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * -
+  #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ /
+  dup #clusters !
+  dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type !
+  base @ decimal base !
+
+  \ Starting offset of first fat.
+  #reserved-sectors @ bytes/sector @ * fat-offset !
+
+  \ Starting offset of root dir.
+  #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset !
+
+  \ Starting offset of "cluster 0".
+  #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ +
+  bytes/cluster @ 2* - cluster-offset ! ;
+
+
+INSTANCE VARIABLE file-cluster
+INSTANCE VARIABLE file-len
+INSTANCE VARIABLE current-pos
+INSTANCE VARIABLE pos-in-data
+
+: seek ( lo hi -- status )
+  lxjoin dup current-pos ! file-cluster @ read-cluster
+  \ Read and skip blocks until we are where we want to be.
+  BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF
+  2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ;
+: read ( adr len -- actual )
+  file-len @ current-pos @ - min \ can't go past end of file
+  #data @ pos-in-data @ - min >r \ length for this transfer
+  data @ pos-in-data @ + swap r@ move \ move the data
+  r@ pos-in-data +!  r@ current-pos +!  pos-in-data @ #data @ = IF
+  next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ;
+: read ( adr len -- actual )
+  file-len @ min                \ len cannot be greater than file size
+  dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed"
+  /string ( tuck - >r + r> ) REPEAT 2drop r> ;
+: load ( adr -- len )
+  file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ;
+
+: close  free-data ;
+: open
+  do-super
+  0 my-args find-path 0= IF close false EXIT THEN
+  file-len !  file-cluster !  0 0 seek 0= ;
diff --git a/qemu/roms/SLOF/slof/fs/packages/filler.fs b/qemu/roms/SLOF/slof/fs/packages/filler.fs
new file mode 100644
index 000000000..bd5c17a39
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/filler.fs
@@ -0,0 +1,21 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+s" filler" device-name
+
+: block-size  s" block-size" $call-parent ;
+: seek        s" seek"       $call-parent ;
+: read        s" read"       $call-parent ;
+
+: open  true ;
+: close ;
diff --git a/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs b/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs
new file mode 100644
index 000000000..6eda8be70
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs
@@ -0,0 +1,325 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+s" iso-9660" device-name
+
+
+0 VALUE iso-debug-flag
+
+\ Method for code clean up - For release version of code iso-debug-flag is
+\ cleared  and for debugging it is set
+
+: iso-debug-print ( str len -- )  iso-debug-flag IF type cr ELSE 2drop THEN  ;
+
+
+\ --------------------------------------------------------
+\ GLOBAL  VARIABLES
+\ --------------------------------------------------------
+
+
+0 VALUE  path-tbl-size
+0 VALUE  path-tbl-addr
+0 VALUE  root-dir-size
+0 VALUE  vol-size
+0 VALUE  logical-blk-size
+0 VALUE  path-table
+0 VALUE  count
+
+
+\ INSTANCE VARIABLES
+
+
+INSTANCE VARIABLE dir-addr
+INSTANCE VARIABLE data-buff
+INSTANCE VARIABLE #data
+INSTANCE VARIABLE ptable
+INSTANCE VARIABLE file-loc
+INSTANCE VARIABLE file-size
+INSTANCE VARIABLE cur-file-offset
+INSTANCE VARIABLE self
+INSTANCE VARIABLE index
+
+
+\ --------------------------------------------------------
+\ COLON DEFINITIONS
+\ --------------------------------------------------------
+
+
+\ This method is used to seek to the required position
+\ Which calls seek of disk-label
+
+: seek  ( pos.lo pos.hi -- status )  s" seek" $call-parent  ;
+
+
+\ This method is used to read the contents of disk
+\ it calls read of disk-label
+
+
+ : read  ( addr len -- actual )  s" read" $call-parent  ;
+
+
+\ This method releases the memory used as  scratch pad buffer.
+
+: free-data ( -- )
+   data-buff @                              ( data-buff )
+   ?DUP  IF  #data @  free-mem  0 data-buff ! 0 #data ! THEN
+;
+
+
+\ This method will release the previous allocated scratch pad buffer and
+\ allocates a fresh buffer and copies the required number of bytes from the
+\ media in to it.
+
+: read-data ( offset size -- )
+   dup #data @ > IF
+      free-data dup dup                  ( offset size size size )
+      #data ! alloc-mem data-buff !      ( offset size )
+   THEN
+   swap xlsplit                          ( size pos.lo pos.hi )
+   seek   -2 and ABORT" seek failed."
+   data-buff @ over read                 ( size actual )
+   <> ABORT" read failed."
+;
+
+
+\ This method extracts the information required from primary volume
+\ descriptor and stores the required information in the global variables
+
+: extract-vol-info  (  --  )
+   10  800 * 800 read-data
+   data-buff @  88  + l@-be  to path-tbl-size   \ read path table size
+   data-buff @  94  + l@-be  to path-tbl-addr   \ read big-endian  path table
+   data-buff @  a2  + l@-be   dir-addr !        \ gather of root directory info
+   data-buff @  0aa + l@-be  to root-dir-size   \ get volume info
+   data-buff @  54  + l@-be  to vol-size        \ size in blocks
+   data-buff @  82  + l@-be  to logical-blk-size
+   path-tbl-size alloc-mem dup  TO path-table path-tbl-size erase
+   path-tbl-addr 800 *  xlsplit seek  drop
+   path-table  path-tbl-size  read  drop     \ pathtable in-system-memory copy
+;
+
+
+\ This method coverts the iso file name to user readble form
+
+: file-name  ( str len --  str' len' )
+   2dup  [char] ; findchar  IF
+      ( str len offset )
+      nip                 \ Omit the trailing ";1" revision of ISO9660 file name
+      2dup + 1-           ( str newlen endptr )
+      c@ [CHAR] . = IF
+         1-               ( str len' )    \ Remove trailing dot
+      THEN
+   THEN
+;
+
+
+\ triplicates top stack element
+
+: dup3  ( num  -- num num num ) dup dup dup  ;
+
+
+\ This method is used for traversing records of path table. If the
+\ file identifier length is odd 1 byte padding is done else not.
+
+: get-next-record  ( rec-addr -- next-rec-offset )
+   dup3               ( rec-addr rec-addr rec-addr rec-addr )
+   self @ 1 +  self ! ( rec-addr rec-addr rec-addr rec-addr )
+   c@  1 AND  IF      ( rec-addr rec-addr rec-addr )
+      c@ +  9         ( rec-addr rec-addr' rec-len )
+   ELSE
+      c@ +  8         ( rec-addr rec-addr' rec-len )
+   THEN
+   + swap  -          ( next-rec-offset )
+;
+
+
+\  This method does search of given directory name in the path table
+\ and returns true  if finds a match else  false.
+
+: path-table-search ( str len -- TRUE | FALSE )
+   path-table path-tbl-size +  path-table ptable @ +  DO ( str len )
+      2dup  I 6 + w@-be index @ =                        ( str len str len )
+      -rot  I 8 +  I c@
+      iso-debug-flag IF
+          ." ISO: comparing path name '"
+          4dup type ." ' with '" type ." '" cr
+      THEN
+      string=ci and  IF                                  ( str len )
+         s" Directory Matched!!  "   iso-debug-print     ( str len )
+         self @   index !                                ( str len )
+         I 2 + l@-be   dir-addr ! I  dup                 ( str len rec-addr )
+         get-next-record + path-table -   ptable !       ( str len )
+         2drop  TRUE UNLOOP EXIT                         ( TRUE )
+      THEN
+      I get-next-record                           ( str len next-rec-offset )
+   +LOOP
+   2drop
+   FALSE                                          ( FALSE )
+   s" Invalid path / directory "  iso-debug-print
+;
+
+
+\ METHOD for searching for a file with in a direcotory
+
+: search-file-dir ( str len  -- TRUE | FALSE )
+   dir-addr @  800 *  dir-addr !             ( str len )
+   dir-addr @ 100 read-data                  ( str len )
+   data-buff @  0e + l@-be  dup >r           ( str len rec-len )
+   100 >  IF                                 ( str len )
+      s" size dir record"  iso-debug-print   ( str len )
+      dir-addr @ r@  read-data               ( str len )
+   THEN
+   r> data-buff @  + data-buff @  DO         ( str len )
+      I 19 + c@  2 and 0=  I c@ 0<> and IF   ( str len )
+         2dup                                ( str len  str len )
+         I 21 + I 20 + c@                    ( str len  str len  str' len' )
+         iso-debug-flag IF
+             ." ISO: comparing file name '"
+             4dup type ." ' with '" type ." '" cr
+         THEN
+         file-name  string=ci  IF            ( str len )
+            s" File found!"  iso-debug-print ( str len )
+            I 6 + l@-be 800 *                ( str len file-loc )
+            file-loc !                       ( str len )
+            I 0e + l@-be  file-size !        ( str len )
+            2drop
+            TRUE                             ( TRUE )
+            UNLOOP
+            EXIT
+         THEN
+      THEN
+      ( str len )
+      I c@ ?dup 0= IF
+         800 I 7ff AND -
+         iso-debug-flag IF
+            ." skipping " dup . ." bytes at end of sector" cr
+         THEN
+      THEN
+      ( str len offset )
+   +LOOP
+   2drop
+   FALSE                                     ( FALSE )
+   s" file not found"   iso-debug-print
+;
+
+
+\ This method splits the given absolute path in to directories from root and
+\ calls search-path-table. when string reaches to state when it can not be
+\ split i.e., end of the path, calls search-file-dir is made to search for
+\ file .
+
+: search-path ( str len -- FALSE|TRUE )
+   0  ptable !
+   1  self !
+   1  index !
+   dup                                             ( str len len )
+   0=  IF
+      3drop FALSE                                  ( FALSE )
+      s"  Empty path name "  iso-debug-print  EXIT ( FALSE )
+   THEN
+   OVER c@                                         ( str len char )
+   [char] \ =  IF                                  ( str len )
+      swap 1 + swap 1 -  BEGIN                     ( str len )
+         [char] \  split                           ( str len  str' len ' )
+         dup 0 =   IF                              ( str len  str' len ' )
+            2drop search-file-dir EXIT             ( TRUE | FALSE )
+         ELSE
+            2swap path-table-search  invert  IF    ( str' len ' )
+               2drop FALSE  EXIT                   ( FALSE )
+            THEN
+         THEN
+      AGAIN
+   ELSE   BEGIN
+      [char] \  split   dup 0 =   IF               ( str len str' len' )
+         2drop search-file-dir EXIT                ( TRUE | FALSE )
+      ELSE
+         2swap path-table-search  invert  IF       ( str' len ' )
+            2drop FALSE  EXIT                      ( FALSE )
+            THEN
+         THEN
+      AGAIN
+   THEN
+;
+
+
+\ this method will seek and read the file in to the given memory location
+
+0 VALUE loc
+: load ( addr -- len )
+   dup to loc                     ( addr )
+   file-loc @  xlsplit seek drop
+   file-size @  read              ( file-size )
+   iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN
+   dup file-size @  <> ABORT" read failed!"
+;
+
+
+
+\ memory used by the file system will be freed
+
+: close ( -- )
+   free-data   count 1 - dup to count  0 =  IF
+      path-table path-tbl-size free-mem
+      0 TO path-table
+   THEN
+;
+
+
+\ open method of the file system
+
+: open ( -- TRUE | FALSE )
+   0 data-buff !
+   0 #data !
+   0 ptable !
+   0 file-loc !
+   0 file-size !
+   0 cur-file-offset !
+   1 self !
+   1 index !
+   count 0 =  IF
+      s" extract-vol-info called "   iso-debug-print
+      extract-vol-info
+   THEN
+   count  1 + to count
+   my-args search-path  IF
+      file-loc @  xlsplit seek drop
+      TRUE    ( TRUE )
+   ELSE
+      close
+      FALSE   ( FALSE )
+   THEN
+   0 cur-file-offset !
+   s" opened ISO9660 package" iso-debug-print
+;
+
+
+\ public seek method
+
+: seek ( pos.lo pos.hi -- status )
+   lxjoin dup  cur-file-offset !  ( offset )
+   file-loc @  + xlsplit          ( pos.lo pos.hi )
+   s" seek" $call-parent          ( status )
+;
+
+
+\ public read method
+
+ : read ( addr len -- actual )
+    file-size @ cur-file-offset @ -             ( addr len remainder-of-file )
+    min                                         ( addr len|remainder-of-file )
+    s" read" $call-parent                       ( actual )
+    dup cur-file-offset @ +  cur-file-offset !  ( actual )
+    cur-file-offset @                           ( offset actual )
+    xlsplit seek drop                           ( actual )
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs b/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs
new file mode 100644
index 000000000..89143a669
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs
@@ -0,0 +1,71 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+s" obp-tftp" device-name
+
+INSTANCE VARIABLE ciregs-buffer
+
+: open ( -- okay? ) 
+    ciregs-size alloc-mem ciregs-buffer ! 
+    true
+;
+
+: load ( addr -- size )
+
+    \ Save old client interface register 
+    ciregs ciregs-buffer @ ciregs-size move
+
+    s" bootargs" get-chosen 0= IF 0 0 THEN >r >r
+    s" bootpath" get-chosen 0= IF 0 0 THEN >r >r
+
+    \ Set bootpath to current device
+    my-parent ihandle>phandle node>path encode-string
+    s" bootpath" set-chosen
+
+    \ Generate arg string for snk like
+    \ "netboot load-addr length filename"
+    (u.) s" netboot " 2swap $cat s"  60000000 " $cat
+
+    \ Allocate 1720 bytes to store the BOOTP-REPLY packet
+    6B8 alloc-mem dup >r (u.) $cat s"  " $cat
+    huge-tftp-load @ IF s"  1 " ELSE s"  0 " THEN $cat
+    \ Add desired TFTP-Blocksize as additional argument
+    s" 1432 " $cat
+    \ Add OBP-TFTP Bootstring argument, e.g. "10.128.0.1,bootrom.bin,10.128.40.1"
+    my-args $cat
+
+    \ Call SNK netboot loadr
+    (client-exec) dup 0< IF drop 0 THEN
+
+    \ Restore to old client interface register 
+    ciregs-buffer @ ciregs ciregs-size move
+
+    \ Recover buffer address of BOOTP-REPLY packet
+    r>
+
+    r> r> over IF s" bootpath" set-chosen ELSE 2drop THEN
+    r> r> over IF s" bootargs" set-chosen ELSE 2drop THEN
+
+    \ Store BOOTP-REPLY packet as property
+    dup 6B8 encode-bytes s" bootp-response" s" /chosen" find-node set-property
+
+    \ free buffer
+    6B8 free-mem
+;
+
+: close ( -- )
+   ciregs-buffer @ ciregs-size free-mem 
+;
+
+: ping  ( -- )
+   s" ping " my-args $cat (client-exec)
+;
diff --git a/qemu/roms/SLOF/slof/fs/packages/rom-files.fs b/qemu/roms/SLOF/slof/fs/packages/rom-files.fs
new file mode 100644
index 000000000..418cf4e05
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/rom-files.fs
@@ -0,0 +1,85 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ package which adds support to read the romfs
+\ this package is somehow limited as the maximum supported length
+\ for a file name is hardcoded to 0x100
+
+s" rom-files" device-name
+
+INSTANCE VARIABLE length
+INSTANCE VARIABLE next-file
+INSTANCE VARIABLE buffer
+INSTANCE VARIABLE buffer-size
+INSTANCE VARIABLE file
+INSTANCE VARIABLE file-size
+INSTANCE VARIABLE found
+
+: open  true 
+  100 dup buffer-size ! alloc-mem buffer ! false found ! ;
+: close buffer @ buffer-size @ free-mem ;
+
+: read ( addr len -- actual ) s" read" $call-parent ;
+
+: seek ( lo hi -- status ) s" seek" $call-parent ;
+
+: .read-file-name ( offset -- str len )
+  \ move to the file name offset
+  0 seek drop 
+  \ read <buffer-size> bytes from that address
+  buffer @ buffer-size @ read drop
+  \ write a 0 to make sure it is a 0 terminated string
+  buffer-size @ 1 - buffer @ + 0 swap c!
+  buffer @ zcount ;
+
+: .print-info ( offset -- )
+  dup 2 spaces 6 0.r 2 spaces dup
+  8 + 0 seek drop length 8 read drop
+  6 length @ swap 0.r 2 spaces
+  20 + .read-file-name type cr ;
+
+: .list-header cr
+  s" --offset---size-----file-name----" type cr ;
+
+: list
+  .list-header
+  0 0 BEGIN + dup 
+  .print-info dup 0 seek drop
+  next-file 8 read drop next-file @
+  dup 0= UNTIL 2drop ;
+
+: (find-file)  ( name len -- offset | -1 )
+   0 0 seek drop false found !
+   file-size ! file ! 0 0 BEGIN + dup
+   20 + .read-file-name file @ file-size @
+   str= IF true found ! THEN
+   dup 0 seek drop
+   next-file 8 read drop next-file @
+   dup 0= found @ or UNTIL drop found @ 0=
+   IF drop -1 THEN ;
+
+: load  ( addr -- size )
+   my-parent instance>args 2@ [char] \ left-parse-string 2drop
+   (find-file) dup -1 = IF 2drop 0 ELSE
+      \ got to the beginning
+      0 0 seek drop
+      \ read the file size
+      dup 8 + 0 seek drop
+      here 8 read drop here @  ( dest-addr offset file-size )
+      \ read data start offset
+      over 18 + 0 seek drop
+      here 8 read drop here @  ( dest-addr offset file-size data-offset )
+      rot + 0 seek drop  ( dest-addr file-size )
+      read 
+   THEN
+;
diff --git a/qemu/roms/SLOF/slof/fs/packages/sms.fs b/qemu/roms/SLOF/slof/fs/packages/sms.fs
new file mode 100644
index 000000000..d8c672f72
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/packages/sms.fs
@@ -0,0 +1,29 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+s" /packages" find-device
+
+new-device
+   s" sms" device-name
+
+   : open true ;
+
+   : close ;
+
+   \ The rest of methods is loaded dynamically from the romfs
+   \ on a first call to sms-start
+
+finish-device
+
+device-end \ leave /packages
+
diff --git a/qemu/roms/SLOF/slof/fs/pci-bridge.fs b/qemu/roms/SLOF/slof/fs/pci-bridge.fs
new file mode 100644
index 000000000..e6af7b65c
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-bridge.fs
@@ -0,0 +1,65 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ get the PUID from the node above
+get-node CONSTANT my-phandle
+s" my-puid" my-phandle parent $call-static CONSTANT my-puid
+
+\ Save the bus number provided by this bridge
+pci-bus-number 1+ CONSTANT my-bus
+
+s" pci-config-bridge.fs" included
+s" dma-function.fs" included
+
+\ generate the rom-fs filename from the vendor and device ID "pci-bridge_VENDORID_DEVICEID.fs"
+: filename ( -- str len )
+  s" pci-bridge_"
+  my-space pci-vendor@ 4 int2str $cat
+  s" _" $cat
+  my-space pci-device@ 4 int2str $cat
+  s" .fs" $cat
+;
+
+\ Set up the Bridge with either default or special settings
+: setup ( -- )
+        \ is there special handling for this device, given vendor and device id?
+        filename romfs-lookup ?dup
+                IF
+                        \ give it a special treatment
+                        evaluate
+                ELSE
+                        \ no special handling for this device, attempt autoconfiguration
+                        my-space pci-class-name type 2a emit cr
+                        my-space pci-bridge-generic-setup
+                        my-space pci-reset-2nd
+                THEN
+;
+
+\ Disable Bus Master, Memory Space and I/O Space for
+\ this device and so for the scanning for the devices behind
+pci-device-disable
+
+\ Enalbe #PERR and #SERR reporting
+pci-error-enable
+
+\ Print out device information
+my-space 42 pci-out     \ config-addr ascii('B')
+
+\ and set up the bridge
+setup
+
+\ And enable Bus Master IO and MEM access again.
+\ we need that on bridges so that the devices behind
+\ can set their state on their own.
+pci-master-enable
+pci-mem-enable
+pci-io-enable
diff --git a/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs b/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs
new file mode 100644
index 000000000..f3a49454d
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs
@@ -0,0 +1,264 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: pci-class-name-00 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        01  OF s" display"               ENDOF
+        dup OF s" unknown-legacy-device" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-01 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" scsi"         ENDOF
+        01  OF s" ide"          ENDOF
+        02  OF s" fdc"          ENDOF
+        03  OF s" ipi"          ENDOF
+        04  OF s" raid"         ENDOF
+        05  OF s" ata"          ENDOF
+        06  OF s" sata"         ENDOF
+        07  OF s" sas"          ENDOF
+        dup OF s" mass-storage" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-02 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" ethernet"   ENDOF
+        01  OF s" token-ring" ENDOF
+        02  OF s" fddi"       ENDOF
+        03  OF s" atm"        ENDOF
+        04  OF s" isdn"       ENDOF
+        05  OF s" worldfip"   ENDOF
+        05  OF s" picmg"      ENDOF
+        dup OF s" network"    ENDOF
+        ENDCASE
+;
+
+: pci-class-name-03 ( addr -- str len )
+        pci-class@ FFFF and CASE
+        0000  OF s" vga"             ENDOF
+        0001  OF s" 8514-compatible" ENDOF
+        0100  OF s" xga"             ENDOF
+        0200  OF s" 3d-controller"   ENDOF
+        dup OF s" display"           ENDOF
+        ENDCASE
+;
+
+: pci-class-name-04 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" video"             ENDOF
+        01  OF s" sound"             ENDOF
+        02  OF s" telephony"         ENDOF
+        dup OF s" multimedia-device" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-05 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" memory"            ENDOF
+        01  OF s" flash"             ENDOF
+        dup OF s" memory-controller" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-06 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" host"                 ENDOF
+        01  OF s" isa"                  ENDOF
+        02  OF s" eisa"                 ENDOF
+        03  OF s" mca"                  ENDOF
+        04  OF s" pci"                  ENDOF
+        05  OF s" pcmcia"               ENDOF
+        06  OF s" nubus"                ENDOF
+        07  OF s" cardbus"              ENDOF
+        08  OF s" raceway"              ENDOF
+        09  OF s" semi-transparent-pci" ENDOF
+        0A  OF s" infiniband"           ENDOF
+        dup OF s" unkown-bridge"        ENDOF
+        ENDCASE
+;
+
+: pci-class-name-07 ( addr -- str len )
+        pci-class@ FFFF and CASE
+        0000  OF s" serial"                   ENDOF
+        0001  OF s" 16450-serial"             ENDOF
+        0002  OF s" 16550-serial"             ENDOF
+        0003  OF s" 16650-serial"             ENDOF
+        0004  OF s" 16750-serial"             ENDOF
+        0005  OF s" 16850-serial"             ENDOF
+        0006  OF s" 16950-serial"             ENDOF
+        0100  OF s" parallel"                 ENDOF
+        0101  OF s" bi-directional-parallel"  ENDOF
+        0102  OF s" ecp-1.x-parallel"         ENDOF
+        0103  OF s" ieee1284-controller"      ENDOF
+        01FE  OF s" ieee1284-device"          ENDOF
+        0200  OF s" multiport-serial"         ENDOF
+        0300  OF s" modem"                    ENDOF
+        0301  OF s" 16450-modem"              ENDOF
+        0302  OF s" 16550-modem"              ENDOF
+        0303  OF s" 16650-modem"              ENDOF
+        0304  OF s" 16750-modem"              ENDOF
+        0400  OF s" gpib"                     ENDOF
+        0500  OF s" smart-card"               ENDOF
+        dup   OF s" communication-controller" ENDOF
+        ENDCASE
+;
+
+
+: pci-class-name-08 ( addr -- str len )
+        pci-class@ FFFF and CASE
+        0000  OF s" interrupt-controller" ENDOF
+        0001  OF s" isa-pic"              ENDOF
+        0002  OF s" eisa-pic"             ENDOF
+        0010  OF s" io-apic"              ENDOF
+        0020  OF s" iox-apic"             ENDOF
+        0100  OF s" dma-controller"       ENDOF
+        0101  OF s" isa-dma"              ENDOF
+        0102  OF s" eisa-dma"             ENDOF
+        0200  OF s" timer"                ENDOF
+        0201  OF s" isa-system-timer"     ENDOF
+        0202  OF s" eisa-system-timer"    ENDOF
+        0300  OF s" rtc"                  ENDOF
+        0301  OF s" isa-rtc"              ENDOF
+        0400  OF s" hot-plug-controller"  ENDOF
+        0500  OF s" sd-host-conrtoller"   ENDOF
+        dup   OF s" system-periphal"      ENDOF
+        ENDCASE
+;
+
+: pci-class-name-09 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" keyboard"         ENDOF
+        01  OF s" pen"              ENDOF
+        02  OF s" mouse"            ENDOF
+        03  OF s" scanner"          ENDOF
+        04  OF s" gameport"         ENDOF
+        dup OF s" input-controller" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-0A ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" dock"            ENDOF
+        dup OF s" docking-station" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-0B ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" 386"           ENDOF
+        01  OF s" 486"           ENDOF
+        02  OF s" pentium"       ENDOF
+        10  OF s" alpha"         ENDOF
+        20  OF s" powerpc"       ENDOF
+        30  OF s" mips"          ENDOF
+        40  OF s" co-processor"  ENDOF
+        dup OF s" cpu"           ENDOF
+        ENDCASE
+;
+
+: pci-class-name-0C ( addr -- str len )
+        pci-class@ FFFF and CASE
+        0000  OF s" firewire"      ENDOF
+        0100  OF s" access-bus"    ENDOF
+        0200  OF s" ssa"           ENDOF
+        0300  OF s" usb-uhci"      ENDOF
+        0310  OF s" usb-ohci"      ENDOF
+	0320  OF s" usb-ehci"      ENDOF
+        0330  OF s" usb-xhci"      ENDOF
+        0380  OF s" usb"           ENDOF
+        03FE  OF s" usb-device"    ENDOF
+        0400  OF s" fibre-channel" ENDOF
+        0500  OF s" smb"           ENDOF
+        0600  OF s" infiniband"    ENDOF
+        0700  OF s" ipmi-smic"     ENDOF
+        0701  OF s" ipmi-kbrd"     ENDOF
+        0702  OF s" ipmi-bltr"     ENDOF
+        0800  OF s" sercos"        ENDOF
+        0900  OF s" canbus"        ENDOF
+        dup OF s" serial-bus"      ENDOF
+        ENDCASE
+;
+
+: pci-class-name-0D ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" irda"                ENDOF
+        01  OF s" consumer-ir"         ENDOF
+        10  OF s" rf-controller"       ENDOF
+        11  OF s" bluetooth"           ENDOF
+        12  OF s" broadband"           ENDOF
+        20  OF s" enet-802.11a"        ENDOF
+        21  OF s" enet-802.11b"        ENDOF
+        dup OF s" wireless-controller" ENDOF
+        ENDCASE
+;
+
+
+: pci-class-name-0E ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        dup OF s" intelligent-io" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-0F ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        01  OF s" satelite-tv"     ENDOF
+        02  OF s" satelite-audio"  ENDOF
+        03  OF s" satelite-voice"  ENDOF
+        04  OF s" satelite-data"   ENDOF
+        dup OF s" satelite-devoce" ENDOF
+        ENDCASE
+;
+
+: pci-class-name-10 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" network-encryption"       ENDOF
+        01  OF s" entertainment-encryption" ENDOF
+        dup OF s" encryption"               ENDOF
+        ENDCASE
+;
+
+: pci-class-name-11 ( addr -- str len )
+        pci-class@ 8 rshift FF and CASE
+        00  OF s" dpio"                       ENDOF
+        01  OF s" counter"                    ENDOF
+        10  OF s" measurement"                ENDOF
+        20  OF s" managment-card"             ENDOF
+        dup OF s" data-processing-controller" ENDOF
+        ENDCASE
+;
+
+\ create a string holding the predefined Class-Code-Names
+: pci-class-name ( addr -- str len )
+        dup pci-class@ 10 rshift CASE
+        00  OF pci-class-name-00 ENDOF
+        01  OF pci-class-name-01 ENDOF
+        02  OF pci-class-name-02 ENDOF
+        03  OF pci-class-name-03 ENDOF
+        04  OF pci-class-name-04 ENDOF
+        05  OF pci-class-name-05 ENDOF
+        06  OF pci-class-name-06 ENDOF
+        07  OF pci-class-name-07 ENDOF
+        08  OF pci-class-name-08 ENDOF
+        09  OF pci-class-name-09 ENDOF
+        0A  OF pci-class-name-0A ENDOF
+        0B  OF pci-class-name-0B ENDOF
+        0C  OF pci-class-name-0C ENDOF
+        0C  OF pci-class-name-0D ENDOF
+        0C  OF pci-class-name-0E ENDOF
+        0C  OF pci-class-name-0F ENDOF
+        0C  OF pci-class-name-10 ENDOF
+        0C  OF pci-class-name-11 ENDOF
+        dup OF drop s" unknown"  ENDOF
+        ENDCASE
+;
diff --git a/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs b/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs
new file mode 100644
index 000000000..689325318
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs
@@ -0,0 +1,111 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Generic config space access function - xt is execution token of rtas-config-xx
+: config-xt  ( config-addr xt -- data )
+   puid >r                            \ Safe puid
+   my-puid TO puid                    \ Set my-puid
+   swap dup ffff00 AND 0= IF          \ Has bus-device-function been specified?
+      my-space OR                     \ No: use my-space instead
+   THEN
+   swap execute                       \ Execute the rtas-config-xx function
+   r> TO puid                         \ Restore previous puid
+;
+
+\ define the config reads
+: config-b@  ( config-addr -- data )  ['] rtas-config-b@ config-xt ;
+: config-w@  ( config-addr -- data )  ['] rtas-config-w@ config-xt ;
+: config-l@  ( config-addr -- data )  ['] rtas-config-l@ config-xt ;
+
+\ define the config writes
+: config-b!  ( data config-addr -- )  ['] rtas-config-b! config-xt ;
+: config-w!  ( data config-addr -- )  ['] rtas-config-w! config-xt ;
+: config-l!  ( data config-addr -- )  ['] rtas-config-l! config-xt ;
+
+\ for Debug purposes: dumps the whole config space
+: config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ;
+
+\ needed to find the right path in the device tree
+: decode-unit ( addr len -- phys.lo ... phys.hi )
+        2 hex-decode-unit       \ decode string
+        B lshift swap           \ shift the devicenumber to the right spot
+        8 lshift or             \ add the functionnumber
+        my-bus 10 lshift or     \ add the busnumber
+        0 0 rot                 \ make phys.lo = 0 = phys.mid
+;
+
+\ needed to have the right unit address in the device tree listing
+\ phys.lo=phys.mid=0 , phys.hi=config-address
+: encode-unit ( phys.lo ... phys.hi -- unit-str unit-len )
+        nip nip                         \ forget the both zeros
+        dup 8 rshift 7 and swap         \ calc Functionnumber
+        B rshift 1F and                 \ calc Devicenumber
+        over IF                         \ IF Function!=0
+                2 hex-encode-unit       \ | create string with DevNum,FnNum
+        ELSE                            \ ELSE
+                nip 1 hex-encode-unit   \ | create string with only DevNum
+        THEN                            \ FI
+;
+
+: map-in ( phys.lo phys.mid phys.hi size -- virt )
+   \ ." map-in called: " .s cr
+   \ Ignore the size, phys.lo and phys.mid, get BAR from config space
+   drop nip nip                         ( phys.hi )
+   \ Sanity check whether config address is in expected range:
+   dup FF AND dup 10 28 WITHIN NOT swap 30 <> AND IF
+      cr ." phys.hi = " . cr
+      ABORT" map-in with illegal config space address"
+   THEN
+   00FFFFFF AND                         \ Need only bus-dev-fn+register bits
+   dup config-l@                        ( phys.hi' bar.lo )
+   dup 7 AND 4 = IF                     \ Is it a 64-bit BAR?
+      swap 4 + config-l@ lxjoin         \ Add upper part of 64-bit BAR
+   ELSE
+      nip
+   THEN
+   F NOT AND                            \ Clear indicator bits
+   \ TODO: Use translate-address here!
+;
+
+: map-out ( virt size -- )
+   \ ." map-out called: " .s cr
+   2drop 
+;
+
+: dma-alloc ( ... size -- virt )
+   \ ." dma-alloc called: " .s cr
+   alloc-mem
+;
+
+: dma-free ( virt size -- )
+   \ ." dma-free called: " .s cr
+   free-mem
+;
+
+: dma-map-in ( ... virt size cacheable? -- devaddr )
+   \ ." dma-map-in called: " .s cr
+   2drop
+;
+
+: dma-map-out ( virt devaddr size -- )
+   \ ." dma-map-out called: " .s cr
+   2drop drop
+;
+
+: dma-sync ( virt devaddr size -- )
+   \ XXX should we add at least a memory barrier here?
+   \ ." dma-sync called: " .s cr
+   2drop drop
+;
+
+: open true ;
+: close ;
diff --git a/qemu/roms/SLOF/slof/fs/pci-device.fs b/qemu/roms/SLOF/slof/fs/pci-device.fs
new file mode 100644
index 000000000..7b177585a
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-device.fs
@@ -0,0 +1,105 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+get-node CONSTANT my-phandle
+
+\ get the PUID from the node above
+s" my-puid" my-phandle parent $call-static CONSTANT my-puid
+
+\ define the config reads
+: config-b@  puid >r my-puid TO puid my-space + rtas-config-b@ r> TO puid ;
+: config-w@  puid >r my-puid TO puid my-space + rtas-config-w@ r> TO puid ;
+: config-l@  puid >r my-puid TO puid my-space + rtas-config-l@ r> TO puid ;
+
+\ define the config writes
+: config-b!  puid >r my-puid TO puid my-space + rtas-config-b! r> TO puid ;
+: config-w!  puid >r my-puid TO puid my-space + rtas-config-w! r> TO puid ;
+: config-l!  puid >r my-puid TO puid my-space + rtas-config-l! r> TO puid ;
+
+\ for Debug purposes: dumps the whole config space
+: config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ;
+
+\ prepare the device for subsequent use
+\ this word should be overloaded by the device file (if present)
+\ the device file can call this file before implementing
+\ its own open functionality
+: open
+        puid >r             \ save the old puid
+        my-puid TO puid     \ set up the puid to the devices Hostbridge
+        pci-master-enable   \ And enable Bus Master, IO and MEM access again.
+        pci-mem-enable      \ enable mem access
+        pci-io-enable       \ enable io access
+        r> TO puid          \ restore puid
+        true
+;
+
+\ close the previously opened device
+\ this word should be overloaded by the device file (if present)
+\ the device file can call this file after its implementation
+\ of own close functionality
+: close 
+        puid >r             \ save the old puid
+        my-puid TO puid     \ set up the puid
+        pci-device-disable  \ and disable the device
+        r> TO puid          \ restore puid
+;
+
+s" dma-function.fs" included
+
+\ generate the rom-fs filename from the vendor and device ID "pci-device_VENDORID_DEVICEID.fs"
+: devicefile ( -- str len )
+  s" pci-device_"
+  my-space pci-vendor@ 4 int2str $cat
+  s" _" $cat
+  my-space pci-device@ 4 int2str $cat
+  s" .fs" $cat
+;
+
+\ generate the rom-fs filename from the base-class id "pci-class_BASECLASS.fs"
+: classfile ( -- str len )
+  s" pci-class_"
+  my-space pci-class@ 10 rshift 2 int2str $cat
+  s" .fs" $cat
+;
+
+\ Set up the device with either default or special settings
+: setup ( -- )
+        \ is there special handling for this device, given vendor and device id?
+        devicefile romfs-lookup ?dup
+                IF
+                        \ give it a special treatment
+                        evaluate
+                ELSE
+                        classfile romfs-lookup ?dup
+                        IF
+                            \ give it a pci-class related treatment
+                            evaluate
+                        ELSE
+                            \ no special handling for this device, attempt autoconfiguration
+                            my-space pci-class-name type 2a emit cr
+                            my-space pci-device-generic-setup
+                        THEN
+                THEN
+;
+
+\ Disable Bus Master, Memory Space and I/O Space for this device
+\ if Bus Master function is needed it should be enabled/disabled by open/close in the device driver code
+pci-device-disable
+
+\ Enalbe #PERR and #SERR reporting
+pci-error-enable
+
+\ Print out device information
+my-space 44 pci-out     \ config-addr ascii('D')
+
+\ and set up the device
+setup
diff --git a/qemu/roms/SLOF/slof/fs/pci-helper.fs b/qemu/roms/SLOF/slof/fs/pci-helper.fs
new file mode 100644
index 000000000..a4f69f1f3
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-helper.fs
@@ -0,0 +1,195 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ ----------------------------------------------------------
+\ **************** PCI Helper functions  *******************
+\ ----------------------------------------------------------
+
+\ convert an integer to string of len digits
+: int2str ( int len -- str len ) swap s>d rot <# 0 ?DO # LOOP #> ;
+
+\ convert addr to busnr
+: pci-addr2bus ( addr -- busnr ) 10 rshift FF and ;
+
+\ convert addr to devnr
+: pci-addr2dev ( addr -- dev ) B rshift 1F and ;
+
+\ convert addr to functionnumber
+: pci-addr2fn ( addr -- dev ) 8 rshift 7 and ;
+
+\ convert busnr devnr to addr
+: pci-bus2addr ( busnr devnr -- addr ) B lshift swap 10 lshift + ;
+
+\ print out a pci config addr
+: pci-addr-out ( addr -- ) dup pci-addr2bus 2 0.r space FFFF and 4 0.r ;
+
+\ Dump out the whole configspace
+: pci-dump ( addr -- )
+        10 0 DO
+                dup
+                cr i 4 * +
+                dup pci-addr-out space
+                rtas-config-l@ 8 0.r
+        LOOP
+        drop cr
+;
+
+
+\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+\ the following functions use l@ to fetch the data,
+\ that's because the some pcie cores have probs with w@
+\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+\ read Vendor ID
+: pci-vendor@ ( addr -- id )                 rtas-config-l@ FFFF and ;
+
+\ read Device ID
+: pci-device@ ( addr -- id )                 rtas-config-l@ 10 rshift ;
+
+\ read Status
+: pci-status@ ( addr -- status )         4 + rtas-config-l@ 10 rshift ;
+
+\ read Revision ID
+: pci-revision@ ( addr -- id )           8 + rtas-config-b@ ;
+
+\ read Class Code
+: pci-class@  ( addr -- class )          8 + rtas-config-l@ 8 rshift ;
+
+\ read Cache Line Size
+: pci-cache@  ( addr -- size )           C + rtas-config-b@ ;
+
+\ read Header Type
+: pci-htype@  ( addr -- type )           E + rtas-config-b@  ;
+
+\ read Sub Vendor ID
+: pci-sub-vendor@ ( addr -- sub-id )    2C + rtas-config-l@ FFFF and ;
+
+\ read Sub Device ID
+: pci-sub-device@ ( addr -- sub-id )    2C + rtas-config-l@ 10 rshift FFFF and ;
+
+\ read Interrupt Pin
+: pci-interrupt@  ( addr -- interrupt ) 3D + rtas-config-b@ ;
+
+\ read Minimum Grant
+: pci-min-grant@  ( addr -- min-gnt )   3E + rtas-config-b@ ;
+
+\ read Maximum Latency
+: pci-max-lat@  ( addr -- max-lat )     3F + rtas-config-b@ ;
+
+\ Check if Capabilities are valid
+: pci-capabilities?  ( addr -- 0|1 ) pci-status@ 4 rshift 1 and ;
+
+\ fetch the offset of the next capability
+: pci-cap-next  ( cap-addr -- next-cap-off ) rtas-config-b@ FC and ;
+
+\ calc the address of the next capability
+: pci-cap-next-addr  ( cap-addr -- next-cap-addr ) 1+ dup pci-cap-next dup IF swap -100 and + ELSE nip THEN ;
+
+
+\ Dump out all capabilities
+: pci-cap-dump ( addr -- )
+        cr
+        dup pci-capabilities? IF
+                33 + BEGIN
+                        pci-cap-next-addr dup 0<>
+                WHILE
+                        dup pci-addr-out s"  : " type
+                        dup rtas-config-b@ 2 0.r cr
+                REPEAT
+                s" end found "
+        ELSE
+                s" capabilities not enabled!"
+        THEN
+        type cr drop
+;
+
+\ search the capability-list for this id
+: pci-cap-find ( addr id -- capp-addr|0 )
+        swap dup pci-capabilities? IF
+                33 + BEGIN
+                        pci-cap-next-addr dup 0<> IF
+                                dup rtas-config-b@ 2 pick =
+                        ELSE
+                                true
+                        THEN
+                UNTIL
+                nip
+        ELSE
+                2drop 0
+        THEN
+;
+
+\ check wether this device is a pci-express device
+: pci-express? ( addr -- 0|1 ) 10 pci-cap-find 0<> ;
+
+\ check wether this device is a pci-express device
+: pci-x? ( addr -- 0|1 ) 07 pci-cap-find 0<> ;
+
+\ check wether this device has extended config space
+: pci-config-ext? ( addr -- 0|1 ) pci-express? ;
+
+
+\ Disable Bus Master, Memory Space and I/O Space for this device
+: pci-device-disable ( -- ) my-space 4 + dup rtas-config-l@ 7 invert and swap rtas-config-l! ;
+
+\ Enable Bus Master
+: pci-master-enable ( -- ) my-space 4 + dup rtas-config-l@ 4 or swap rtas-config-l! ;
+
+\ Disable Bus Master
+: pci-master-disable ( -- ) my-space 4 + dup rtas-config-l@ 4 invert and swap rtas-config-l! ;
+
+\ Enable response to mem accesses of pci device
+: pci-mem-enable ( -- ) my-space 4 + dup rtas-config-w@ 2 or swap rtas-config-w! ;
+
+\ Enable response to I/O accesses of pci-device
+: pci-io-enable ( -- ) my-space 4 + dup rtas-config-w@ 1 or swap rtas-config-w! ;
+
+\ Enable Bus Master, I/O and mem access
+: pci-enable ( -- ) my-space 4 + dup rtas-config-w@ 7 or swap rtas-config-w! ;
+
+\ Enable #PERR and #SERR errors of pci-device
+: pci-error-enable ( -- ) my-space 4 + dup rtas-config-w@ 140 or swap rtas-config-w! ;
+
+\ prints out the ScanInformation about a device
+\ char is a sign for device type e.g. D - device ; B - bridge
+: pci-out ( addr char -- )
+        15 spaces
+        over pci-addr-out
+        s"  (" type emit s" ) : " type
+        dup pci-vendor@ 4 0.r space
+        pci-device@ 4 0.r
+        4 spaces
+;
+
+
+\ set and fetch the interrupt Pin
+: pci-irq-line@  ( addr -- irq-pin ) 3C + rtas-config-b@ ;
+: pci-irq-line!  ( pin addr -- ) 3C + rtas-config-b! ;
+
+\ set and fetch primary bus number
+: pci-bus-prim! ( nr addr -- ) 18 + dup rtas-config-l@ FFFFFF00 and rot + swap rtas-config-l! ;
+: pci-bus-prim@ ( addr -- nr ) 18 + rtas-config-l@ FF and ;
+
+\ set and fetch secondary bus number
+: pci-bus-scnd! ( nr addr -- ) 18 + dup rtas-config-l@ FFFF00FF and rot 8 lshift + swap rtas-config-l! ;
+: pci-bus-scnd@ ( addr -- nr ) 18 + rtas-config-l@ 8 rshift FF and ;
+
+\ set and fetch subordinate bus number
+: pci-bus-subo! ( nr addr -- ) 18 + dup rtas-config-l@ FF00FFFF and rot 10 lshift + swap rtas-config-l! ;
+: pci-bus-subo@ ( addr -- nr ) 18 + rtas-config-l@ 10 rshift FF and ;
+
+\ set and fetch primary, secondary and subordinate bus number
+: pci-bus! ( subo scnd prim addr -- ) swap rot 8 lshift + rot 10 lshift + swap 18 + dup rtas-config-l@ FF000000 and rot + swap rtas-config-l! ;
+: pci-bus@ ( addr -- subo scnd prim ) 18 + rtas-config-l@ dup 10 rshift FF and swap dup 8 rshift FF and swap FF and ;
+
+\ Reset secondary Status
+: pci-reset-2nd ( addr -- ) 1C + dup rtas-config-l@ FFFF0000 or swap rtas-config-l! ;
diff --git a/qemu/roms/SLOF/slof/fs/pci-properties.fs b/qemu/roms/SLOF/slof/fs/pci-properties.fs
new file mode 100644
index 000000000..4f134024f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-properties.fs
@@ -0,0 +1,668 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+#include "pci-class-code-names.fs"
+
+\ read the various bar type sizes
+: pci-bar-size@     ( bar-addr -- bar-size ) -1 over rtas-config-l! rtas-config-l@ ;
+: pci-bar-size-mem@ ( bar-addr -- mem-size ) pci-bar-size@ -10 and invert 1+ FFFFFFFF and ;
+: pci-bar-size-io@  ( bar-addr -- io-size  ) pci-bar-size@ -4 and invert 1+ FFFFFFFF and ;
+
+\ fetch raw bar size but keep original BAR value
+: pci-bar-size ( bar-addr -- bar-size-raw )
+        dup rtas-config-l@ swap \ fetch original Value  ( bval baddr )
+        -1 over rtas-config-l!  \ make BAR show size    ( bval baddr )
+        dup rtas-config-l@      \ and fetch the size    ( bval baddr bsize )
+        -rot rtas-config-l!     \ restore Value
+;
+
+\ calc 32 bit MEM BAR size
+: pci-bar-size-mem32 ( bar-addr -- bar-size )
+        pci-bar-size            \ fetch raw size
+        -10 and invert 1+       \ calc size
+        FFFFFFFF and            \ keep lower 32 bits
+;
+
+\ calc 32 bit ROM BAR size
+: pci-bar-size-rom ( bar-addr -- bar-size )
+        pci-bar-size            \ fetch raw size
+        FFFFF800 and invert 1+  \ calc size
+        FFFFFFFF and            \ keep lower 32 bits
+;
+
+\ calc 64 bit MEM BAR size
+: pci-bar-size-mem64 ( bar-addr -- bar-size )
+        dup pci-bar-size        \ fetch raw size lower 32 bits
+        swap 4 + pci-bar-size   \ fetch raw size upper 32 bits
+        20 lshift +             \ and put them together
+        -10 and invert 1+       \ calc size
+;
+
+\ calc IO BAR size
+: pci-bar-size-io ( bar-addr -- bar-size )
+        pci-bar-size            \ fetch raw size
+        -4 and invert 1+        \ calc size
+        FFFFFFFF and            \ keep lower 32 bits
+;
+
+
+\ decode the Bar Type
+\ +----------------------------------------------------------------------------------------+
+\ |                                         3 2 1 0                                        |
+\ |           +----------------------------+-+--+-+                                        |
+\ | MEM-BAR : |         Base Address       |P|TT|0|   P - prefechtable ; TT - 00 : 32 Bit  |
+\ |           +----------------------------+-+--+-+                           10 : 64 Bit  |
+\ |           +-------------------------------+-+-+                                        |
+\ |  IO-BAR : |         Base Address          |0|1|                                        |
+\ |           +-------------------------------+-+-+                                        |
+\ | That is: 0 - no encoded BarType                                                        |
+\ |          1 - IO - Bar                                                                  |
+\ |          2 - Memory 32 Bit                                                             |
+\ |          3 - Memory 32 Bit prefetchable                                                |
+\ |          4 - Memory 64 Bit                                                             |
+\ |          5 - Memory 64 Bit prefetchable                                                |
+\ +----------------------------------------------------------------------------------------+
+: pci-bar-code@ ( bar-addr -- 0|1..4|5 )
+        rtas-config-l@ dup                \ fetch the BaseAddressRegister
+        1 and IF                          \ IO BAR ?
+                2 and IF 0 ELSE 1 THEN    \ only '01' is valid
+        ELSE                              \ Memory BAR ?
+                F and CASE
+                        0   OF 2 ENDOF    \ Memory 32 Bit Non-Prefetchable
+                        8   OF 3 ENDOF    \ Memory 32 Bit Prefetchable
+                        4   OF 4 ENDOF    \ Memory 64 Bit Non-Prefetchable
+                        C   OF 5 ENDOF    \ Memory 64 Bit Prefechtable
+                        dup OF 0 ENDOF    \ Not a valid BarType
+                ENDCASE
+        THEN
+;
+
+\ ***************************************************************************************
+\ Assigning the new Value to the BARs
+\ ***************************************************************************************
+\ align the current mem and set var to next mem
+\ align with a size of 0 returns 0 !!!
+: assign-var ( size var -- al-mem )
+        2dup @                          \ ( size var size cur-mem ) read current free mem
+        swap #aligned                   \ ( size var al-mem )       align the mem to the size
+        dup 2swap -rot +                \ ( al-mem var new-mem )    add size to aligned mem
+        swap !                          \ ( al-mem )                set variable to new mem
+;
+
+\ set bar to current free mem ( in variable ) and set variable to next free mem
+: assign-bar-value32 ( bar size var -- 4 )
+        over IF                         \ IF size > 0
+                assign-var              \ | ( bar al-mem ) set variable to next mem
+                swap rtas-config-l!     \ | ( -- )         set the bar to al-mem
+        ELSE                            \ ELSE
+                2drop drop              \ | clear stack
+        THEN                            \ FI
+        4                               \ size of the base-address-register
+;
+
+\ set bar to current free mem ( in variable ) and set variable to next free mem
+: assign-bar-value64 ( bar size var -- 8 )
+        over IF                         \ IF size > 0
+                assign-var              \ | ( bar al-mem ) set variable to next mem
+                swap                    \ | ( al-mem addr ) calc config-addr of this bar
+                2dup rtas-config-l!     \ | ( al-mem addr ) set the Lower part of the bar to al-mem
+                4 + swap 20 rshift      \ | ( al-mem>>32 addr ) prepare the upper part of the al-mem
+                swap rtas-config-l!     \ | ( -- ) and set the upper part of the bar
+        ELSE                            \ ELSE
+                2drop drop              \ | clear stack
+        THEN                            \ FI
+        8                               \ size of the base-address-register
+;
+
+\ Setup a prefetchable 64bit BAR and return its size
+: assign-mem64-bar ( bar-addr -- 8 )
+        dup pci-bar-size-mem64         \ fetch size
+        pci-next-mem64 @ 0 = IF          \ Check if we have 64-bit memory range
+	    pci-next-mem
+	ELSE
+	    pci-next-mem64
+	THEN
+        assign-bar-value64              \ and set it all
+;
+
+\ Setup a prefetchable 32bit BAR and return its size
+: assign-mem32-bar ( bar-addr -- 4 )
+        dup pci-bar-size-mem32          \ fetch size
+        pci-next-mem                    \ var to change
+        assign-bar-value32              \ and set it all
+;
+
+\ Setup a non-prefetchable 64bit BAR and return its size
+: assign-mmio64-bar ( bar-addr -- 8 )
+        dup pci-bar-size-mem64          \ fetch size
+        pci-next-mem64 @ 0 = IF          \ Check if we have 64-bit memory range
+	    pci-next-mmio
+	ELSE
+	    pci-next-mem64              \ for board-qemu we will use same range
+	THEN
+        assign-bar-value64              \ and set it all
+;
+
+\ Setup a non-prefetchable 32bit BAR and return its size
+: assign-mmio32-bar ( bar-addr -- 4 )
+        dup pci-bar-size-mem32          \ fetch size
+        pci-next-mmio                   \ var to change
+        assign-bar-value32              \ and set it all
+;
+
+\ Setup an IO-Bar and return the size of the base-address-register
+: assign-io-bar ( bar-addr -- 4 )
+        dup pci-bar-size-io             \ fetch size
+        pci-next-io                     \ var to change
+        assign-bar-value32              \ and set it all
+;
+
+\ Setup an Expansion ROM bar
+: assign-rom-bar ( bar-addr -- )
+        dup pci-bar-size-rom            \ fetch size
+        dup IF                          \ IF size > 0
+                over >r                 \ | save bar addr for enable
+                pci-next-mmio           \ | var to change
+                assign-bar-value32      \ | and set it
+                drop                    \ | forget the BAR length
+                r@ rtas-config-l@       \ | fetch BAR
+                1 or r> rtas-config-l!  \ | and enable the ROM
+        ELSE                            \ ELSE
+                2drop                   \ | clear stack
+        THEN
+;
+
+\ Setup the BAR due to its type and return the size of the register (4 or 8 Bytes ) used as increment for the BAR-Loop
+: assign-bar ( bar-addr -- reg-size )
+        dup pci-bar-code@                       \ calc BAR type
+        dup IF                                  \ IF >0
+                CASE                            \ | CASE Setup the right type
+                1 OF assign-io-bar     ENDOF    \ | - set up an IO-Bar
+                2 OF assign-mmio32-bar ENDOF    \ | - set up an 32bit MMIO-Bar
+                3 OF assign-mem32-bar  ENDOF    \ | - set up an 32bit MEM-Bar (prefetchable)
+                4 OF assign-mmio64-bar ENDOF    \ | - set up an 64bit MMIO-Bar
+                5 OF assign-mem64-bar  ENDOF    \ | - set up an 64bit MEM-Bar (prefetchable)
+                ENDCASE                         \ | ESAC
+        ELSE                                    \ ELSE
+                ABORT                           \ | Throw an exception
+        THEN                                    \ FI
+;
+
+\ Setup all the bars of a pci device
+: assign-all-device-bars ( configaddr -- )
+        28 10 DO                        \ BARs start at 10 and end at 27
+                dup i +                 \ calc config-addr of the BAR
+                assign-bar              \ and set it up
+        +LOOP                           \ add 4 or 8 to the index and loop
+        30 + assign-rom-bar             \ set up the ROM if available
+;
+
+\ Setup all the bars of a pci device
+: assign-all-bridge-bars ( configaddr -- )
+        18 10 DO                        \ BARs start at 10 and end at 17
+                dup i +                 \ calc config-addr of the BAR
+                assign-bar              \ and set it up
+        +LOOP                           \ add 4 or 8 to the index and loop
+        38 + assign-rom-bar             \ set up the ROM if available
+;
+
+\ +---------------------------------------------------------------------------------------+
+\ | Numerical Representaton of a PCI address (PCI Bus Binding 2.2.1.1)                   |
+\ |                                                                                       |
+\ |           31      24       16    11   8        0                                      |
+\ |           +--------+--------+-----+---+--------+                                      |
+\ | phys.hi:  |npt000ss|  bus   | dev |fnc|   reg  |    n - 0 relocatable                 |
+\ |           +--------+--------+-----+---+--------+    p - 1 prefetchable                |
+\ |                                                     t - 1 aliased or <1MB or <64KB    |
+\ |                                                    ss - 00 Configuration Space        |
+\ |                                                         01 I/O Space                  |
+\ |                                                         10 Memory Space 32bits        |
+\ |                                                         11 Memory Space 64bits        |
+\ +---------------------------------------------------------------------------------------+
+
+\ ***************************************************************************************
+\ Generating the assigned-addresses property
+\ ***************************************************************************************
+\ generate assigned-addresses property for 64Bit MEM-BAR and return BAR-reg-size
+: gen-mem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 )
+        dup pci-bar-size-mem64                  \ fetch BAR Size        ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size)
+                over 4 + rtas-config-l@         \ | fetch upper 32 bits               ( paddr plen baddr val.lo val.hi R: size)
+                20 lshift + -10 and >r          \ | calc 64 bit value and save it     ( paddr plen baddr R: size val )
+                83000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        8                                       \ sizeof(BAR) = 8 Bytes
+;
+
+\ generate assigned-addresses property for prefetchable 64Bit MEM-BAR and return BAR-reg-size
+: gen-pmem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 )
+        dup pci-bar-size-mem64                  \ fetch BAR Size        ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size)
+                over 4 + rtas-config-l@         \ | fetch upper 32 bits               ( paddr plen baddr val.lo val.hi R: size)
+                20 lshift + -10 and >r          \ | calc 64 bit value and save it     ( paddr plen baddr R: size val )
+                C3000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        8                                       \ sizeof(BAR) = 8 Bytes
+;
+
+\ generate assigned-addresses property for 32Bit MEM-BAR and return BAR-reg-size
+: gen-mem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
+        dup pci-bar-size-mem32                  \ fetch BAR Size        ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
+                -10 and >r                      \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
+                82000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ sizeof(BAR) = 4 Bytes
+;
+
+\ generate assigned-addresses property for prefetchable 32Bit MEM-BAR and return BAR-reg-size
+: gen-pmem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
+        dup pci-bar-size-mem32                  \ fetch BAR Size        ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
+                -10 and >r                      \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
+                C2000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ sizeof(BAR) = 4 Bytes
+;
+
+\ generate assigned-addresses property for IO-BAR and return BAR-reg-size
+: gen-io-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
+        dup pci-bar-size-io                     \ fetch BAR Size                      ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
+                -4 and >r                       \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
+                81000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ sizeof(BAR) = 4 Bytes
+;
+
+\ generate assigned-addresses property for ROM-BAR
+: gen-rom-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len )
+        dup pci-bar-size-rom                    \ fetch BAR Size                      ( paddr plen baddr bsize )
+        dup IF                                  \ IF Size > 0
+                >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
+                FFFFF800 and >r                 \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
+                82000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
+                r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
+                r> encode-64+                   \ | Encode size                       ( paddr plen )
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+;
+
+\ add another BAR to the assigned addresses property and return the size of the encoded register
+: pci-add-assigned-address ( prop-addr prop-len bar-addr -- prop-addr prop-len bsize )
+        dup pci-bar-code@                               \ calc BAR type                         ( paddr plen baddr btype)
+        CASE                                            \ CASE for the BAR types                ( paddr plen baddr )
+                0 OF drop 4              ENDOF          \ - not a valid type so do nothing
+                1 OF gen-io-bar-prop     ENDOF          \ - IO-BAR
+                2 OF gen-mem32-bar-prop  ENDOF          \ - MEM32
+                3 OF gen-pmem32-bar-prop ENDOF          \ - MEM32 prefetchable
+                4 OF gen-mem64-bar-prop  ENDOF          \ - MEM64
+                5 OF gen-pmem64-bar-prop ENDOF          \ - MEM64 prefetchable
+        ENDCASE                                         \ ESAC ( paddr plen bsize )
+;
+
+\ generate the assigned address property for a PCI device
+: pci-device-assigned-addresses-prop ( addr -- )
+        encode-start                                    \ provide mem for property              ( addr paddr plen )
+        2 pick 30 + gen-rom-bar-prop                    \ assign the rom bar
+        28 10 DO                                        \ we have 6 possible BARs
+                2 pick i +                              \ calc BAR address                      ( addr paddr plen bar-addr )      
+                pci-add-assigned-address                \ and generate the props for the BAR
+        +LOOP                                           \ increase Index by returned len
+        s" assigned-addresses" property drop            \ and write it into the device tree
+;
+
+\ generate the assigned address property for a PCI bridge
+: pci-bridge-assigned-addresses-prop ( addr -- )
+        encode-start                                    \ provide mem for property
+        2 pick 38 + gen-rom-bar-prop                    \ assign the rom bar
+        18 10 DO                                        \ we have 2 possible BARs
+                2 pick i +                              \ ( addr paddr plen current-addr )
+                pci-add-assigned-address                \ and generate the props for the BAR
+        +LOOP                                           \ increase Index by returned len
+        s" assigned-addresses" property drop            \ and write it into the device tree
+;
+
+\ check if the range is valid and if so encode it into
+\ child.hi child.mid child.lo parent.hi parent.mid parent.lo size.hi size.lo
+\ This is needed to translate the childrens addresses
+\ We implement only 1:1 mapping for all PCI bridges
+: pci-bridge-gen-range ( paddr plen base limit type -- paddr plen )
+        >r over -                       \ calc size             ( paddr plen base size R:type )
+        dup 0< IF                       \ IF Size < 0           ( paddr plen base size R:type )
+                2drop r> drop           \ | forget values       ( paddr plen )
+        ELSE                            \ ELSE
+                1+ swap 2swap           \ | adjust stack        ( size base paddr plen R:type )
+                r@ encode-int+          \ | Child type          ( size base paddr plen R:type )
+                2 pick encode-64+       \ | Child address       ( size base paddr plen R:type )
+                r> encode-int+          \ | Parent type         ( size base paddr plen )
+                rot encode-64+          \ | Parent address      ( size paddr plen )
+                rot encode-64+          \ | Encode size         ( paddr plen )
+        THEN                            \ FI
+;
+
+
+\ generate an mmio space to the ranges property
+: pci-bridge-gen-mmio-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
+        2 pick 20 + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
+        dup 0000FFF0 and 10 lshift      \ calc base-address     ( addr paddr plen val base )
+        swap 000FFFFF or                \ calc limit-address    ( addr paddr plen base limit )
+        02000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
+;
+
+\ generate an mem space to the ranges property
+: pci-bridge-gen-mem-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
+        2 pick 24 + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
+        dup 000FFFFF or                 \ calc limit Bits 31:0  ( addr paddr plen val limit.31:0 )
+        swap 0000FFF0 and 10 lshift     \ calc base Bits 31:0   ( addr paddr plen limit.31:0 base.31:0 )
+        4 pick 28 + rtas-config-l@      \ fetch upper Basebits  ( addr paddr plen limit.31:0 base.31:0 base.63:32 )
+        20 lshift or swap               \ and calc Base         ( addr paddr plen base.63:0 limit.31:0 )
+        4 pick 2C + rtas-config-l@      \ fetch upper Limitbits ( addr paddr plen base.63:0 limit.31:0 limit.63:32 )
+        20 lshift or                    \ and calc Limit        ( addr paddr plen base.63:0 limit.63:0 )
+        42000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
+;
+
+\ generate an io space to the ranges property
+: pci-bridge-gen-io-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
+        2 pick 1C + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
+        dup 0000F000 and 00000FFF or    \ calc Limit Bits 15:0  ( addr paddr plen val limit.15:0 )
+        swap 000000F0 and 8 lshift      \ calc Base Bits 15:0   ( addr paddr plen limit.15:0 base.15:0 )
+        4 pick 30 + rtas-config-l@      \ fetch upper Bits      ( addr paddr plen limit.15:0 base.15:0 val )
+        dup FFFF and 10 lshift rot or   \ calc Base             ( addr paddr plen limit.15:0 val base.31:0 )
+        -rot FFFF0000 and or            \ calc Limit            ( addr paddr plen base.31:0 limit.31:0 )
+        01000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
+;
+
+\ generate the ranges property for a PCI bridge
+: pci-bridge-range-props ( addr -- )
+        encode-start                    \ provide mem for property
+        pci-bridge-gen-mmio-range       \ generate the non prefetchable Memory Entry
+        pci-bridge-gen-mem-range        \ generate the prefetchable Memory Entry
+        pci-bridge-gen-io-range         \ generate the IO Entry
+        dup IF                          \ IF any space present (propsize>0)
+                s" ranges" property     \ | write it into the device tree
+        ELSE                            \ ELSE
+               s" " s" ranges" property
+                2drop                   \ | forget the properties
+        THEN                            \ FI
+        drop                            \ forget the address
+;
+
+\ create the interrupt map for this bridge
+: pci-bridge-interrupt-map ( -- )
+        encode-start                                    \ create the property                           ( paddr plen )
+        get-node child                                  \ find the first child                          ( paddr plen handle )
+        BEGIN dup WHILE                                 \ Loop as long as the handle is non-zero        ( paddr plen handle )
+                dup >r >space                           \ Get the my-space                              ( paddr plen addr R: handle )
+                pci-gen-irq-entry                       \ and Encode the interrupt settings             ( paddr plen R: handle)
+                r> peer                                 \ Get neighbour                                 ( paddr plen handle )
+        REPEAT                                          \ process next childe node                      ( paddr plen handle )
+        drop                                            \ forget the null                               ( paddr plen )
+        s" interrupt-map" property                      \ and set it                                    ( -- )
+        1 encode-int s" #interrupt-cells" property      \ encode the cell#
+        f800 encode-int 0 encode-int+ 0 encode-int+     \ encode the bit mask for config addr (Dev only)
+        7 encode-int+ s" interrupt-map-mask" property   \ encode IRQ#=7 and generate property
+;
+
+\ ***************************************************************************************
+\ Generating the reg property
+\ ***************************************************************************************
+\ reg = config-addr 0 0 0 0 [BAR-config-addr 0 0 size.high size.low]
+
+\ encode the reg prop for a nonprefetchable 32bit MEM-BAR
+: encode-mem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 )
+        dup pci-bar-size-mem32                  \ calc BAR-size ( not changing the BAR )
+        dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
+                >r 02000000 or encode-int+      \ | save size and encode BAR addr
+                0 encode-64+                    \ | make mid and lo zero
+                r> encode-64+                   \ | encode size
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ BAR-Len = 4 (32Bit)
+;
+
+\ encode the reg prop for a prefetchable 32bit MEM-BAR
+: encode-pmem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 )
+        dup pci-bar-size-mem32                  \ calc BAR-size ( not changing the BAR )
+        dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
+                >r 42000000 or encode-int+      \ | save size and encode BAR addr
+                0 encode-64+                    \ | make mid and lo zero
+                r> encode-64+                   \ | encode size
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ BAR-Len = 4 (32Bit)
+;
+
+\ encode the reg prop for a nonprefetchable 64bit MEM-BAR
+: encode-mem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 )
+        dup pci-bar-size-mem64                  \ calc BAR-size ( not changing the BAR )
+        dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
+                >r 03000000 or encode-int+      \ | save size and encode BAR addr
+                0 encode-64+                    \ | make mid and lo zero
+                r> encode-64+                   \ | encode size
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        8                                       \ BAR-Len = 8 (64Bit)
+;
+
+\ encode the reg prop for a prefetchable 64bit MEM-BAR
+: encode-pmem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 )
+        dup pci-bar-size-mem64                  \ calc BAR-size ( not changing the BAR )
+        dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
+                >r 43000000 or encode-int+      \ | save size and encode BAR addr
+                0 encode-64+                    \ | make mid and lo zero
+                r> encode-64+                   \ | encode size
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        8                                       \ BAR-Len = 8 (64Bit)
+;
+
+\ encode the reg prop for a ROM-BAR
+: encode-rom-bar ( prop-addr prop-len configaddr -- prop-addr prop-len )
+        dup pci-bar-size-rom                            \ fetch raw BAR-size
+        dup IF                                          \ IF BAR is used
+                >r 02000000 or encode-int+              \ | save size and encode BAR addr
+                0 encode-64+                            \ | make mid and lo zero
+                r> encode-64+                           \ | calc and encode the size
+        ELSE                                            \ ELSE
+                2drop                                   \ | don't do anything
+        THEN                                            \ FI
+;
+
+\ encode the reg prop for an IO-BAR
+: encode-io-bar ( prop-addr prop-len BAR-addr BAR-value -- prop-addr prop-len 4 )
+        dup pci-bar-size-io                     \ calc BAR-size ( not changing the BAR )
+        dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
+                >r 01000000 or encode-int+      \ | save size and encode BAR addr
+                0 encode-64+                    \ | make mid and lo zero
+                r> encode-64+                   \ | encode size
+        ELSE                                    \ ELSE
+                2drop                           \ | don't do anything
+        THEN                                    \ FI
+        4                                       \ BAR-Len = 4 (32Bit)
+;
+
+\ write the representation of this BAR into the reg property
+: encode-bar ( prop-addr prop-len bar-addr -- prop-addr prop-len bar-len )
+        dup pci-bar-code@                               \ calc BAR type
+        CASE                                            \ CASE for the BAR types ( paddr plen baddr val )
+                0 OF drop 4             ENDOF           \ - not a valid type so do nothing
+                1 OF encode-io-bar      ENDOF           \ - IO-BAR
+                2 OF encode-mem32-bar   ENDOF           \ - MEM32
+                3 OF encode-pmem32-bar  ENDOF           \ - MEM32 prefetchable
+                4 OF encode-mem64-bar   ENDOF           \ - MEM64
+                5 OF encode-pmem64-bar  ENDOF           \ - MEM64 prefetchable
+        ENDCASE                                         \ ESAC ( paddr plen blen )
+;
+
+\ Setup reg property
+\ first encode the configuration space address
+: pci-reg-props ( configaddr -- )
+        dup encode-int                  \ configuration space           ( caddr paddr plen )
+        0 encode-64+                    \ make the rest 0
+        0 encode-64+                    \ encode the size as 0
+        2 pick pci-htype@               \ fetch Header Type             ( caddr paddr plen type )
+        1 and IF                        \ IF Bridge                     ( caddr paddr plen )
+                18 10 DO                \ | loop over all BARs
+                        2 pick i +      \ | calc bar-addr               ( caddr paddr plen baddr )
+                        encode-bar      \ | encode this BAR             ( caddr paddr plen blen )
+                     +LOOP              \ | increase LoopIndex by the BARlen
+                2 pick 38 +             \ | calc ROM-BAR for a bridge   ( caddr paddr plen baddr )
+                encode-rom-bar          \ | encode the ROM-BAR          ( caddr paddr plen )
+        ELSE                            \ ELSE ordinary device          ( caddr paddr plen )
+               28 10 DO                 \ | loop over all BARs
+                        2 pick i +      \ | calc bar-addr               ( caddr paddr plen baddr )
+                        encode-bar      \ | encode this BAR             ( caddr paddr plen blen )
+                     +LOOP              \ | increase LoopIndex by the BARlen
+                2 pick 30 +             \ | calc ROM-BAR for a device   ( caddr paddr plen baddr )
+                encode-rom-bar          \ | encode the ROM-BAR          ( caddr paddr plen )
+        THEN                            \ FI                            ( caddr paddr plen )
+        s" reg" property                \ and store it into the property
+        drop
+;
+
+\ ***************************************************************************************
+\ Generating common properties
+\ ***************************************************************************************
+\ set up common properties for devices and bridges
+: pci-common-props ( addr -- )
+        dup pci-class-name device-name
+        dup pci-vendor@    encode-int s" vendor-id"      property
+        dup pci-device@    encode-int s" device-id"      property
+        dup pci-revision@  encode-int s" revision-id"    property
+        dup pci-class@     encode-int s" class-code"     property
+                         3 encode-int s" #address-cells" property
+                         2 encode-int s" #size-cells"    property
+
+        dup pci-config-ext? IF 1 encode-int s" ibm,pci-config-space-type" property THEN
+
+        dup pci-status@
+                dup 9 rshift 3 and encode-int s" devsel-speed" property
+                dup 7 rshift 1 and IF 0 0 s" fast-back-to-back" property THEN
+                dup 6 rshift 1 and IF 0 0 s" 66mhz-capable" property THEN
+                    5 rshift 1 and IF 0 0 s" udf-supported" property THEN
+        dup pci-cache@     ?dup IF encode-int s" cache-line-size" property THEN
+            pci-interrupt@ ?dup IF encode-int s" interrupts"      property THEN
+;
+
+\ set up device only properties
+: pci-device-props ( addr -- )
+        \ FIXME no s" compatible" prop
+        \ FIXME no s" alternate-reg" prop
+        \ FIXME no s" fcode-rom-offset" prop
+        \ FIXME no s" power-consumption" prop
+        dup pci-common-props
+        dup pci-min-grant@ encode-int s" min-grant"   property
+        dup pci-max-lat@   encode-int s" max-latency" property
+        dup pci-sub-device@ ?dup IF encode-int s" subsystem-id" property THEN
+        dup pci-sub-vendor@ ?dup IF encode-int s" subsystem-vendor-id" property THEN
+        dup pci-device-assigned-addresses-prop
+        pci-reg-props
+        pci-hotplug-enabled IF
+            \ QEMU uses static assignments for my-drc-index:
+            \ 40000000h + $bus << 8 + $slot << 3
+            dup dup pci-addr2bus 8 lshift
+            swap pci-addr2dev 3 lshift or
+            40000000 + encode-int s" ibm,my-drc-index" property
+            \ QEMU uses "Slot $bus*32$slotno" for loc-code
+            dup dup pci-addr2bus 20 *
+            swap pci-addr2dev +
+            a base !
+            s" Slot " rot $cathex
+            hex
+            encode-string s" ibm,loc-code" property
+        THEN
+;
+
+\ set up bridge only properties
+: pci-bridge-props ( addr -- )
+        \ FIXME no s" slot-names" prop
+        \ FIXME no s" bus-master-capable" prop
+        \ FIXME no s" clock-frequency" prop
+        dup pci-bus@
+              encode-int s" primary-bus" property
+              encode-int s" secondary-bus" property
+              encode-int s" subordinate-bus" property
+        dup pci-bus@ drop encode-int rot encode-int+ s" bus-range" property
+            pci-device-slots encode-int s" slot-names" property
+        dup pci-bridge-range-props
+        dup pci-bridge-assigned-addresses-prop
+	\ Only create interrupt-map when it doesn't already exist
+	\ (it can be provided by qemu)
+	s" interrupt-map" get-node get-property IF
+            pci-bridge-interrupt-map
+	ELSE 2drop THEN
+        pci-reg-props
+;
+
+
+\ used to set up all unknown Bridges.
+\ If a Bridge has no special handling for setup
+\ the device file (pci-bridge_VENDOR_DEVICE.fs) can call
+\ this word to setup busses and scan beyond.
+: pci-bridge-generic-setup ( addr -- )
+        pci-device-slots >r             \ save the slot array on return stack
+        dup pci-common-props            \ set the common properties before scanning the bus
+        s" pci" device-type             \ the type is allways "pci"
+        dup pci-bridge-probe            \ find all device connected to it
+        dup assign-all-bridge-bars      \ set up all memory access BARs
+        dup pci-set-irq-line            \ set the interrupt pin
+        dup pci-set-capabilities        \ set up the capabilities
+            pci-bridge-props            \ and generate all properties
+        r> TO pci-device-slots          \ and reset the slot array
+;
+
+DEFER func-pci-device-props
+
+\ used for an gerneric device set up
+\ if a device has no special handling for setup
+\ the device file (pci-device_VENDOR_DEVICE.fs) can call
+\ this word to setup the device
+: pci-device-generic-setup ( config-addr -- )
+        dup assign-all-device-bars      \ calc all BARs
+        dup pci-set-irq-line            \ set the interrupt pin
+        dup pci-set-capabilities        \ set up the capabilities
+        dup func-pci-device-props       \ and generate all properties
+        drop                            \ forget the config-addr
+;
+
+' pci-device-props TO func-pci-device-props
diff --git a/qemu/roms/SLOF/slof/fs/pci-scan.fs b/qemu/roms/SLOF/slof/fs/pci-scan.fs
new file mode 100644
index 000000000..b8b9fe61f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/pci-scan.fs
@@ -0,0 +1,344 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ ----------------------------------------------------------
+\ **********  Variables to be set by host bridge  **********
+\ ----------------------------------------------------------
+
+\ Values of the next free memory area
+VARIABLE pci-next-mem           \ prefetchable memory mapped
+VARIABLE pci-max-mem
+VARIABLE pci-next-mmio          \ non-prefetchable memory
+VARIABLE pci-max-mmio
+VARIABLE pci-next-io            \ I/O space
+VARIABLE pci-max-io
+VARIABLE pci-next-mem64           \ prefetchable 64-bit memory mapped
+VARIABLE pci-max-mem64
+
+\ Counter of busses found
+0 VALUE pci-bus-number
+\ Counter of devices found
+0 VALUE pci-device-number
+\ bit field of devices plugged into this bridge
+0 VALUE pci-device-slots
+\ byte field holding the device-slot number vector of the current device
+\ the vector can be as deep as the max depth of bridges possible
+\ 3,4,5 means
+\       the 5th slot on the bus of the bridge in
+\       the 4th slot on the bus of the bridge in
+\       the 3rd slot on the HostBridge bus
+here 100 allot CONSTANT pci-device-vec
+0 VALUE pci-device-vec-len
+\ enable/disable creation of hotplug-specific properties
+0 VALUE pci-hotplug-enabled
+
+
+\ Fixme Glue to the pci-devices ... remove this later
+: next-pci-mem ( addr -- addr ) pci-next-mem ;
+: next-pci-mmio ( addr -- addr ) pci-next-mmio ;
+: next-pci-io ( addr -- addr ) pci-next-io ;
+
+
+#include "pci-helper.fs"
+
+\ Dump out the pci device-slot vector
+: pci-vec ( -- )
+        cr s" device-vec(" type
+        pci-device-vec-len dup 2 0.r s" ):" type
+        1+ 0 DO
+                pci-device-vec i + c@
+                space 2 0.r
+        LOOP
+        cr
+;
+
+\ prints out all relevant pci variables
+: pci-var-out ( -- )
+        s"   mem:" type pci-next-mem @ 16 0.r cr
+        s"  mmio:" type pci-next-mmio @ 16 0.r cr
+        s"    io:" type pci-next-io @ 16 0.r cr
+;
+
+
+\ Update the device-slot number vector
+\ Set the bit of the DeviceSlot in the Slot array
+: pci-set-slot ( addr -- )
+        pci-addr2dev dup                \ calc slot number
+        pci-device-vec-len              \ the end of the vector
+        pci-device-vec + c!             \ and update the vector
+        80000000 swap rshift            \ calc bit position of the device slot
+        pci-device-slots or             \ set this bit
+        TO pci-device-slots             \ and write it back
+;
+
+\ Update pci-next-mmio to be 1MB aligned and set the mmio-base register
+\ and set the Limit register to the maximum available address space
+\ needed for scanning possible devices behind the bridge
+: pci-bridge-set-mmio-base ( addr -- )
+        pci-next-mmio @ 100000 #aligned         \ read the current Value and align to 1MB boundary
+        dup 100000 + pci-next-mmio !            \ and write back with 1MB for bridge
+        10 rshift                               \ mmio-base reg is only the upper 16 bits
+        pci-max-mmio @ 1- FFFF0000 and or       \ and Insert mmio Limit (set it to max)
+        swap 20 + rtas-config-l!                \ and write it into the bridge
+;
+
+\ Update pci-next-mmio to be 1MB aligned and set the mmio-limit register
+\ The Limit Value is one less then the upper boundary
+\ If the limit is less than the base the mmio is disabled
+: pci-bridge-set-mmio-limit ( addr -- )
+        pci-next-mmio @ 100000 #aligned         \ fetch current value and align to 1MB
+        dup pci-next-mmio !                     \ and write it back
+        1- FFFF0000 and                         \ make it one less and keep upper 16 bits
+        over 20 + rtas-config-l@ 0000FFFF and   \ fetch original value
+        or swap 20 + rtas-config-l!             \ and write it into the Reg
+;
+
+\ Update pci-next-mem to be 1MB aligned and set the mem-base and mem-base-upper register
+\ and set the Limit register to the maximum available address space
+\ needed for scanning possible devices behind the bridge
+: pci-bridge-set-mem-base ( addr -- )
+        pci-next-mem @ 100000 #aligned          \ read the current Value and align to 1MB boundary
+        dup 100000 + pci-next-mem !             \ and write back with 1MB for bridge
+        over 24 + rtas-config-w@                \ check if 64bit support
+        1 and IF                                \ IF 64 bit support
+                2dup 20 rshift                  \ | keep upper 32 bits
+                swap 28 + rtas-config-l!        \ | and write it into the Base-Upper32-bits
+                pci-max-mem @ 20 rshift         \ | fetch max Limit address and keep upper 32 bits
+                2 pick 2C + rtas-config-l!      \ | and set the Limit
+        THEN                                    \ FI
+        10 rshift                               \ keep upper 16 bits
+        pci-max-mem @ 1- FFFF0000 and or        \ and Insert mmem Limit (set it to max)
+        swap 24 + rtas-config-l!                \ and write it into the bridge
+;
+
+\ Update pci-next-mem to be 1MB aligned and set the mem-limit register
+\ The Limit Value is one less then the upper boundary
+\ If the limit is less than the base the mem is disabled
+: pci-bridge-set-mem-limit ( addr -- )
+        pci-next-mem @ 100000 #aligned          \ read the current Value and align to 1MB boundary
+        dup pci-next-mem !                      \ and write it back
+        1-                                      \ make limit one less than boundary
+        over 24 + rtas-config-w@                \ check if 64bit support
+        1 and IF                                \ IF 64 bit support
+                2dup 20 rshift                  \ | keep upper 32 bits
+                swap 2C + rtas-config-l!        \ | and write it into the Limit-Upper32-bits
+        THEN                                    \ FI
+        FFFF0000 and                            \ keep upper 16 bits
+        over 24 + rtas-config-l@ 0000FFFF and   \ fetch original Value
+        or swap 24 + rtas-config-l!             \ and write it into the bridge
+;
+
+\ Update pci-next-io to be 4KB aligned and set the io-base and io-base-upper register
+\ and set the Limit register to the maximum available address space
+\ needed for scanning possible devices behind the bridge
+: pci-bridge-set-io-base ( addr -- )
+        pci-next-io @ 1000 #aligned             \ read the current Value and align to 4KB boundary
+        dup 1000 + pci-next-io !                \ and write back with 4K for bridge
+        over 1C + rtas-config-l@                \ check if 32bit support
+        1 and IF                                \ IF 32 bit support
+                2dup 10 rshift                  \ | keep upper 16 bits
+                pci-max-io @ FFFF0000 and or    \ | insert upper 16 bits of Max-Limit
+                swap 30 + rtas-config-l!        \ | and write it into the Base-Upper16-bits
+        THEN                                    \ FI
+        8 rshift 000000FF and                   \ keep upper 8 bits
+        pci-max-io @ 1- 0000FF00 and or         \ insert upper 8 bits of Max-Limit
+        over rtas-config-l@ FFFF0000 and        \ fetch original Value
+        or swap 1C + rtas-config-l!             \ and write it into the bridge
+;
+
+\ Update pci-next-io to be 4KB aligned and set the io-limit register
+\ The Limit Value is one less then the upper boundary
+\ If the limit is less than the base the io is disabled
+: pci-bridge-set-io-limit ( addr -- )
+        pci-next-io @ 1000 #aligned             \ read the current Value and align to 4KB boundary
+        dup pci-next-io !                       \ and write it back
+        1-                                      \ make limit one less than boundary
+        over 1D + rtas-config-b@                \ check if 32bit support
+        1 and IF                                \ IF 32 bit support
+                2dup FFFF0000 and               \ | keep upper 16 bits
+                over 30 + rtas-config-l@        \ | fetch original Value
+                or swap 30 + rtas-config-l!     \ | and write it into the Limit-Upper16-bits
+        THEN                                    \ FI
+        0000FF00 and                            \ keep upper 8 bits
+        over 1C + rtas-config-l@ FFFF00FF and   \ fetch original Value
+        or swap 1C + rtas-config-l!             \ and write it into the bridge
+;
+
+\ set up all base registers to the current variable Values
+: pci-bridge-set-bases ( addr -- )
+        dup pci-bridge-set-mmio-base
+        dup pci-bridge-set-mem-base
+            pci-bridge-set-io-base
+;
+
+\ set up all limit registers to the current variable Values
+: pci-bridge-set-limits ( addr -- )
+        dup pci-bridge-set-mmio-limit
+        dup pci-bridge-set-mem-limit
+            pci-bridge-set-io-limit
+;
+
+\ ----------------------------------------------------------
+\ ******************  PCI Scan functions  ******************
+\ ----------------------------------------------------------
+
+\ define function pointer as forward declaration of pci-probe-bus
+DEFER func-pci-probe-bus
+DEFER func-pci-bridge-range-props
+
+\ Setup the Base and Limits in the Bridge
+\ and scan the bus(es) beyond that Bridge
+: pci-bridge-probe ( addr -- )
+        dup pci-bridge-set-bases                        \ SetUp all Base Registers
+	dup func-pci-bridge-range-props                 \ Setup temporary "range
+        pci-bus-number 1+ TO pci-bus-number             \ increase number of busses found
+        pci-device-vec-len 1+ TO pci-device-vec-len     \ increase the device-slot vector depth
+        dup                                             \ stack config-addr for pci-bus!
+        FF swap                                         \ Subordinate Bus Number ( for now to max to open all subbusses )
+        pci-bus-number swap                             \ Secondary   Bus Number ( the new busnumber )
+        dup pci-addr2bus swap                           \ Primary     Bus Number ( the current bus )
+        pci-bus!                                        \ and set them into the bridge
+        pci-enable                                      \ enable mem/IO transactions
+        dup pci-bus-scnd@ func-pci-probe-bus            \ and probe the secondary bus
+        dup pci-bus-number swap pci-bus-subo!           \ set SubOrdinate Bus Number to current number of busses
+        pci-device-vec-len 1- TO pci-device-vec-len     \ decrease the device-slot vector depth
+        dup pci-bridge-set-limits                       \ SetUp all Limit Registers
+        drop                                            \ forget the config-addr
+;
+
+\ set up the pci-device
+: pci-device-setup ( addr -- )
+        drop                            \ since the config-addr is coded in my-space, drop it here
+        s" pci-device.fs" included      \ and setup the device as node in the device tree
+;
+
+\ set up the pci bridge
+: pci-bridge-setup ( addr -- )
+        drop                            \ since the config-addr is coded in my-space, drop it here
+        s" pci-bridge.fs" included      \ and setup the bridge as node in the device tree
+;
+
+\ add the new found device/bridge to the device tree and set it up
+: pci-add-device ( addr -- )
+        new-device                      \ create a new device-tree node
+            dup set-space               \ set the config addr for this device tree entry
+            dup pci-set-slot            \ set the slot bit
+            dup pci-htype@              \ read HEADER-Type
+            7f and                      \ Mask bit 7 - multifunction device
+            CASE
+               0 OF pci-device-setup ENDOF  \ | set up the device
+               1 OF pci-bridge-setup ENDOF  \ | set up the bridge
+               dup OF dup pci-htype@ pci-out ENDOF
+           ENDCASE
+        finish-device                   \ and close the device-tree node
+;
+
+\ check for multifunction and for each function
+\ (dependig from header type) call device or bridge setup
+: pci-setup-device ( addr -- )
+        dup pci-htype@                      \ read HEADER-Type
+        80 and IF 8 ELSE 1 THEN             \ check for multifunction
+        0 DO                                \ LOOP over all possible functions (either 8 or only 1)
+                dup
+                i 8 lshift +                \ calc device-function-config-addr
+                dup pci-vendor@             \ check if valid function
+                FFFF = IF
+                        drop                \ non-valid so forget the address
+                ELSE
+                    pci-device-number 1+    \ increase the number of devices
+                    TO pci-device-number    \ and store it
+                    pci-add-device          \ and add the device to the device tree and set it up
+                THEN
+        LOOP                                \ next function
+        drop                                \ forget the device-addr
+;
+
+\ check if a device is plugged into this bus at this device number
+: pci-probe-device ( busnr devicenr -- )
+        pci-bus2addr                                    \ calc pci-address
+        dup pci-vendor@                                 \ fetch Vendor-ID
+        FFFF = IF                                       \ check if valid
+                drop                                    \ if not forget it
+        ELSE
+                pci-setup-device                        \ if valid setup the device
+        THEN
+;
+
+\ walk through all 32 possible pci devices on this bus and probe them
+: pci-probe-bus ( busnr -- )
+        0 TO pci-device-slots           \ reset slot array to unpoppulated
+        20 0 DO
+                dup
+                i pci-probe-device
+        LOOP
+        drop
+;
+
+\ setup the function pointer used in pci-bridge-setup
+' pci-probe-bus TO func-pci-probe-bus
+
+\ ----------------------------------------------------------
+\ ******************  System functions  ********************
+\ ----------------------------------------------------------
+\ Setup the whole system for pci devices
+\ start with the bus-min and try all busses
+\ until at least 1 device was found
+\ ( needed for HostBridges that don't start with Bus 0 )
+: pci-probe-all ( bus-max bus-min -- )                  \ Check all busses from bus-min up to bus-max if needed
+        0 TO pci-device-vec-len                         \ reset the device-slot vector
+        DO
+                i TO pci-bus-number                     \ set current Busnumber
+                0 TO pci-device-number                  \ reset Device Number
+                pci-bus-number pci-probe-bus            \ and probe this bus
+                pci-device-number 0 > IF LEAVE THEN     \ if we found a device we're done
+        LOOP                                            \ else next bus
+;
+
+: (probe-pci-host-bridge) ( bus-max bus-min -- )
+        0d emit ."  Adapters on " puid 10 0.r cr        \ print the puid we're looking at
+        ( bus-max bus-min ) pci-probe-all               \ and walk the bus
+        pci-device-number 0= IF                         \ IF no devices found
+                15 spaces                               \ | indent the output
+                ." None" cr                             \ | tell the world our result
+        THEN                                            \ FI
+;
+
+\ probe the hostbridge that is specified in my-puid
+\ for the mmio mem and io addresses:
+\ base is the least available address
+\ max is the highest available address
+: probe-pci-host-bridge ( bus-max bus-min mmio-max mmio-base mem-max mem-base io-max io-base my-puid -- )
+        puid >r TO puid                                 \ save puid and set the new
+        pci-next-io !                                   \ save the next io-base address
+        pci-max-io !                                    \ save the max io-space address
+        pci-next-mem !                                  \ save the next mem-base address
+        pci-max-mem !                                   \ save the max mem-space address
+        pci-next-mmio !                                 \ save the next mmio-base address
+        pci-max-mmio !                                  \ save the max mmio-space address
+	(probe-pci-host-bridge)
+        r> TO  puid                                     \ restore puid
+;
+
+\ provide the device-alias definition words
+#include <pci-aliases.fs>
+
+\ provide all words for the interrupts settings
+#include <pci-interrupts.fs>
+
+\ provide all words for the pci capabilities init
+#include <pci-capabilities.fs>
+
+\ provide all words needed to generate the properties and/or assign BAR values
+#include "pci-properties.fs"
+
+\ setup the function pointer for bridge ranges
+' pci-bridge-range-props TO func-pci-bridge-range-props
diff --git a/qemu/roms/SLOF/slof/fs/preprocessor.fs b/qemu/roms/SLOF/slof/fs/preprocessor.fs
new file mode 100644
index 000000000..a13fb3004
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/preprocessor.fs
@@ -0,0 +1,41 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: ([IF])
+  BEGIN
+    BEGIN parse-word dup 0= WHILE
+      2drop refill
+    REPEAT
+
+    2dup s" [IF]" str= IF 1 throw THEN
+    2dup s" [ELSE]" str= IF 2 throw THEN
+    2dup s" [THEN]" str= IF 3 throw THEN
+    s" \" str= IF linefeed parse 2drop THEN
+  AGAIN
+  ;
+
+: [IF] ( flag -- )
+  IF exit THEN
+  1 BEGIN
+    ['] ([IF]) catch 
+    CASE
+      1 OF 1+ ENDOF
+      2 OF dup 1 = if 1- then ENDOF
+      3 OF 1- ENDOF
+    ENDCASE
+    dup 0 <=
+  UNTIL drop
+; immediate
+
+: [ELSE] 0 [COMPILE] [IF] ; immediate
+: [THEN] ; immediate
+
diff --git a/qemu/roms/SLOF/slof/fs/property.fs b/qemu/roms/SLOF/slof/fs/property.fs
new file mode 100644
index 000000000..cb99fbe9d
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/property.fs
@@ -0,0 +1,192 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Properties 5.3.5
+
+\ Words on the property list for a node are actually executable words,
+\ that return the address and length of the property's data.  Special
+\ nodes like /options can have their properties use specialized code to
+\ dynamically generate their data; most nodes just use a 2CONSTANT.
+
+\ Put the type as byte before the property
+\   { int = 1, bytes = 2, string = 3 }
+\ This is used by .properties for pretty print
+
+\ Flag for type encoding, encode-* resets, set-property set the flag
+true value encode-first?
+
+: decode-int  over >r 4 /string r> 4c@ swap 2swap swap bljoin ;
+: decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ;
+: decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
+   dup 0= IF 2dup EXIT THEN \ string properties with zero length
+   over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1-
+    EXIT THEN 1+ AGAIN ;
+
+\ Remove a word from a wordlist.
+: (prune) ( name len head -- )
+  dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF
+  >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
+: prune ( name len -- )  last (prune) ;
+
+: set-property ( data dlen name nlen phandle -- )
+    true to encode-first?
+    get-current >r  node>properties @ set-current
+    2dup prune  $2CONSTANT  r> set-current ;
+: delete-property ( name nlen -- )
+    get-node get-current >r  node>properties @ set-current
+    prune r> set-current ;
+: property ( data dlen name nlen -- )  get-node set-property ;
+: get-property ( str len phandle -- true | data dlen false )
+  ?dup 0= IF cr cr cr ." get-property for " type ."  on zero phandle"
+  cr cr true EXIT THEN
+  node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ;
+: get-package-property ( str len phandle -- true | data dlen false )
+  get-property ;
+: get-my-property ( str len -- true | data dlen false )
+  my-self ihandle>phandle get-property ;
+: get-parent-property ( str len -- true | data dlen false )
+  my-parent ihandle>phandle get-property ;
+
+: get-inherited-property ( str len -- true | data dlen false )
+   my-self ihandle>phandle
+   BEGIN
+      3dup get-property 0= IF
+         \ Property found
+         rot drop rot drop rot drop false EXIT
+      THEN
+      parent dup 0= IF
+         \ Root node has been reached, but property has not been found
+         3drop true EXIT
+      THEN
+   AGAIN
+;
+
+\ Print out properties.
+
+20 CONSTANT indent-prop
+
+: .prop-int ( str len -- )
+   space
+   400 min 0
+   ?DO
+      i over + dup                                 ( str act-addr act-addr )
+      c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str )
+      i c and c = IF                           \ check for multipleof 16 bytes
+	 cr indent @ indent-prop + 1+ 0        \ linefeed + indent
+	 DO
+	    space                              \ print spaces
+	 LOOP
+      ELSE
+	 space space                           \ print two spaces
+      THEN
+   4 +LOOP
+   drop
+;
+
+: .prop-bytes ( str len -- )
+   2dup -4 and .prop-int                       ( str len )
+
+   dup 3 and dup IF                            ( str len len%4 )
+      >r -4 and + r>                           ( str' len%4 )
+      bounds                                   ( str' str'+len%4 )
+      DO
+	 i c@ 2 0.r                            \ Print last 3 bytes
+      LOOP
+   ELSE
+      3drop
+   THEN
+;
+
+: .prop-string ( str len )
+   2dup space type
+   cr indent @ indent-prop + 0 DO space LOOP   \ Linefeed
+   .prop-bytes
+;
+
+: .propbytes ( xt -- )
+   execute dup
+   IF
+      over cell- @ execute
+   ELSE
+      2drop
+   THEN
+;
+: .property ( lfa -- )
+    cr indent @ 0
+    ?DO
+	space
+    LOOP
+    link> dup >name name>string 2dup type nip ( len )
+    indent-prop swap -                        ( xt 20-len )
+    dup 0< IF drop 0 THEN 0                   ( xt number-of-space 0 )
+    ?DO
+	space
+    LOOP
+    .propbytes
+;
+: (.properties) ( phandle -- )
+  node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ;
+: .properties ( -- )
+  get-node (.properties) ;
+
+: next-property ( str len phandle -- false | str' len' true )
+  ?dup 0= IF device-tree @ THEN  \ XXX: is this line required?
+  node>properties @
+  >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN
+  @ dup IF link>name name>string true THEN ;
+
+
+\ encode-* words and all helpers
+
+\ Start a encoded property string
+: encode-start ( -- prop 0 )
+   ['] .prop-int compile,
+   false to encode-first?
+   here 0
+;
+
+: encode-int ( val -- prop prop-len )
+   encode-first? IF
+      ['] .prop-int compile,             \ Execution token for print
+      false to encode-first?
+   THEN
+   here swap lbsplit c, c, c, c, /l
+;
+: encode-bytes ( str len -- prop-addr prop-len )
+   encode-first? IF
+      ['] .prop-bytes compile,           \ Execution token for print
+      false to encode-first?
+   THEN
+   here over 2dup 2>r allot swap move 2r>
+;
+: encode-string ( str len -- prop-addr prop-len )
+   encode-first? IF
+      ['] .prop-string compile,          \ Execution token for print
+      false to encode-first?
+   THEN
+   encode-bytes 0 c, char+
+;
+
+: encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len )
+   nip + ;
+: encode-int+  encode-int encode+ ;
+: encode-64    xlsplit encode-int rot encode-int+ ;
+: encode-64+   encode-64 encode+ ;
+
+
+\ Helpers for common nodes.  Should perhaps remove "compatible", as it's
+\ not typically a single string.
+: device-name  encode-string s" name"        property ;
+: device-type  encode-string s" device_type" property ;
+: model        encode-string s" model"       property ;
+: compatible   encode-string s" compatible"  property ;
diff --git a/qemu/roms/SLOF/slof/fs/quiesce.fs b/qemu/roms/SLOF/slof/fs/quiesce.fs
new file mode 100644
index 000000000..47006e44d
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/quiesce.fs
@@ -0,0 +1,58 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+100 CONSTANT quiesce-xt#
+
+\ The array with the quiesce execution tokens:
+CREATE quiesce-xts quiesce-xt# cells allot
+quiesce-xts quiesce-xt# cells erase
+
+0 VALUE quiesce-done?
+
+
+\ Add a token to the quiesce execution token array:
+: add-quiesce-xt  ( xt -- )
+   quiesce-xt# 0 DO
+      quiesce-xts I cells +    ( xt arrayptr )
+      dup @ 0=                 ( xt arrayptr true|false )
+      IF
+         ! UNLOOP EXIT
+      ELSE                     ( xt arrayptr )
+         over swap             ( xt xt arrayptr )
+         @ =                   \ xt already stored ?
+         IF
+            drop UNLOOP EXIT
+         THEN                  ( xt )
+      THEN
+   LOOP
+   drop                        ( xt -- )
+   ." Warning: quiesce xt list is full." cr
+;
+
+
+\ The quiesce call asserts that the firmware and all hardware
+\ is in a sane state (e.g. assert that no background DMA is
+\ running anymore)
+: quiesce  ( -- )
+   quiesce-done? IF EXIT THEN
+   true to quiesce-done?
+   quiesce-xt# 0 DO
+      quiesce-xts I cells +    ( arrayptr )
+      @ dup IF                 ( xt )
+         EXECUTE
+      ELSE
+         drop UNLOOP EXIT
+      THEN
+   LOOP
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/rmove.fs b/qemu/roms/SLOF/slof/fs/rmove.fs
new file mode 100644
index 000000000..c28dba9c4
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rmove.fs
@@ -0,0 +1,53 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+defer '(r@)
+defer '(r!)
+1 VALUE /(r)
+
+
+\ The rest of the code already implemented in prim.in
+\ In the end all of this should be moved over there and this file terminated
+
+: (rfill) ( addr size pattern 'r! /r -- )
+	to /(r) to '(r!) ff and
+	dup 8 lshift or dup 10 lshift or dup 20 lshift or
+	-rot bounds ?do dup i '(r!) /(r) +loop drop
+;
+
+: (fwrmove) ( src dest size -- )
+	>r 0 -rot r> bounds ?do + dup '(r@) i '(r!) /(r) dup +loop 2drop
+;
+
+\ Move from main to device memory
+: mrmove ( src dest size -- )
+	3dup or or 7 AND CASE
+		0 OF ['] x@ ['] rx! /x ENDOF
+		4 OF ['] l@ ['] rl! /l ENDOF
+		2 OF ['] w@ ['] rw! /w ENDOF
+		dup OF ['] c@ ['] rb! /c ENDOF
+	ENDCASE
+	( We already know that source and destination do not overlap )
+	to /(r) to '(r!) to '(r@) (fwrmove)
+;
+
+: rfill ( addr size pattern -- )
+	3dup drop or 7 AND CASE
+		0 OF ['] rx! /x ENDOF
+		4 OF ['] rl! /l ENDOF
+		2 OF ['] rw! /w ENDOF
+		dup OF ['] rb! /c ENDOF
+	ENDCASE (rfill)
+;
+
+
+
diff --git a/qemu/roms/SLOF/slof/fs/romfs.fs b/qemu/roms/SLOF/slof/fs/romfs.fs
new file mode 100644
index 000000000..7d7e4637e
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/romfs.fs
@@ -0,0 +1,123 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+STRUCT
+	cell field romfs>file-header
+	cell field romfs>data
+	cell field romfs>data-size
+	cell field romfs>flags
+
+CONSTANT /romfs-lookup-control-block
+
+CREATE romfs-lookup-cb /romfs-lookup-control-block allot
+romfs-lookup-cb /romfs-lookup-control-block erase
+
+: create-filename ( string -- string\0 )
+    here >r dup 8 + allot
+    r@ over 8 + erase
+    r@ zplace r> ;
+
+: romfs-lookup ( fn-str fn-len -- data size | false )
+    create-filename romfs-base
+    romfs-lookup-cb romfs-lookup-entry call-c
+    0= IF romfs-lookup-cb dup romfs>data @ swap romfs>data-size @ ELSE
+    false THEN ;
+
+: ibm,romfs-lookup ( fn-str fn-len -- data-high data-low size | 0 0 false )
+  romfs-lookup dup
+  0= if drop 0 0 false else
+  swap dup 20 rshift swap ffffffff and then ;
+
+\ FIXME For a short time ...
+: romfs-lookup-client ibm,romfs-lookup ;
+
+\ Fixme temp implementation
+
+STRUCT
+	cell field romfs>next-off
+	cell field romfs>size
+	cell field romfs>flags
+	cell field romfs>data-off
+	cell field romfs>name
+
+CONSTANT /romfs-cb
+
+: romfs-map-file ( fn-str fn-len -- file-addr file-size )
+  romfs-base >r
+  BEGIN 2dup r@ romfs>name zcount string=ci not WHILE
+    ( fn-str fn-len ) ( R: rom-cb-file-addr )
+    r> romfs>next-off dup @ dup 0= IF 1 THROW THEN + >r REPEAT
+    ( fn-str fn-len ) ( R: rom-cb-file-addr )
+    2drop r@ romfs>data-off @ r@ + r> romfs>size @ ;
+
+\ returns address of romfs-header file
+: flash-header ( -- address | false )
+    get-flash-base 28 +         \ prepare flash header file address
+    dup rx@                     \ fetch "magic123"
+    6d61676963313233 <> IF      \ IF flash is not valid
+       drop                     \ | forget address
+       false                    \ | return false
+    THEN                        \ FI
+;
+
+CREATE bdate-str 10 allot
+: bdate2human ( -- addr len )
+  flash-header 40 + rx@ (.)
+  drop dup 0 + bdate-str 6 + 4 move
+  dup 4 + bdate-str 0 + 2 move
+  dup 6 + bdate-str 3 + 2 move
+  dup 8 + bdate-str b + 2 move
+  a + bdate-str e + 2 move
+  2d bdate-str 2 + c!
+  2d bdate-str 5 + c!
+  20 bdate-str a + c!
+  3a bdate-str d + c!
+  bdate-str 10
+;
+
+
+\ Look up a file in the ROM file system and evaluate it
+
+: included  ( fn fn-len -- )
+   2dup >r >r romfs-lookup dup IF
+      r> drop r> drop evaluate
+   ELSE
+      drop ." Cannot open file : " r> r> type cr
+   THEN
+;
+
+: include  ( " fn " -- )
+   parse-word included
+;
+
+: ?include  ( flag " fn " -- )
+   parse-word rot IF included ELSE 2drop THEN
+;
+
+: include?  ( nargs flag " fn " -- )
+   parse-word rot IF
+      rot drop included
+   ELSE
+      2drop 0 ?DO drop LOOP
+   THEN
+;
+
+
+\ List files in ROMfs
+
+: (print-romfs-file-info)  ( file-addr -- )
+   9 emit  dup b 0.r  2 spaces  dup 8 + @ 6 0.r  2 spaces  20 + zcount type cr
+;
+
+: romfs-list  ( -- )
+   romfs-base 0 cr BEGIN + dup (print-romfs-file-info) dup @ dup 0= UNTIL 2drop
+;
diff --git a/qemu/roms/SLOF/slof/fs/root.fs b/qemu/roms/SLOF/slof/fs/root.fs
new file mode 100644
index 000000000..21c710951
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/root.fs
@@ -0,0 +1,84 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ this creates the root and common branches of the device tree
+
+defer (client-exec)
+defer client-exec
+
+\ defined in slof/fs/client.fs
+defer callback
+defer continue-client
+
+0 VALUE chosen-node
+
+: chosen
+  chosen-node dup 0= IF
+    drop s" /chosen" find-node dup to chosen-node
+  THEN
+;
+
+: set-chosen ( prop len name len -- )
+  chosen set-property ;
+
+: get-chosen ( name len -- [ prop len ] success )
+  chosen get-property 0= ;
+
+\ Look for an exising root, create one if needed
+" /" find-node dup 0= IF
+    drop
+    new-device
+    s" /" device-name
+ELSE
+    extend-device
+THEN
+
+\ Create /chosen if it doesn't exist
+" /chosen" find-node dup 0= IF
+    drop
+    new-device
+    s" chosen" device-name
+    s" " encode-string s" bootargs" property
+    s" " encode-string s" bootpath" property
+    finish-device
+ELSE
+    drop
+THEN
+
+\ Create /aliases
+new-device
+    s" aliases" device-name
+finish-device
+
+\ Create /options
+new-device
+    s" options" device-name
+finish-device
+
+\ Create /openprom
+new-device
+    s" openprom" device-name
+    0 0 s" relative-addressing" property
+finish-device
+
+\ Create /packages
+new-device 
+#include <packages.fs>
+finish-device
+
+: open true ;
+: close ;
+#include <archsupport.fs>
+
+\ Finish root
+finish-device
+
diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs
new file mode 100644
index 000000000..c133abc40
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs
@@ -0,0 +1,23 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: rtas-start-cpu  ( pid loc r3 -- status )
+   [ s" start-cpu" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   3  rtas-cb rtas>nargs l!
+   1  rtas-cb rtas>nret l!
+   rtas-cb rtas>args2 l!
+   rtas-cb rtas>args1 l!
+   rtas-cb rtas>args0 l!
+   0 rtas-cb rtas>args3 l!
+   enter-rtas
+   rtas-cb rtas>args3 l@
+;
diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs
new file mode 100644
index 000000000..f8abeaaf0
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs
@@ -0,0 +1,46 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: rtas-ibm-update-flash-64-and-reboot  ( block-list -- status )
+   [ s" ibm,update-flash-64-and-reboot" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   1 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args1 l@
+;
+
+: rtas-ibm-manage-flash-image  ( image-to-commit -- status )
+   [ s" ibm,manage-flash-image" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   1 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args1 l@
+;
+
+: rtas-set-flashside  ( flashside -- status )
+   [ s" rtas-set-flashside" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   1 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args1 l@
+;
+
+: rtas-get-flashside  ( -- status )
+   [ s" rtas-get-flashside" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   0 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   enter-rtas
+   rtas-cb rtas>args0 l@
+;
diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs
new file mode 100644
index 000000000..8451cfde7
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs
@@ -0,0 +1,121 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ (rtas-size) determines the size required for RTAS.
+\ It looks at the rtas binary in the flash and reads the rtas-size from
+\ its header at offset 8.
+: (rtas-size)  ( -- rtas-size )
+   s" rtas" romfs-lookup dup 0=
+   ABORT" romfs-lookup for rtas failed"
+   drop 8 + @
+;
+
+(rtas-size) CONSTANT rtas-size
+
+: instantiate-rtas ( adr -- entry )
+    dup rtas-size erase
+    s" rtas" romfs-lookup 0=
+    ABORT" romfs-lookup for rtas failed"
+    rtas-config swap start-rtas ;
+
+here fff + fffffffffffff000 and here - allot
+here rtas-size allot CONSTANT rtas-start-addr
+
+rtas-start-addr instantiate-rtas CONSTANT rtas-entry-point
+
+: drone-rtas
+   rtas-start-addr
+   dup rtas-size erase
+   2000000 start-rtas to rtas-entry-point
+;
+
+
+\ ffffffffffffffff CONSTANT rtas-entry-point
+
+\ rtas control block
+
+STRUCT
+	/l field rtas>token
+	/l field rtas>nargs
+	/l field rtas>nret
+	/l field rtas>args0
+        /l field rtas>args1
+        /l field rtas>args2
+        /l field rtas>args3
+        /l field rtas>args4
+        /l field rtas>args5
+        /l field rtas>args6
+        /l field rtas>args7
+        /l C * field rtas>args
+        /l field rtas>bla
+
+CONSTANT /rtas-control-block
+
+CREATE rtas-cb /rtas-control-block allot
+rtas-cb  /rtas-control-block erase
+
+\ call-c ( p0 p1 p2 entry -- ret )
+
+: enter-rtas ( -- )
+    rtas-cb rtas-start-addr 0 rtas-entry-point call-c drop ;
+
+
+\ This is the structure of the RTAS function jump table in the C code:
+STRUCT
+	cell FIELD rtasfunctab>name
+	cell FIELD rtasfunctab>func
+	cell FIELD rtasfunctab>flags
+CONSTANT rtasfunctab-size
+
+\ Create RTAS token properties by analyzing the jump table in the C code:
+: rtas-create-token-properties ( -- )
+    rtas-start-addr 10 + @ rtas-start-addr +     \ Get pointer to jump table
+    rtas-start-addr 18 + @ rtas-start-addr + l@  \ Get the number of entries
+    0  DO
+	dup rtasfunctab>func @ 0<>            \ function pointer must not be NULL
+	over rtasfunctab>flags @ 1 and 0=     \ Check the only-internal flag
+	and
+	IF
+	    i 1+ encode-int                   \ Create the token value
+	    2 pick rtasfunctab>name @ zcount  \ Create the token name string
+	    property                          \ Create the property
+	THEN
+	rtasfunctab-size +                    \ Proceed to the next entry
+    LOOP
+    drop
+;
+
+\ Get the RTAS token that corresponds to an RTAS property name:
+: rtas-get-token ( str len -- token|0 )
+    rtas-start-addr 10 + @ rtas-start-addr +     \ Get pointer to jump table
+    rtas-start-addr 18 + @ rtas-start-addr + l@  \ Get the number of entries
+    0  DO
+	dup rtasfunctab>name @          \ Get pointer to function name
+	dup 0<>                         \ function name must not be NULL
+	over zcount 5 pick = nip and    \ Check if both strings have same length
+	IF
+	    3 pick 3 pick               \ Make a copy of the token name string
+	    comp 0=
+	    IF
+		drop 2drop
+		i 1+                    \ If the name matched, return the token
+		UNLOOP EXIT
+	    THEN
+	ELSE
+	    drop
+	THEN
+	rtasfunctab-size +              \ Proceed to the next entry
+    LOOP
+    drop
+    ." RTAS token not found: " type cr
+    0
+;
diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs
new file mode 100644
index 000000000..a9539ecc1
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs
@@ -0,0 +1,33 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: rtas-power-off   ( x y -- status )
+   [ s" power-off" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   2 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args0 l!
+   rtas-cb rtas>args1 l!
+   enter-rtas
+   rtas-cb rtas>args2 l@
+;
+
+: power-off  ( -- )  0 0 rtas-power-off ;
+
+
+: rtas-system-reboot  ( -- status )
+   [ s" system-reboot" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   0 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args1 l@
+;
diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs
new file mode 100644
index 000000000..7fb4b547d
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs
@@ -0,0 +1,33 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: rtas-read-vpd  ( offset length data -- status )
+   [ s" msg-read-vpd" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   3 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args2 l!
+   rtas-cb rtas>args1 l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args3 l@
+;
+
+: rtas-write-vpd  ( offset length data -- status )
+   [ s" msg-write-vpd" rtas-get-token ] LITERAL rtas-cb rtas>token l!
+   3 rtas-cb rtas>nargs l!
+   1 rtas-cb rtas>nret l!
+   rtas-cb rtas>args2 l!
+   rtas-cb rtas>args1 l!
+   rtas-cb rtas>args0 l!
+   enter-rtas
+   rtas-cb rtas>args3 l@
+;
diff --git a/qemu/roms/SLOF/slof/fs/scsi-disk.fs b/qemu/roms/SLOF/slof/fs/scsi-disk.fs
new file mode 100644
index 000000000..197847147
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/scsi-disk.fs
@@ -0,0 +1,324 @@
+\ *****************************************************************************
+\ * Copyright (c) 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Create new VSCSI child device
+
+\ Create device
+new-device
+
+\ Set name
+s" disk" device-name
+
+s" block" device-type
+
+false VALUE scsi-disk-debug?
+
+\ Get SCSI bits
+scsi-open
+
+\ Send SCSI commands to controller
+
+: execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... )
+                       ( ... [ sense-buf sense-len ] stat )
+    " execute-scsi-command" $call-parent
+;
+
+: retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... )
+                     ( ... 0 | [ sense-buf sense-len ] stat )
+    " retry-scsi-command" $call-parent
+;
+
+\ ---------------------------------\
+\ Common SCSI Commands and helpers \
+\ ---------------------------------\
+
+0 INSTANCE VALUE block-size
+0 INSTANCE VALUE max-transfer
+0 INSTANCE VALUE max-block-num
+0 INSTANCE VALUE is_cdrom
+INSTANCE VARIABLE deblocker
+
+\ This scratch area is made global for now as we only
+\ use it for small temporary commands such as inquiry
+\ read-capacity or media events
+CREATE scratch 100 allot
+CREATE cdb 10 allot
+
+: dump-scsi-error ( sense-buf sense-len stat name namelen -- )
+    ." SCSI-DISK: " my-self instance>path type ." ," type ."  failed" cr
+    ." SCSI-DISK: Status " dup . .status-text
+    0<> IF
+        ."  Sense " scsi-get-sense-data dup . .sense-text
+	."  ASC " . ." ASCQ " . cr
+    ELSE drop THEN
+;
+
+: read-blocks ( addr block# #blocks -- #read )
+    scsi-disk-debug? IF
+        ." SCSI-DISK: read-blocks " .s cr
+    THEN
+
+    \ Bound check. This should probably be done by deblocker
+    \ but it doesn't at this point so do it here
+    2dup + max-block-num > IF
+        ." SCSI-DISK: Access beyond end of device ! " cr
+	drop
+	dup max-block-num > IF
+	  drop drop 0 EXIT
+	THEN
+	dup max-block-num swap -
+    THEN
+
+    dup block-size *                            ( addr block# #blocks len )
+    >r rot r> 			                ( block# #blocks addr len )
+    2swap                                       ( addr len block# #blocks )
+    dup >r
+    cdb scsi-build-read-10                      ( addr len )
+    r> -rot                                     ( #blocks addr len )
+    scsi-dir-read cdb scsi-param-size 10
+    retry-scsi-command
+                                                ( #blocks [ sense-buf sense-len ] stat )
+    dup 0<> IF " read-blocks" dump-scsi-error -65 throw ELSE drop THEN
+;
+
+: (inquiry) ( size -- buffer | NULL )
+    dup cdb scsi-build-inquiry
+    \ 16 retries for inquiry to flush out any UAs
+    scratch swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
+    \ Success ?
+    0= IF scratch ELSE 2drop 0 THEN
+;
+
+: inquiry ( -- buffer | NULL )
+    scsi-disk-debug? IF
+	." SCSI-DISK: inquiry " .s cr
+    THEN
+    d# 36 (inquiry) 0= IF 0 EXIT THEN
+    scratch inquiry-data>add-length c@ 5 +
+    (inquiry)
+;
+
+: read-capacity ( -- blocksize #blocks )
+    \ Now issue the read-capacity command
+    scsi-disk-debug? IF
+        ." SCSI-DISK: read-capacity " .s cr
+    THEN
+    \ Make sure that there are zeros in the buffer in case something goes wrong:
+    scratch 10 erase
+    cdb scsi-build-read-cap-10 scratch scsi-length-read-cap-10-data scsi-dir-read
+    cdb scsi-param-size 1 retry-scsi-command
+    \ Success ?
+    dup 0<> IF " read-capacity" dump-scsi-error 0 0 EXIT THEN
+    drop scratch scsi-get-capacity-10 1 +
+;
+
+100 CONSTANT test-unit-retries
+
+\ SCSI test-unit-read
+: test-unit-ready ( true | [ ascq asc sense-key false ] )
+    scsi-disk-debug? IF
+        ." SCSI-DISK: test-unit-ready " .s cr
+    THEN
+    cdb scsi-build-test-unit-ready
+    0 0 0 cdb scsi-param-size test-unit-retries retry-scsi-command
+    \ stat == 0, return
+    0= IF true EXIT THEN
+    \ check sense len, no sense -> return HW error
+    0= IF drop 0 0 4 false EXIT THEN
+    \ get sense
+    scsi-get-sense-data false
+;
+
+
+: start-stop-unit ( state# -- true | false )
+    scsi-disk-debug? IF
+        ." SCSI-DISK: start-stop-unit " .s cr
+    THEN
+    cdb scsi-build-start-stop-unit
+    0 0 0 cdb scsi-param-size 10 retry-scsi-command
+    \ Success ?
+    0= IF true ELSE 2drop false THEN
+;
+
+: compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false )
+    3 pick =	    ( ascq asc key ascq2 asc2 keycmp )
+    swap 4 pick =   ( ascq asc key ascq2 keycmp asccmp )
+    rot 5 pick =    ( ascq asc key keycmp asccmp ascqcmp )
+    and and nip nip nip
+;
+
+\ -------------------------\
+\ CDROM specific functions \
+\ -------------------------\
+
+0 CONSTANT CDROM-READY
+1 CONSTANT CDROM-NOT-READY
+2 CONSTANT CDROM-NO-DISK
+3 CONSTANT CDROM-TRAY-OPEN
+4 CONSTANT CDROM-INIT-REQUIRED
+5 CONSTANT CDROM-TRAY-MAYBE-OPEN
+
+: cdrom-try-close-tray ( -- )
+    scsi-const-load start-stop-unit drop
+;
+
+: cdrom-must-close-tray ( -- )
+    scsi-const-load start-stop-unit not IF
+        ." Tray open !" cr -65 throw
+    THEN
+;
+
+: get-media-event ( -- true | false )
+    scsi-disk-debug? IF
+        ." SCSI-DISK: get-media-event " .s cr
+    THEN
+    cdb scsi-build-get-media-event
+    scratch scsi-length-media-event scsi-dir-read cdb scsi-param-size 1 retry-scsi-command
+    \ Success ?
+    0= IF true ELSE 2drop false THEN
+;
+
+: cdrom-status ( -- status )
+    test-unit-ready
+    IF CDROM-READY EXIT THEN
+
+    scsi-disk-debug? IF
+        ." TestUnitReady sense: " 3dup . . . cr
+    THEN
+
+    3dup 1 4 2 compare-sense IF
+        3drop CDROM-NOT-READY EXIT
+    THEN
+
+    get-media-event IF
+        scratch w@ 4 >= IF
+	    scratch 2 + c@ 04 = IF
+	        scratch 5 + c@
+		dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN
+		dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN
+		drop 3drop CDROM-NO-DISK EXIT
+	    THEN
+	THEN
+    THEN
+
+    3dup 2 4 2 compare-sense IF
+        3drop CDROM-INIT-REQUIRED EXIT
+    THEN
+    over 4 = over 2 = and IF
+        \ Format in progress... what do we do ? Just ignore
+	3drop CDROM-READY EXIT
+    THEN
+    over 3a = IF
+        3drop CDROM-NO-DISK EXIT
+    THEN
+
+    \ Other error...
+    3drop CDROM-TRAY-MAYBE-OPEN
+;
+
+: prep-cdrom ( -- ready? )
+    5 0 DO
+        cdrom-status CASE
+	    CDROM-READY           OF UNLOOP true EXIT ENDOF
+	    CDROM-NO-DISK         OF ." No medium !" cr UNLOOP false EXIT ENDOF
+	    CDROM-TRAY-OPEN       OF cdrom-must-close-tray ENDOF
+	    CDROM-INIT-REQUIRED   OF cdrom-try-close-tray ENDOF
+	    CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF
+	ENDCASE
+	d# 1000 ms
+    LOOP
+    ." Drive not ready !" cr false
+;
+
+\ ------------------------\
+\ Disk specific functions \
+\ ------------------------\
+
+: prep-disk ( -- ready? )
+    test-unit-ready not IF
+        ." SCSI-DISK: Disk not ready ! "
+        ." Sense " dup .sense-text ." [" . ." ]"
+	."  ASC " . ."  ASCQ " . cr
+	false EXIT THEN true
+;
+
+\ --------------------------\
+\ Standard device interface \
+\ --------------------------\
+
+: open ( -- true | false )
+    scsi-disk-debug? IF
+        ." SCSI-DISK: open [" .s ." ] unit is " my-unit . . ."  [" .s ." ]" cr
+    THEN
+    my-unit " set-address" $call-parent
+
+    inquiry dup 0= IF drop false EXIT THEN
+    scsi-disk-debug? IF
+        ." ---- inquiry: ----" cr
+        dup 100 dump cr
+        ." ------------------" cr
+    THEN
+
+    \ Skip devices with PQ != 0
+    dup inquiry-data>peripheral c@ e0 and 0 <> IF
+        ." SCSI-DISK: Unsupported PQ != 0" cr
+	false EXIT
+    THEN
+
+    inquiry-data>peripheral c@ CASE
+        5   OF true to is_cdrom ENDOF
+        7   OF true to is_cdrom ENDOF
+    ENDCASE
+
+    scsi-disk-debug? IF
+        is_cdrom IF
+            ." SCSI-DISK: device treated as CD-ROM" cr
+        ELSE
+            ." SCSI-DISK: device treated as disk" cr
+        THEN
+    THEN
+
+    is_cdrom IF prep-cdrom ELSE prep-disk THEN
+    not IF false EXIT THEN
+
+    " max-transfer" $call-parent to max-transfer
+
+    read-capacity to max-block-num to block-size
+    max-block-num 0= block-size 0= OR IF
+       ." SCSI-DISK: Failed to get disk capacity!" cr
+       FALSE EXIT
+    THEN
+
+    scsi-disk-debug? IF
+        ." Capacity: " max-block-num . ." blocks of " block-size . cr
+    THEN
+
+    0 0 " deblocker" $open-package dup deblocker ! dup IF 
+        " disk-label" find-package IF
+            my-args rot interpose
+        THEN
+   THEN 0<>
+;
+
+: close ( -- )
+    deblocker @ close-package ;
+
+: seek ( pos.lo pos.hi -- status )
+    s" seek" deblocker @ $call-method ;
+
+: read ( addr len -- actual )
+    s" read" deblocker @ $call-method ;
+
+\ Get rid of SCSI bits
+scsi-close
+
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs b/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs
new file mode 100644
index 000000000..579ce37f9
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs
@@ -0,0 +1,127 @@
+\ This file is meant to be included by SCSI hosts to provide
+\ helpers such as retry-scsi-command
+
+\ Returns 1 for retry, 0 for return with no error and
+\ -1 for return with an error
+\
+: check-retry-sense? ( sense-buf sense-len -- retry? )
+    \ Check if the sense-len is at least 8 bytes
+    8 < IF -1 EXIT THEN
+
+    \ Fixed sense record, look for filemark etc...
+    dup sense-data>response-code c@ 7e and 70 = IF
+        dup sense-data>sense-key c@ e0 and IF drop -1 EXIT THEN
+    THEN
+
+    \ Get sense data
+    scsi-get-sense-data? IF 	( ascq asc sense-key )
+        \ No sense or recoverable, return success
+	dup 2 < IF 3drop 0 EXIT THEN
+	\ not ready and unit attention, retry
+	dup 2 = swap 6 = or nip nip IF 1 EXIT THEN
+    THEN
+    \ Return failure
+    -1
+;
+
+\ This is almost as the standard retry-command but returns
+\ additionally the length of the returned sense information
+\
+\ The hw-err? field is gone, stat is -1 for a HW error, and
+\ the sense data is provided iff stat is CHECK_CONDITION (02)
+\
+\ Additionally we wait 10ms between retries
+\
+0 INSTANCE VALUE rcmd-buf-addr
+0 INSTANCE VALUE rcmd-buf-len
+0 INSTANCE VALUE rcmd-dir
+0 INSTANCE VALUE rcmd-cmd-addr
+0 INSTANCE VALUE rcmd-cmd-len
+
+: retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... )
+                     ( ... 0 | [ sense-buf sense-len ] stat )
+    >r \ stash #retries
+    to rcmd-cmd-len to rcmd-cmd-addr to rcmd-dir to rcmd-buf-len to rcmd-buf-addr
+    0  \ dummy status & sense
+    r> \ retreive #retries              ( stat #retries )
+    0 DO
+        \ drop previous status & sense
+        0<> IF 2drop THEN
+
+	\ Restore arguments
+	rcmd-buf-addr
+	rcmd-buf-len
+	rcmd-dir
+	rcmd-cmd-addr
+	rcmd-cmd-len
+
+	\ Send command
+	execute-scsi-command		( [ sense-buf sense-len ] stat )
+
+	\ Success ?
+	dup 0= IF LEAVE THEN
+
+	\ HW error ?
+	dup -1 = IF LEAVE THEN
+
+	\ Check condition ?
+	dup 2 = IF  			( sense-buf sense-len stat )
+	    >r	\ stash stat		( sense-buf sense len )
+	    2dup
+	    check-retry-sense?	        ( sense-buf sense-len retry? )
+	    r> swap \ unstash stat	( sense-buf sense-len stat retry? )
+	    \ Check retry? result
+	    CASE
+	         0 OF 3drop 0 LEAVE ENDOF	\ Swallow error, return 0
+	        -1 OF LEAVE ENDOF		\ No retry
+	    ENDCASE
+        ELSE \ Anything other than busy -> exit
+            dup 8 <> IF LEAVE THEN
+	THEN
+	a ms
+    LOOP
+;
+
+\ -----------------------------------------------------------
+\ Some command helpers
+\ -----------------------------------------------------------
+\
+\ TODO: Get rid of global "sector" and instead return an
+\ allocated block for the caller to free
+
+CREATE sector d# 512 allot
+CREATE cdb 10 allot
+
+: (inquiry) ( size -- buffer | NULL )
+    dup cdb scsi-build-inquiry
+    \ 16 retries for inquiry to flush out any UAs
+    sector swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
+    \ Success ?
+    0= IF sector ELSE 2drop 0 THEN
+;
+
+\ Read the initial 36bytes and then decide how much more is to be read
+: inquiry ( -- buffer | NULL )
+    d# 36 (inquiry) 0= IF 0 EXIT THEN
+    sector inquiry-data>add-length c@ 5 +
+    (inquiry)
+;
+
+: report-luns ( -- [ sector ] true | false )
+    200 cdb scsi-build-report-luns
+    \ 16 retries to flush out any UAs
+    sector 200 scsi-dir-read cdb scsi-param-size 10 retry-scsi-command
+    \ Success ?
+    0= IF sector true ELSE drop false THEN
+;
+
+\ This routine creates a disk alias for the first found disk/cdrom
+: make-disk-alias                               ( $name srplun -- )
+    >r 2dup r> -rot                             ( $name srplun $name)
+    find-alias 0<> IF 4drop exit THEN
+    get-node node>path
+    20 allot
+    " /disk@" string-cat                        ( $name srplun npath npathl )
+    rot base @ >r hex (u.) r> base ! string-cat ( $name $diskpath )
+    set-alias
+;
diff --git a/qemu/roms/SLOF/slof/fs/scsi-loader.fs b/qemu/roms/SLOF/slof/fs/scsi-loader.fs
new file mode 100644
index 000000000..fec1f78dc
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/scsi-loader.fs
@@ -0,0 +1,77 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ **************************************
+\ Last change: MiR 13.11.2007 10:55:57
+\ **************************************
+
+: .ansi-attr-off 1b emit ." [0m"  ;    \ ESC Sequence: all terminal attributes off
+: .ansi-blue     1b emit ." [34m" ;    \ ESC Sequence: foreground-color = blue
+: .ansi-green    1b emit ." [32m" ;    \ ESC Sequence: foreground-color = green
+: .ansi-red      1b emit ." [31m" ;    \ ESC Sequence: foreground-color = green
+: .ansi-bold     1b emit ." [1m"  ;    \ ESC Sequence: foreground-color bold
+
+false VALUE scsi-supp-present?
+
+: scsi-xt-err ." SCSI-ERROR (Intern) " ;
+' scsi-xt-err VALUE scsi-open-xt        \ preset with an invalid token
+
+\ *************************************
+\ utility to show all active word-lists
+\ *************************************
+: .wordlists      ( -- )
+   .ansi-red
+   get-order      ( -- wid1 .. widn n )
+   dup space 28 emit .d ." word lists : "
+   0 DO
+      . 08 emit 2c emit
+   LOOP
+   08 emit                 \ 'bs'
+   29 emit                 \ ')'
+   cr space 28 emit
+   ." Context: " context dup .
+   @ 5b emit . 8 emit 5d emit
+   space
+   ." / Current: " current .
+   .ansi-attr-off
+   cr
+;
+
+\ *************************************
+\ utility to show first word-lists
+\ *************************************
+: .context  ( num -- )
+   .ansi-red
+    space
+   5b emit
+   23 emit . 3a emit
+   context @
+   . 8 emit 5d emit space
+   .ansi-attr-off
+;
+
+\ ****************************************************************************
+\ open scsi-support by adding a new word list on top of search path
+\ first check if scsi-support.fs must be included (first call)
+\ when open use execution pointer to access version in new word list
+\ ****************************************************************************
+: scsi-open  ( -- )
+   scsi-supp-present? NOT
+   IF
+      s" scsi-support.fs" included  ( xt-open )
+      to scsi-open-xt               (  )
+      true to scsi-supp-present?
+   THEN
+   scsi-open-xt execute
+;
+
+
diff --git a/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs b/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs
new file mode 100644
index 000000000..6aec8b159
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs
@@ -0,0 +1,95 @@
+\ This file is meant to be included by SCSI hosts to provide
+\ probing helpers - scsi-find-disks
+
+: wrapped-inquiry ( -- true | false )
+    inquiry 0= IF false EXIT THEN
+    \ Skip devices with PQ != 0
+    sector inquiry-data>peripheral c@ e0 and 0 =
+;
+
+: scsi-read-lun     ( addr -- lun true | false )
+    dup c@ C0 AND CASE
+	40 OF w@-be 3FFF AND TRUE ENDOF
+	0  OF w@-be          TRUE ENDOF
+	dup dup OF ." Unsupported LUN format = " . cr FALSE ENDOF
+    ENDCASE
+;
+
+: vscsi-report-luns ( -- array ndev )
+    \ array of pointers, up to 8 devices
+    dev-max-target 3 << alloc-mem dup
+    0                                    ( devarray devcur ndev )
+    dev-max-target 0 DO
+	i 0 dev-generate-srplun (set-target)
+	report-luns nip IF
+	    sector l@                     ( devarray devcur ndev size )
+	    sector 8 + swap               ( devarray devcur ndev lunarray size )
+	    dup 8 + dup alloc-mem         ( devarray devcur ndev lunarray size size+ mem )
+	    dup rot 0 fill                ( devarray devcur ndev lunarray size mem )
+	    dup >r swap move r>           ( devarray devcur ndev mem )
+	    dup sector l@ 3 >> 0 ?DO      ( devarray devcur ndev mem memcur )
+		dup dup scsi-read-lun IF
+		    j swap dev-generate-srplun  swap x! 8 +
+		ELSE
+		    2drop
+		THEN
+	    LOOP drop
+	    rot                           ( devarray ndev mem devcur )
+	    dup >r x! r> 8 +              ( devarray ndev devcur )
+	    swap 1 +
+	ELSE
+	    dev-max-target 1 = IF
+		\ Some USB MSC devices do not implement report
+		\ luns. That will stall the bulk pipe. These devices are
+		\ single lun devices, report it accordingly
+
+		( devarray devcur ndev )
+		16 alloc-mem ( devarray devcur ndev mem )
+		dup 16 0 fill ( devarray devcur ndev mem )
+		dup 0 0 dev-generate-srplun swap x!  ( devarray devcur ndev mem )
+		rot x!  ( devarray ndev )
+		1 +
+		UNLOOP EXIT
+	    THEN
+	THEN
+    LOOP
+    nip
+;
+
+: make-media-alias ( $name srplun -- )
+    >r
+    get-next-alias ?dup IF
+        r> make-disk-alias
+    ELSE
+        r> drop
+    THEN
+;
+
+: scsi-find-disks      ( -- )
+    ."        SCSI: Looking for devices" cr
+    vscsi-report-luns
+    0 ?DO
+	dup x@
+	BEGIN
+	    dup x@
+	    dup 0= IF drop TRUE ELSE
+		(set-target) wrapped-inquiry IF
+		    ."           " current-target (u.) type ."  "
+		    \ XXX FIXME: Check top bits to ignore unsupported units
+		    \            and maybe provide better printout & more cases
+		    \ XXX FIXME: Actually check for LUNs
+		    sector inquiry-data>peripheral c@ CASE
+			0   OF ." DISK     : " " disk"  current-target make-media-alias ENDOF
+			5   OF ." CD-ROM   : " " cdrom" current-target make-media-alias ENDOF
+			7   OF ." OPTICAL  : " " cdrom" current-target make-media-alias ENDOF
+			e   OF ." RED-BLOCK: " " disk"  current-target make-media-alias ENDOF
+			dup dup OF ." ? (" . 8 emit 29 emit 5 spaces ENDOF
+		    ENDCASE
+		    sector .inquiry-text cr
+		THEN
+		8 + FALSE
+	    THEN
+	UNTIL drop
+	8 +
+    LOOP drop
+;
diff --git a/qemu/roms/SLOF/slof/fs/scsi-support.fs b/qemu/roms/SLOF/slof/fs/scsi-support.fs
new file mode 100644
index 000000000..3e65c8781
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/scsi-support.fs
@@ -0,0 +1,847 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ ************************************************
+\ create a new scsi word-list named 'scsi-words'
+\ ************************************************
+vocabulary scsi-words                  \ create new word list named 'scsi-words'
+also scsi-words  definitions           \ place next definitions into new list
+
+\ for some commands specific parameters are used, which normally
+\ need not to be altered. These values are preset at include time
+\ or explicit by a call of 'scsi-supp-init'
+false  value   scsi-param-debug        \ common debugging flag
+d# 0   value   scsi-param-size         \ length of CDB processed last
+h# 0   value   scsi-param-control      \ control word for CDBs as defined in SAM-4
+d# 0   value   scsi-param-errors       \ counter for detected errors
+
+\ utility to increment error counter
+: scsi-inc-errors
+   scsi-param-errors 1 + to scsi-param-errors
+;
+
+\ ***************************************************************************
+\ SCSI-Command: TEST UNIT READY
+\         Type: Primary Command (SPC-3 clause 6.33)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-test-unit-ready    ( cdb -- )
+\ ***************************************************************************
+\ checks if a device is ready to receive commands
+\ ***************************************************************************
+\ command code:
+00 CONSTANT scsi-cmd-test-unit-ready
+\ CDB structure:
+STRUCT
+	/c	FIELD test-unit-ready>operation-code     \ 00h
+	4	FIELD test-unit-ready>reserved           \ unused
+	/c	FIELD test-unit-ready>control            \ control byte as specified in SAM-4
+CONSTANT scsi-length-test-unit-ready
+
+\ cdb build:
+\ all fields are zeroed
+: scsi-build-test-unit-ready  ( cdb -- )
+   dup scsi-length-test-unit-ready erase  ( cdb )
+   scsi-param-control swap test-unit-ready>control c!  ( )
+   scsi-length-test-unit-ready to scsi-param-size   \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: REPORT LUNS
+\         Type: Primary Command
+\ ***************************************************************************
+\ Forth Word:   scsi-build-report-luns    ( cdb -- )
+\ ***************************************************************************
+\ report all LUNs supported by a device
+\ ***************************************************************************
+\ command code:
+a0 CONSTANT scsi-cmd-report-luns
+\ CDB structure:
+STRUCT
+	/c	FIELD report-luns>operation-code     \ a0h
+	1	FIELD report-luns>reserved           \ unused
+        /c      FIELD report-luns>select-report      \ report select byte
+        3       FIELD report-luns>reserved2          \ unused
+        /l      FIELD report-luns>alloc-length       \ report length
+	1	FIELD report-luns>reserved3          \ unused
+	/c	FIELD report-luns>control            \ control byte
+CONSTANT scsi-length-report-luns
+
+\ cdb build:
+\ all fields are zeroed
+: scsi-build-report-luns ( alloc-len cdb -- )
+   dup scsi-length-report-luns erase              \ 12 bytes CDB
+	scsi-cmd-report-luns over	          ( alloc-len cdb cmd cdb )
+	report-luns>operation-code c!	          ( alloc-len cdb )
+   scsi-param-control over report-luns>control c! ( alloc-len cdb )
+	report-luns>alloc-length l!	  \ size of Data-In Buffer
+   scsi-length-report-luns to scsi-param-size     \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: REQUEST SENSE
+\         Type: Primary Command (SPC-3 clause 6.27)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-request-sense    ( cdb -- )
+\ ***************************************************************************
+\ for return data a buffer of at least 252 bytes must be present!
+\ see spec: SPC-3 (r23) / clauses 4.5 and 6.27
+\ ***************************************************************************
+\ command code:
+03 CONSTANT scsi-cmd-request-sense
+\ CDB structure:
+STRUCT
+	/c	FIELD request-sense>operation-code     \ 03h
+	3	FIELD request-sense>reserved           \ unused
+	/c	FIELD request-sense>allocation-length  \ buffer-length for data response
+	/c	FIELD request-sense>control            \ control byte as specified in SAM-4
+CONSTANT scsi-length-request-sense
+
+\ cdb build:
+: scsi-build-request-sense    ( alloc-len cdb -- )
+   >r                         ( alloc-len )  ( R: -- cdb )
+   r@ scsi-length-request-sense erase  ( alloc-len )
+   scsi-cmd-request-sense r@           ( alloc-len cmd cdb )
+   request-sense>operation-code c!     ( alloc-len )
+   dup d# 252 >                        \ buffer length too big ?
+   IF
+      scsi-inc-errors
+      drop d# 252                      \ replace with 252
+   ELSE
+      dup d# 18 <                      \ allocated buffer too small ?
+      IF
+         scsi-inc-errors
+         drop 0                        \ reject return data
+      THEN
+   THEN                                      ( alloclen )
+   r@ request-sense>allocation-length c!     (  )
+   scsi-param-control r> request-sense>control c!  ( alloc-len cdb )  ( R: cdb -- )
+   scsi-length-request-sense to scsi-param-size  \ update CDB length
+;
+
+\ ----------------------------------------
+\ SCSI-Response: SENSE_DATA
+\ ----------------------------------------
+70 CONSTANT scsi-response(request-sense-0)
+71 CONSTANT scsi-response(request-sense-1)
+
+STRUCT
+   /c FIELD sense-data>response-code   \ 70h (current errors) or 71h (deferred errors)
+   /c FIELD sense-data>obsolete
+   /c FIELD sense-data>sense-key       \ D3..D0 = sense key, D7 = EndOfMedium
+   /l FIELD sense-data>info
+   /c FIELD sense-data>alloc-length    \ <= 244 (for max size)
+   /l FIELD sense-data>command-info
+   /c FIELD sense-data>asc             \ additional sense key
+   /c FIELD sense-data>ascq            \ additional sense key qualifier
+   /c FIELD sense-data>unit-code
+   3  FIELD sense-data>key-specific
+   /c FIELD sense-data>add-sense-bytes \ start of appended extra bytes
+CONSTANT scsi-length-sense-data
+
+\ ----------------------------------------
+\ get from SCSI response block:
+\  - Additional Sense Code Qualifier
+\  - Additional Sense Code
+\  - sense-key
+\ ----------------------------------------
+\ Forth Word:   scsi-get-sense-data  ( addr -- ascq asc sense-key )
+\ ----------------------------------------
+: scsi-get-sense-data                  ( addr -- ascq asc sense-key )   
+   >r                                  ( R: -- addr )
+   r@ sense-data>response-code c@ 7f and 72 >= IF
+     r@ 3 + c@                           ( ascq )
+     r@ 2 + c@                           ( ascq asc ) 
+     r> 1 + c@ 0f and                    ( ascq asc sense-key )
+   ELSE
+     r@ sense-data>ASCQ c@               ( ascq )
+     r@ sense-data>ASC c@                ( ascq asc )
+     r> sense-data>sense-key c@ 0f and   ( ascq asc sense-key ) ( R: addr -- )
+   THEN
+;
+
+\ --------------------------------------------------------------------------
+\ Forth Word:   scsi-get-sense-data?  ( addr -- false | ascq asc sense-key true )
+\ --------------------------------------------------------------------------
+: scsi-get-sense-data?                 ( addr -- false | ascq asc sense-key true )
+   dup
+   sense-data>response-code c@
+   7e AND dup 70 = swap 72 = or         \ Response code (some devices have MSB set)
+   IF
+      scsi-get-sense-data TRUE
+   ELSE
+      drop FALSE        \ drop addr
+   THEN
+
+;
+
+\ --------------------------------------------------------------------------
+\ Forth Word:   scsi-get-sense-ID?  ( addr -- false | sense-ID true )
+\ same as scsi-get-sense-data? but returns
+\ a single word composed of: sense-key<<16 | asc<<8 | ascq
+\ --------------------------------------------------------------------------
+: scsi-get-sense-ID?                 ( addr -- false | ascq asc sense-key true )
+   dup
+   sense-data>response-code c@
+   7e AND 70 =          \ Response code (some devices have MSB set)
+   IF
+      scsi-get-sense-data        ( ascq asc sense-key )
+      10 lshift                  ( ascq asc sense-key16 )
+      swap 8 lshift or           ( ascq sense-key+asc )
+      swap or                    \ 24-bit sense-ID ( sense-key+asc+ascq )
+      TRUE
+   ELSE
+      drop FALSE        \ drop addr
+   THEN
+;
+
+\ ***************************************************************************
+\ SCSI-Command: INQUIRY
+\         Type: Primary Command (SPC-3 clause 6.4)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-inquiry    ( alloc-len cdb -- )
+\ ***************************************************************************
+\ command code:
+12 CONSTANT scsi-cmd-inquiry
+
+\ CDB structure
+STRUCT
+	/c	FIELD inquiry>operation-code     \ 0x12
+	/c	FIELD inquiry>reserved           \ + EVPD-Bit (vital product data)
+	/c	FIELD inquiry>page-code          \ page code for vital product data (if used)
+	/w	FIELD inquiry>allocation-length  \ length of Data-In-Buffer
+	/c	FIELD inquiry>control            \ control byte as specified in SAM-4
+CONSTANT scsi-length-inquiry
+
+\ Setup command INQUIRY
+: scsi-build-inquiry                   ( alloc-len cdb -- )
+   dup scsi-length-inquiry erase       \ 6 bytes CDB
+	scsi-cmd-inquiry over				   ( alloc-len cdb cmd cdb )
+	inquiry>operation-code c!	         ( alloc-len cdb )
+   scsi-param-control over inquiry>control c! ( alloc-len cdb )
+	inquiry>allocation-length w!	      \ size of Data-In Buffer
+   scsi-length-inquiry to scsi-param-size    \ update CDB length
+;
+
+\ ----------------------------------------
+\ block structure of inquiry return data:
+\ ----------------------------------------
+STRUCT
+	/c	   FIELD inquiry-data>peripheral       \ qualifier and device type
+	/c	   FIELD inquiry-data>reserved1
+	/c	   FIELD inquiry-data>version          \ supported SCSI version (1,2,3)
+	/c	   FIELD inquiry-data>data-format
+	/c	   FIELD inquiry-data>add-length       \ total block length - 4
+	/c	   FIELD inquiry-data>flags1
+	/c	   FIELD inquiry-data>flags2
+	/c	   FIELD inquiry-data>flags3
+	d# 8	FIELD inquiry-data>vendor-ident     \ vendor string
+	d# 16	FIELD inquiry-data>product-ident    \ device string
+	/l 	FIELD inquiry-data>product-revision \ revision string
+	d# 20	FIELD inquiry-data>vendor-specific  \ optional params
+\ can be increased by vendor specific fields
+CONSTANT scsi-length-inquiry-data
+
+\ ***************************************************************************
+\ SCSI-Command: READ CAPACITY (10)
+\         Type: Block Command (SBC-3 clause 5.12)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read-capacity-10    ( cdb -- )
+\ ***************************************************************************
+25 CONSTANT scsi-cmd-read-capacity-10  \ command code
+
+STRUCT                                 \ SCSI 10-byte CDB structure
+	/c	FIELD read-cap-10>operation-code
+	/c	FIELD read-cap-10>reserved1
+	/l	FIELD read-cap-10>lba
+	/w	FIELD read-cap-10>reserved2
+	/c	FIELD read-cap-10>reserved3
+	/c	FIELD read-cap-10>control
+CONSTANT scsi-length-read-cap-10
+
+\ Setup READ CAPACITY (10) command
+: scsi-build-read-cap-10                     ( cdb -- )
+   dup scsi-length-read-cap-10 erase         ( cdb )
+	scsi-cmd-read-capacity-10 over            ( cdb cmd cdb )
+	read-cap-10>operation-code c!             ( cdb )
+   scsi-param-control swap read-cap-10>control c! ( )
+   scsi-length-read-cap-10 to scsi-param-size    \ update CDB length
+;
+
+\ ----------------------------------------
+\ get from SCSI response block:
+\  - Additional Sense Code Qualifier
+\  - Additional Sense Code
+\  - sense-key
+\ ----------------------------------------
+\ Forth Word:   scsi-get-capacity-10  ( addr -- block-size #blocks )
+\ ----------------------------------------
+\ Block structure
+STRUCT
+	/l	FIELD read-cap-10-data>max-lba
+	/l	FIELD read-cap-10-data>block-size
+CONSTANT scsi-length-read-cap-10-data
+
+\ get data-block
+: scsi-get-capacity-10                 ( addr -- block-size #blocks )
+   >r                                  ( addr -- ) ( R: -- addr )
+   r@ read-cap-10-data>block-size l@   ( block-size )
+   r> read-cap-10-data>max-lba l@      ( block-size #blocks ) ( R: addr -- )
+;
+
+\ ***************************************************************************
+\ SCSI-Command: READ CAPACITY (16)
+\         Type: Block Command (SBC-3 clause 5.13)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read-capacity-16    ( cdb -- )
+\ ***************************************************************************
+9e CONSTANT scsi-cmd-read-capacity-16        \ command code
+
+STRUCT                                       \ SCSI 16-byte CDB structure
+	/c	FIELD read-cap-16>operation-code
+	/c	FIELD read-cap-16>service-action
+	/l	FIELD read-cap-16>lba-high
+	/l	FIELD read-cap-16>lba-low
+	/l	FIELD read-cap-16>allocation-length    \ should be 32
+	/c	FIELD read-cap-16>reserved
+	/c	FIELD read-cap-16>control
+CONSTANT scsi-length-read-cap-16
+
+\ Setup READ CAPACITY (16) command
+: scsi-build-read-cap-16  ( cdb -- )
+   >r r@                                     ( R: -- cdb )
+   scsi-length-read-cap-16 erase             (  )
+	scsi-cmd-read-capacity-16                 ( code )
+	r@ read-cap-16>operation-code c!          (  )
+   10 r@ read-cap-16>service-action c!
+   d# 32                                     \ response size 32 bytes
+   r@ read-cap-16>allocation-length l!       (  )
+   scsi-param-control r> read-cap-16>control c! ( R: cdb -- )
+   scsi-length-read-cap-16 to scsi-param-size \ update CDB length
+;
+
+\ ----------------------------------------
+\ get from SCSI response block:
+\  - Block Size (in Bytes)
+\  - Number of Blocks
+\ ----------------------------------------
+\ Forth Word:   scsi-get-capacity-16  ( addr -- block-size #blocks )
+\ ----------------------------------------
+\ Block structure for return data
+STRUCT
+	/l	FIELD read-cap-16-data>max-lba-high    \ upper quadlet of Max-LBA
+	/l	FIELD read-cap-16-data>max-lba-low     \ lower quadlet of Max-LBA
+	/l	FIELD read-cap-16-data>block-size      \ logical block length in bytes
+   /c	FIELD read-cap-16-data>protect         \ type of protection (4 bits)
+   /c	FIELD read-cap-16-data>exponent        \ logical blocks per physical blocks
+   /w	FIELD read-cap-16-data>lowest-aligned  \ first LBA of a phsy. block
+   10 FIELD read-cap-16-data>reserved        \ 16 reserved bytes
+CONSTANT scsi-length-read-cap-16-data        \ results in 32
+
+\ get data-block
+: scsi-get-capacity-16                       ( addr -- block-size #blocks )
+   >r                                        ( R: -- addr )
+   r@ read-cap-16-data>block-size l@         ( block-size )
+   r@ read-cap-16-data>max-lba-high l@       ( block-size #blocks-high )
+   d# 32 lshift                              ( block-size #blocks-upper )
+   r> read-cap-16-data>max-lba-low l@ +      ( block-size #blocks ) ( R: addr -- )
+;
+
+\ ***************************************************************************
+\ SCSI-Command: MODE SENSE (10)
+\         Type: Primary Command (SPC-3 clause 6.10)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-mode-sense-10  ( alloc-len subpage page cdb -- )
+\ ***************************************************************************
+5a CONSTANT scsi-cmd-mode-sense-10
+
+\ CDB structure
+STRUCT
+	/c	FIELD mode-sense-10>operation-code
+	/c	FIELD mode-sense-10>res-llbaa-dbd-res
+	/c	FIELD mode-sense-10>pc-page-code       \ page code + page control
+	/c	FIELD mode-sense-10>sub-page-code
+	3	FIELD mode-sense-10>reserved2
+	/w	FIELD mode-sense-10>allocation-length
+	/c	FIELD mode-sense-10>control
+CONSTANT scsi-length-mode-sense-10
+
+: scsi-build-mode-sense-10                   ( alloc-len subpage page cdb -- )
+   >r                                        ( alloc-len subpage page ) ( R: -- cdb )
+   r@ scsi-length-mode-sense-10 erase        \ 10 bytes CDB
+	scsi-cmd-mode-sense-10                    ( alloc-len subpage page cmd )
+   r@  mode-sense-10>operation-code c!		   ( alloc-len subpage page )
+   10 r@ mode-sense-10>res-llbaa-dbd-res c!  \ long LBAs accepted
+	r@ mode-sense-10>pc-page-code c!	         ( alloc-len subpage )
+	r@ mode-sense-10>sub-page-code c!	      ( alloc-len )
+	r@ mode-sense-10>allocation-length w!     ( )
+
+   scsi-param-control r> mode-sense-10>control c!  ( R: cdb -- )
+   scsi-length-mode-sense-10 to scsi-param-size  \ update CDB length
+;
+
+\ return data processing
+\ (see spec: SPC-3 clause 7.4.3)
+
+STRUCT
+	/w	FIELD mode-sense-10-data>head-length
+	/c	FIELD mode-sense-10-data>head-medium
+	/c	FIELD mode-sense-10-data>head-param
+	/c	FIELD mode-sense-10-data>head-longlba
+	/c	FIELD mode-sense-10-data>head-reserved
+	/w	FIELD mode-sense-10-data>head-descr-len
+CONSTANT scsi-length-mode-sense-10-data
+
+\ ****************************************
+\ This function shows the mode page header
+\ helpful for further analysis
+\ ****************************************
+: .mode-sense-data   ( addr -- )
+   cr
+   dup mode-sense-10-data>head-length
+   w@ ." Mode Length: " .d space
+   dup mode-sense-10-data>head-medium
+   c@ ." / Medium Type: " .d space
+   dup mode-sense-10-data>head-longlba
+   c@ ." / Long LBA: " .d space
+   mode-sense-10-data>head-descr-len
+   w@ ." / Descr. Length: " .d
+;
+
+\ ***************************************************************************
+\ SCSI-Command: READ (6)
+\         Type: Block Command (SBC-3 clause 5.7)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read-6  ( block# #blocks cdb -- )
+\ ***************************************************************************
+\ this SCSI command uses 21 bits to represent start LBA
+\ and 8 bits to specify the numbers of blocks to read
+\ The value of 0 blocks is interpreted as 256 blocks
+\
+\ command code
+08 CONSTANT scsi-cmd-read-6
+
+\ CDB structure
+STRUCT
+   /c FIELD read-6>operation-code      \ 08h
+   /c FIELD read-6>block-address-msb   \ upper 5 bits
+   /w FIELD read-6>block-address       \ lower 16 bits
+   /c FIELD read-6>length              \ number of blocks to read
+   /c FIELD read-6>control             \ CDB control
+CONSTANT scsi-length-read-6
+
+: scsi-build-read-6                    ( block# #blocks cdb -- )
+   >r                                  ( block# #blocks ) ( R: -- cdb )
+   r@ scsi-length-read-6 erase         \ 6 bytes CDB
+	scsi-cmd-read-6 r@ read-6>operation-code c! ( block# #blocks )
+
+   \ check block count to read (#blocks)
+   dup d# 255 >                        \ #blocks exceeded limit ?
+   IF
+      scsi-inc-errors
+      drop 1                           \ replace with any valid number
+   THEN
+   r@ read-6>length c!                 \ set #blocks to read
+
+   \ check starting block number (block#)
+   dup 1fffff >                        \ check address upper limit
+   IF
+      scsi-inc-errors
+      drop                             \ remove original block#
+      1fffff                           \ replace with any valid address
+   THEN
+   dup d# 16 rshift
+   r@ read-6>block-address-msb c!      \ set upper 5 bits
+   ffff and
+   r@ read-6>block-address w!                \ set lower 16 bits
+   scsi-param-control r> read-6>control c!   ( R: cdb -- )
+   scsi-length-read-6 to scsi-param-size     \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: READ (10)
+\         Type: Block Command (SBC-3 clause 5.8)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read-10  ( block# #blocks cdb -- )
+\ ***************************************************************************
+\ command code
+28 CONSTANT scsi-cmd-read-10
+
+\ CDB structure
+STRUCT
+   /c FIELD read-10>operation-code
+   /c FIELD read-10>protect
+   /l FIELD read-10>block-address      \ logical block address (32bits)
+   /c FIELD read-10>group
+   /w FIELD read-10>length             \ transfer length (16-bits)
+   /c FIELD read-10>control
+CONSTANT scsi-length-read-10
+
+: scsi-build-read-10                         ( block# #blocks cdb -- )
+   >r                                        ( block# #blocks )  ( R: -- cdb )
+   r@ scsi-length-read-10 erase             \ 10 bytes CDB
+	scsi-cmd-read-10 r@ read-10>operation-code c! ( block# #blocks )
+   r@ read-10>length w!                      ( block# )
+   r@ read-10>block-address l!               (  )
+   scsi-param-control r> read-10>control c!  ( R: cdb -- )
+   scsi-length-read-10 to scsi-param-size    \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: READ (12)
+\         Type: Block Command (SBC-3 clause 5.9)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read-12  ( block# #blocks cdb -- )
+\ ***************************************************************************
+\ command code
+a8 CONSTANT scsi-cmd-read-12
+
+\ CDB structure
+STRUCT
+   /c FIELD read-12>operation-code     \ code: a8
+   /c FIELD read-12>protect            \ RDPROTECT, DPO, FUA, FUA_NV
+   /l FIELD read-12>block-address      \ lba
+   /l FIELD read-12>length             \ transfer length (32bits)
+   /c FIELD read-12>group              \ group number
+   /c FIELD read-12>control
+CONSTANT scsi-length-read-12
+
+: scsi-build-read-12                         ( block# #blocks cdb -- )
+   >r                                        ( block# #blocks )  ( R: -- cdb )
+   r@ scsi-length-read-12 erase             \ 12 bytes CDB
+	scsi-cmd-read-12 r@ read-12>operation-code c! ( block# #blocks )
+   r@ read-12>length l!                      ( block# )
+   r@ read-12>block-address l!               (  )
+   scsi-param-control r> read-12>control c!  ( R: cdb -- )
+   scsi-length-read-12 to scsi-param-size    \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: READ with autodetection of required command
+\               read(10) or read(12) depending on parameter size
+\               (read(6) removed because obsolete in some cases (USB))
+\         Type: Block Command
+\ ***************************************************************************
+\ Forth Word:   scsi-build-read?    ( block# #blocks cdb -- )
+\
+\                         +----------------+---------------------------|
+\                         |  block# (lba)  |  #block (transfer-length) |
+\             +-----------+----------------+---------------------------|
+\             | read-6    |  16-Bits       |  8  Bits                  |
+\             | read-10   |  32-Bits       |  16 Bits                  |
+\             | read-12   |  32-Bits       |  32 Bits                  |
+\ ***************************************************************************
+: scsi-build-read?   ( block# #blocks cdb -- length )
+   over              ( block# #blocks cdb #blocks )
+   fffe >            \ tx-length (#blocks) exceeds 16-bit limit ?
+   IF
+      scsi-build-read-12   ( block# #blocks cdb -- )
+      scsi-length-read-12  ( length )
+   ELSE                    ( block# #blocks cdb )
+      scsi-build-read-10   ( block# #blocks cdb -- )
+      scsi-length-read-10  ( length )
+   THEN
+;
+
+\ ***************************************************************************
+\ SCSI-Command: START STOP UNIT
+\         Type: Block Command (SBC-3 clause 5.19)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-start-stop-unit  ( state# cdb -- )
+\ ***************************************************************************
+\ command code
+1b CONSTANT scsi-cmd-start-stop-unit
+
+\ CDB structure
+STRUCT
+   /c FIELD start-stop-unit>operation-code
+   /c FIELD start-stop-unit>immed
+   /w FIELD start-stop-unit>reserved
+   /c FIELD start-stop-unit>pow-condition
+   /c FIELD start-stop-unit>control
+CONSTANT scsi-length-start-stop-unit
+
+\ START/STOP constants
+\ (see spec: SBC-3 clause 5.19)
+f1 CONSTANT scsi-const-active-power    \ param used for start-stop-unit
+f2 CONSTANT scsi-const-idle-power      \ param used for start-stop-unit
+f3 CONSTANT scsi-const-standby-power   \ param used for start-stop-unit
+3  CONSTANT scsi-const-load            \ param used for start-stop-unit
+2  CONSTANT scsi-const-eject           \ param used for start-stop-unit
+1  CONSTANT scsi-const-start
+0  CONSTANT scsi-const-stop
+
+: scsi-build-start-stop-unit                 ( state# cdb -- )
+   >r                                        ( state# )  ( R: -- cdb )
+   r@ scsi-length-start-stop-unit erase      \ 6 bytes CDB
+	scsi-cmd-start-stop-unit r@ start-stop-unit>operation-code c!
+   dup 3 >
+   IF
+      4 lshift                         \ shift to upper nibble
+   THEN                                ( state )
+   r@ start-stop-unit>pow-condition c!       (  )
+   scsi-param-control r> start-stop-unit>control c!  ( R: cdb -- )
+   scsi-length-start-stop-unit to scsi-param-size  \ update CDB length
+;
+
+\ ***************************************************************************
+\ SCSI-Command: SEEK(10)
+\         Type: Block Command (obsolete)
+\ ***************************************************************************
+\ Forth Word:   scsi-build-seek  ( state# cdb -- )
+\ Obsolete function (last listed in spec SBC / Nov. 1997)
+\ implemented only for the sake of completeness
+\ ***************************************************************************
+\ command code
+2b CONSTANT scsi-cmd-seek
+
+\ CDB structure
+STRUCT
+   /c FIELD seek>operation-code
+   /c FIELD seek>reserved1
+   /l FIELD seek>lba
+   3  FIELD seek>reserved2
+   /c FIELD seek>control
+CONSTANT scsi-length-seek
+
+: scsi-build-seek  ( lba cdb -- )
+   >r              ( lba )  ( R: -- cdb )
+   r@ scsi-length-seek erase           \ 10 bytes CDB
+	scsi-cmd-seek r@ seek>operation-code c!
+   r> seek>lba l!  (  )  ( R: cdb -- )
+   scsi-length-seek to scsi-param-size \ update CDB length
+;
+
+\ ****************************************************************************
+\ CDROM media event stuff
+\ ****************************************************************************
+
+STRUCT
+    /w FIELD media-event-data-len
+    /c FIELD media-event-nea-class
+    /c FIELD media-event-supp-class
+    /l FIELD media-event-data
+CONSTANT scsi-length-media-event
+
+: scsi-build-get-media-event                     ( cdb -- )
+   dup c erase				         ( cdb )
+   4a over c!				         ( cdb )
+   01 over 1 + c!
+   10 over 4 + c!
+   08 over 8 + c!
+   drop
+;
+
+
+
+\ ***************************************************************************
+\ SCSI-Utility: .sense-code
+\ ***************************************************************************
+\ this utility prints a string associated to the sense code
+\ see specs: SPC-3/r23 clause 4.5.6
+\ ***************************************************************************
+: .sense-text ( scode -- )
+   case
+      0    OF s" OK"               ENDOF
+      1    OF s" RECOVERED ERR"    ENDOF
+      2    OF s" NOT READY"        ENDOF
+      3    OF s" MEDIUM ERROR"     ENDOF
+      4    OF s" HARDWARE ERR"     ENDOF
+      5    OF s" ILLEGAL REQUEST"  ENDOF
+      6    OF s" UNIT ATTENTION"   ENDOF
+      7    OF s" DATA PROTECT"     ENDOF
+      8    OF s" BLANK CHECK"      ENDOF
+      9    OF s" VENDOR SPECIFIC"  ENDOF
+      a    OF s" COPY ABORTED"     ENDOF
+      b    OF s" ABORTED COMMAND"  ENDOF
+      d    OF s" VOLUME OVERFLOW"  ENDOF
+      e    OF s" MISCOMPARE"       ENDOF
+      dup  OF s" UNKNOWN"          ENDOF
+   endcase
+   5b emit type 5d emit
+;
+
+\ ***************************************************************************
+\ SCSI-Utility: .status-code
+\ ***************************************************************************
+\ this utility prints a string associated to the status code
+\ see specs: SAM-3/r14 clause 5.3
+\ ***************************************************************************
+: .status-text  ( stat -- )
+   case
+      00  OF s" GOOD"                  ENDOF
+      02  OF s" CHECK CONDITION"       ENDOF
+      04  OF s" CONDITION MET"         ENDOF
+      08  OF s" BUSY"                  ENDOF
+      18  OF s" RESERVATION CONFLICT"  ENDOF
+      28  OF s" TASK SET FULL"         ENDOF
+      30  OF s" ACA ACTIVE"            ENDOF
+      40  OF s" TASK ABORTED"          ENDOF
+      dup OF s" UNKNOWN"               ENDOF
+   endcase
+   5b emit type 5d emit
+;
+
+\ ***************************************************************************
+\ SCSI-Utility: .capacity-text
+\ ***************************************************************************
+\ utility that shows total capacity on screen by use of the return data
+\ from read-capacity calculation is SI conform (base 10)
+\ ***************************************************************************
+\ sub function to print a 3 digit decimal
+\ number with 2 post decimal positions xxx.yy
+: .dec3-2 ( prenum postnum -- )
+   swap
+   base @ >r                           \ save actual base setting
+   decimal                             \ show decimal values
+   4 .r 2e emit
+   dup 9 <= IF 30 emit THEN .d         \ 3 pre-decimal, right aligned
+   r> base !                           \ restore base
+;
+
+: .capacity-text  ( block-size #blocks -- )
+   scsi-param-debug                    \ debugging flag set ?
+   IF                                  \ show additional info
+      2dup
+      cr
+      ." LBAs: " .d                    \ highest logical block number
+      ." / Block-Size: " .d
+      ." / Total Capacity: "
+   THEN
+   *                                   \ calculate total capacity
+   dup d# 1000000000000 >=             \ check terabyte limit
+   IF
+      d# 1000000000000 /mod
+      swap
+      d# 10000000000 /                 \ limit remainder to two digits
+      .dec3-2 ." TB"                   \ show terabytes as xxx.yy
+   ELSE
+      dup d# 1000000000 >=             \ check gigabyte limit
+      IF
+         d# 1000000000 /mod
+         swap
+         d# 10000000 /
+         .dec3-2 ." GB"                \ show gigabytes as xxx.yy
+      ELSE
+         dup d# 1000000 >=
+         IF
+            d# 1000000 /mod            \ check mega byte limit
+            swap
+            d# 10000 /
+            .dec3-2 ." MB"             \ show megabytes as xxx.yy
+         ELSE
+            dup d# 1000 >=             \ check kilo byte limit
+            IF
+               d# 1000 /mod
+               swap
+               d# 10 /
+               .dec3-2 ." kB"
+            ELSE
+               .d ."  Bytes"
+            THEN
+         THEN
+      THEN
+   THEN
+;
+
+\ ***************************************************************************
+\ SCSI-Utility: .inquiry-text  ( addr -- )
+\ ***************************************************************************
+\ utility that shows:
+\     vendor-ident product-ident and revision
+\ from an inquiry return data block (addr)
+\ ***************************************************************************
+: .inquiry-text  ( addr -- )
+   22 emit     \ enclose text with "
+   dup inquiry-data>vendor-ident      8 type space
+   dup inquiry-data>product-ident    10 type space
+       inquiry-data>product-revision  4 type
+   22 emit
+;
+
+\ ***************************************************************************
+\ SCSI-Utility: scsi-supp-init  ( -- )
+\ ***************************************************************************
+\ utility that helps to ensure that parameters are set to valid values
+: scsi-supp-init  ( -- )
+   false   to scsi-param-debug         \ no debug strings
+   h# 0   to scsi-param-size
+   h# 0   to scsi-param-control        \ common CDB control byte
+   d# 0   to scsi-param-errors         \ local errors (param limits)
+;
+
+\ ***************************************************************************
+\ Constants used by SCSI controller's execute-scsi-command
+\ ***************************************************************************
+true  CONSTANT scsi-dir-read
+false CONSTANT scsi-dir-write
+
+
+\ ***************************************************************************
+\ scsi loader
+\ ***************************************************************************
+0 VALUE scsi-context                   \ addr of word list on top
+
+
+\ ****************************************************************************
+\ open scsi-support by adding a new word list on top of search path
+\   precondition: scsi-support.fs must have been included
+\ ****************************************************************************
+: scsi-init  ( -- )
+   also scsi-words                     \ append scsi word-list
+   context  to scsi-context            \ save for close process
+   scsi-supp-init                      \ preset all scsi-param-xxx values
+   scsi-param-debug
+   IF
+      space ." SCSI-SUPPORT OPENED" cr
+      .wordlists
+   THEN
+;
+
+\ ****************************************************************************
+\ close scsi-session and remove scsi word list (if exists)
+\ ****************************************************************************
+\ if 'previous' is used without a preceding 'also' all forth words are lost !
+\ ****************************************************************************
+: scsi-close  ( -- )
+\ FIXME This only works if scsi-words is the last vocabulary on the stack
+\       Instead we could use get-order to find us on the "wordlist stack",
+\       remove us and write the wordlist stack back with set-order.
+\       BUT: Is this worth the effort?
+
+   scsi-param-debug
+   IF
+      space ." Closing SCSI-SUPPORT .. " cr
+   THEN
+   context scsi-context =              \ scsi word list still active ?
+   IF
+      scsi-param-errors 0<>          \ any errors occurred ?
+      IF
+         cr ." ** WARNING: " scsi-param-errors .d
+         ." SCSI Errors occurred ** " cr
+      THEN
+      previous                         \ remove scsi word list on top
+      0 to scsi-context                \ prevent from being misinterpreted
+   ELSE
+      cr ." ** WARNING: Trying to close non-open SCSI-SUPPORT (1) ** " cr
+   THEN
+   scsi-param-debug
+   IF
+     .wordlists
+   THEN
+;
+
+
+s" scsi-init" $find drop               \ return execution pointer, when included
+
+previous                               \ remove scsi word list from search path
+definitions                            \ place next definitions into previous list
+
diff --git a/qemu/roms/SLOF/slof/fs/search.fs b/qemu/roms/SLOF/slof/fs/search.fs
new file mode 100644
index 000000000..3acca2f11
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/search.fs
@@ -0,0 +1,89 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\
+\ Copyright 2002,2003,2004  Segher Boessenkool  <segher@kernel.crashing.org>
+\
+
+
+\ stuff we should already have:
+
+: linked ( var -- )  here over @ , swap ! ;
+
+HEX
+
+\ \ \
+\ \ \	Wordlists
+\ \ \
+
+VARIABLE wordlists  forth-wordlist wordlists !
+
+\ create a new wordlist
+: wordlist ( -- wid )  here wordlists linked 0 , ;
+
+
+\ \ \
+\ \ \	Search order
+\ \ \
+
+10 CONSTANT max-in-search-order	\ should define elsewhere
+\ CREATE search-order max-in-search-order cells allot	\ stack of wids	\ is in engine now
+\ search-order VALUE context	\ top of stack	\ is in engine now
+
+: also ( -- )  clean-hash  context dup cell+ dup to context  >r @ r> ! ;
+: previous ( -- )  clean-hash  context cell- to context ;
+: only ( -- )  clean-hash  search-order to context  ( minimal-wordlist search-order ! ) ;
+: seal ( -- )  clean-hash  context @  search-order dup to context  ! ;
+
+: get-order ( -- wid_n .. wid_1 n )
+	context >r search-order BEGIN dup r@ u<= WHILE
+	dup @ swap cell+ REPEAT r> drop
+	search-order - cell / ;
+: set-order ( wid_n .. wid_1 n -- )	\ XXX: special cases for 0, -1
+	clean-hash  1- cells search-order + dup to context
+	BEGIN dup search-order u>= WHILE
+	dup >r ! r> cell- REPEAT drop ;
+
+
+\ \ \
+\ \ \	Compilation wordlist
+\ \ \
+
+: get-current ( -- wid )  current ;
+: set-current ( wid -- )  to current ;
+
+: definitions ( -- )  context @ set-current ;
+
+
+\ \ \
+\ \ \	Vocabularies
+\ \ \
+
+: VOCABULARY ( C: "name" -- ) ( -- )  CREATE wordlist drop  DOES> clean-hash  context ! ;
+\ : VOCABULARY ( C: "name" -- ) ( -- )  wordlist CREATE ,  DOES> @ context ! ;
+\ XXX we'd like to swap forth and forth-wordlist around (for .voc 's sake)
+: FORTH ( -- )  clean-hash  forth-wordlist context ! ;
+
+: .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that )
+	dup cell- @ ['] vocabulary ['] forth within IF
+	2 cells - >name name>string type ELSE u. THEN  space ;
+: vocs ( -- ) \ display all wordlist names
+	cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ;
+: order ( -- )
+	cr ." context:  " get-order 0 ?DO .voc LOOP
+	cr ." current:  " get-current .voc ;
+
+
+
+
+\ some handy helper
+: voc-find ( wid -- 0 | link )
+   clean-hash  cell+ @ (find)  clean-hash ;
diff --git a/qemu/roms/SLOF/slof/fs/slof-logo.fs b/qemu/roms/SLOF/slof/fs/slof-logo.fs
new file mode 100644
index 000000000..53d318447
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/slof-logo.fs
@@ -0,0 +1,20 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: .slof-logo
+   cr ."         ..`. ..     .......  ..           ......      ......."
+   cr ."     ..`...`''.`'. .''``````..''.       .`''```''`.  `''``````"
+   cr ."        .`` .:' ': `''.....  .''.       ''`     .''..''......."
+   cr ."          ``.':.';. ``````''`.''.      .''.      ''``''`````'`"
+   cr ."          ``.':':`   .....`''.`'`...... `'`.....`''.`'`       "
+   cr ."         .`.`'``   .'`'`````.  ``''''''  ``''`'''`. `'`       "
+;
diff --git a/qemu/roms/SLOF/slof/fs/sms/sms-load.fs b/qemu/roms/SLOF/slof/fs/sms/sms-load.fs
new file mode 100644
index 000000000..8e4db8060
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/sms/sms-load.fs
@@ -0,0 +1,70 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+false VALUE (sms-loaded?)
+
+false value (sms-available?)
+
+s" sms.fs" romfs-lookup IF true to (sms-available?) drop THEN
+
+(sms-available?) [IF]
+
+#include "packages/sms.fs"
+
+\ Initialize SMS NVRAM handling.
+#include "sms-nvram.fs"
+
+\ Dynamically load sms code from the romfs file
+\ Assumption is that skeleton sms package already exists
+\ but aside of open & close, all other methods are in a romfs file (sms.fs)
+\ Here we open the package and load the rest of the functionality
+
+\ After that, one needs to find-device and execute sms-start method
+\ The shorthand for that is given as (global) sms-start word
+
+: $sms-node s" /packages/sms" ;
+
+: (sms-init-package) ( -- true|false )
+   (sms-loaded?) ?dup IF EXIT THEN
+   $sms-node ['] find-device catch IF 2drop false EXIT THEN
+   s" sms.fs" [COMPILE] included
+   device-end
+   true dup to (sms-loaded?)
+;
+
+\ External wrapper for sms package method
+: (sms-evaluate) ( addr len -- )
+   (sms-init-package) not IF
+      cr ." SMS is not available." cr 2drop exit
+   THEN
+
+   s" Entering SMS ..." type
+   disable-watchdog
+   reset-dual-emit
+
+   \ if we only had execute-device-method...
+   2>r $sms-node find-device
+   2r> evaluate
+   device-end
+   vpd-boot-import
+;
+
+: sms-start ( -- ) s" sms-start" (sms-evaluate) ;
+: sms-fru-replacement ( -- ) s" sms-fru-replacement" (sms-evaluate) ;
+
+[ELSE]
+
+: sms-start ( -- ) cr ." SMS is not available." cr ;
+: sms-fru-replacement ( -- ) cr ." SMS FRU replacement is not available." cr ;
+
+[THEN]
+
diff --git a/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs b/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs
new file mode 100644
index 000000000..4f5d6ddd5
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs
@@ -0,0 +1,124 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Initialize SMS NVRAM handling.
+
+: sms-init-nvram ( -- )
+   nvram-partition-type-sms get-nvram-partition IF
+      cr ." Could not find SMS partition in NVRAM - "
+      nvram-partition-type-sms s" SMS" d# 1024 new-nvram-partition
+      ABORT" Failed to create SMS NVRAM partition"
+      2dup erase-nvram-partition drop
+
+      2dup s" lang"			  s" 1" internal-set-env drop
+
+      2dup s" tftp-retries"		  s" 5" internal-set-env drop
+      2dup s" tftp-blocksize"		s" 512" internal-set-env drop
+      2dup s" bootp-retries"		s" 255" internal-set-env drop
+      2dup s" client"	    s" 000.000.000.000" internal-set-env drop
+      2dup s" server"       s" 000.000.000.000" internal-set-env drop
+      2dup s" gateway"      s" 000.000.000.000" internal-set-env drop
+      2dup s" netmask"      s" 255.255.255.000" internal-set-env drop
+      2dup s" net-protocol"		  s" 0" internal-set-env drop
+      2dup s" net-flags"		  s" 0" internal-set-env drop
+      2dup s" net-device"		  s" 0" internal-set-env drop
+      2dup s" net-client-name"		   s" " internal-set-env drop
+
+      2dup s" scsi-spinup"		  s" 6" internal-set-env drop
+      2dup s" scsi-id-0"		  s" 7" internal-set-env drop
+      2dup s" scsi-id-1"		  s" 7" internal-set-env drop
+      2dup s" scsi-id-2"		  s" 7" internal-set-env drop
+      2dup s" scsi-id-3"		  s" 7" internal-set-env drop
+      ." created" cr
+   THEN
+   s" sms-nvram-partition" $2constant
+;
+
+sms-init-nvram
+
+: sms-add-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-add-env drop ;
+: sms-set-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-set-env drop ;
+: sms-get-env ( "name" -- "value" TRUE | FALSE) sms-nvram-partition 2swap internal-get-env ;
+
+: sms-get-net-device ( -- n )	s" net-device" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
+: sms-set-net-device ( n -- )	(.d) s" net-device" 2swap sms-set-env ;
+
+: sms-get-net-flags ( -- n )	s" net-flags" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
+: sms-set-net-flags ( n -- )	(.d) s" net-flags" 2swap sms-set-env ;
+
+: sms-get-net-protocol ( -- n )	s" net-protocol" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
+: sms-set-net-protocol ( n -- )	(.d) s" net-protocol" 2swap sms-set-env ;
+
+: sms-get-lang ( -- n )	s" lang" sms-get-env IF $dnumber IF 1 THEN ELSE 1 THEN ;
+: sms-set-lang ( n -- )	(.d) s" lang" 2swap sms-set-env ;
+
+: sms-get-bootp-retries ( -- n ) s" bootp-retries" sms-get-env IF $dnumber IF 255 THEN ELSE 255 THEN ;
+: sms-set-bootp-retries ( n -- ) (.d) s" bootp-retries" 2swap sms-set-env ;
+
+: sms-get-tftp-retries ( -- n )	s" tftp-retries" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
+: sms-set-tftp-retries ( n -- ) (.d) s" tftp-retries" 2swap sms-set-env ;
+
+: sms-get-tftp-blocksize ( -- n ) s" tftp-blocksize" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
+: sms-set-tftp-blocksize ( n -- ) (.d) s" tftp-blocksize" 2swap sms-set-env ;
+
+: sms-get-client ( -- FALSE | n1 n2 n3 n4 TRUE ) s" client" sms-get-env IF (ipaddr) ELSE false THEN ;
+: sms-set-client ( n1 n2 n3 n4 -- ) (ipformat) s" client" 2swap sms-set-env ;
+
+: sms-get-server ( -- FALSE | n1 n2 n3 n4 TRUE ) s" server" sms-get-env IF (ipaddr) ELSE false THEN ;
+: sms-set-server ( n1 n2 n3 n4 -- ) (ipformat) s" server" 2swap sms-set-env ;
+
+: sms-get-gateway ( -- FALSE | n1 n2 n3 n4 TRUE ) s" gateway" sms-get-env IF (ipaddr) ELSE false THEN ;
+: sms-set-gateway ( n1 n2 n3 n4 -- ) (ipformat) s" gateway" 2swap sms-set-env ;
+
+: sms-get-subnet ( -- FALSE | n1 n2 n3 n4 TRUE ) s" netmask" sms-get-env IF (ipaddr) ELSE false THEN ;
+: sms-set-subnet ( n1 n2 n3 n4 -- ) (ipformat) s" netmask" 2swap sms-set-env ;
+
+: sms-get-client-name ( -- FALSE | addr len TRUE ) s" net-client-name" sms-get-env ;
+: sms-set-client-name ( addr len -- ) s" net-client-name" 2swap sms-set-env ;
+
+: sms-get-scsi-spinup ( -- n )	s" scsi-spinup" sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
+: sms-set-scsi-spinup ( n -- )	(.d) s" scsi-spinup" 2swap sms-set-env ;
+
+: sms-get-scsi-id ( n -- id )	s" scsi-id-" rot (.) $cat sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
+: sms-set-scsi-id ( id n -- ) swap (.d) rot s" scsi-id-" rot (.) $cat sms-set-env ;
+
+
+\ generates the boot-file part of the boot string
+
+: sms-get-net-boot-file ( -- addr len )
+   \ the format is
+   \ :[bootp,]siaddr,filename,ciaddr,giaddr,bootp-retries,tftp-retries
+   \ we choose dhcp as a default!
+   s" net" sms-get-net-device (.) $cat
+   s" :dhcp," $cat
+   sms-get-server IF (ipformat) $cat THEN
+   s" ," $cat
+   sms-get-client-name IF $cat THEN
+   s" ," $cat
+   sms-get-client IF (ipformat) $cat THEN
+   s" ," $cat
+   sms-get-gateway IF (ipformat) $cat THEN
+   s" ," $cat
+   \ If the number of retries is 255 (max), assume default timeout (10min)
+   sms-get-bootp-retries dup ff <> IF (.) $cat ELSE drop THEN
+   s" ," $cat
+   sms-get-tftp-retries (.) $cat
+   \ now write the string to the boot path
+   dup IF
+      \ This could be considered a memory leak, but it is only
+      \ executed once for booting so it is not a problem
+      strdup ( s" :" 2swap $cat strdup )
+   THEN
+;
+
+' sms-get-net-boot-file to furnish-boot-file
+
diff --git a/qemu/roms/SLOF/slof/fs/stack.fs b/qemu/roms/SLOF/slof/fs/stack.fs
new file mode 100644
index 000000000..0f7e097bf
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/stack.fs
@@ -0,0 +1,57 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+\ Example:
+\
+\ To get a 30 element stack, go:
+\
+\ 0 > 30 new-stack my-stack
+\ 0 > my-stack
+\ 0 > 20 push 30 push
+\ 0 > pop pop .s
+
+0 value current-stack
+
+: new-stack ( cells <>name -- )
+   create >r here    ( here R: cells )
+   dup r@ 2 + cells  ( here here bytes R: cells )
+   dup allot erase   ( here R: cells)
+   cell+ r>          ( here+1cell cells )
+   swap !            ( )
+   DOES> to current-stack
+;
+
+: reset-stack ( -- )
+   0 current-stack !
+;
+
+: stack-depth ( -- depth )
+   current-stack @
+;
+
+: push ( value -- )
+   current-stack @
+   current-stack cell+ @ over <= ABORT" Stack overflow"
+   cells
+   1 current-stack +!
+   current-stack 2 cells + + !
+;
+
+: pop ( -- value )
+   current-stack @ 0= ABORT" Stack underflow"
+   current-stack @ cells
+   current-stack + cell+ @
+   -1 current-stack +!
+;
+
+
diff --git a/qemu/roms/SLOF/slof/fs/start-up.fs b/qemu/roms/SLOF/slof/fs/start-up.fs
new file mode 100644
index 000000000..f1488fa38
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/start-up.fs
@@ -0,0 +1,171 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+: (boot) ( -- )
+   s" Executing following boot-command: "
+   boot-command $cat nvramlog-write-string-cr
+   s" boot-command" evaluate      \ get boot command
+   ['] evaluate catch ?dup IF     \ and execute it
+      ." boot attempt returned: "
+      abort"-str @ count type cr
+      nip nip                     \ drop string from 1st evaluate
+      throw
+   THEN
+;
+
+\ Note: The following ESC sequences has to be handled:
+\     1B 4F 50
+\     1B 5B 31 31 7E
+
+\ Reads and converts the function key.
+\ key = F1 -- n = 1
+: (function-key) ( -- n )
+   key? IF
+      key CASE
+	 50  OF 1 ENDOF
+	 7e  OF 1 ENDOF
+	 dup OF 0 ENDOF
+      ENDCASE
+   THEN
+;
+
+\ Checks if an ESC sequence occurs.
+: (esc-sequence) ( -- n )
+   key? IF
+      key CASE
+	  4f  OF (function-key) ENDOF
+	  5b  OF
+	     key key (function-key) ENDOF
+	  dup OF 0 ENDOF
+       ENDCASE
+   THEN
+;
+
+: (s-pressed) ( -- )
+   s" An 's' has been pressed. Entering Open Firmware Prompt"
+   nvramlog-write-string-cr
+;
+
+: (boot?) ( -- )
+   of-prompt? not auto-boot? and IF
+      (boot)
+   THEN
+;
+
+
+#include "sms/sms-load.fs"
+
+
+\ Watchdog will be rearmed during load if use-load-watchdog variable is TRUE
+TRUE VALUE use-load-watchdog?
+
+1 value my-boot-dev
+1 value digit-val
+0 value boot-dev-no
+
+: boot-selected
+   1 to my-boot-dev
+   BEGIN parse-word dup WHILE
+      boot-dev-no my-boot-dev = IF
+         s" boot " 2swap $cat
+         ['] evaluate catch ?dup IF     \ and execute it
+            ." boot attempt returned: "
+            abort"-str @ count type cr
+            throw
+         THEN
+         0 0 load-list 2!
+         UNLOOP EXIT
+      ELSE
+         2drop
+      THEN
+      my-boot-dev 1 + to my-boot-dev
+   REPEAT 2drop 0 0 load-list 2!
+
+   (boot)
+;
+
+: boot-start
+   \ Remove multiple F12 key presses if any
+   BEGIN key? WHILE
+      key drop
+   REPEAT
+
+   decimal
+   BEGIN parse-word dup WHILE
+      my-boot-dev (u.) s" . " $cat type 2dup type ." : " de-alias type cr
+      my-boot-dev 1 + to my-boot-dev
+   REPEAT 2drop 0 0 load-list 2!
+
+   cr BEGIN KEY dup emit
+      dup isdigit IF
+         dup 30 - to digit-val
+         boot-dev-no a * digit-val + to boot-dev-no
+      THEN
+   d = UNTIL
+
+   boot-dev-no my-boot-dev < IF
+      s" boot-selected " s" $bootdev" evaluate $cat strdup evaluate
+   ELSE
+      ." Invalid choice!" cr
+   THEN
+   hex
+;
+
+: boot-menu-start
+   ." Select boot device:" cr cr
+   s" boot-start " s" $bootdev" evaluate $cat strdup evaluate
+;
+
+: boot-menu-enabled? ( -- true|false )
+   s" qemu,boot-menu" get-chosen IF
+      decode-int 1 = IF
+         2drop TRUE EXIT
+      THEN
+      2drop
+   THEN
+   FALSE
+;
+
+: f12-pressed?
+   34 = >r 32 = r> and IF
+      TRUE
+   ELSE
+      FALSE
+   THEN
+;
+
+: start-it ( -- )
+   key? IF
+      key CASE
+	 [char] s  OF (s-pressed) ENDOF
+	 1b        OF
+	     (esc-sequence) CASE
+		 1   OF
+                        console-clean-fifo
+                        f12-pressed? boot-menu-enabled? and IF
+		           boot-menu-start
+                        ELSE
+                           (boot?)
+                        THEN
+                     ENDOF
+		 dup OF (boot?) ENDOF
+	     ENDCASE
+	 ENDOF
+	 dup OF (boot?) ENDOF
+      ENDCASE
+   ELSE
+      (boot?)
+   THEN
+
+   disable-watchdog  FALSE to use-load-watchdog?
+   .banner
+;
diff --git a/qemu/roms/SLOF/slof/fs/term-io.fs b/qemu/roms/SLOF/slof/fs/term-io.fs
new file mode 100644
index 000000000..52ce12a5b
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/term-io.fs
@@ -0,0 +1,97 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+: input  ( dev-str dev-len -- )
+   open-dev ?dup IF
+      \ Close old stdin:
+      s" stdin" get-chosen IF
+         decode-int nip nip ?dup IF close-dev THEN
+      THEN
+      \ Now set the new stdin:
+      encode-int s" stdin"  set-chosen
+   THEN
+;
+
+: output  ( dev-str dev-len -- )
+   open-dev ?dup IF
+      \ Close old stdout:
+      s" stdout" get-chosen IF
+         decode-int nip nip ?dup IF close-dev THEN
+      THEN
+      \ Now set the new stdout:
+      encode-int s" stdout" set-chosen
+   THEN
+;
+
+: io  ( dev-str dev-len -- )
+   2dup input output
+;
+
+
+1 BUFFER: (term-io-char-buf)
+
+: term-io-key  ( -- char )
+   s" stdin" get-chosen IF
+      decode-int nip nip dup 0= IF 0 EXIT THEN
+      >r BEGIN
+         (term-io-char-buf) 1 s" read" r@ $call-method
+         0 >
+      UNTIL
+      (term-io-char-buf) c@
+      r> drop
+   ELSE
+      [ ' key behavior compile, ]
+   THEN
+;
+
+' term-io-key to key
+
+\ this word will check what the current chosen input device is:
+\ - if it is a serial device, it will use serial-key? to check for available input
+\ - if it is a keyboard, it will check if the "key-available?" method is implemented (i.e. for usb-keyboard) and use that
+\ - if it's an hv console, use hvterm-key?
+\ otherwise it will always return false
+: term-io-key?  ( -- true|false )
+   s" stdin" get-chosen IF
+      decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set
+      >r \ store ihandle on return stack
+      s" device_type" r@ ihandle>phandle ( propstr len phandle )
+      get-property ( true | data dlen false )
+      IF
+         \ device_type not found, return false and exit
+         false
+      ELSE
+         1 - \ remove 1 from length to ignore null-termination char
+         \ device_type found, check wether it is serial or keyboard
+         2dup s" serial" str= IF
+	    2drop serial-key? r> drop EXIT
+	 THEN \ call serial-key, cleanup return-stack, exit
+         2dup s" keyboard" str= IF 
+            2drop ( )
+            \ keyboard found, check for key-available? method, execute it or return false 
+            s" key-available?" r@ ihandle>phandle find-method IF 
+               drop s" key-available?" r@ $call-method  
+            ELSE 
+               false 
+            THEN
+            r> drop EXIT \ cleanup return-stack, exit
+         THEN
+         2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
+      THEN
+   ELSE
+      \ stdin not set, return false
+      false
+   THEN
+;
+
+' term-io-key? to key?
diff --git a/qemu/roms/SLOF/slof/fs/terminal.fs b/qemu/roms/SLOF/slof/fs/terminal.fs
new file mode 100644
index 000000000..582bedeb3
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/terminal.fs
@@ -0,0 +1,212 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ \\\\\\\\\\\\\\ Global Data
+
+0 VALUE line#
+0 VALUE column#
+false VALUE inverse?
+false VALUE inverse-screen?
+18 VALUE #lines
+50 VALUE #columns
+
+false VALUE cursor
+false VALUE saved-cursor
+
+
+\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods
+
+defer draw-character	\ 2B inited by display driver
+defer reset-screen	\ 2B inited by display driver
+defer toggle-cursor	\ 2B inited by display driver
+defer erase-screen	\ 2B inited by display driver
+defer blink-screen	\ 2B inited by display driver
+defer invert-screen	\ 2B inited by display driver
+defer insert-characters	\ 2B inited by display driver
+defer delete-characters	\ 2B inited by display driver
+defer insert-lines	\ 2B inited by display driver
+defer delete-lines	\ 2B inited by display driver
+defer draw-logo		\ 2B inited by display driver
+
+: nop-toggle-cursor ( nop ) ;
+' nop-toggle-cursor to toggle-cursor
+
+\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous)
+\ *
+\ *
+: (cursor-off) ( -- ) cursor dup to saved-cursor
+	IF toggle-cursor false to cursor THEN ;
+: (cursor-on) ( -- ) cursor dup to saved-cursor
+	0= IF toggle-cursor true to cursor THEN ;
+: restore-cursor ( -- ) saved-cursor dup cursor
+	<> IF toggle-cursor to cursor ELSE drop THEN ;
+
+' (cursor-off) to cursor-off
+' (cursor-on) to cursor-on
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ Generic device methods:
+\ *
+
+
+\ \\\\\\\\\\\\\\ Exported Interface:
+\ *
+\ *
+
+false VALUE esc-on
+false VALUE csi-on
+defer esc-process
+0 VALUE esc-num-parm
+0 VALUE esc-num-parm2
+0 VALUE saved-line#
+0 VALUE saved-column#
+
+: get-esc-parm ( default -- value )
+	esc-num-parm dup 0> IF nip ELSE drop THEN 0 to esc-num-parm ;
+: get-esc-parm2 ( default -- value )
+	esc-num-parm2 dup 0> IF nip ELSE drop THEN 0 to esc-num-parm2 ;
+: set-esc-parm ( newdigit -- ) [char] 0 - esc-num-parm a * + to esc-num-parm ;
+
+: reverse-cursor ( oldpos -- newpos) dup IF 1 get-esc-parm - THEN ;
+: advance-cursor ( bound oldpos -- newpos) tuck > IF 1 get-esc-parm + THEN ;
+: erase-in-line #columns column# - dup 0> IF delete-characters ELSE drop THEN ;
+
+: terminal-line++ ( -- )
+	line# 1+ dup #lines = IF 1- 0 to line# 1 delete-lines THEN
+	to line#
+;
+
+0 VALUE dang
+0 VALUE blipp
+false VALUE stopcsi
+0 VALUE term-background
+7 VALUE term-foreground
+
+: set-term-color
+   dup d# 30 d# 39 between IF dup d# 30 - to term-foreground THEN
+   dup d# 40 d# 49 between IF dup d# 40 - to term-background THEN
+   0 = IF
+      0 to term-background
+      7 to term-foreground
+  THEN
+  term-foreground term-background <= to inverse?
+;
+
+: ansi-esc ( char -- )
+    csi-on IF
+	dup [char] 0 [char] 9 between IF set-esc-parm
+	ELSE true to stopcsi CASE
+	    [char] A OF line# reverse-cursor to line# ENDOF
+	    [char] B OF #lines line# advance-cursor to line# ENDOF
+	    [char] C OF #columns column# advance-cursor to column# ENDOF
+	    [char] D OF column# reverse-cursor to column# ENDOF
+	    [char] E OF ( FIXME: Cursor Next Line - No idea what does it mean )
+	    	#lines line# advance-cursor to line#
+	    ENDOF
+	    [char] f OF
+		1 get-esc-parm2 to line# column# get-esc-parm to column#
+	    ENDOF
+	    [char] H OF
+		1 get-esc-parm2 to line# column# get-esc-parm to column#
+	    ENDOF
+	    ( second parameter delimiter for f and H commands )
+	    [char] ; OF false to stopcsi 0 get-esc-parm to esc-num-parm2 ENDOF
+	    [char] ? OF false to stopcsi ENDOF ( FIXME: Ignore that for now )
+	    [char] l OF ENDOF ( FIXME: ?25l should hide cursor )
+	    [char] h OF ENDOF ( FIXME: ?25h should show cursor )
+	    [char] J OF
+		#lines line# - dup 0> IF
+			line# 1+ to line# delete-lines line# 1- to line#
+		ELSE drop THEN
+		erase-in-line
+	    ENDOF
+	    [char] K OF erase-in-line ENDOF
+	    [char] L OF 1 get-esc-parm insert-lines ENDOF
+	    [char] M OF 1 get-esc-parm delete-lines ENDOF
+	    [char] @ OF 1 get-esc-parm insert-characters ENDOF
+	    [char] P OF 1 get-esc-parm delete-characters ENDOF
+	    [char] m OF 0 get-esc-parm set-term-color ENDOF
+	    ( These are non-ANSI commands recommended by OpenBoot )
+	    [char] p OF inverse-screen? IF false to inverse-screen?
+			inverse? 0= to inverse? invert-screen
+		THEN
+	    ENDOF
+	    [char] q OF inverse-screen? 0= IF true to inverse-screen?
+			inverse? 0= to inverse? invert-screen
+		THEN
+	    ENDOF
+\ 	    [char] s OF reset-screen ENDOF ( FIXME: this conflicts w. ANSI )
+\ 	    [char] s OF line# to saved-line# column# to saved-column# ENDOF
+	    [char] u OF saved-line# to line# saved-column# to column# ENDOF
+	    dup dup to dang OF blink-screen ENDOF
+	ENDCASE stopcsi IF false to csi-on
+	        false to esc-on 0 to esc-num-parm 0 to esc-num-parm2 THEN
+	THEN
+    ELSE CASE
+	( DEV VT compatibility stuff used by accept.fs )
+	[char] 7 OF line# to saved-line# column# to saved-column# ENDOF
+	[char] 8 OF saved-line# to line# saved-column# to column# ENDOF
+	[char] [ OF true to csi-on ENDOF
+	dup dup OF false to esc-on to blipp ENDOF
+        ENDCASE
+	csi-on 0= IF false to esc-on THEN 0 to esc-num-parm 0 to esc-num-parm2
+    THEN
+;
+
+' ansi-esc to esc-process
+CREATE twtracebuf 4000 allot twtracebuf 4000 erase
+twtracebuf VALUE twbp
+0 VALUE twbc
+
+: twtrace
+	twbc 4000 = IF 0 to twbc twtracebuf to twbp THEN
+	dup twbp c! twbp 1+ to twbp twbc 1+ to twbc
+;
+
+: terminal-write ( addr len -- actual-len )
+ 	cursor-off
+	tuck bounds ?DO i c@
+		twtrace
+		esc-on IF esc-process
+		ELSE CASE
+			1B OF true to esc-on ENDOF
+			carret OF 0 to column# ENDOF
+			linefeed OF terminal-line++ ENDOF
+			bell OF blink-screen ENDOF
+			9 ( TAB ) OF column# 7 + -8 and dup #columns < IF
+					to column#
+				ELSE drop THEN
+			ENDOF
+			B ( VT ) OF line# ?dup IF 1- to line# THEN ENDOF
+			C ( FF ) OF 0 to line# 0 to column# erase-screen ENDOF
+			bs OF	column# 1- dup 0< IF
+					line# IF
+						line# 1- to line#
+						drop #columns 1-
+					ELSE drop column#
+					THEN
+				THEN
+				to column# ( bl draw-character )
+			ENDOF
+			dup OF
+				i c@ draw-character
+				column# 1+ dup #columns >= IF
+					drop 0 terminal-line++
+				THEN
+				to column#
+			ENDOF
+		    ENDCASE
+		THEN
+	LOOP
+ 	restore-cursor
+;
diff --git a/qemu/roms/SLOF/slof/fs/timebase.fs b/qemu/roms/SLOF/slof/fs/timebase.fs
new file mode 100644
index 000000000..00a0bd203
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/timebase.fs
@@ -0,0 +1,24 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\ Define all timebase related words
+
+: tb@  ( -- tb )
+   BEGIN tbu@ tbl@ tbu@ rot over <> WHILE 2drop REPEAT
+   20 lshift swap ffffffff and or
+;
+
+: milliseconds ( -- ms ) tb@ d# 1000 * tb-frequency / ;
+: microseconds ( -- us ) tb@ d# 1000000 * tb-frequency / ;
+
+: ms ( ms-to-wait -- ) milliseconds + BEGIN milliseconds over >= UNTIL drop ;
+: get-msecs ( -- n ) milliseconds ;
+: us  ( us-to-wait -- )  microseconds +  BEGIN microseconds over >= UNTIL  drop ;
diff --git a/qemu/roms/SLOF/slof/fs/translate.fs b/qemu/roms/SLOF/slof/fs/translate.fs
new file mode 100644
index 000000000..9654f242f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/translate.fs
@@ -0,0 +1,150 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ this is a C-to-Forth translation from the translate
+\ address code in the client
+\ with extensions to handle different sizes of #size-cells
+
+\ this tries to figure out if it is a PCI device what kind of
+\ translation is wanted
+\ if prop_type is 0, "reg" property is used, otherwise "assigned-addresses"
+: pci-address-type  ( node address prop_type -- type )
+   -rot 2 pick ( prop_type node address prop_type )
+   0= IF
+      swap s" reg" rot get-property  ( prop_type address data dlen false )
+   ELSE
+      swap s" assigned-addresses" rot get-property  ( prop_type address data dlen false )
+   THEN
+   IF  2drop -1  EXIT  THEN  4 / 5 /
+   \ advance (phys-addr(3) size(2)) steps
+   0 DO
+      \ BARs and Expansion ROM must be in assigned-addresses...
+      \ so if prop_type is 0 ("reg") and a config space offset is set
+      \ we skip this entry...
+      dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? )
+      3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? )
+      AND NOT IF 
+         2dup 4 + ( prop_type address data address data' )
+         2dup @ 2 pick 8 + @ + <= -rot @  >= and  IF
+            l@ 03000000 and 18 rshift nip
+            ( prop_type type )
+            swap drop ( type )
+            UNLOOP EXIT
+         THEN
+      THEN
+      \ advance in 4 byte steps and (phys-addr(3) size(2)) steps
+      4 5 * +
+   LOOP
+   3drop -1
+;
+
+: (range-read-cells)  ( range-addr #cells -- range-value )
+   \ if number of cells != 1; do 64bit read; else a 32bit read
+   1 =  IF  l@  ELSE  @  THEN
+;
+
+\ this functions tries to find a mapping for the given address
+\ it assumes that if we have #address-cells == 3 that we are trying
+\ to do a PCI translation
+
+\ nac - #address-cells
+\ nsc - #size-cells
+\ pnac - parent #address-cells
+
+: (map-one-range)  ( type range pnac nsc nac address -- address true | address false )
+   \ only check for the type if nac == 3 (PCI)
+   over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and  IF
+      >r 2drop 3drop r> false EXIT
+   THEN
+   \ get size
+   4 pick 4 pick 3 pick + 4 * +
+   \ get nsc
+   3 pick
+   \ read size
+   ( type range pnac nsc nac address range nsc )
+   (range-read-cells)
+   ( type range pnac nsc nac address size )
+   \ skip type if PCI
+   5 pick 3 pick 3 =  IF
+      4 +
+   THEN
+   \ get nac
+   3 pick
+   ( type range pnac nsc nac address size range nac )
+   \ read child-mapping
+   (range-read-cells)
+   ( type range pnac nsc nac address size child-mapping )
+   dup >r dup 3 pick > >r + over <= r> or  IF
+      \ address is not inside the mapping range
+      >r 2drop 3drop r> r> drop false EXIT
+   THEN
+   dup r> -
+   ( type range pnac nsc nac address offset )
+   \ add the offset on the parent mapping
+   5 pick 5 pick 3 =  IF
+      \ skip type if PCI
+      4 +
+   THEN
+   3 pick 4 * +
+   ( type range pnac nsc nac address offset parent-mapping-address )
+   \ get pnac
+   5 pick
+   \ read parent mapping
+   (range-read-cells)
+   ( type range pnac nsc nac address offset parent-mapping )
+   + >r 3drop 3drop r> true
+;
+
+\ this word translates the given address starting from the node specified
+\ in node; the word will return to the node it was started from
+: translate-address  ( node address -- address )
+   \ check for address type in "assigned-addresses"
+   2dup 1 pci-address-type  ( node address type )
+   dup -1 = IF
+      \ not found in "assigned-addresses", check in "reg"
+      drop 2dup 0 pci-address-type ( node address type )
+   THEN
+   rot parent BEGIN
+      \ check if it is the root node
+      dup parent 0=  IF  2drop EXIT  THEN
+      ( address type parent )
+      s" #address-cells" 2 pick get-property 2drop l@ >r        \ nac
+      s" #size-cells" 2 pick get-property 2drop l@ >r           \ nsc
+      s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac
+      -rot ( node address type )
+      s" ranges" 4 pick get-property  IF
+         3drop
+         ABORT" no ranges property; not translatable"
+      THEN
+      r> r> r> 3 roll
+      ( node address type ranges pnac nsc nac length )
+      4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO
+         ( node type ranges pnac nsc nac address )
+         6dup (map-one-range) IF
+            nip leave
+         THEN
+         nip
+         \ advance ranges
+         4 roll
+         ( node type pnac nsc nac address ranges )
+         4 pick 4 pick 4 pick + + 4 * + 4 -roll
+      LOOP
+      >r 2drop 2drop r> ( node type address )
+      swap rot parent ( address type node )
+      dup 0=
+   UNTIL
+;
+
+\ this words translates the given address starting from the current node
+: translate-my-address  ( address -- address' )
+   get-node swap translate-address
+;
diff --git a/qemu/roms/SLOF/slof/fs/update_flash.fs b/qemu/roms/SLOF/slof/fs/update_flash.fs
new file mode 100644
index 000000000..e04869d77
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/update_flash.fs
@@ -0,0 +1,110 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Set by update-flash -f to true, preventing update-flash -c
+false value flash-new
+
+: update-flash-help ( -- )
+   cr ." update-flash tool to flash host FW " cr
+   ."              -f <filename>      : Flash from file (e.g. net:\boot_rom.bin)" cr
+   ."              -l                 : Flash from load-base" cr
+   ."              -d                 : Flash from old load base (used by drone)" cr
+   ."              -c                 : Flash from temp to perm" cr
+   ."              -r                 : Flash from perm to temp" cr
+;
+
+: flash-read-temp ( -- success? )
+   get-flashside 1 = IF flash-addr get-load-base over flash-image-size rmove true
+   ELSE
+      false
+   THEN
+;
+
+: flash-read-perm ( -- success? )
+   get-flashside 0= IF
+      flash-addr get-load-base over flash-image-size rmove true
+   ELSE
+      false
+   THEN
+;
+
+: flash-switch-side ( side -- success? )
+   set-flashside 0<> IF
+      s" Cannot change flashside" type cr false
+   ELSE
+      true
+   THEN
+;
+
+: flash-ensure-temp ( -- success? )
+   get-flashside 0= IF
+      cr ." Cannot flash perm! Switching to temp side!"
+      1 flash-switch-side
+   ELSE
+      true
+   THEN
+;
+
+\ update-flash -f <filename>
+\              -l
+\              -c
+\              -r
+
+: update-flash ( "text" )
+   get-flashside >r                              \ Save old flashside
+   parse-word                      ( str len )   \ Parse first string
+   drop dup c@                     ( str first-char )
+   [char] - <> IF
+      update-flash-help r> 2drop EXIT
+   THEN
+
+   1+ c@                           ( second-char )
+   CASE
+      [char] f OF
+         parse-word cr s" do-load" evaluate
+         flash-ensure-temp TO flash-new
+      ENDOF
+      [char] l OF
+         flash-ensure-temp
+      ENDOF
+      [char] d OF
+         flash-load-base get-load-base 200000 move
+         flash-ensure-temp
+      ENDOF
+      [char] c OF
+         flash-read-temp 0= flash-new or IF
+            ." Cannot commit temp, need to boot on temp first " cr false
+         ELSE
+            0 flash-switch-side
+         THEN
+      ENDOF
+      [char] r OF
+         flash-read-perm 0= IF
+         ." Cannot commit perm, need to boot on perm first " cr false
+         ELSE
+         1 flash-switch-side
+         THEN
+      ENDOF
+      dup      OF
+         false
+      ENDOF
+   ENDCASE
+
+   ( true| false )
+
+   0= IF
+      update-flash-help r> drop EXIT
+   THEN
+
+   get-load-base flash-write 0= IF ." Flash write failed !! " cr THEN
+   r> set-flashside drop                           \ Restore old flashside
+;
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs b/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs
new file mode 100644
index 000000000..5fb25b8b6
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs
@@ -0,0 +1,71 @@
+\ *****************************************************************************
+\ * Copyright (c) 2006, 2012, 2013 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+\ *
+\ * [OEX]HCI functions
+\ *
+\ ****************************************************************************
+
+\ ( num $name type )
+
+VALUE usb_type \ USB type
+
+\ Open Firmware Properties
+device-type
+" usb" 2dup device-name
+
+rot
+VALUE usb_num                           \ controller number
+usb_num $cathex strdup			\ create alias name
+2dup find-alias 0= IF
+   get-node node>path set-alias
+ELSE 3drop THEN
+
+/hci-dev BUFFER: hcidev
+usb_num hcidev usb-setup-hcidev
+TRUE VALUE first-time-init?
+0 VALUE open-count
+
+false VALUE dev-hci-debug?
+
+1 encode-int s" #address-cells" property
+0 encode-int s" #size-cells" property
+
+\ converts physical address to text unit string
+: encode-unit ( port -- unit-str unit-len ) 1 hex-encode-unit ;
+
+\ Converts text unit string to phyical address
+: decode-unit ( addr len -- port ) 1 hex-decode-unit ;
+
+: get-hci-dev ( -- hcidev )
+    hcidev
+;
+
+: hc-cleanup ( -- )
+    my-phandle set-node
+    dev-hci-debug? IF ." USB-HCI: Cleaning up " pwd cr THEN
+    hcidev USB-HCD-EXIT
+    0 set-node
+;
+
+: open   ( -- true | false )
+    true
+;
+
+: close
+;
+
+\ create a new entry to cleanup and suspend HCI
+\ after first init
+first-time-init? IF
+   ['] hc-cleanup add-quiesce-xt
+   false to first-time-init?
+THEN
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs b/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs
new file mode 100644
index 000000000..ba0b33437
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs
@@ -0,0 +1,32 @@
+new-device
+
+VALUE sudev
+
+s" slofdev.fs" included
+sudev slof-dev>port l@ dup set-unit encode-phys " reg" property
+sudev slof-dev>udev @ VALUE udev
+
+s" hub" device-name
+
+s" dev-parent-calls.fs" included
+
+1 encode-int s" #address-cells" property
+0 encode-int s" #size-cells" property
+: decode-unit  1 hex-decode-unit ;
+: encode-unit  1 hex-encode-unit ;
+
+: usb-hub-init ( usbdev -- true | false )
+    udev USB-HUB-INIT
+;
+
+: open   ( -- true | false )
+    TRUE
+;
+
+: close
+;
+
+."     USB HUB " cr
+usb-hub-init drop
+
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs b/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs
new file mode 100644
index 000000000..db9e23ef1
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs
@@ -0,0 +1,54 @@
+new-device
+
+VALUE sudev
+false VALUE usb-keyb-debug?
+
+s" slofdev.fs" included
+sudev slof-dev>port l@ dup set-unit encode-phys " reg" property
+sudev slof-dev>udev @ VALUE udev
+
+s" usb-keyboard" device-name
+s" keyboard" device-type
+s" EN" encode-string s" language" property
+s" keyboard" get-node node>path set-alias
+
+s" dev-parent-calls.fs" included
+
+0 VALUE open-count
+
+: open   ( -- true | false )
+    usb-keyb-debug? IF ." USB-KEYB: Opening (count is " open-count . ." )" cr THEN
+    open-count 0= IF
+	udev USB-HID-INIT 0= IF
+	    ." USB keyboard setup failed " pwd cr false EXIT
+	THEN
+    THEN
+    open-count 1 + to open-count
+    true
+;
+
+: close
+    usb-keyb-debug? IF ." USB-KEYB: Closing (count is " open-count . ." )" cr THEN
+    open-count 0> IF
+	open-count 1 - dup to open-count
+	0= IF
+	    my-phandle set-node
+	    udev USB-HID-EXIT drop
+	    0 set-node
+	THEN
+    THEN
+;
+
+\ method to check if a key is present in output buffer
+\ used by 'term-io.fs'
+: key-available? ( -- true|false )
+    udev USB-KEY-AVAILABLE IF TRUE ELSE FALSE THEN
+;
+
+: read                     ( addr len -- actual )
+    0= IF drop 0 EXIT THEN
+    udev USB-READ-KEYB ?dup IF swap c! 1 ELSE 0 swap c! 0 then
+;
+
+."     USB Keyboard " cr
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs b/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs
new file mode 100644
index 000000000..f6acd7e28
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs
@@ -0,0 +1,20 @@
+new-device
+
+VALUE sudev
+s" slofdev.fs" included
+sudev slof-dev>port l@ dup set-unit encode-phys " reg" property
+sudev slof-dev>udev @ VALUE udev
+
+s" usb-mouse" device-name
+
+\ .S cr
+\     dup slof-dev>udev dup . @ . cr
+\     dup slof-dev>port dup . l@ . cr
+\     dup slof-dev>devaddr dup . l@ . cr
+\     dup slof-dev>hcitype dup . l@ . cr
+\     dup slof-dev>num dup . l@ . cr
+\     dup slof-dev>devtype dup . l@ . cr
+
+."     USB mouse " cr
+
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs b/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs
new file mode 100644
index 000000000..57fa8ebdc
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs
@@ -0,0 +1,15 @@
+\ ****************************************************************************/
+\ * Copyright (c) 2011 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+get-node CONSTANT my-phandle
+
+s" dma-function.fs" included
diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs b/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs
new file mode 100644
index 000000000..94f8421d3
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs
@@ -0,0 +1,361 @@
+\ *****************************************************************************
+\ * Copyright (c) 2013 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ ( usbdev -- )
+
+new-device
+
+VALUE usbdev
+
+s" slofdev.fs" included
+
+false VALUE usb-disk-debug?
+
+usbdev slof-dev>port l@ dup set-unit encode-phys " reg" property
+s" storage" device-name
+
+s" dev-parent-calls.fs" included
+
+2 encode-int s" #address-cells" property
+0 encode-int s" #size-cells" property
+
+: decode-unit 2 hex64-decode-unit ;
+: encode-unit 2 hex64-encode-unit ;
+
+0 CONSTANT USB_PIPE_OUT
+1 CONSTANT USB_PIPE_IN
+
+\ -----------------------------------------------------------
+\ Specific properties
+\ -----------------------------------------------------------
+
+usbdev slof-dev>udev @ VALUE udev
+usbdev slof-dev>port l@ VALUE port
+usbdev slof-dev>hcitype l@ VALUE hcitype
+
+0 INSTANCE VALUE lun
+10000 VALUE dev-max-transfer
+0     VALUE resp-buffer
+0     VALUE resp-size
+0f CONSTANT SCSI-COMMAND-OFFSET
+
+\ -------------------------------------------------------
+\ DMA-able buffers
+\ -------------------------------------------------------
+
+STRUCT
+   dev-max-transfer FIELD usb>data
+   40 FIELD usb>cmd
+   20 FIELD usb>csw
+CONSTANT /dma-buf
+
+0 VALUE dma-buf
+0 VALUE dma-buf-phys
+0 VALUE td-buf
+0 VALUE td-buf-phys
+1000 CONSTANT /td-buf
+
+: (dma-buf-init)  ( -- )
+   /dma-buf dma-alloc TO dma-buf
+   dma-buf /dma-buf 0 dma-map-in TO dma-buf-phys
+   /td-buf dma-alloc TO td-buf
+   td-buf /td-buf 0 dma-map-in TO td-buf-phys
+;
+
+: (dma-buf-free)  ( -- )
+   td-buf td-buf-phys /td-buf dma-map-out
+   td-buf /td-buf dma-free
+   0 TO td-buf
+   0 TO td-buf-phys
+   dma-buf dma-buf-phys /dma-buf dma-map-out
+   dma-buf /dma-buf dma-free
+   0 TO dma-buf
+   0 TO dma-buf-phys
+;
+
+
+scsi-open
+
+\ -----------------------------------------------------------
+\ Perform SCSI commands
+\ -----------------------------------------------------------
+
+0 INSTANCE VALUE current-target
+
+\ SCSI command. We do *NOT* implement the "standard" execute-command
+\ because that doesn't have a way to return the sense buffer back, and
+\ we do have auto-sense with some hosts. Instead we implement a made-up
+\ do-scsi-command.
+\
+\ Note: stat is -1 for "hw error" (ie, error queuing the command or
+\ getting the response).
+\
+\ A sense buffer is returned whenever the status is non-0 however
+\ if sense-len is 0 then no sense data is actually present
+\
+
+: do-bulk-command ( resp-buffer resp-size -- TRUE | FALSE )
+    TO resp-size
+    TO resp-buffer
+    udev USB_PIPE_OUT td-buf td-buf-phys dma-buf-phys usb>cmd 1F
+    usb-transfer-bulk IF \ transfer CBW
+	resp-size IF
+	    d# 125 us
+	    udev USB_PIPE_IN td-buf td-buf-phys resp-buffer resp-size
+	    usb-transfer-bulk 1 = not IF \ transfer data
+	        usb-disk-debug?	IF ." Data phase failed " cr THEN
+		\ FALSE EXIT
+		\ in case of a stall/halted endpoint we clear the halt
+		\ Fall through and try reading the CSW
+	    THEN
+	THEN
+	d# 125 us
+	udev USB_PIPE_IN td-buf td-buf-phys dma-buf-phys usb>csw 0D
+	usb-transfer-bulk \ transfer CSW
+    ELSE
+	FALSE EXIT
+    THEN
+;
+
+STRUCT \ cbw
+    /l FIELD cbw>sig
+    /l FIELD cbw>tag
+    /l FIELD cbw>len
+    /c FIELD cbw>flags
+    /c FIELD cbw>lun     \ 0:3 bits
+    /c FIELD cbw>cblen   \ 0:4 bits
+CONSTANT cbw-length
+
+STRUCT \ csw
+    /l FIELD csw>sig
+    /l FIELD csw>tag
+    /l FIELD csw>data-residue
+    /c FIELD csw>status
+CONSTANT cbw-length
+
+0 VALUE cbw-addr
+0 VALUE csw-addr
+
+: build-cbw ( tag xfer-len dir lun cmd-len addr -- )
+    TO cbw-addr               ( tag xfer-len dir lun cmd-len )
+    cbw-addr cbw-length erase ( tag xfer-len dir lun cmd-len )
+    cbw-addr cbw>cblen c!     ( tag xfer-len dir lun )
+    cbw-addr cbw>lun c!       ( tag xfer-len dir )
+    \ dir is true or false
+    \ bmCBWFlags
+    \           BIT 7 Direction
+    \               0 - OUT
+    \               1 - IN
+    IF 80 ELSE 0 THEN
+    cbw-addr cbw>flags c!     ( tag xfer-len )
+    cbw-addr cbw>len l!-le    ( tag )
+    cbw-addr cbw>tag l!-le    ( )
+    43425355 cbw-addr cbw>sig l!-le
+;
+
+0 INSTANCE VALUE usb-buf-addr
+0 INSTANCE VALUE usb-buf-len
+0 INSTANCE VALUE usb-dir
+0 INSTANCE VALUE usb-cmd-addr
+0 INSTANCE VALUE usb-cmd-len
+1 VALUE tag
+
+: execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... )
+                       ( ... [ sense-buf sense-len ] stat )
+    \ Cleanup virtio request and response
+    to usb-cmd-len to usb-cmd-addr to usb-dir to usb-buf-len to usb-buf-addr
+
+    dma-buf usb>cmd 40 0 fill
+    dma-buf usb>csw 20 0 fill
+
+    tag usb-buf-len usb-dir lun usb-cmd-len dma-buf usb>cmd
+    ( tag transfer-len dir lun cmd-len addr )
+    build-cbw
+    1 tag + to tag
+
+    usb-cmd-addr
+    dma-buf usb>cmd SCSI-COMMAND-OFFSET +
+    usb-cmd-len
+    move
+
+    \ Send it
+    dma-buf-phys usb>data usb-buf-len
+    do-bulk-command IF
+	dma-buf usb>data usb-buf-addr usb-buf-len move
+    ELSE
+        ." USB-DISK: Bulk commad failed!" cr
+        0 0 -1 EXIT
+    THEN
+
+    dma-buf usb>csw to csw-addr
+    csw-addr csw>sig l@ 55534253 <> IF
+	." USB-DISK: CSW signature invalid " cr
+	0 0 -1 EXIT
+    THEN
+
+    csw-addr csw>status c@ CASE
+	0 OF ENDOF			\ Good
+	1 OF
+	    usb-disk-debug? IF
+		." USB-DISK: CSW Data residue: "
+		csw-addr csw>data-residue l@-le . cr
+	    THEN
+	    0 0 8 EXIT ENDOF	\ Command failed, Retry
+	dup OF 0 0 -1 EXIT ENDOF	\ Anything else -> HW error
+    ENDCASE
+
+    \ Other error status
+    csw-addr csw>status c@ dup 0<> IF
+	usb-disk-debug? IF
+	    over scsi-get-sense-data
+	    ." USB-DISK: Sense key [ " dup . ." ] " .sense-text
+	    ."  ASC,ASCQ: " . . cr
+        THEN
+       rot
+    THEN
+;
+
+\ --------------------------------
+\ Include the generic host helpers
+\ --------------------------------
+
+" scsi-host-helpers.fs" included
+
+0 VALUE open-count
+
+: usb-storage-init  (  -- TRUE )
+    td-buf 0= IF
+	usb-disk-debug? IF ." USB-DISK: Allocating buffer "  cr THEN
+	(dma-buf-init)
+	udev USB-MSC-INIT 0= IF
+	    ." USB-DISK: Unable to initialize MSC " cr
+	    FALSE
+	ELSE
+	    TRUE
+	THEN
+    THEN
+;
+
+: usb-storage-cleanup
+    td-buf 0<> IF
+	usb-disk-debug? IF ." USB-DISK: Freeing buffer " cr THEN
+	(dma-buf-free)
+	udev USB-MSC-EXIT 0= IF ." USB-DISK: Unable to exit MSC " cr THEN
+    THEN
+;
+
+: open
+    usb-disk-debug? IF ." USB-DISK: Opening (count is " open-count . ." )" cr THEN
+
+    open-count 0= IF
+	usb-storage-init IF
+	    1 to open-count true
+	ELSE ." USB-DISK initialization failed !" cr false THEN
+    ELSE
+	open-count 1 + to open-count
+	true
+    THEN
+;
+
+: close
+    usb-disk-debug? IF ." USB-DISK: Closing (count is " open-count . ." )" cr THEN
+
+    open-count 0> IF
+        open-count 1 - dup to open-count
+	0= IF
+	    usb-storage-cleanup
+	THEN
+    THEN
+;
+
+\ -----------------------------------------------------------
+\ SCSI scan at boot and child device support
+\ -----------------------------------------------------------
+
+\ We use SRP luns of the form 01000000 | (target << 8) | lun
+\ in the top 32 bits of the 64-bit LUN
+: (set-target)
+    dup 20 >> FFFF and to lun
+    dup 30 >> FF and to port
+    to current-target
+    usb-disk-debug? IF ." USB-DISK: udev " udev . ." lun:" lun . ." port:" port . cr THEN
+;
+
+: dev-generate-srplun ( target lun-id -- srplun )
+    swap drop port 0100 or 10 << or 20 <<
+;
+
+\ FIXME: Check max transfer coming from virtio config
+: max-transfer ( -- n )
+    dev-max-transfer
+;
+
+\ We obtain here a unit address on the stack, since our #address-cells
+\ is 2, the 64-bit srplun is split in two cells that we need to join
+\
+\ Note: This diverges a bit from the original OF scsi spec as the two
+\ cells are the 2 words of a 64-bit SRP LUN
+: set-address ( srplun.lo srplun.hi -- )
+    lxjoin (set-target)
+    usb-disk-debug? IF ." USB-DISK: udev " udev . ." lun:" lun . ." port:" port . cr THEN
+;
+
+1 CONSTANT #target
+: dev-max-target ( -- #target )
+    #target
+;
+
+" scsi-probe-helpers.fs" included
+
+scsi-close        \ no further scsi words required
+
+\ Set scsi alias if none is set yet
+: setup-alias
+    s" scsi" find-alias 0= IF
+	s" scsi" get-node node>path set-alias
+    ELSE
+	drop
+    THEN
+;
+
+: usb-storage-init-and-scan ( -- )
+   usb-disk-debug? IF ." Initializing usb-disk: udev " udev . cr THEN
+
+  \ Create instance for scanning:
+   0 0 get-node open-node ?dup 0= IF EXIT THEN
+   my-self >r
+   dup to my-self
+
+   hcitype
+   CASE
+      1 OF 4000 TO dev-max-transfer ENDOF \ OHCI
+      2 OF 10000 TO dev-max-transfer ENDOF \ EHCI
+      3 OF F000 TO dev-max-transfer ENDOF \ XHCI
+   ENDCASE
+   usb-storage-init
+   scsi-find-disks
+   setup-alias
+   usb-storage-cleanup
+   \ Close the temporary instance:
+   close-node
+   r> to my-self
+;
+
+."     USB Storage " cr
+: usb-scsi-add-disk
+     " scsi-disk.fs" included
+;
+
+usb-scsi-add-disk
+usb-storage-init-and-scan
+
+finish-device
diff --git a/qemu/roms/SLOF/slof/fs/usb/slofdev.fs b/qemu/roms/SLOF/slof/fs/usb/slofdev.fs
new file mode 100644
index 000000000..d6e20fdcd
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/slofdev.fs
@@ -0,0 +1,8 @@
+STRUCT
+    /n FIELD slof-dev>udev
+    /l FIELD slof-dev>port
+    /l FIELD slof-dev>devaddr
+    /l FIELD slof-dev>hcitype
+    /l FIELD slof-dev>num
+    /l FIELD slof-dev>devtype
+CONSTANT slof-usb-dev
diff --git a/qemu/roms/SLOF/slof/fs/usb/usb-static.fs b/qemu/roms/SLOF/slof/fs/usb/usb-static.fs
new file mode 100644
index 000000000..47db7276a
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/usb/usb-static.fs
@@ -0,0 +1,70 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011, 2013 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+\ Load dev hci
+: load-dev-hci ( num name-str name-len )
+   s" dev-hci.fs" INCLUDED
+;
+
+0 VALUE ohci-init
+0 VALUE ehci-init
+0 VALUE xhci-init
+0 VALUE usb-alias-num
+
+: get-usb-alias-num
+  usb-alias-num dup 1+ to usb-alias-num
+;
+
+\ create a new ohci device alias for the current node
+: set-ohci-alias  (  -- )
+    1 to ohci-init 
+    get-usb-alias-num       ( num )
+    s" ohci" 1 load-dev-hci
+;
+
+\ create a new ehci device alias for the current node
+: set-ehci-alias  (  -- )
+    1 to ehci-init
+    get-usb-alias-num       ( num )
+    s" ehci" 2 load-dev-hci
+;
+
+\ create a new xhci device alias for the current node
+: set-xhci-alias  (  -- )
+    1 to xhci-init 
+    get-usb-alias-num       ( num )
+    s" xhci" 3 load-dev-hci
+;
+
+: usb-enumerate ( hcidev -- )
+    USB-HCD-INIT
+;
+
+: usb-scan ( -- )
+    ." Scanning USB " cr
+    ohci-init 1 = IF USB-OHCI-REGISTER THEN
+    ehci-init 1 = IF USB-EHCI-REGISTER THEN
+    xhci-init 1 = IF USB-XHCI-REGISTER THEN
+
+    usb-alias-num 0 ?DO
+	" usb" i $cathex find-device
+	" get-hci-dev" get-node find-method
+	IF
+	    execute usb-enumerate
+	ELSE
+	    ." get-base-address method not found for usb@" i . 
+	    ."  Device type: "
+	    " device_type" get-node get-property 0= IF decode-string type cr 2drop THEN
+	THEN
+    LOOP
+    0 set-node     \ FIXME Setting it back
+;
diff --git a/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs b/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs
new file mode 100644
index 000000000..5a082156f
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs
@@ -0,0 +1,134 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+4 CONSTANT vpd-bootlist-size
+
+\ Bootable devices
+00 CONSTANT FLOPPY
+01 CONSTANT USB
+02 CONSTANT SAS
+03 CONSTANT SATA
+04 CONSTANT ISCSI
+05 CONSTANT ISCSICRITICAL
+06 CONSTANT NET
+07 CONSTANT NOTSPECIFIED
+08 CONSTANT HDD0
+09 CONSTANT HDD1
+0a CONSTANT HDD2
+0b CONSTANT HDD3
+0c CONSTANT CDROM
+0e CONSTANT HDD4
+10 CONSTANT SCSI
+
+: check-bootlist ( -- true | false )
+   vpd-bootlist l@
+   dup 0= IF
+      ( bootlist == 0 means that probably nothing from vpd has been received )
+      s" Boot list could not be read from VPD" log-string cr
+      s" Boot watchdog has been rearmed" log-string cr
+      2 set-watchdog
+      EXIT
+   THEN
+
+   FFFFFFFF = IF
+      ( bootlist all FFs means that the vpd has no useful information )
+      .banner
+      -6b boot-exception-handler
+      \ The next message is duplicate, but sent w. log-string
+      s" Boot list successfully read from VPD but no useful information received" log-string cr
+      s" Please specify the boot device in the management module" log-string cr
+      s" Specified Boot Sequence not valid" mm-log-warning
+      false
+      EXIT
+   THEN
+
+   true
+;
+
+\ the following words are necessary for vpd-boot-import
+defer set-boot-device
+defer add-boot-device
+
+\ select-install? is a flag which is used in the SMS panel #20
+\ "Select/Install Boot Devices".
+\ This panel can be used to temporarily override the boot device.
+false VALUE select-install?
+
+\ select/install-path stores string address and string length of the
+\ device node chosen in the SMS panel #20 "Select/Install Boot Devices"
+\ This device node is prepended to the boot path if select-install? is
+\ true.
+CREATE select/install-path 2 cells allot
+
+\ Import boot device list from VPD
+\ If none, keep the existing list in NVRAM
+\ This word can be used to overwrite read-bootlist if wanted
+
+: vpd-boot-import  ( -- )
+   0 0 set-boot-device
+
+   select-install? IF
+      select/install-path 2@ add-boot-device
+   THEN
+
+   vpd-read-bootlist
+   check-bootlist  IF
+      4 0  DO  vpd-bootlist i + c@
+         CASE
+            6  OF  \ cr s" 2B Booting from Network" log-string cr
+               furnish-boot-file strdup add-boot-device
+	    ENDOF
+
+            HDD0  OF  \ cr s" 2B Booting from hdd0" log-string cr
+               s" disk hdd0" add-boot-device ENDOF
+
+            HDD1  OF  \ cr s" 2B Booting from hdd1" log-string cr
+               s" hdd1" add-boot-device ENDOF
+
+            HDD2  OF  \ cr s" 2B Booting from hdd2" log-string cr
+               s" hdd2" add-boot-device ENDOF
+
+            HDD3  OF  \ cr s" 2B Booting from hdd3" log-string cr
+               s" hdd3" add-boot-device ENDOF
+
+            CDROM OF  \ cr s" 2B Booting from CDROM" log-string cr
+               s" cdrom" add-boot-device ENDOF
+
+            HDD4  OF  \ cr s" 2B Booting from hdd4" log-string cr
+               s" hdd4" add-boot-device ENDOF
+
+            F  OF  \ cr s" 2B Booting from SAS - w. Timeout" log-string cr
+		s" sas" add-boot-device ENDOF
+
+            SCSI  OF  \ cr s" 2B Booting from SAS - Continuous Retry" log-string cr
+		s" sas" add-boot-device ENDOF
+
+         ENDCASE
+      LOOP
+      bootdevice 2@ nip
+      IF 0
+      ELSE
+	 \ Check for all no device -> use boot-device  
+	 vpd-bootlist l@ 07070707 = IF 0 ELSE -6b THEN 
+      THEN
+   ELSE -6a THEN
+   boot-exception-handler
+;
+
+: vpd-bootlist-restore-default  ( -- )
+   NOTSPECIFIED vpd-bootlist 0 + c!
+   NOTSPECIFIED vpd-bootlist 1 + c!
+   NOTSPECIFIED vpd-bootlist 2 + c!
+   HDD0 vpd-bootlist 3 + c!
+   vpd-write-bootlist
+;
+
diff --git a/qemu/roms/SLOF/slof/fs/xmodem.fs b/qemu/roms/SLOF/slof/fs/xmodem.fs
new file mode 100644
index 000000000..122192212
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/xmodem.fs
@@ -0,0 +1,120 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2008 IBM Corporation
+\ * All rights reserved.
+\ * This program and the accompanying materials
+\ * are made available under the terms of the BSD License
+\ * which accompanies this distribution, and is available at
+\ * http://www.opensource.org/licenses/bsd-license.php
+\ *
+\ * Contributors:
+\ *     IBM Corporation - initial implementation
+\ ****************************************************************************/
+
+
+01 CONSTANT XM-SOH   \ Start of header
+04 CONSTANT XM-EOT   \ End-of-transmission
+06 CONSTANT XM-ACK   \ Acknowledge
+15 CONSTANT XM-NAK   \ Neg. acknowledge
+
+0 VALUE xm-retries   \ Retry count
+0 VALUE xm-block#
+
+
+\ *
+\ * Internal function:
+\ * wait <timeout> seconds for a new character
+\ *
+: xmodem-get-byte  ( timeout -- byte|-1 )
+   d# 1000 *
+   0 DO
+      key? IF key UNLOOP EXIT THEN
+      1 ms
+   LOOP
+   -1
+;
+
+
+\ *
+\ * Internal function:
+\ * Receive one XMODEM packet, check block number and check sum.
+\ *
+: xmodem-rx-packet  ( address -- success? )
+   1 xmodem-get-byte    \ Get block number
+   dup 0 < IF
+      2drop false EXIT  \ Timeout
+   THEN
+   1 xmodem-get-byte    \ Get neg. block number
+   dup 0 < IF
+      3drop false EXIT  \ Timeout
+   THEN
+   rot 0                ( blk# ~blk# address chksum )
+   80 0 DO
+      1 xmodem-get-byte dup 0 < IF     ( blk# ~blk# address chksum byte )
+         3drop 2drop UNLOOP FALSE EXIT
+      THEN
+      dup 3 pick c!            ( blk# ~blk# address chksum byte )
+      + swap 1+ swap           ( blk# ~blk# address+1 chksum' )
+   LOOP
+   ( blk# ~blk# address chksum )
+   \ Check sum:
+   0ff and
+   1 xmodem-get-byte <> IF
+      \ CRC failed!
+      3drop FALSE EXIT
+   THEN
+   drop                        ( blk# ~blk# )
+   \ finally check if block numbers are ok:
+   over xm-block# <> IF
+      \ Wrong block number!
+      2drop FALSE EXIT
+   THEN                        ( blk# ~blk# )
+   ff xor =
+;
+
+
+\ *
+\ * Internal function:
+\ * Load file to given address via XMODEM protocol
+\ *
+: (xmodem-load)  ( address -- bytes )
+   1 to xm-block#
+   0 to xm-retries
+   dup
+   BEGIN
+      d# 10 xmodem-get-byte dup >r
+      CASE
+         XM-SOH OF
+            dup xmodem-rx-packet IF
+               \ A packet has been received successfully
+               XM-ACK emit
+               80 +                     ( start-addr next-addr  R: rx-byte )
+               0 to xm-retries                    \ Reset retry count
+               xm-block# 1+ ff and to xm-block#   \ Increase current block#
+            ELSE
+               \ Error while receiving packet
+               XM-NAK emit
+               xm-retries 1+ to xm-retries  \ Increase retry count
+            THEN
+         ENDOF
+         XM-EOT OF
+            XM-ACK emit
+         ENDOF
+         dup OF
+            XM-NAK emit
+            xm-retries 1+ to xm-retries  \ Increase retry count
+         ENDOF
+      ENDCASE
+      r> XM-EOT =
+      xm-retries d# 10 >= OR
+   UNTIL                         ( start-address end-address )
+   swap -                        ( bytes received )
+;
+
+
+\ *
+\ * Load file to load-base via XMODEM protocol
+\ *
+: xmodem-load  ( -- bytes )
+   cr ." Waiting for start of XMODEM upload..." cr
+   get-load-base (xmodem-load)
+;