Diff for /gforth/see.fs between versions 1.10 and 1.22

version 1.10, 1996/01/07 17:22:14 version 1.22, 1999/02/16 06:32:30
Line 25 Line 25
   
 \ Ideas:        Level should be a stack  \ Ideas:        Level should be a stack
   
   require look.fs
 require termsize.fs  require termsize.fs
   require wordinfo.fs
   [IFUNDEF] .name : .name name>string type space ; [THEN]
   
 decimal  decimal
   
Line 50  VARIABLE Level Line 53  VARIABLE Level
 : level-        -7 Level +! ;  : level-        -7 Level +! ;
   
 VARIABLE nlflag  VARIABLE nlflag
   VARIABLE uppercase      \ structure words are in uppercase
   
 DEFER nlcount ' noop IS nlcount  DEFER nlcount ' noop IS nlcount
   
 : nl            nlflag on ;  : nl            nlflag on ;
 : (nl)          nlcount  : (nl)          nlcount
                 XPos @ Level @ = ?Exit                  XPos @ Level @ = IF EXIT THEN \ ?Exit
                 C-Formated @ IF                  C-Formated @ IF
                 C-Output @                  C-Output @
                 IF C-Clearline @ IF cols XPos @ - spaces                  IF C-Clearline @ IF cols XPos @ - spaces
Line 68  DEFER nlcount ' noop IS nlcount Line 72  DEFER nlcount ' noop IS nlcount
                 nlflag @ IF (nl) nlflag off THEN                  nlflag @ IF (nl) nlflag off THEN
                 XPos @ over + cols u>= IF (nl) THEN ;                  XPos @ over + cols u>= IF (nl) THEN ;
   
   : c-to-upper ( c1 -- c2 ) \ gforth
       \ nac05feb1999 there is a primitive, toupper, with this function
       dup [char] a >= over [char] z <= and if  bl -  then ;
   
 : ctype         ( adr len -- )  : ctype         ( adr len -- )
                 warp? dup XPos +! C-Output @ IF type ELSE 2drop THEN ;                  warp? dup XPos +! C-Output @ 
                   IF uppercase @ IF bounds ?DO i c@ c-to-upper emit LOOP
                                     uppercase off ELSE type THEN
                   ELSE 2drop THEN ;
   
 : cemit         1 warp?  : cemit         1 warp?
                 over bl = Level @ XPos @ = and                  over bl = Level @ XPos @ = and
Line 98  VARIABLE Colors Colors on Line 109  VARIABLE Colors Colors on
 ' (.string) IS .string  ' (.string) IS .string
   
   
 : .struc        Str# .string ;  : .struc        
           uppercase on Str# .string ;
   
 \ CODES                                                 15may93jaw  \ CODES (Branchtypes)                                    15may93jaw
   
 21 CONSTANT RepeatCode  21 CONSTANT RepeatCode
 22 CONSTANT AgainCode  22 CONSTANT AgainCode
Line 110  VARIABLE Colors Colors on Line 122  VARIABLE Colors Colors on
 11 CONSTANT AheadCode  11 CONSTANT AheadCode
 13 CONSTANT WhileCode2  13 CONSTANT WhileCode2
 14 CONSTANT Disable  14 CONSTANT Disable
   15 CONSTANT LeaveCode
   
   
 \ FORMAT WORDS                                          13jun93jaw  \ FORMAT WORDS                                          13jun93jaw
   
 VARIABLE C-Stop  VARIABLE C-Stop
 VARIABLE Branches  VARIABLE Branches
   
 VARIABLE BranchPointer  VARIABLE BranchPointer  \ point to the end of branch table
 VARIABLE SearchPointer  VARIABLE SearchPointer
   
   \ The branchtable consists of three entrys:
   \ address of branch , branch destination , branch type
   
 CREATE BranchTable 500 allot  CREATE BranchTable 500 allot
 here 3 cells -  here 3 cells -
 ACONSTANT MaxTable  ACONSTANT MaxTable
   
 : FirstBranch BranchTable cell+ SearchPointer ! ;  : FirstBranch BranchTable cell+ SearchPointer ! ;
   
 : (BranchAddr?) ( a-addr -- a-addr true | false )  : (BranchAddr?) ( a-addr1 -- a-addr2 true | false )
   \ searches a branch with destination a-addr1
   \ a-addr1: branch destination
   \ a-addr2: pointer in branch table
         SearchPointer @          SearchPointer @
         BEGIN   dup BranchPointer @ u<          BEGIN   dup BranchPointer @ u<
         WHILE          WHILE
