home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / REF.SEQ < prev    next >
Encoding:
Text File  |  1989-09-21  |  2.9 KB  |  99 lines
  1. \ REF.SEQ       Reference word REF              by Leon Dent
  2.  
  3. comment:
  4.  
  5.   Used in the form  REF <word>
  6.  
  7.   REF hunts out references of <word> in all occurences of colon words
  8.  
  9.   Much of this file has been cannibalized from the files DECOM.SEQ and
  10.   WORDS.SEQ, also a few words ( .VYET, EXECUTION-CLASS, ?KEYPAUSE etc )
  11.   are re-used so the above files must be loaded.
  12.  
  13.   REF           captures CFA of word
  14.   (REF)         searches from vocabulary to vocabulary
  15.   .RVOCWORDS    searches within each vocabulary
  16.   R.NAME        searches within each colon word, prints out matches
  17.  
  18.    ┌─────────────────────────────────────────────┐
  19.    │ Modified & optimized by Tom Zimmer for F-PC │
  20.    └─────────────────────────────────────────────┘
  21.  
  22. comment;
  23.  
  24. only forth also hidden also definitions
  25.  
  26. headerless
  27.  
  28. 0 value colseg
  29.  
  30. 0 value REFCFA                  \ holds cfa we're hunting for
  31.  
  32. : %r.name       ( link cfa --- link cfa )
  33.                 .VYET 17 ?LINE over L>NAME  .ID         \ found it
  34.                 #OUT @ 64 < IF TAB THEN
  35.                 TOTALWORDS INCR ;
  36.  
  37. : R.NAME  ( LINK -- )   \ looks at COLON, DEFER, an USER DEFER words
  38.         DUP LINK> DUP @REL>ABS 'DOCOL = \ look through ":" defs
  39.         IF      dup >BODY @ +XSEG =: sseg
  40.                                 \ first look for end of definition
  41.                 0 $140 ['] unnest scanw 0= if drop $40 then 2/
  42.                                 \ then look for word we are referencing
  43.                 0 swap refcfa scanw nip
  44.                 if      %r.name
  45.                 then    ?cs: =: sseg
  46.         ELSE    dup @rel>abs ['] bgstuff @rel>abs =     \ and DEFERed words
  47.                 if      dup >body @ refcfa =
  48.                         if      %r.name
  49.                         then
  50.                 else    dup @rel>abs ['] key @rel>abs = \ and USER DEFERed
  51.                         if      dup >is @ refcfa =
  52.                                 if      %r.name
  53.                                 then
  54.                         then
  55.                 then
  56.         THEN    2DROP   ;
  57.  
  58. : .RVOCWORDS  ( ADDR -- )
  59.         DUP HERE 500 + #THREADS 2* CMOVE   \ copy threads
  60.         BODY> >NAME VADDR ! VYET OFF
  61.         BEGIN   HERE 500 + #THREADS LARGEST DUP  \ search thread copy
  62.                 ?KEYPAUSE
  63.         WHILE   DUP R.NAME Y@ SWAP !    \ insert last link into thread
  64.         REPEAT
  65.         2DROP  ;
  66.  
  67. : (REF) ( -- )
  68.         TOTALWORDS OFF
  69.         savestate
  70.         COLS 2- RMARGIN !
  71.         15 TABSIZE !
  72.         2  LMARGIN !
  73.         CR  ."  *  Press SPACE to pause, or ESC to exit  *"
  74.         VOC-LINK @
  75.         BEGIN
  76.                 DUP #THREADS 2* -
  77.                 .RVOCWORDS
  78.                 @ DUP 0=
  79.         UNTIL
  80.         DROP
  81.         CR TOTALWORDS @ U. ." Words printed" CR
  82.         restorestate ;
  83.  
  84. headers
  85.  
  86. forth definitions
  87.  
  88. : REF   ( | name --- )
  89.         ' =: REFCFA (REF)  ;
  90.  
  91. ' ref alias XREF
  92. ' ref alias USEDIN
  93. ' ref alias CALLS
  94.  
  95. behead
  96.  
  97. only forth also definitions
  98.  
  99.