home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / words.seq < prev    next >
Encoding:
Text File  |  1991-04-12  |  5.8 KB  |  179 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.                 W$ 1+ " COLON.*" CAPS-COMP 0= OR
  74.                 IF      ['] ?*.* @REL>ABS =: WORDTYPE
  75.                         ['] ?WORDTYPE IS ?W.NAME
  76.                 THEN    ;
  77.  
  78. : ?VARIABLE.*   ( --- )
  79.                 W$ 1+ " VARIABLE.*" CAPS-COMP 0=
  80.                 IF      ['] TOTALWORDS @REL>ABS =: WORDTYPE
  81.                         ['] ?WORDTYPE IS ?W.NAME
  82.                 THEN    ;
  83.  
  84. : ?USER-VARIABLE.* ( --- )
  85.                 W$ 1+ " USER-VARIABLE.*" CAPS-COMP 0=
  86.                 IF      ['] BASE @REL>ABS =: WORDTYPE
  87.                         ['] ?WORDTYPE IS ?W.NAME
  88.                 THEN    ;
  89.  
  90. : ?CONSTANT.*   ( --- )
  91.                 W$ 1+ " CONSTANT.*" CAPS-COMP 0=
  92.                 IF      ['] BL       @REL>ABS =: WORDTYPE
  93.                         ['] ?WORDTYPE IS ?W.NAME
  94.                 THEN    ;
  95.  
  96. : ?VALUE.*      ( --- )
  97.                 W$ 1+ " VALUE.*" CAPS-COMP 0=
  98.                 IF      ['] WORDTYPE @REL>ABS =: WORDTYPE
  99.                         ['] ?WORDTYPE IS ?W.NAME
  100.                 THEN    ;
  101.  
  102. : ?DEFERED.*    ( --- )
  103.                 W$ 1+ " DEFERED.*" CAPS-COMP 0=
  104.                 IF      ['] ?W.TEST @REL>ABS =: WORDTYPE
  105.                         ['] ?WORDTYPE IS ?W.NAME
  106.                 THEN    ;
  107.  
  108. : ?USER-DEFERED.* ( --- )
  109.                 W$ 1+ " USER-DEFERED.*" CAPS-COMP 0=
  110.                 IF      ['] EMIT @REL>ABS =: WORDTYPE
  111.                         ['] ?WORDTYPE IS ?W.NAME
  112.                 THEN    ;
  113.  
  114. : ?TOTAL.*      ( --- )
  115.                 W$ 1+ " TOTAL.*" CAPS-COMP 0=
  116.                 IF      CR ." Not displaying, just counting the TOTAL "
  117.                         ['] ?TOTALWORDS IS ?W.NAME
  118.                 THEN    ;
  119.  
  120. headerless
  121.  
  122. FALSE VALUE CONTEXTONLY         \ display only words in context vocabulary
  123.  
  124. headers
  125.  
  126. \ WORDS <return>        print words in current vocabulary.
  127. \ WORDS <string>        print words containing string in all vocabularies.
  128. \ WORDS *.*             print all words of all vocabularies.
  129.  
  130. \ WORDS enhancements by Tom Zimmer
  131.  
  132. DEFER PREWORDS  ' NOOP IS PREWORDS
  133.  
  134.  : WORDS       ( <t1> -- )
  135.                 TOTALWORDS OFF
  136.                 SAVESTATE
  137.                COLS 2- RMARGIN !
  138.                15 TABSIZE !
  139.                   LMARGIN OFF
  140.                 CR ."  ** Press SPACE to pause, or ESC to exit ** "
  141.                 PREWORDS
  142.                 >IN @ #TIB @ <>
  143.                 IF      ['] ?INNAME IS ?W.NAME
  144.                         BL WORD W$      OVER C@ 1+ 32 MIN CMOVE
  145.                         BL WORD W$ 32 + OVER C@ 1+ 32 MIN CMOVE
  146.                         ?*.*            ?CODE.*         ?:.*
  147.                         ?VARIABLE.*     ?CONSTANT.*     ?DEFERED.*
  148.                         ?VALUE.*        ?USER-VARIABLE.*
  149.                         ?USER-DEFERED.* ?TOTAL.*
  150.                         CONTEXTONLY
  151.                         FALSE =: CONTEXTONLY
  152.                         IF      CONTEXT @ .VOCWORDS
  153.                         ELSE    VOC-LINK @
  154.                                 BEGIN   DUP #THREADS 2* - .VOCWORDS
  155.                                         @ DUP 0=
  156.                                 UNTIL   DROP
  157.                         THEN
  158.                 ELSE    ['] NOOP IS ?W.NAME
  159.                         FALSE =: CONTEXTONLY
  160.                         CONTEXT @ .VOCWORDS
  161.                 THEN    CR TOTALWORDS @ U. ." Words displayed" CR
  162.                 RESTORESTATE ;
  163.  
  164. \       Example:  THESE WORDS XYZ <enter>
  165. \       will display all words in the CONTEXT vocabulary containing XYZ
  166.  
  167. : THESE         ( --- )         \ Preceeds WORDS to subset CONTEXT vocabulary
  168.                 TRUE !> CONTEXTONLY ;
  169.  
  170. ROOT DEFINITIONS
  171.  
  172. ' WORDS ALIAS WORDS
  173.  
  174. FORTH DEFINITIONS
  175.  
  176. behead
  177.  
  178.  
  179.