[BACK]Return to see.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

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

version 1.26, 2000/05/27 18:55:55 version 1.28, 2000/06/15 09:01:11
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 -- ) \ gforth
 \  hook for the disassembler: disassemble code at addr (as far as the  \G 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 ) \ gforth
       \G find the next primitive after addr1 (unreliable)
       1+ >r -1 primstart
       begin ( umin head R: boundary )
           @ dup
       while
           tuck name>int >code-address ( head1 umin ca R: boundary )
           r@ - umin
           swap
       repeat
       drop dup r@ negate u>=
       \ "umin+boundary within [0,boundary)" = "umin within [-boundary,0)"
       if ( umin R: boundary ) \ no primitive found behind -> use a default length
           drop 31
       then
       r> + ;
   
 : seecode ( xt -- )  : seecode ( xt -- )
     dup s" Code" .defname      dup s" Code" .defname
Line 527  IS discode Line 558  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 627  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.28

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