Add qemu 2.4.0

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

5 files changed, 535 insertions, 0 deletions

diff --git a/qemu/roms/openbios/forth/debugging/build.xml b/qemu/roms/openbios/forth/debugging/build.xml
new file mode 100644
index 000000000..3b9a0ca44
--- /dev/null
+++ b/qemu/roms/openbios/forth/debugging/build.xml
@@ -0,0 +1,18 @@
+<build>
+
+ <!--
+  build description for forth debugging command group
+ 
+  Copyright (C) 2004-2005 by Stefan Reinauer
+  See the file "COPYING" for further information about
+  the copyright and warranty status of this work.
+  -->
+
+ <dictionary name="openbios" target="forth">
+  <object source="client.fs"/>
+  <object source="fcode.fs"/>
+  <object source="firmware.fs"/>
+  <object source="see.fs"/>
+ </dictionary>
+
+</build>
diff --git a/qemu/roms/openbios/forth/debugging/client.fs b/qemu/roms/openbios/forth/debugging/client.fs
new file mode 100644
index 000000000..f37440445
--- /dev/null
+++ b/qemu/roms/openbios/forth/debugging/client.fs
@@ -0,0 +1,299 @@
+\ 7.6 Client Program Debugging command group
+
+
+\ 7.6.1    Registers display
+
+: ctrace    ( -- )
+  ;
+  
+: .registers    ( -- )
+  ;
+
+: .fregisters    ( -- )
+  ;
+
+\ to    ( param [old-name< >] -- )
+
+
+\ 7.6.2    Program download and execute
+
+struct ( saved-program-state )
+  /n field >sps.entry
+  /n field >sps.file-size
+  /n field >sps.file-type
+constant saved-program-state.size
+create saved-program-state saved-program-state.size allot
+
+variable state-valid
+0 state-valid !
+
+variable file-size
+
+: !load-size file-size ! ;
+
+: load-size file-size @ ;
+
+
+\ File types identified by (init-program)
+
+0  constant elf-boot
+1  constant elf
+2  constant bootinfo
+3  constant xcoff
+4  constant pe
+5  constant aout
+10 constant fcode
+11 constant forth
+12 constant bootcode
+
+
+: init-program    ( -- )
+  \ Call down to the lower level for relocation etc.
+  s" (init-program)" $find if
+    execute
+  else
+    s" Unable to locate (init-program)!" type cr
+  then
+  ;
+
+: (find-bootdevice) ( param-str param-len -- bootpath-str bootpath-len)
+  \ Parse the <param> string which is a space-separated list of one or
+  \ more potential boot devices, and return the first one that can be
+  \ successfully opened.
+
+  \ Space-separated bootpath string
+  bl left-split 	\ bootpathstr bootpathstr-len bootdevstr bootdevstr-len
+  dup 0= if
+
+    \ None specified. As per IEEE-1275 specification, search through each value
+    \ in boot-device and use the first that returns a valid ihandle on open.
+
+    2drop		\ drop the empty device string as we're going to use our own
+
+    s" boot-device" $find drop execute 
+    bl left-split
+    begin 
+      dup 
+    while
+      2dup s" Trying " type type s" ..." type cr
+      2dup open-dev ?dup if
+        close-dev
+	2swap drop 0	\ Fake end of string so we exit loop
+      else
+        2drop
+        bl left-split
+      then
+    repeat
+    2drop
+  then
+
+  \ bootargs
+  2swap dup 0= if
+    \ None specified, use default from nvram
+    2drop s" boot-file" $find drop execute
+  then
+
+  \ Set the bootargs property
+  encode-string
+  " /chosen" (find-dev) if
+    " bootargs" rot (property)
+  then
+;
+
+\ Locate the boot-device opened by this ihandle (currently taken as being
+\ the first non-interposed package in the instance chain)
+
+: ihandle>boot-device-handle ( ihandle -- 0 | device-ihandle -1 )
+  >r 0
+  begin r> dup >in.my-parent @ dup >r while
+    ( result ihandle R: ihandle.parent )
+    dup >in.interposed @ 0= if
+      \ Find the first non-interposed package
+      over 0= if
+        swap drop
+      else
+        drop
+      then
+    else
+      drop
+    then
+  repeat
+  r> drop drop
+
+  dup 0<> if
+    -1
+  then
+;
+
+: $load ( devstr len )
+  open-dev ( ihandle )
+  dup 0= if
+    drop
+    exit
+  then
+  dup >r
+  " load-base" evaluate swap ( load-base ihandle )
+  dup ihandle>phandle " load" rot find-method ( xt 0|1 )
+  if swap call-package !load-size else cr ." Cannot find load for this package" 2drop then
+
+  \ If the boot device path doesn't contain an explicit partition id, e.g. cd:,\\:tbxi
+  \ then the interposed partition package may have auto-probed a suitable partition. If
+  \ this is the case then it will have set the " selected-partition-args" property in
+  \ the partition package to contain the new device arguments.
+  \
+  \ In order to ensure that bootpath contains the partition argument, we use the contents
+  \ of this property if it exists to override the boot device arguments when generating
+  \ the full bootpath using get-instance-path.
+
+  my-self
+  r@ to my-self
+  " selected-partition-args" get-inherited-property 0= if
+    decode-string 2swap 2drop
+    ( myself-save partargs-str partargs-len )
+    r@ ihandle>boot-device-handle if
+      ( myself-save partargs-str partargs-len block-ihandle )
+      \ Override the arguments before get-instance-path
+      dup >in.arguments 2@ >r >r dup >r    ( R: block-ihandle arg-len arg-str )
+      >in.arguments 2!    ( myself-save )
+      r@ " get-instance-path" $find if
+        execute   ( myself-save bootpathstr bootpathlen )
+      then
+      \ Now write the original arguments back
+      r> r> r> rot >in.arguments 2!   ( myself-save bootpathstr bootpathlen  R: )
+      rot    ( bootpathstr bootpathlen myself-save )
+    then
+  else
+    my-self " get-instance-path" $find if
+      execute  ( myself-save bootpathstr pathlen )
+      rot    ( bootpathstr bootpathlen myself-save )
+    then
+  then
+  to my-self
+
+  \ Set bootpath property in /chosen
+  encode-string " /chosen" (find-dev) if
+    " bootpath" rot (property)
+  then
+
+  r> close-dev
+  init-program
+  ;
+
+: load    ( "{params}<cr>" -- )
+  linefeed parse
+  (find-bootdevice)
+  $load
+;
+
+: dir ( "{paths}<cr>" -- )
+  linefeed parse
+  ascii , split-after
+  2dup open-dev dup 0= if
+    drop
+    cr ." Unable to locate device " type
+    2drop
+    exit
+  then
+  -rot 2drop -rot 2 pick
+  " dir" rot ['] $call-method catch
+  if
+    3drop
+    cr ." Cannot find dir for this package"
+  then
+  close-dev
+;
+
+: go    ( -- )
+  state-valid @ not if
+    s" No valid state has been set by load or init-program" type cr
+    exit 
+  then
+
+  \ Call the architecture-specific code to launch the client image
+  s" (go)" $find if
+    execute
+  else
+    ." go is not yet implemented"
+    2drop
+  then
+  ;
+
+
+\ 7.6.3    Abort and resume
+
+\ already defined !?
+\ : go    ( -- )
+\   ;
+
+  
+\ 7.6.4    Disassembler
+
+: dis    ( addr -- )
+  ;
+  
+: +dis    ( -- )
+  ;
+
+\ 7.6.5    Breakpoints
+: .bp    ( -- )
+  ;
+
+: +bp    ( addr -- )
+  ;
+
+: -bp    ( addr -- )
+  ;
+
+: --bp    ( -- )
+  ;
+
+: bpoff    ( -- )
+  ;
+
+: step    ( -- )
+  ;
+
+: steps    ( n -- )
+  ;
+
+: hop    ( -- )
+  ;
+
+: hops    ( n -- )
+  ;
+
+\ already defined
+\ : go    ( -- )
+\   ;
+
+: gos    ( n -- )
+  ;
+
+: till    ( addr -- )
+  ;
+
+: return    ( -- )
+  ;
+
+: .breakpoint    ( -- )
+  ;
+
+: .step    ( -- )
+  ;
+
+: .instruction    ( -- )
+  ;
+
+
+\ 7.6.6    Symbolic debugging
+: .adr    ( addr -- )
+  ;
+
+: sym    ( "name< >" -- n )
+  ;
+
+: sym>value    ( addr len -- addr len false | n true )
+  ;
+
+: value>sym    ( n1 -- n1 false | n2 addr len true )
+  ;
diff --git a/qemu/roms/openbios/forth/debugging/fcode.fs b/qemu/roms/openbios/forth/debugging/fcode.fs
new file mode 100644
index 000000000..76099558d
--- /dev/null
+++ b/qemu/roms/openbios/forth/debugging/fcode.fs
@@ -0,0 +1,14 @@
+\ 7.7 FCode Debugging command group
+
+\ The user interface versions of these FCode functions allow
+\ the user to debug FCode programs by providing named commands 
+\ corresponding to FCode functions.
+
+: headerless    ( -- )
+  ;
+
+: headers    ( -- )
+  ;
+
+: apply    ( ... "method-name< >device-specifier< >" -- ??? )
+  ;
diff --git a/qemu/roms/openbios/forth/debugging/firmware.fs b/qemu/roms/openbios/forth/debugging/firmware.fs
new file mode 100644
index 000000000..5e16a6c57
--- /dev/null
+++ b/qemu/roms/openbios/forth/debugging/firmware.fs
@@ -0,0 +1,90 @@
+\ 7.5 Firmware Debugging command group
+
+
+\ 7.5.1    Automatic stack display
+
+: (.s
+  depth 0 ?do
+    depth i - 1- pick .
+  loop
+  depth 0<> if ascii < emit space then
+  ;
+
+: showstack    ( -- )
+  ['] (.s to status
+  ;
+  
+: noshowstack    ( -- )
+  ['] noop to status
+  ;
+
+\ 7.5.2    Serial download
+
+: dl    ( -- )
+  ;
+
+  
+\ 7.5.3    Dictionary
+
+\ 7.5.3.1    Dictionary search
+: .calls    ( xt -- )
+  ;
+  
+: $sift    ( text-addr text-len -- )
+  ;
+  
+: sifting    ( "text< >" -- )
+  ;
+
+\ : words    ( -- )
+\   \ Implemented in forth bootstrap.
+\   ;
+
+  
+\ 7.5.3.2    Decompiler
+
+\ implemented in see.fs
+
+\ : see    ( "old-name< >" -- )
+\   ;
+  
+\ : (see)    ( xt -- )
+\   ;
+
+  
+\ 7.5.3.3    Patch
+
+: patch ( "new-name< >old-name< >word-to-patch< >" -- )
+  ;
+
+: (patch)    ( new-n1 num1? old-n2 num2? xt -- )
+  ;
+
+
+\ 7.5.3.4    Forth source-level debugger
+ 
+: debug    ( "old-name< >" -- )
+  parse-word            \ Look up word CFA in dictionary
+  $find
+  0 = if
+    ." could not locate word for debugging"
+    2drop
+  else
+    (debug
+  then
+  ;
+  
+: stepping    ( -- )
+  ;
+  
+: tracing    ( -- )
+  ;
+  
+: debug-off    ( -- )
+  (debug-off)
+  ;
+  
+: resume    ( -- )
+  \ Set interpreter termination flag
+  1 to terminate?
+  ;
diff --git a/qemu/roms/openbios/forth/debugging/see.fs b/qemu/roms/openbios/forth/debugging/see.fs
new file mode 100644
index 000000000..6977d29eb
--- /dev/null
+++ b/qemu/roms/openbios/forth/debugging/see.fs
@@ -0,0 +1,114 @@
+\ tag: Forth Decompiler 
+\ 
+\ this code implements IEEE 1275-1994 ch. 7.5.3.2
+\ 
+\ Copyright (C) 2003 Stefan Reinauer
+\ 
+\ See the file "COPYING" for further information about
+\ the copyright and warranty status of this work.
+\ 
+
+1 value (see-indent) 
+
+: (see-cr)
+  cr (see-indent) spaces
+  ;
+
+: indent+
+  (see-indent) 2+ to (see-indent)
+  ;
+
+: indent-
+  (see-indent) 2- to (see-indent)
+  ;
+  
+: (see-colon)
+  dup ." : " cell - lfa2name type (see-cr)
+   begin
+   cell+ dup @ dup ['] (semis) <>
+   while
+    space
+    dup
+    case
+
+      ['] do?branch of
+        ." if" (see-cr) indent+
+        drop cell+ 
+      endof
+      
+      ['] dobranch of
+      	." then" indent- (see-cr)
+	drop cell+ 
+      endof
+      
+      ['] (begin) of
+        ." begin" indent+ (see-cr) 
+	drop
+      endof
+
+      ['] (again) of
+      	." again" (see-cr) 
+	drop
+      endof
+
+      ['] (until) of
+        ." until" (see-cr)
+	drop
+      endof
+
+      ['] (while) of
+        indent- (see-cr)
+      	."  while" 
+	indent+ (see-cr)
+	drop 2 cells +
+      endof
+
+      ['] (repeat) of
+        indent- (see-cr) 
+        ."  repeat" 
+	(see-cr) 
+        drop 2 cells +
+      endof
+
+      ['] (lit) of
+        ." ( lit ) h# " 
+	drop 1 cells +
+	dup @ u.
+      endof
+
+      ['] (") of
+        22 emit space drop dup cell+ @ 
+	2dup swap 2 cells + swap type 
+	22 emit
+	+ aligned cell+
+      endof
+
+      cell - lfa2name type 
+    endcase
+   repeat
+  cr ."   ;"
+  2drop
+  ;
+
+: (see) ( xt -- )
+  cr
+  dup @ case
+    1 of 
+      (see-colon)  
+    endof
+    3 of 
+      ." constant " dup cell - lfa2name type ."  =  " execute . 
+    endof
+    4 of 
+      ." variable " dup cell - lfa2name type ."  =  " execute @ . 
+    endof
+    5 of 
+      ." defer " dup  cell - lfa2name type cr 
+      ." is " cell+ @ cell - lfa2name type cr
+    endof
+    ." primword " swap cell - lfa2name type 
+  endcase
+  cr
+  ;
+
+: see ' (see) ;