( see DAY 09.04.2001 )

needs case case
needs id. contools
needs colon? patch

variable _closest \ nfa

: NLNK
   N> 2+ W@
;

: WordByAddr ( t-addr  -- nfa -1 | 0 )
  0 _closest !
  DUP LAST @ NLNK > IF DROP 0 EXIT THEN
  >R LAST @
  BEGIN
    DUP NLNK DUP R@ > 0=
    SWAP _closest @ NLNK > AND
    IF DUP _closest ! THEN
    CDR DUP 0=
  UNTIL DROP RDROP 
  _closest @ L>NAME -1
;

: xt>name ( xt -- nfa -1 | 0 )
   wordByAddr
;

: seeLit ( t-addr -- t-addr1 )
   dup t> 2+ @ .
   6 + 
;

: seeWLit ( t-addr -- t-addr1 )
   dup t> 2+ w@ .
   cell+
;

: seeWord ( t-addr -- t-addr1 )
   dup xt>name
   if id.
   else ." [unk]"
   then space
   swap 2+ swap
;

: seeBranch ( t-addr -- t-addr1)
   dup t> 2+ w@ .
   cell+ 
;

: seeSLit ( t-addr -- t-addr1)
   dup t> dup 2+ w@ w>s
   swap cell+ w@ 
   [char] s emit
   [char] " emit bl emit
   type [char] " emit
   6 + space
;

: seeColon ( xt -- )
   2+
   begin
     dup .
     dup t> w@ >r
     r@
     case
         ['] pLit of seeLit endof
         ['] pLitW of seeWLit endof
         ['] pLoop of ." loop " cell+ endof
         ['] pDo   of ." do " cell+ endof
         ['] p?Do  of ." ?do " cell+ endof
         ['] p+Loop of ." +loop " cell+ endof
         ['] p?Branch of ." ?branch->" 
                        seeBranch endof
         ['] pBranch of ." branch->" 
                        seeBranch endof
         ['] pSLit of seeSLit endof
         seeWord
     endcase cr
     r> ['] exit =
   until drop
;

: see ( -- )
  ' dup colon? 0=
  abort" not a colon!"
  dup cr . [char] : emit cr
  seeColon
;