home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / WC.4TH < prev   
Encoding:
Text File  |  1992-03-30  |  5.9 KB  |  262 lines
  1. \ Word count program
  2. \ Will count characters, words, lines, pages, and printing time for
  3. \ any file or file(s) in the current directory
  4. \ Program copyright (C) 1985 Thomas Almy.  All rights reserved.
  5. \ Permission is granted to registered users of Forthcmp to sell or distribute
  6. \ computer programs incorporating the compiled contents of this file.
  7.  
  8. 200 MSDOS
  9. INCLUDE VARS
  10. INCLUDE DOS1
  11.  
  12. \ *** PRINTER CHARACTERISTICS FOR PRINTING PRINTER TIME *******
  13. \ *** MUST SET FOR YOUR PRINTER.  THESE ARE FOR EPSON FX-85 ***
  14.  
  15. 160 CONSTANT chars/sec    \ printing speed, ignoring line feed
  16. 66 CONSTANT lines/page  
  17. 6 CONSTANT lines/sec    \ slew rate for line feed
  18.  
  19. 0 0 IN/OUT
  20. : USAGE MESSAGES  CR  
  21.     ." USAGE: WC {filenames}" CR
  22.     ." Filenames may have * or ? wildcards." CR
  23.     ." File `-' means standard input." CR
  24.     ;
  25.  
  26.  
  27. 128 CONSTANT SCRATCH_BUF \ file block
  28.  
  29.  
  30. HCB INFILE
  31.  
  32. \ KEY -- FROM A FILE
  33.  
  34. \ We will blanket allocate memory from location 6000 for 55k
  35. \  to be used as a large file buffer.
  36.  
  37. 1024 55 *  CONSTANT INBUFSZ
  38. 6000 CONSTANT INBUFFER   \ PUT INPUT BUFFER IN HIGH MEMORY
  39. VARIABLE INBUFPTR
  40. VARIABLE INBUFEND  
  41.  
  42. : KEY  INBUFPTR @ INBUFEND @ = IF ( fetch block )
  43.      INFILE INBUFFER INBUFSZ FREAD ?DUP IF ( everything OK )
  44.             INBUFFER INBUFPTR !  INBUFFER + INBUFEND !
  45.      ELSE CONTROL Z EXIT 
  46.      THEN
  47.     THEN
  48.     INBUFPTR @ C@ 127 AND
  49.    1 INBUFPTR +! ;
  50.  
  51.  
  52. \ DIRECTORY SEARCHING STUFF
  53.  
  54. VARIABLE NEXTITEM
  55.  
  56. \ We will take the program argument list and fake it as a
  57. \ line of keyboard input to make parsing easier.
  58. 0 0 IN/OUT
  59. : DODIR  ( -- )
  60.    SCRATCH_BUF 1+ TIB 128 CMOVE     \ get the argument list
  61.    TIB 128 + TIB DO I C@ ASCII / = IF ASCII \ I C! THEN LOOP 
  62.    128 C@ #TIB !        \ and its length
  63.    >IN OFF            \ start reading at begining of line
  64.    NEXTITEM ON            \ force reading of next item
  65.    ;
  66.  
  67.  
  68. \ PRINT A VALUE, PRINT A TIME
  69.  
  70. 2 0 IN/OUT
  71. : .VAL  ( dvalue -- )   
  72.    <# #S #> 10 OVER - SPACES TYPE ;
  73.  
  74. 2 0 IN/OUT
  75. : .TIME  ( dtime -- )   
  76.   5 SPACES
  77.   60 MU/MOD 60 MU/MOD DROP
  78.   ?DUP IF . ." hr " THEN
  79.   ?DUP IF . ." min " THEN
  80.   ?DUP IF . ." sec " THEN ;
  81.  
  82. \ GOTO A NEW FILE
  83. 2VARIABLE NBYTES    
  84. 2VARIABLE TOTBYTES
  85. 2VARIABLE NWORDS    
  86. 2VARIABLE TOTWORDS
  87. 2VARIABLE NLINES    
  88. 2VARIABLE TOTLINES
  89. VARIABLE NPAGES     
  90. 2VARIABLE TOTPAGES
  91. VARIABLE PAGEPOS
  92.  
  93. HCB WILDFILE 
  94.  
  95. VARIABLE INFILEP
  96.  
  97. 1 0 IN/OUT 
  98. : PUTN ( character -- , put in string of INFILE )
  99.    INFILEP @ C! 1 INFILEP +! ;
  100.  
  101. VARIABLE /PNTR
  102. 0 0 IN/OUT
  103. : MAKE-FILENAME \ set up INFILE with path from WILDFILE and
  104.         \ file name from SCRATCH_BUF
  105.     INFILE 3 + INFILEP ! \ address of destination string
  106.     INFILEP @  /PNTR !  \ location of last slash 
  107.     WILDFILE HCB>N COUNT 0 ?DO COUNT DUP PUTN 
  108.         DUP ASCII \ = OVER ASCII / = OR SWAP ASCII : = OR IF
  109.             INFILEP @ /PNTR ! THEN 
  110.     LOOP
  111.     DROP ( wildfile pointer )
  112.     /PNTR @ INFILEP !    \ get rid of characters after last \
  113.     SCRATCH_BUF 30 + \ remainder of filename
  114.     BEGIN COUNT DUP WHILE PUTN REPEAT 2DROP
  115.     INFILEP @ INFILE 3 + - INFILE 2 + C! \ length
  116.     0 PUTN \ zero delimit string
  117.     ;
  118.  
  119. 0 0 IN/OUT
  120. : RESET-STUFF
  121.   0. NBYTES 2!
  122.   0. NWORDS 2!
  123.   0. NLINES 2!
  124.   1 NPAGES !        \ each file is always at least 1 page
  125.   INBUFEND @ INBUFPTR !  ( force first read )
  126.   ;
  127.  
  128. 0 1 IN/OUT 
  129. : NEW-FILE? ( -- success )
  130.   BEGIN NEXTITEM @ IF ( must scan input stream )
  131.         BL WORD DUP @ ASCII - 8 << 1+ = IF ( use std-input )
  132.             DROP
  133.             " (std-input)" INFILE NAME>HCB
  134.             stdin @ INFILE !
  135.             RESET-STUFF
  136.             -1
  137.             EXIT
  138.         THEN
  139.         DUP C@ 0= IF DROP 0 EXIT THEN ( End of line )
  140.         WILDFILE NAME>HCB
  141.         WILDFILE HCB>N 0 firstf
  142.         NEXTITEM OFF 
  143.     ELSE
  144.         nextf
  145.     THEN 
  146.     WHILE ( search failed )
  147.     NEXTITEM ON
  148.     REPEAT
  149.   MAKE-FILENAME
  150.   INFILE O_RD FOPEN IF CR 
  151.     ." OPEN FAILED FOR " INFILE .FNAME
  152.     NEW-FILE? EXIT THEN    \ recurse for additional files
  153.   RESET-STUFF
  154.   -1 ( SUCCESS! )   ;
  155.  
  156. \ PRINT TOTALS
  157. 2VARIABLE TOTTIME
  158. 0 0 IN/OUT
  159. : PRINT-TOTALS
  160.   NBYTES 2@ TOTBYTES 2@ D- D0= IF CR EXIT THEN
  161.   CR ." TOTALS--" 11 SPACES
  162.   TOTBYTES 2@ .VAL  
  163.   TOTWORDS 2@ .VAL
  164.   TOTLINES 2@ .VAL  
  165.   TOTPAGES 2@ .VAL
  166.   TOTTIME 2@ .TIME   
  167.   CR ;
  168.  
  169. 0 0 IN/OUT
  170. : PRINT-STATISTICS
  171.   CR INFILE .FNAME
  172.   19 INFILE HCB>N C@ - 0 MAX SPACES
  173.   NBYTES 2@  2DUP  .VAL      TOTBYTES 2@ D+  TOTBYTES 2!
  174.   NWORDS 2@  2DUP  .VAL      TOTWORDS 2@ D+  TOTWORDS 2!
  175.   NLINES 2@  2DUP  .VAL      TOTLINES 2@ D+  TOTLINES 2!
  176.   NPAGES @ 0 2DUP  .VAL      TOTPAGES 2@ D+  TOTPAGES 2!
  177.   NBYTES 2@  chars/sec  UM/MOD  NIP  0
  178.     NPAGES @  lines/page lines/sec / UM*
  179.     D+ ( total time )
  180.   2DUP  .TIME    TOTTIME 2@ D+  TOTTIME 2! ;
  181.  
  182.  
  183. \  COUNT THE FILE
  184. 1 0 IN/OUT
  185. \ : BUMP   DUP 2@ 1. D+ ROT 2! ;
  186. CODE BUMP  
  187.     AX BX MOV
  188.     1 # 2 +[BX] ADD
  189.     0 # [BX] ADC
  190.     RET
  191. END-CODE
  192.  
  193.  
  194. 0 0 IN/OUT
  195. : COUNT-FILE   PAGEPOS OFF
  196.     NBYTES BUMP
  197.     KEY ( prime the pump )
  198.     BEGIN  
  199.       BEGIN ( out of word loop )
  200.         DUP BL <= 
  201.       WHILE
  202.     CASE
  203.       CONTROL L OF 1 NPAGES +! PAGEPOS OFF ENDOF
  204.       CONTROL J OF NLINES BUMP 1 PAGEPOS +!
  205.         PAGEPOS @ 66 > IF 1 NPAGES +! PAGEPOS OFF THEN ENDOF
  206.       CONTROL Z OF NBYTES 2@ 1. D- NBYTES 2! EXIT ENDOF ( done! )
  207.     ENDCASE
  208.         NBYTES BUMP  KEY
  209.       REPEAT
  210.       NWORDS BUMP ( entering a word )
  211.       BEGIN ( in word loop )
  212.         DUP BL >
  213.       WHILE
  214.         DROP
  215.     NBYTES BUMP
  216.     KEY
  217.       REPEAT
  218.     AGAIN
  219. ;
  220.  
  221.  
  222. \ CLOSE THE FILE
  223.  
  224. 0 0 IN/OUT
  225. : CLOSE-THE-FILE
  226.     INFILE HCB>H stdin <> IF
  227.         INFILE FCLOSE DROP
  228.     THEN ;
  229.  
  230. \ MESSAGES
  231. 0 0 IN/OUT
  232. : HELLO \ MESSAGES
  233. \  ." Word Count Program," CR
  234. \  ." Copyright (C) 1985 by Tom Almy" CR  CONSOLE
  235.   ." FILENAME                BYTES     WORDS     LINES     PAGES     TIME"  CR
  236.   0. TOTBYTES 2!  
  237.   0. TOTWORDS 2!  
  238.   0. TOTLINES 2!  
  239.   0. TOTPAGES 2!
  240.   0. TOTTIME  2!
  241. ;
  242.  
  243. : MAIN 
  244.     128 C@ 0= IF USAGE EXIT THEN
  245.     HELLO 
  246.     DODIR
  247.     BEGIN 
  248.       NEW-FILE? WHILE
  249.       COUNT-FILE
  250.       CLOSE-THE-FILE
  251.       PRINT-STATISTICS
  252.     REPEAT
  253.     PRINT-TOTALS
  254. ;
  255.  
  256.  
  257. INCLUDE DOS2
  258. INCLUDE FORTHLIB
  259.  
  260. END
  261.  
  262.