home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / TAIL.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  4.6 KB  |  193 lines
  1. \ TAIL PROGRAM, BY TOM ALMY.
  2.  
  3. \ THIS PROGRAM IS COPYRIGHT (C) 1985 BY TOM ALMY,
  4. \ ALL RIGHTS RESERVED.
  5. \  Users of ForthCMP are given permission to use or distribute this
  6. \  program, as long as no charge is made and the credit message is maintained.
  7.  
  8. 100 MSDOS
  9. HEX 1000 DECIMAL CONSTANT BUFSIZ
  10. INCLUDE FILTER
  11.  
  12.  
  13. \ DATA DECLARATIONS
  14. 0 CONSTANT FALSE  
  15. -1 CONSTANT TRUE
  16. CONTROL J CONSTANT NL    \ line delimiter character
  17. VARIABLE +FLAG        \ flags in option string
  18. VARIABLE CFLAG
  19. VARIABLE RFLAG
  20. 2VARIABLE LCOUNT
  21. 2VARIABLE OFFSET    \ Offset into file of pointer
  22. VARIABLE RLINEBUF    \ reverse line buffer
  23.  
  24. \ MESSAGES
  25. 0 0 IN/OUT 
  26. : NOTICE  CONSOLE  
  27.    ." TAIL PRINTING PROGRAM " CR
  28.    ." COPYRIGHT (C) 1985 BY THOMAS ALMY " CR ;
  29.  
  30. 0 0 IN/OUT 
  31. : USAGE   CONSOLE CR
  32.  ." USAGE:  TAIL [-[+][n][C][R]] [srcfile] [destfile]" CR
  33.  ." where srcfile is an ascii source file, or - for standard input" CR
  34.  ." and destfile is output file." CR
  35.  ." + --> type leading lines instead of tail" CR
  36.  ." n --> line count (default to 10)" CR
  37.  ." C --> `n' is character count" CR
  38.  ." R --> output lines backwards (+ or C ignored)" CR 
  39.  ABORT ;
  40.  
  41. 0 1 IN/OUT
  42. : MORE-LINES? ( -- true if more lines )
  43.   LCOUNT 2@ 2DUP OR -ROT -1. D+ LCOUNT 2! ;
  44.  
  45. 1 0 IN/OUT
  46. : ?DIE  IF CONSOLE ." I/O ERROR" ABORT THEN ;
  47.  
  48.  
  49.  
  50. \ routines for reverse reading
  51.  
  52. 0 1 IN/OUT
  53. : BACKREAD ( -- bofflag )
  54.    OFFSET 2@ OR 0= IF TRUE EXIT THEN ( backed up to start already )
  55.    OFFSET 2@ BUFSIZ 0 D- OFFSET 2!
  56.    infile OFFSET 2@ 0 FSEEK 2DROP ( back file up )
  57.    infile inbuffer @ BUFSIZ FREAD DUP BUFSIZ <> ?DIE 
  58.    inbuffer @ +  DUP inbufend !  inbufptr ! ( start at end of buffer )
  59.    FALSE
  60.    ;
  61.    
  62. 0 0 IN/OUT
  63. : INIT-REVERSE
  64.   infile 0 0 2 FSEEK  OFFSET 2! ( compute file size )
  65.   OFFSET 2+ @  BUFSIZ 1- AND ?DUP IF ( short first buffer? )
  66.       DUP NEGATE OFFSET 2+ +! ( adjust offset )
  67.         infile OFFSET 2@ 0 FSEEK 2DROP
  68.       infile inbuffer @ 2 PICK FREAD TUCK <> ?DIE
  69.       inbuffer @ + DUP inbufend ! inbufptr !
  70.   ELSE
  71.     inbuffer @ inbufptr !
  72.       BACKREAD DROP 
  73.   THEN ;
  74.  
  75. 0 1 IN/OUT
  76. : -KEY ( -- key or -1 if BOF )
  77.   inbuffer @ inbufptr @ = IF BACKREAD IF TRUE EXIT THEN THEN
  78.   -1 inbufptr +!
  79.   inbufptr @ C@  ;
  80.  
  81.  
  82. \ Copying routines
  83. 0 0 IN/OUT
  84. : +COPY                 \ Copy in forward direction
  85.   CFLAG @ IF ( by character )
  86.     BEGIN
  87.       MORE-LINES? WHILE ( non-zero so move a character )
  88.       KEY DUP 0< NOT IF EMIT ELSE DROP EXIT THEN
  89.     REPEAT
  90.   ELSE  ( by line )
  91.     BEGIN
  92.       MORE-LINES? WHILE ( non-zero so move a line )
  93.         BEGIN KEY DUP 0< IF DROP EXIT THEN
  94.            DUP NL <> WHILE
  95.            EMIT
  96.         REPEAT EMIT
  97.     REPEAT  THEN ;
  98.  
  99.  
  100. 0 0 IN/OUT
  101. : RCOPY                 \ Reverse copy
  102.   2 ALLOT
  103.   HERE RLINEBUF !  
  104.   256 ALLOT ( allot our storage )
  105.   INIT-REVERSE ( will go backwards )
  106.   -KEY 0< IF EXIT THEN ( quit if nothing )
  107.   BEGIN MORE-LINES? WHILE  RLINEBUF @ ( end of line )
  108.       BEGIN -KEY DUP 0< NOT  OVER NL <> AND WHILE
  109.        OVER C! 1+ REPEAT  ( buffer, key )  SWAP
  110.       BEGIN  DUP RLINEBUF @  <> WHILE
  111.             1- DUP C@ EMIT 
  112.       REPEAT DROP
  113.       NL EMIT 
  114.       TRUE = IF EXIT THEN
  115.   REPEAT  ;
  116.  
  117.  
  118.  
  119. 0 0 IN/OUT
  120. : BACK-LINES    \ Search backwards from end by lines
  121.     INIT-REVERSE
  122.     BEGIN BEGIN -KEY DUP 0< IF DROP  EXIT THEN
  123.                  NL = UNTIL
  124.           MORE-LINES? 0= UNTIL
  125.     KEY DROP ;
  126.  
  127. 0 0 IN/OUT
  128. : BACK-CHARS    \ Tricky search backwards by characters 
  129.    infile 0 0 2 FSEEK LCOUNT 2@ DMIN DNEGATE 
  130.    infile -ROT 1 FSEEK 2DROP ;
  131.  
  132. 0 0 IN/OUT
  133. : -COPY                 \ Copy final lines/characters
  134.    CFLAG @ IF BACK-CHARS ELSE BACK-LINES THEN
  135.    BEGIN KEY DUP 0< NOT WHILE
  136.          EMIT REPEAT  DROP ;
  137.  
  138.  
  139. \ Parse Command stream
  140.  
  141. 1 0 IN/OUT
  142. : BAD-OPTION \ Just print the error message then quit
  143.    CONSOLE CR ." BAD OPTION - " EMIT USAGE ;
  144.  
  145. 0 0 IN/OUT
  146. : READ-OPTIONS
  147.   +FLAG OFF 
  148.   CFLAG OFF 
  149.   RFLAG OFF 
  150.   10. LCOUNT 2!
  151.   OPTIONSTRING 2@ 0 ?DO  COUNT 
  152.   DUP ASCII a >= IF BL - THEN CASE
  153.     ASCII C OF CFLAG ON  1 ENDOF
  154.     ASCII + OF +FLAG ON  1 ENDOF  
  155.     ASCII R OF RFLAG ON  1 ENDOF
  156.         DUP ASCII 0 >= OVER ASCII 9 <= AND IF
  157.           DROP DUP >R 2- 0. ROT CONVERT -ROT LCOUNT 2! DUP R> - 1+ 0
  158.           ELSE BAD-OPTION THEN  ENDCASE
  159.       +LOOP DROP ;
  160.  
  161.  
  162. 1 1 IN/OUT
  163. CODE SERIAL? ( handle -- TRUE if serial device )
  164. HEX
  165.     AX BX MOV
  166.     4400 # AX MOV
  167.     21 INT
  168.     DX AX MOV
  169.     80 # AX AND
  170.     RET
  171. END-CODE
  172.  
  173. \ MAIN ROUTINE
  174. : MAIN
  175.     SETBUFS
  176.     NOTICE
  177.     SETFILES infile HCB>H SERIAL? OR IF USAGE THEN
  178.     READ-OPTIONS
  179.     RFLAG @ IF 
  180.         RCOPY 
  181.     ELSE
  182.         +FLAG @ IF 
  183.             +COPY 
  184.         ELSE 
  185.             -COPY 
  186.         THEN 
  187.     THEN
  188.     BYE ;
  189.  
  190. INCLUDE DOS2
  191. INCLUDE FORTHLIB
  192. END
  193.