[Win32forth-cvs] win32forth/src/tools xref.f,1.1,1.2

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/tools
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17160/win32forth/src/tools

Modified Files:
	xref.f 
Log Message:
gah: modified xref.f to suppress false entries caused by cfa pointer(s) in name(s) of the word being cross-referenced. Improved formatting of listing 

Index: xref.f
===================================================================
RCS file: /cvsroot/win32forth/win32forth/src/tools/xref.f,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** xref.f	21 Dec 2004 00:19:11 -0000	1.1
--- xref.f	5 Jul 2005 07:44:11 -0000	1.2
***************
*** 6,14 ****
  \ This is by Rainbow sally circa December 2002 by John Peters' request
  \ Optimized xref_inhileveldef? gah Thursday, June 24 2004 - 0:22
! \ Anew Cross-Reference  ( Anew does not work in this particular case )
  
  internal
  
! \ Fun\IN-EMPTY.F -- -- checks for additional input
  : ?in-empty     ( -- tf )
      \ Returns TRUE flag if line being interpreted
--- 6,15 ----
  \ This is by Rainbow sally circa December 2002 by John Peters' request
  \ Optimized xref_inhileveldef? gah Thursday, June 24 2004 - 0:22
! \ gah Monday, July 04 2005 added test to suppress treating the cfaptr as a reference
! \     which caused the last word in system space to be printed. Improved output format
  
  internal
  
! \ checks for additional input
  : ?in-empty     ( -- tf )
      \ Returns TRUE flag if line being interpreted
***************
*** 16,25 ****
      >in @ bl word c@ 0= swap >in ! ;
  
! 
! \ Fun\QuitKey.F -- Returns TRUE flag if key is <esc> or Q (case insensitive)
  : ?quitkey
          key upc 'Q' over = swap 27 = or
          if sp0 @ sp! cr ." Quitting.." cr quit then ;
  
  external
  
--- 17,41 ----
      >in @ bl word c@ 0= swap >in ! ;
  
! \ Returns TRUE flag if key is <esc> or Q (case insensitive)
  : ?quitkey
          key upc 'Q' over = swap 27 = or
          if sp0 @ sp! cr ." Quitting.." cr quit then ;
  
+ \ Is addr the cfaptr of a word
+ : ?cfaptr         { addr \ flag -- f }
+                 false to flag
+                 voc-link
+                 begin   @ ?dup
+                 while   dup vlink>voc
+                         dup voc#threads 0
+                         do      dup i cells +
+                                 begin   @ ?dup
+                                 while   dup l>name n>cfaptr addr =
+                                         if      true to flag
+                                         then
+                                 repeat
+                         loop    drop
+                 repeat  flag ;
+ 
  external
  
***************
*** 35,58 ****
  
  : xref_FindLoop ( end start find-cfa -- found=T )
-     0 \ to ValidFlg
      0 \ to FoundFlg
!     0 \ to LatestCFA
!     { ValidFlg FoundFlg LatestCFA \ StartAddr FindAddr -- FoundFlg }
      to FindAddr
      do
          i @ FindAddr =
          if
              TRUE to FoundFlg
              i
!             xref_InHiLevelDef?
!             ( a -- cfa flg ) to ValidFlg to LatestCfa
!             ValidFlg 0=
!             if ." [ ??? "
!             then
! \in-system-ok LatestCfa >name .id
!             ValidFlg 0=
!             if
!             ."  ]"
!             then
              25 tab-size >r to tab-size
                  tab
--- 51,68 ----
  
  : xref_FindLoop ( end start find-cfa -- found=T )
      0 \ to FoundFlg
!     { FoundFlg \ StartAddr FindAddr -- FoundFlg }
      to FindAddr
      do
          i @ FindAddr =
          if
+         i ?cfaptr 0= if
              TRUE to FoundFlg
              i
!             xref_InHiLevelDef? 
!             0= tuck
!             if ." [ ??? " then
! \in-system-ok  >name .id
!             if ."  ]" then
              25 tab-size >r to tab-size
                  tab
***************
*** 60,64 ****
              getxy drop
              ?cr
-             0 to ValidFlg
              key?
              if cr ." Current Search Address: " i .
--- 70,73 ----
***************
*** 67,71 ****
                  key drop ?quitkey cr
              then
!         then
          xref_Aligned    \ check if only looking in lists (TRUE to xref_Aligned)
          if      4
--- 76,80 ----
                  key drop ?quitkey cr
              then
!         then then
          xref_Aligned    \ check if only looking in lists (TRUE to xref_Aligned)
          if      4
***************
*** 79,83 ****
      \ start address specified.  Start address can be any
      \ executable text or number
!     cr ." -------------------- "
      defined 0= abort" Can't find name"
      cr
--- 88,92 ----
      \ start address specified.  Start address can be any
      \ executable text or number
!     cr ." ------------------------------------------------ "
      defined 0= abort" Can't find name"
      cr
***************
*** 104,116 ****
      EndAddr StartAddr FindAddr
      xref_FindLoop
!     0= >r
  
      sys-here sys-origin FindAddr
      xref_FindLoop
!     0= r> and
!     if
!         ." No Cross Refs Found"
!     then
!     cr ;
  
  external
--- 113,124 ----
      EndAddr StartAddr FindAddr
      xref_FindLoop
!     0= if ." No Cross References found in Application Space" then cr
!     ." ------------------------------------------------ " cr
  
      sys-here sys-origin FindAddr
      xref_FindLoop
!     0= if ." No Cross References found in System Space" then cr
!     ." ------------------------------------------------ " cr
!  ;
  
  external