[gforth] / gforth / see.fs  

gforth: gforth/see.fs

Diff for /gforth/see.fs between version 1.43 and 1.44

version 1.43, Fri Dec 13 21:20:39 2002 UTC version 1.44, Wed Dec 25 21:16:54 2002 UTC
Line 248 
Line 248 
 : back? ( n -- flag ) 0< ;  : back? ( n -- flag ) 0< ;
 : ahead? ( n -- flag ) 0> ;  : ahead? ( n -- flag ) 0> ;
   
 : c-lit  
     Display? IF  
         dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit  
     THEN  
     cell+ ;  
   
 : .word ( addr xt -- addr )  : .word ( addr xt -- addr )
     look 0= IF      look 0= IF
         drop dup 1 cells - @ dup body> look          drop dup 1 cells - @ dup body> look
Line 270 
Line 264 
         dup name>string rot wordinfo .string          dup name>string rot wordinfo .string
     THEN ;      THEN ;
   
 : c-call  : c-call ( addr1 -- addr2 )
     Display? IF  ." call " dup @ body> .word bl cemit  THEN  cell+ ;      Display? IF
           dup @ body> .word bl cemit
       THEN
       cell+ ;
   
   : c-callxt ( addr1 -- addr2 )
       Display? IF
           dup @ .word bl cemit
       THEN
       cell+ ;
   
   \ here docon: , docol: , dovar: , douser: , dodefer: , dofield: ,
   \ here over - 2constant doers
   
   : c-lit ( addr1 -- addr2 )
       Display? IF
           dup @ dup body> dup cfaligned over = swap in-dictionary? and if
               ( addr1 addr1@ )
               dup body> @ dovar: = if
                   drop c-call EXIT
               endif
           endif
           \ !! test for cfa here, and print "['] ..."
           dup abs 0 <# #S rot sign #> 0 .string bl cemit
       endif
       cell+ ;
   
   : c-lit+ ( addr1 -- addr2 )
       Display? if
           dup @ dup abs 0 <# #S rot sign #> 0 .string bl cemit
           s" + " 0 .string
       endif
       cell+ ;
   
 : .name-without ( addr -- addr )  : .name-without ( addr -- addr )
 \ prints a name without () e.g. (+LOOP) or (s")  \ prints a name without () e.g. (+LOOP) or (s")
Line 444 
Line 470 
   
 CREATE C-Table  CREATE C-Table
                 ' lit A,            ' c-lit A,                  ' lit A,            ' c-lit A,
                   ' does-exec A,      ' c-callxt A,
                   ' lit@ A,           ' c-call A,
 [IFDEF] call    ' call A,           ' c-call A, [THEN]  [IFDEF] call    ' call A,           ' c-call A, [THEN]
   \               ' useraddr A,       ....
                   ' lit-perform A,    ' c-call A,
                   ' lit+ A,           ' c-lit+ A,
 [IFDEF] (s")    ' (s") A,           ' c-c" A, [THEN]  [IFDEF] (s")    ' (s") A,           ' c-c" A, [THEN]
 [IFDEF] (.")    ' (.") A,           ' c-c" A, [THEN]  [IFDEF] (.")    ' (.") A,           ' c-c" A, [THEN]
 [IFDEF] "lit    ' "lit A,           ' c-c" A, [THEN]  [IFDEF] "lit    ' "lit A,           ' c-c" A, [THEN]
Line 475 
Line 506 
   
 \ DOTABLE                                               15may93jaw  \ DOTABLE                                               15may93jaw
   
 : DoTable ( cfa -- flag )  : DoTable ( ca/cfa -- flag )
         C-Table      decompile-prim C-Table BEGIN ( cfa table-entry )
         BEGIN   dup @ dup 0=          dup @ dup 0=  IF
                 IF drop cell+ @ dup              drop cell+ @ dup IF ( next table!)
                   IF ( next table!) dup @ ELSE                  dup @
                         ( end!) 2drop false EXIT THEN              ELSE ( end!)
                   2drop false EXIT
               THEN
                 THEN                  THEN
                 \ jump over to extender, if any 26jan97jaw                  \ jump over to extender, if any 26jan97jaw
                 xt>threaded 2 pick <>                  xt>threaded 2 pick <>
         WHILE   2 cells +      WHILE
               2 cells +
         REPEAT          REPEAT
         nip cell+ perform          nip cell+ perform
         true          true

Generate output suitable for use with a patch program
Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help