Diff for /gforth/cross.fs between versions 1.180 and 1.181

version 1.180, 2012/02/13 22:58:13 version 1.181, 2012/03/09 21:16:22
Line 2128  Create tag-tab 1 c,  09 c, Line 2128  Create tag-tab 1 c,  09 c,
         s" ,0" tag-file-id write-line throw          s" ,0" tag-file-id write-line throw
     THEN ;      THEN ;
   
 : cross-gnu-tag-entry  ( -- )  : put-cross-gnu-tag-entry  ( addr u -- )
     tlast @ 0<> \ not an anonymous (i.e. noname) header      tlast @ 0<> \ not an anonymous (i.e. noname) header
     IF      IF
         put-load-file-name          put-load-file-name
         source >in @ min tag-file-id write-file throw          source >in @ min tag-file-id write-file throw
         tag-beg count tag-file-id write-file throw          tag-beg count tag-file-id write-file throw
         Last-Header-Ghost @ >ghostname tag-file-id write-file throw          tag-file-id write-file throw
         tag-end count tag-file-id write-file throw          tag-end count tag-file-id write-file throw
         base @ decimal sourceline# 0 <# #s #> tag-file-id write-file throw          base @ decimal sourceline# 0 <# #s #> tag-file-id write-file throw
 \       >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw  \       >in @ 0 <# #s [char] , hold #> tag-file-id write-line throw
         s" ,0" tag-file-id write-line throw          s" ,0" tag-file-id write-line throw
         base !          base !
     THEN ;      ELSE  2drop  THEN ;
   
 : cross-vi-tag-entry ( -- )  : cross-gnu-tag-entry  ( -- )
       Last-Header-Ghost @ >ghostname put-cross-gnu-tag-entry ;
   
   : put-cross-vi-tag-entry ( addr u -- )
     tlast @ 0<> \ not an anonymous (i.e. noname) header      tlast @ 0<> \ not an anonymous (i.e. noname) header
     IF      IF
         sourcefilename vi-tag-file-id write-file throw          sourcefilename vi-tag-file-id write-file throw
         tag-tab count vi-tag-file-id write-file throw          tag-tab count vi-tag-file-id write-file throw
         Last-Header-Ghost @ >ghostname vi-tag-file-id write-file throw          vi-tag-file-id write-file throw
         tag-tab count vi-tag-file-id write-file throw          tag-tab count vi-tag-file-id write-file throw
         s" /^" vi-tag-file-id write-file throw          s" /^" vi-tag-file-id write-file throw
         source vi-tag-file-id write-file throw          source vi-tag-file-id write-file throw
         s" $/" vi-tag-file-id write-line throw          s" $/" vi-tag-file-id write-line throw
     THEN ;      ELSE  2drop  THEN ;
   
   : cross-vi-tag-entry ( -- )
       Last-Header-Ghost @ >ghostname put-cross-vi-tag-entry ;
   
 : cross-tag-entry ( -- )  : cross-tag-entry ( -- )
     cross-gnu-tag-entry      cross-gnu-tag-entry
     cross-vi-tag-entry ;      cross-vi-tag-entry ;
   
   : put-cross-tag-entry ( addr u -- )
       2dup put-cross-gnu-tag-entry
       put-cross-vi-tag-entry ;
   
   : cross-record-name ( -- )
       >in @ parse-name put-cross-tag-entry >in ! ;
   
 \ Check for words  \ Check for words
   
 Defer skip? ' false IS skip?  Defer skip? ' false IS skip?
Line 3290  Cond: ABORT"    if, ahead, there [char] Line 3303  Cond: ABORT"    if, ahead, there [char]
 [THEN]  [THEN]
   
 X has? rom [IF]  X has? rom [IF]
 Cond: IS        T ' >body @ H compile ALiteral compile ! ;Cond  Cond: IS        cross-record-name T ' >body @ H compile ALiteral compile ! ;Cond
 : IS            T >address ' >body @ ! H ;  : IS            cross-record-name T >address ' >body @ ! H ;
 Cond: TO        T ' >body @ H compile ALiteral compile ! ;Cond  Cond: TO        T ' >body @ H compile ALiteral compile ! ;Cond
 : TO            T ' >body @ ! H ;  : TO            T ' >body @ ! H ;
 Cond: CTO       T ' >body H compile ALiteral compile ! ;Cond  Cond: CTO       T ' >body H compile ALiteral compile ! ;Cond
 : CTO           T ' >body ! H ;  : CTO           T ' >body ! H ;
 [ELSE]  [ELSE]
 Cond: IS        T ' >body H compile ALiteral compile ! ;Cond  Cond: IS        cross-record-name T ' >body H compile ALiteral compile ! ;Cond
 : IS            T >address ' >body ! H ;  : IS            cross-record-name T >address ' >body ! H ;
 Cond: TO        T ' >body H compile ALiteral compile ! ;Cond  Cond: TO        T ' >body H compile ALiteral compile ! ;Cond
 : TO            T ' >body ! H ;  : TO            T ' >body ! H ;
 [THEN]  [THEN]

Removed from v.1.180  
changed lines
  Added in v.1.181


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