Diff for /gforth/see.fs between versions 1.26 and 1.27

version 1.26, 2000/05/27 18:55:55 version 1.27, 2000/06/14 20:31:47
Line 514  Defer xt-see-xt ( xt -- ) Line 514  Defer xt-see-xt ( xt -- )
     then      then
     space ;      space ;
   
 Defer discode ( addr -- )  Defer discode ( addr u -- )
 \  hook for the disassembler: disassemble code at addr (as far as the  \  hook for the disassembler: disassemble code at addr of length u
 \  disassembler thinks is sensible)  ' dump IS discode
 :noname ( addr -- )  
     drop ." ..." ;  : next-head ( addr1 -- addr2 ) \ gforth
 IS discode      \G find the next header starting after addr1, up to here (unreliable).
       here swap u+do
           i head?
           if
               i unloop exit
           then
       cell +loop
       here ;
   
   : umin ( u1 u2 -- u )
       2dup u>
       if
           swap
       then
       drop ;
           
   : next-prim ( addr1 -- addr2 )
       \G find the next primitive after addr1
       1+ >r -1 primstart
       begin ( umin head R: boundary )
           @ dup
       while
           tuck name>int >code-address ( head1 umin c-addr )
           r@ - umin
           swap
       repeat
       drop r> + ;
   
 : seecode ( xt -- )  : seecode ( xt -- )
     dup s" Code" .defname      dup s" Code" .defname
Line 527  IS discode Line 553  IS discode
     if      if
         >code-address          >code-address
     then      then
     discode      dup in-dictionary? \ user-defined code word?
     ."  end-code" cr ;      if
           dup next-head
       else
           dup next-prim
       then
       over - discode
       ." end-code" cr ;
 : seevar ( xt -- )  : seevar ( xt -- )
     s" Variable" .defname cr ;      s" Variable" .defname cr ;
 : seeuser ( xt -- )  : seeuser ( xt -- )
Line 590  IS discode Line 622  IS discode
 [ [IFDEF] dofield: ]  [ [IFDEF] dofield: ]
         dofield: of seefield endof          dofield: of seefield endof
 [ [THEN] ]  [ [THEN] ]
         over >body of seecode endof          over       of seecode endof \ direct threaded code words
           over >body of seecode endof \ indirect threaded code words
         2drop abort" unknown word type"          2drop abort" unknown word type"
     ENDCASE ;      ENDCASE ;
   

Removed from v.1.26  
changed lines
  Added in v.1.27


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