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

Diff for /gforth/see.fs between versions 1.34 and 1.42

version 1.34, 2001/01/28 17:39:33 version 1.42, 2002/12/04 10:42:59
Line 254  VARIABLE C-Pass Line 254  VARIABLE C-Pass
     THEN      THEN
     cell+ ;      cell+ ;
   
   : .word ( addr xt -- addr )
       look 0= IF
           drop dup 1 cells - @ dup body> look
           IF
               nip dup ." <" name>string rot wordinfo .string ." >"
           ELSE
               drop ." <" 0 .r ." >"
           THEN
       ELSE
           dup cell+ @ immediate-mask and
           IF
               bl cemit  ." POSTPONE "
           THEN
           dup name>string rot wordinfo .string
       THEN ;
   
   : c-call
       Display? IF  ." call " dup @ body> .word bl cemit  THEN  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")
   dup 1 cells - @ look     dup 1 cells - @ look 
Line 425  VARIABLE C-Pass Line 444  VARIABLE C-Pass
   
 CREATE C-Table  CREATE C-Table
                 ' lit A,            ' c-lit A,                  ' lit A,            ' c-lit A,
                 ' (s") A,           ' c-c" A,  [IFDEF] call    ' call A,           ' c-call A, [THEN]
                  ' (.") A,          ' c-c" A,  [IFDEF] (s")    ' (s") A,           ' c-c" A, [THEN]
                 ' "lit A,           ' c-c" A,  [IFDEF] (.")    ' (.") A,           ' c-c" A, [THEN]
   [IFDEF] "lit    ' "lit A,           ' c-c" A, [THEN]
 [IFDEF] (c")    ' (c") A,           ' c-c" A, [THEN]  [IFDEF] (c")    ' (c") A,           ' c-c" A, [THEN]
                 ' (do) A,           ' c-do A,                  ' (do) A,           ' c-do A,
 [IFDEF] (+do)   ' (+do) A,          ' c-do A, [THEN]  [IFDEF] (+do)   ' (+do) A,          ' c-do A, [THEN]
Line 444  CREATE C-Table Line 464  CREATE C-Table
 [IFDEF] (-loop) ' (-loop) A,        ' c-loop A, [THEN]  [IFDEF] (-loop) ' (-loop) A,        ' c-loop A, [THEN]
                 ' (next) A,         ' c-loop A,                  ' (next) A,         ' c-loop A,
                 ' ;s A,             ' c-exit A,                  ' ;s A,             ' c-exit A,
                 ' (abort") A,       ' c-abort" A,  [IFDEF] (abort") ' (abort") A,      ' c-abort" A, [THEN]
 \ only defined if compiler is loaded  \ only defined if compiler is loaded
 [IFDEF] (compile) ' (compile) A,      ' c-(compile) A, [THEN]  [IFDEF] (compile) ' (compile) A,      ' c-(compile) A, [THEN]
 [IFDEF] (does>) ' (does>) A,        ' c-does> A, [THEN]  [IFDEF] (does>) ' (does>) A,        ' c-does> A, [THEN]
Line 463  c-extender ! Line 483  c-extender !
                         ( end!) 2drop false EXIT THEN                           ( end!) 2drop false EXIT THEN 
                 THEN                  THEN
                 \ jump over to extender, if any 26jan97jaw                  \ jump over to extender, if any 26jan97jaw
                 2 pick <>                  xt>threaded 2 pick <>
         WHILE   2 cells +          WHILE   2 cells +
         REPEAT          REPEAT
         nip cell+ perform          nip cell+ perform
Line 493  c-extender ! Line 513  c-extender !
     dup >r DoTable r> swap IF drop EXIT THEN      dup >r DoTable r> swap IF drop EXIT THEN
     Display?      Display?
     IF      IF
         look 0= IF          .word bl cemit
             drop dup 1 cells - @ ." <" 0 .r ." >"  
         ELSE  
             dup cell+ @ immediate-mask and  
             IF  
                 bl cemit  ." POSTPONE "  
             THEN  
             dup name>string rot wordinfo .string  
         THEN  
         bl cemit  
     ELSE      ELSE
         drop          drop
     THEN ;      THEN ;
Line 573  Defer discode ( addr u -- ) \ gforth Line 584  Defer discode ( addr u -- ) \ gforth
   
 : seecode ( xt -- )  : seecode ( xt -- )
     dup s" Code" .defname      dup s" Code" .defname
     threading-method      >code-address
     if  
         >code-address  
     then  
     dup in-dictionary? \ user-defined code word?      dup in-dictionary? \ user-defined code word?
     if      if
         dup next-head          dup next-head
Line 668  Defer discode ( addr u -- ) \ gforth Line 676  Defer discode ( addr u -- ) \ gforth
     if \ normal or immediate word      if \ normal or immediate word
         swap xt-see (.immediate)          swap xt-see (.immediate)
     else      else
         r@ ['] compile-only-error =          r@ ['] ticking-compile-only-error =
         if \ compile-only word          if \ compile-only word
             swap xt-see (.immediate) ."  compile-only"              swap xt-see (.immediate) ."  compile-only"
         else \ interpret/compile word          else \ interpret/compile word
Removed from v.1.34  
changed lines
  Added in v.1.42

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