--- gforth/see.fs	2002/12/26 14:09:20	1.45
+++ gforth/see.fs	2004/01/13 16:00:55	1.53
@@ -1,6 +1,6 @@
 \ SEE.FS       highend SEE for ANSforth                16may93jaw
 
-\ Copyright (C) 1995,2000 Free Software Foundation, Inc.
+\ Copyright (C) 1995,2000,2003 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -28,19 +28,6 @@
 require look.fs
 require termsize.fs
 require wordinfo.fs
-[IFUNDEF] .name
-: id. ( nt -- ) \ gforth
-    \G Print the name of the word represented by @var{nt}.
-    \ this name comes from fig-Forth
-    name>string type space ;
-
-' id. alias .id ( nt -- )
-\G F83 name for @code{id.}.
-
-' id. alias .name ( nt -- )
-\G Gforth <=0.5.0 name for @code{id.}.
-
-[THEN]
 
 decimal
 
@@ -275,21 +262,25 @@ VARIABLE C-Pass
 : back? ( addr target -- addr flag )
     over u< ;
 
-: .word ( addr xt -- addr )
-    look 0= IF
-	drop dup 1 cells - @ dup body> look
-	IF
-	    nip dup ." <" name>string rot wordinfo .string ." >"
-	ELSE
-	    drop ." <" 0 .r ." >"
-	THEN
-    ELSE
-	dup cell+ @ immediate-mask and
-	IF
-	    bl cemit  ." POSTPONE "
-	THEN
-	dup name>string rot wordinfo .string
-    THEN ;
+: .word ( addr x -- addr )
+    \ print x as a word if possible
+    dup look 0= IF
+	drop dup threaded>name dup 0= if
+	    2drop dup 1 cells - @ dup body> look
+	    IF
+		nip dup ." <" name>string rot wordinfo .string ." > "
+	    ELSE
+		drop ." <" 0 .r ." > "
+	    THEN
+	    EXIT
+	then
+    THEN
+    nip dup cell+ @ immediate-mask and
+    IF
+	bl cemit  ." POSTPONE "
+    THEN
+    dup name>string rot wordinfo .string
+    ;
 
 : c-call ( addr1 -- addr2 )
     Display? IF
@@ -327,8 +318,9 @@ VARIABLE C-Pass
     cell+ ;
 
 : .name-without ( addr -- addr )