Line 153  ACONSTANT MaxTable Line 174  ACONSTANT MaxTable
         2drop true          2drop true
         THEN ;          THEN ;
   
   : MyBranch      ( a-addr -- a-addr a-addr2 )
   \ finds branch table entry for branch at a-addr
                   dup @ over +
                   BranchAddr?
                   BEGIN
                   WHILE 1 cells - @
                         over <>
                   WHILE dup @ over +
                         MoreBranchAddr?
                   REPEAT
                   SearchPointer @ 3 cells -
                   ELSE    true ABORT" SEE: Table failure"
                   THEN ;
   
 \  \
 \                 addrw               addrt  \                 addrw               addrt
 \       BEGIN ... WHILE ... AGAIN ... THEN  \       BEGIN ... WHILE ... AGAIN ... THEN
Line 216  VARIABLE C-Pass Line 251  VARIABLE C-Pass
     THEN      THEN
     cell+ ;      cell+ ;
   
 : c-@local#  : .name-without ( addr -- addr )
     Display? IF  \ prints a name without () e.g. (+LOOP) or (s")
         S" @local" 0 .string    dup 1 cells - @ look 
         dup @ dup 1 cells / abs 0 <# #S rot sign #> 0 .string bl cemit    IF   name>string over c@ '( = IF 1 /string THEN
     THEN         2dup + 1- c@ ') = IF 1- THEN .struc ELSE drop 
     cell+ ;    THEN ;
   
 : c-flit  
     Display? IF  
         dup f@ scratch represent 0=  
         IF    2drop  scratch 3 min 0 .string  
         ELSE  
             IF  '- cemit  THEN  1-  
             scratch over c@ cemit '. cemit 1 /string 0 .string  
             'E cemit  
             dup abs 0 <# #S rot sign #> 0 .string bl cemit  
         THEN THEN  
     float+ ;  
   
 : c-f@local#  
     Display? IF  
         S" f@local" 0 .string  
         dup @ dup 1 floats / abs 0 <# #S rot sign #> 0 .string bl cemit  
     THEN  
     cell+ ;  
   
 : c-laddr#  
     Display? IF  
         S" laddr# " 0 .string  
         dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit  
     THEN  
     cell+ ;  
   
 : c-lp+!#  
     Display? IF  
         S" lp+!# " 0 .string  
         dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit  
     THEN  
     cell+ ;  
   
 : c-s"  
         count 2dup + aligned -rot  
         Display?  
         IF      [char] S cemit [char] " cemit bl cemit 0 .string  
                 [char] " cemit bl cemit  
         ELSE    2drop  
         THEN ;  
   
 : c-."  
         count 2dup + aligned -rot  
         Display?  
         IF      [char] . cemit  
                 [char] " cemit bl cemit 0 .string  
                 [char] " cemit bl cemit  
         ELSE    2drop  
         THEN ;  
   
 : c-c"  : c-c"
           Display? IF nl .name-without THEN
         count 2dup + aligned -rot          count 2dup + aligned -rot
         Display?          Display?
         IF      [char] C cemit [char] " cemit bl cemit 0 .string          IF      bl cemit 0 .string
                 [char] " cemit bl cemit                  [char] " cemit bl cemit
         ELSE    2drop          ELSE    2drop
         THEN ;          THEN ;
   
   
 : Forward? ( a-addr true | false -- )  : Forward? ( a-addr true | false -- a-addr true | false )
   \ a-addr1 is pointer into branch table
   \ returns true when jump is a forward jump
         IF      dup dup @ swap 1 cells - @ -          IF      dup dup @ swap 1 cells - @ -
                 Ahead? IF true ELSE drop false THEN                  Ahead? IF true ELSE drop false THEN
                 \ only if forward jump                  \ only if forward jump
         ELSE    false THEN ;          ELSE    false THEN ;
   
 : RepeatCheck  : RepeatCheck ( a-addr1 a-addr2 true | false -- false )
         IF  BEGIN  2dup          IF  BEGIN  2dup
                    1 cells - @ swap dup @ +                     1 cells - @ swap dup @ +
                    u<=                     u<=
Line 327  VARIABLE C-Pass Line 315  VARIABLE C-Pass
                         IF      drop S" REPEAT " .struc nl                          IF      drop S" REPEAT " .struc nl
                         ELSE    S" AGAIN " .struc nl                          ELSE    S" AGAIN " .struc nl
                         THEN                          THEN
                 ELSE    dup cell+ BranchAddr? Forward?                  ELSE    MyBranch cell+ @ LeaveCode =
                         IF      dup cell+ @ WhileCode2 =                          IF      S" LEAVE " .struc
                                 IF nl S" ELSE" .struc level+                          ELSE
                                 ELSE level- nl S" ELSE" .struc level+ THEN                                  dup cell+ BranchAddr? Forward?
                                 cell+ Disable swap !                                  IF      dup cell+ @ WhileCode2 =
                         ELSE    S" AHEAD" .struc level+                                          IF nl S" ELSE" .struc level+
                         THEN                                          ELSE level- nl S" ELSE" .struc level+ THEN
                                           cell+ Disable swap !
                                   ELSE    S" AHEAD" .struc level+
                                   THEN
                           THEN
                 THEN                  THEN
         THEN          THEN
         Debug?          Debug?
Line 341  VARIABLE C-Pass Line 333  VARIABLE C-Pass
         ELSE    cell+          ELSE    cell+
         THEN ;          THEN ;
   
 : MyBranch      ( a-addr -- a-addr a-addr2 )  
                 dup @ over +  
                 BranchAddr?  
                 BEGIN  
                 WHILE 1 cells - @  
                       over <>  
                 WHILE dup @ over +  
                       MoreBranchAddr?  
                 REPEAT  
                 SearchPointer @ 3 cells -  
                 ELSE    true ABORT" SEE: Table failure"  
                 THEN ;  
   
 : DebugBranch  : DebugBranch
         Debug?          Debug?
         IF      dup @ over + swap THEN ; \ return 2 different addresses          IF      dup @ over + swap THEN ; \ return 2 different addresses
Line 376  VARIABLE C-Pass Line 355  VARIABLE C-Pass
                                 level- nl                                  level- nl
                                 S" WHILE " .struc                                  S" WHILE " .struc
                                 level+                                  level+
                         ELSE    nl S" IF " .struc level+                          ELSE    MyBranch cell+ @ LeaveCode =
                                   IF   s" 0= ?LEAVE " .struc
                                   ELSE nl S" IF " .struc level+
                                   THEN
                         THEN                          THEN
                 THEN                  THEN
         THEN          THEN
         DebugBranch          DebugBranch
         cell+ ;          cell+ ;
   
 : c-?branch-lp+!#  c-?branch cell+ ;  : c-for
 : c-branch-lp+!#   c-branch  cell+ ;          Display? IF nl S" FOR" .struc level+ THEN ;
   
   : c-loop
           Display? IF level- nl .name-without bl cemit nl THEN
           DebugBranch cell+ 
           Scan? 
           IF      dup BranchAddr? 
                   BEGIN   WHILE cell+ LeaveCode swap !
                           dup MoreBranchAddr?
                   REPEAT
           THEN
           cell+ ;
   
 : c-do  : c-do
         Display? IF nl S" DO" .struc level+ THEN ;          Display? IF nl .name-without level+ THEN ;
   
 : c-?do  : c-?do
         Display? IF nl S" ?DO" .struc level+ THEN          Display? IF nl S" ?DO" .struc level+ THEN
         DebugBranch cell+ ;          DebugBranch cell+ ;
   
 : c-for  
         Display? IF nl S" FOR" .struc level+ THEN ;  
   
 : c-next  
         Display? IF level- nl S" NEXT " .struc nl THEN  
         DebugBranch cell+ cell+ ;  
   
 : c-loop  
         Display? IF level- nl S" LOOP " .struc nl THEN  
         DebugBranch cell+ cell+ ;  
   
 : c-+loop  
         Display? IF level- nl S" +LOOP " .struc nl THEN  
         DebugBranch cell+ cell+ ;  
   
 : c-s+loop  
         Display? IF level- nl S" S+LOOP " .struc nl THEN  
         DebugBranch cell+ cell+ ;  
   
 : c--loop  
         Display? IF level- nl S" -LOOP " .struc nl THEN  
         DebugBranch cell+ cell+ ;  
   
 : c-next-lp+!#  c-next cell+ ;  
 : c-loop-lp+!#  c-loop cell+ ;  
 : c-+loop-lp+!#  c-+loop cell+ ;  
 : c-s+loop-lp+!#  c-s+loop cell+ ;  
 : c--loop-lp+!#  c--loop cell+ ;  
   
 : c-leave  
         Display? IF S" LEAVE " .struc THEN  
         Debug? IF dup @ + THEN cell+ ;  
   
 : c-?leave  
         Display? IF S" ?LEAVE " .struc THEN  
         cell+ DebugBranch swap cell+ swap cell+ ;  
   
 : c-exit  dup 1 cells -  : c-exit  dup 1 cells -
         CheckEnd          CheckEnd
         IF      Display? IF nlflag off S" ;" Com# .string THEN          IF      Display? IF nlflag off S" ;" Com# .string THEN
Line 440  VARIABLE C-Pass Line 396  VARIABLE C-Pass
   
 : c-does>               \ end of create part  : c-does>               \ end of create part
         Display? IF S" DOES> " Com# .string THEN          Display? IF S" DOES> " Com# .string THEN
         Cell+ cell+ ;          maxaligned /does-handler + ;
   
 : c-abort"  : c-abort"
         count 2dup + aligned -rot          count 2dup + aligned -rot
Line 453  VARIABLE C-Pass Line 409  VARIABLE C-Pass
   
   
 CREATE C-Table  CREATE C-Table
         ' lit A,            ' c-lit A,                  ' lit A,            ' c-lit A,
         ' @local# A,        ' c-@local# A,                  ' (s") A,           ' c-c" A,
         ' flit A,           ' c-flit A,                   ' (.") A,          ' c-c" A,
         ' f@local# A,       ' c-f@local# A,                  ' "lit A,           ' c-c" A,
         ' laddr# A,         ' c-laddr# A,  [IFDEF] (c")    ' (c") A,           ' c-c" A, [THEN]
         ' lp+!# A,          ' c-lp+!# A,                  ' (do) A,           ' c-do A,
         ' (s") A,           ' c-s" A,  [IFDEF] (+do)   ' (+do) A,          ' c-do A, [THEN]
         ' (.") A,           ' c-." A,  [IFDEF] (u+do)  ' (u+do) A,         ' c-do A, [THEN]
         ' "lit A,           ' c-c" A,  [IFDEF] (-do)   ' (-do) A,          ' c-do A, [THEN]
         ' leave A,          ' c-leave A,  [IFDEF] (u-do)  ' (u-do) A,         ' c-do A, [THEN]
         ' ?leave A,         ' c-?leave A,                  ' (?do) A,          ' c-?do A,
         ' (do) A,           ' c-do A,                  ' (for) A,          ' c-for A,
         ' (?do) A,          ' c-?do A,                  ' ?branch A,        ' c-?branch A,
         ' (for) A,          ' c-for A,                  ' branch A,         ' c-branch A,
         ' ?branch A,        ' c-?branch A,                  ' (loop) A,         ' c-loop 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]
         ' (+loop) A,        ' c-+loop A,  [IFDEF] (-loop) ' (-loop) A,        ' c-loop A, [THEN]
         ' (s+loop) A,       ' c-s+loop A,                  ' (next) A,         ' c-loop A,
         ' (-loop) A,        ' c--loop A,                  ' ;s A,             ' c-exit A,
         ' (next) A,         ' c-next A,                  ' (does>) A,        ' c-does> A,
         ' ?branch-lp+!# A,  ' c-?branch-lp+!# A,                  ' (abort") A,       ' c-abort" A,
         ' branch-lp+!# A,   ' c-branch-lp+!# A,                  ' (compile) A,      ' c-(compile) A,
         ' (loop)-lp+!# A,   ' c-loop-lp+!# A,                  0 ,             here 0 ,
         ' (+loop)-lp+!# A,  ' c-+loop-lp+!# A,  
         ' (s+loop)-lp+!# A, ' c-s+loop-lp+!# A,  avariable c-extender
         ' (-loop)-lp+!# A,  ' c--loop-lp+!# A,  c-extender !
         ' (next)-lp+!# A,   ' c-next-lp+!# A,  
         ' ;s A,             ' c-exit A,  
         ' (does>) A,        ' c-does> A,  
         ' (abort") A,       ' c-abort" A,  
         ' (compile) A,      ' c-(compile) A,  
         0 ,  
   
 \ DOTABLE                                               15may93jaw  \ DOTABLE                                               15may93jaw
   
 : DoTable ( cfa -- flag )  : DoTable ( cfa -- flag )
         C-Table          C-Table
         BEGIN   dup @ dup          BEGIN   dup @ dup 0= 
         WHILE   2 pick <>                  IF drop cell+ @ dup 
                     IF ( next table!) dup @ ELSE 
                           ( end!) 2drop false EXIT THEN 
                   THEN
                   \ jump over to extender, if any 26jan97jaw
                   2 pick <>
         WHILE   2 cells +          WHILE   2 cells +
         REPEAT          REPEAT
         nip cell+ @ EXECUTE          nip cell+ perform
         true          true
         ELSE          ;
         2drop drop false  
         THEN ;  
   
 : BranchTo? ( a-addr -- a-addr )  : BranchTo? ( a-addr -- a-addr )
         Display?  IF     dup BranchAddr?          Display?  IF    dup BranchAddr?
                         IF BEGIN cell+ @ dup 20 u>                          IF
                                   BEGIN cell+ @ dup 20 u>
                                 IF drop nl S" BEGIN " .struc level+                                  IF drop nl S" BEGIN " .struc level+
                                 ELSE                                  ELSE
                                   dup Disable <>                                    dup Disable <> over LeaveCode <> and
                                   IF   WhileCode2 =                                    IF   WhileCode2 =
                                        IF nl S" THEN " .struc nl ELSE                                         IF nl S" THEN " .struc nl ELSE
                                        level- nl S" THEN " .struc nl THEN                                         level- nl S" THEN " .struc nl THEN
