summaryrefslogtreecommitdiffstats
path: root/qemu/roms/openbios/forth/debugging/see.fs
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/openbios/forth/debugging/see.fs
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/openbios/forth/debugging/see.fs')
-rw-r--r--qemu/roms/openbios/forth/debugging/see.fs114
1 files changed, 114 insertions, 0 deletions
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) ;