-\ prints a name without a() e.g. a(+LOOP) or (s")
-    dup 1 cells - @ look IF
+    \ !! the stack effect cannot be correct
+    \ prints a name without a() e.g. a(+LOOP) or (s")
+    dup 1 cells - @ threaded>name dup IF
 	name>string over c@ 'a = IF
 	    1 /string
 	THEN
@@ -354,8 +346,9 @@ VARIABLE C-Pass
     \ if f is false, addr2=addr1
     \ recognizes the following patterns:
     \ c":     ahead X: len string then lit X
-    \ s\":    ahead X: string then lit X lit len
-    \ .\":    ahead X: string then lit X lit len type
+    \ flit:   ahead X: float      then lit X f@
+    \ s\":    ahead X: string     then lit X lit len
+    \ .\":    ahead X: string     then lit X lit len type
     \ !! not recognized anywhere:
     \ abort": if ahead X: len string then lit X c(abort") then
     dup @ back? if false exit endif
@@ -363,8 +356,8 @@ VARIABLE C-Pass
     r@ @ decompile-prim ['] lit xt>threaded <> if rdrop false exit endif
     r@ cell+ @ over cell+ <> if rdrop false exit endif
     \ we have at least C"
-    r@ 2 cells + @ decompile-prim ['] lit xt>threaded = if
-	r@ 3 cells + @ over cell+ + aligned r@ = if
+    r@ 2 cells + @ decompile-prim dup ['] lit xt>threaded = if
+	drop r@ 3 cells + @ over cell+ + aligned r@ = if
 	    \ we have at least s"
 	    r@ 4 cells + @ decompile-prim ['] lit-perform xt>threaded =
 	    r@ 5 cells + @ ['] type >body = and if
@@ -381,6 +374,12 @@ VARIABLE C-Pass
 	    nip cells r> + true exit
 	endif
     endif
+    ['] f@ xt>threaded = if
+	display? if
+	    r@ cell+ @ f@ 10 8 16 f>str-rdp 0 .string bl cemit
+	endif
+	drop r> 3 cells + true exit
+    endif
     \ !! check if count matches space?
     display? if
 	s\" c\" " 0 .string r@ cell+ @ count 0 .string '" cemit bl cemit
@@ -561,19 +560,19 @@ CREATE C-Table
 [IFDEF] "lit    ' "lit A,           ' c-c" A, [THEN]
 [IFDEF] (c")	' (c") A,	    ' c-c" A, [THEN]
         	' (do) A,           ' c-do A,
-[IFDEF] (+do)	' a(+do) A,	    ' c-?do A, [THEN]
-[IFDEF] (u+do)	' a(u+do) A,	    ' c-?do A, [THEN]
-[IFDEF] (-do)	' a(-do) A,	    ' c-?do A, [THEN]
-[IFDEF] (u-do)	' a(u-do) A,	    ' c-?do A, [THEN]
-        	' a(?do) A,         ' c-?do A,
+[IFDEF] (+do)	' (+do) A,	    ' c-?do A, [THEN]
+[IFDEF] (u+do)	' (u+do) A,	    ' c-?do A, [THEN]
+[IFDEF] (-do)	' (-do) A,	    ' c-?do A, [THEN]
+[IFDEF] (u-do)	' (u-do) A,	    ' c-?do A, [THEN]
+        	' (?do) A,          ' c-?do A,
         	' (for) A,          ' c-for A,
-        	' a?branch A,       ' c-?branch A,
-        	' abranch A,        ' c-branch A,
-        	' a(loop) A,        ' c-loop A,
-        	' a(+loop) A,       ' c-loop A,
-[IFDEF] (s+loop) ' a(s+loop) A,     ' c-loop A, [THEN]
-[IFDEF] (-loop) ' a(-loop) A,       ' c-loop A, [THEN]
-        	' a(next) A,        ' c-loop A,
+        	' ?branch A,        ' c-?branch A,
+        	' branch A,         ' c-branch A,
+        	' (loop) A,         ' c-loop A,
+        	' (+loop) A,        ' c-loop A,
+[IFDEF] (s+loop) ' (s+loop) A,      ' c-loop A, [THEN]
+[IFDEF] (-loop) ' (-loop) A,        ' c-loop A, [THEN]
+        	' (next) A,         ' c-loop A,
         	' ;s A,             ' c-exit A,
 [IFDEF] (abort") ' (abort") A,      ' c-abort" A, [THEN]
 \ only defined if compiler is loaded
@@ -722,7 +721,7 @@ Defer discode ( addr u -- ) \ gforth
     >name ?dup-if
 	." IS " .name cr
     else
-	." lastxt >body !"
+	." latestxt >body !"
     then ;
 : see-threaded ( addr -- )
     C-Pass @ DebugMode = IF
@@ -774,7 +773,7 @@ Defer discode ( addr u -- ) \ gforth
     ENDCASE ;
 
 : (xt-see-xt) ( xt -- )
-    xt-see cr ." lastxt" ;
+    xt-see cr ." latestxt" ;
 ' (xt-see-xt) is xt-see-xt
 
 : (.immediate) ( xt -- )
@@ -795,7 +794,7 @@ Defer discode ( addr u -- ) \ gforth
 	else \ interpret/compile word
 	    r@ xt-see-xt cr
 	    swap xt-see-xt cr
-	    ." interpret/compile " over .name (.immediate)
+	    ." interpret/compile: " over .name drop
 	then
     then
     rdrop drop ;