Line 523  CREATE C-Table Line 477  CREATE C-Table
         dup >r DoTable r> swap IF drop EXIT THEN          dup >r DoTable r> swap IF drop EXIT THEN
         Display?          Display?
         IF look 0= IF  drop dup 1 cells - @ .  \ ABORT" SEE: Bua!"          IF look 0= IF  drop dup 1 cells - @ .  \ ABORT" SEE: Bua!"
            ELSE  dup cell+ count 31 and rot wordinfo .string  THEN  bl cemit          ELSE
               dup cell+ count dup immediate-mask and
               IF  bl cemit  ." POSTPONE " THEN
               31 and rot wordinfo .string  THEN  bl cemit
         ELSE drop          ELSE drop
         THEN ;          THEN ;
   
Line 535  CREATE C-Table Line 492  CREATE C-Table
         Branches on ;          Branches on ;
   
 : makepass ( a-addr -- )  : makepass ( a-addr -- )
         c-stop off      c-stop off
         BEGIN      BEGIN
                 analyse          analyse
                 c-stop @          c-stop @
         UNTIL drop ;      UNTIL drop ;
   
 DEFER dosee  Defer xt-see-xt ( xt -- )
   \ this one is just a forward declaration for indirect recursion
 : dopri .name ." is primitive" cr ;  
 : dovar ." Variable " .name cr ;  : .defname ( xt c-addr u -- )
 : douse ." User " .name cr ;      rot look
 : docon  dup cell+ (name>) >body @ . ." Constant " .name cr ;      if ( c-addr u nfa )
 : doval  dup cell+ (name>) >body @ . ." Value " .name cr ;          -rot type space .name
 : dodef ." Defer " dup >r .name cr      else
     r@ cell+ (name>) >body @ look          drop ." noname " type
     0= ABORT" SEE: No valid xt in deferred word"      then
     dup dosee cr      space ;
     ." ' " .name r> ." IS " .name cr ;  
 : dodoe ." Create " dup .name cr  Defer discode ( addr -- )
         S" DOES> " Com# .string XPos @ Level ! name>  \  hook for the disassembler: disassemble code at addr (as far as the
         >does-code dup C-Pass @ DebugMode = IF ScanMode c-pass ! EXIT THEN  \  disassembler thinks is sensible)
         ScanMode c-pass ! dup makepass  :noname ( addr -- )
         DisplayMode c-pass ! makepass ;      drop ." ..." ;
 : doali here @ .name ." Alias " .name cr  IS discode
         here @ dosee ;  
 : docol  : seecode ( xt -- )
     S" : " Com# .string      dup s" Code" .defname
     dup name>string 2 pick wordinfo .string bl cemit bl cemit      threading-method
     ( XPos @ ) 2 Level !      if
     name> >body          >code-address
     C-Pass @ DebugMode =      then
     IF      discode
         ScanMode c-pass ! EXIT      ."  end-code" cr ;
   : seevar ( xt -- )
       s" Variable" .defname cr ;
   : seeuser ( xt -- )
       s" User" .defname cr ;
   : seecon ( xt -- )
       dup >body ?
       s" Constant" .defname cr ;
   : seevalue ( xt -- )
       dup >body ?
       s" Value" .defname cr ;
   : seedefer ( xt -- )
       dup >body @ xt-see-xt cr
       dup s" Defer" .defname cr
       >name dup ??? = if
           drop ." lastxt >body !"
       else
           ." IS " .name cr
       then ;
   : see-threaded ( addr -- )
       C-Pass @ DebugMode = IF
           ScanMode c-pass !
           EXIT
     THEN      THEN
     ScanMode c-pass ! dup makepass      ScanMode c-pass ! dup makepass
     DisplayMode c-pass ! makepass ;      DisplayMode c-pass ! makepass ;
   : seedoes ( xt -- )
 create wordtypes      dup s" create" .defname cr
         Pri# ,   ' dopri A,      S" DOES> " Com# .string XPos @ Level !
         Var# ,   ' dovar A,      >does-code see-threaded ;
         Con# ,   ' docon A,  : seecol ( xt -- )
         Val# ,   ' doval A,      dup s" :" .defname nl
         Def# ,   ' dodef A,      2 Level !
         Doe# ,   ' dodoe A,      >body see-threaded ;
         Ali# ,   ' doali A,  : seefield ( xt -- )
         Col# ,   ' docol A,      dup >body ." 0 " ? ." 0 0 "
         Use# ,   ' douse A,      s" Field" .defname cr ;
         0 ,  
   : xt-see ( xt -- )
 : (dosee) ( lfa -- )      cr c-init
         dup dup cell+ c@ >r      dup >does-code
         wordinfo      if
         wordtypes          seedoes EXIT
         BEGIN dup @ dup      then
         WHILE 2 pick = IF cell+ @ nip EXECUTE      dup xtprim?
                           r> dup 32 and IF ."  immediate" THEN      if
                                  64 and IF ."  restrict" THEN EXIT THEN          seecode EXIT
               2 cells +      then
         REPEAT      dup >code-address
         2drop rdrop      CASE
         .name ." Don't know how to handle" cr ;          docon: of seecon endof
           docol: of seecol endof
 ' (dosee) IS dosee          dovar: of seevar endof
   [ [IFDEF] douser: ]
 : xtc ( xt -- )       \ do see at xt          douser: of seeuser endof
         Look 0= ABORT" SEE: No valid XT"  [ [THEN] ]
         cr c-init  [ [IFDEF] dodefer: ]
         dosee ;          dodefer: of seedefer endof
   [ [THEN] ]
 : see   name sfind 0= IF ." Word unknown" cr exit THEN  [ [IFDEF] dofield: ]
         xtc ;          dofield: of seefield endof
   [ [THEN] ]
 : lfc   cr c-init cell+ dosee ;          over >body of seecode endof
 : nfc   cr c-init dosee ;          2drop abort" unknown word type"
       ENDCASE ;
   
   : (xt-see-xt) ( xt -- )
       xt-see cr ." lastxt" ;
   ' (xt-see-xt) is xt-see-xt
   
   : (.immediate) ( xt -- )
       ['] execute = if
           ."  immediate"
       then ;
   
   : name-see ( nfa -- )
       dup name>int >r
       dup name>comp 
       over r@ =
       if \ normal or immediate word
           swap xt-see (.immediate)
       else
           r@ ['] compile-only-error =
           if \ compile-only word
               swap xt-see (.immediate) ."  compile-only"
           else \ interpret/compile word
               r@ xt-see-xt cr
               swap xt-see-xt cr
               ." interpret/compile " over .name (.immediate)
           then
       then
       rdrop drop ;
   
   : see ( "<spaces>name" -- ) \ tools
       \G Locate @var{name} using the current search order. Display the
       \G definition of @var{name}. Since this is achieved by decompiling
       \G the definition, the formatting is mechanised and some source
       \G information (comments, interpreted sequences within definitions
       \G etc.) is lost.
       name find-name dup 0=
       IF
           drop -&13 bounce
       THEN
       name-see ;
   
   

Removed from v.1.10  
changed lines
  Added in v.1.22


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>