home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / FPC35_5.ZIP / FPCSRC.ZIP / WORDS.SEQ < prev    next >
Encoding:
Text File  |  1989-07-03  |  5.7 KB  |  178 lines
  1. \ WORDS.SEQ     The WORDS definition       Enhancements by Tom Zimmer
  2.  
  3. VARIABLE VYET   \ DID WE PRINT VOCABULARY YET
  4. VARIABLE VADDR  \ VOCABULARY NAME ADDRESS
  5.  
  6. : .VYET         ( --- ) VYET @ IF EXIT THEN
  7.                 VADDR @ CR ." --[ " .ID ."  ]--" VYET ON
  8.                 CR LMARGIN @ SPACES  ;
  9.  
  10. VARIABLE TOTALWORDS
  11. DEFER W.ID ' .ID IS W.ID
  12.  
  13. headerless
  14.  
  15. CREATE W$ 64 ALLOT
  16.        W$ 64 ERASE
  17.  
  18. : ?INNAME       ( NFA --- F1 )
  19.                 @> YSEG SWAP ?CS: HERE 31 CMOVEL
  20.                 $C0 HERE CRESET                 \ mask to real count only
  21.                 $80 HERE COUNT + DUP OFF        \ clear end of name to NULL
  22.                 1- CRESET                       \ mast high bit of last char
  23.                 W$      COUNT HERE COUNT SEARCH NIP
  24.                 W$ 32 + COUNT HERE COUNT SEARCH NIP AND ;
  25.  
  26. : ?CODENAME     ( NFA --- F1 )
  27.                 NAME> C@ DUP ( CALL) 232 <> SWAP ( JMP) 233 <> AND ;
  28.  
  29. 0 VALUE WORDTYPE
  30.  
  31. : ?WORDTYPE     ( NFA --- F1 )
  32.                 NAME> @REL>ABS WORDTYPE = ;
  33.  
  34. : ?TOTALWORDS   ( NFA --- FALSE )
  35.                 DROP FALSE
  36.                 TOTALWORDS INCR ;
  37.  
  38. DEFER ?W.NAME
  39.  
  40. : <W.NAME>      ( NFA --- )     \ Print name filtered by HERE
  41.                 DUP ?W.NAME
  42.                 IF      .VYET 17 ?LINE W.ID
  43.                         #OUT @ COLS 16 - < IF TAB THEN
  44.                         TOTALWORDS INCR
  45.                 ELSE    DROP THEN    ;
  46.  
  47. DEFER W.NAME    ' <W.NAME> IS W.NAME
  48.  
  49. : .VOCWORDS     ( A1 --- )
  50.                 DUP HERE 500 + #THREADS 2* CMOVE
  51.                 BODY> >NAME VADDR !     VYET OFF
  52.                 BEGIN   HERE 500 + #THREADS LARGEST DUP
  53.                         ?KEYPAUSE
  54.                 WHILE   DUP L>NAME W.NAME Y@ SWAP !
  55.                 REPEAT  2DROP ;
  56.  
  57. DEFER ?W.TEST   ' NOOP IS ?W.TEST
  58.  
  59. headers
  60.  
  61. : ?*.*          ( --- )
  62.                 W$ 1+ " *.*" COMP 0=
  63.                 IF      ['] NOOP IS ?W.NAME
  64.                 THEN    ;
  65.  
  66. : ?CODE.*       ( --- )
  67.                 W$ 1+ " CODE.*" CAPS-COMP 0=
  68.                 IF      ['] ?CODENAME IS ?W.NAME
  69.                 THEN    ;
  70.  
  71. : ?:.*          ( --- )
  72.                 W$ 1+ " :.*" CAPS-COMP 0=
  73.                 IF      ['] ?*.* @REL>ABS =: WORDTYPE
  74.                         ['] ?WORDTYPE IS ?W.NAME
  75.                 THEN    ;
  76.  
  77. : ?VARIABLE.*   ( --- )
  78.                 W$ 1+ " VARIABLE.*" CAPS-COMP 0=
  79.                 IF      ['] TOTALWORDS @REL>ABS =: WORDTYPE
  80.                         ['] ?WORDTYPE IS ?W.NAME
  81.                 THEN    ;
  82.  
  83. : ?UVARIABLE.*  ( --- )
  84.                 W$ 1+ " UVARIABLE.*" CAPS-COMP 0=
  85.                 IF      ['] BASE @REL>ABS =: WORDTYPE
  86.                         ['] ?WORDTYPE IS ?W.NAME
  87.                 THEN    ;
  88.  
  89. : ?CONSTANT.*   ( --- )
  90.                 W$ 1+ " CONSTANT.*" CAPS-COMP 0=
  91.                 IF      ['] BL       @REL>ABS =: WORDTYPE
  92.                         ['] ?WORDTYPE IS ?W.NAME
  93.                 THEN    ;
  94.  
  95. : ?VALUE.*      ( --- )
  96.                 W$ 1+ " VALUE.*" CAPS-COMP 0=
  97.                 IF      ['] WORDTYPE @REL>ABS =: WORDTYPE
  98.                         ['] ?WORDTYPE IS ?W.NAME
  99.                 THEN    ;
  100.  
  101. : ?DEFER.*      ( --- )
  102.                 W$ 1+ " DEFER.*" CAPS-COMP 0=
  103.                 IF      ['] ?W.TEST @REL>ABS =: WORDTYPE
  104.                         ['] ?WORDTYPE IS ?W.NAME
  105.                 THEN    ;
  106.  
  107. : ?UDEFER.*     ( --- )
  108.                 W$ 1+ " UDEFER.*" CAPS-COMP 0=
  109.                 IF      ['] EMIT @REL>ABS =: WORDTYPE
  110.                         ['] ?WORDTYPE IS ?W.NAME
  111.                 THEN    ;
  112.  
  113. : ?TOTAL.*      ( --- )
  114.                 W$ 1+ " TOTAL.*" CAPS-COMP 0=
  115.                 IF      CR ." Not displaying, just counting the TOTAL "
  116.                         ['] ?TOTALWORDS IS ?W.NAME
  117.                 THEN    ;
  118.  
  119. headerless
  120.  
  121. FALSE VALUE CONTEXTONLY
  122.  
  123. headers
  124.  
  125. \ WORDS <return>        print words in current vocabulary.
  126. \ WORDS <string>        print words containing string in all vocabularies.
  127. \ WORDS *.*             print all words of all vocabularies.
  128.  
  129. \ WORDS enhancements by Tom Zimmer
  130.  
  131. DEFER PREWORDS  ' NOOP IS PREWORDS
  132.  
  133.  : WORDS       ( <t1> -- )
  134.                 TOTALWORDS OFF
  135.                 SAVESTATE
  136.                COLS 2- RMARGIN !
  137.                15 TABSIZE !
  138.                   LMARGIN OFF
  139.                 CR ."  ** Press SPACE to pause, or ESC to exit ** "
  140.                 PREWORDS
  141.                 >IN @ #TIB @ <>
  142.                 IF      ['] ?INNAME IS ?W.NAME
  143.                         BL WORD W$      OVER C@ 1+ 32 MIN CMOVE
  144.                         BL WORD W$ 32 + OVER C@ 1+ 32 MIN CMOVE
  145.                         ?*.*            ?CODE.*         ?:.*
  146.                         ?VARIABLE.*     ?CONSTANT.*     ?DEFER.*
  147.                         ?VALUE.*
  148.                         ?UVARIABLE.*    ?UDEFER.*       ?TOTAL.*
  149.                         CONTEXTONLY
  150.                         FALSE =: CONTEXTONLY
  151.                         IF      CONTEXT @ .VOCWORDS
  152.                         ELSE    VOC-LINK @
  153.                                 BEGIN   DUP #THREADS 2* - .VOCWORDS
  154.                                         @ DUP 0=
  155.                                 UNTIL   DROP
  156.                         THEN
  157.                 ELSE    ['] NOOP IS ?W.NAME
  158.                         FALSE =: CONTEXTONLY
  159.                         CONTEXT @ .VOCWORDS
  160.                 THEN    CR TOTALWORDS @ U. ." Words displayed" CR
  161.                 RESTORESTATE ;
  162.  
  163. \       Example:  THESE WORDS XYZ <enter>
  164. \       will display all words in the CONTEXT vocabulary containing XYZ
  165.  
  166. : THESE         ( --- )         \ Preceeds WORDS to subset CONTEXT vocabulary
  167.                 TRUE =: CONTEXTONLY ;
  168.  
  169. ROOT DEFINITIONS
  170.  
  171. ' WORDS ALIAS WORDS \ : WORDS    WORDS ;
  172.  
  173. FORTH DEFINITIONS
  174.  
  175. behead
  176.  
  177.  
  178.