Add qemu 2.4.0

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

1 files changed, 465 insertions, 0 deletions

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
+;