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