home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware 1 2 the Maxx
/
sw_1.zip
/
sw_1
/
PROGRAM
/
FORTHCMP.ZIP
/
FFIND.4TH
< prev
next >
Wrap
Text File
|
1992-03-30
|
6KB
|
212 lines
\ FORTH FIND PROGRAM, BY TOM ALMY.
\ THIS PROGRAM IS COPYRIGHT (C) 1985 BY TOM ALMY,
\ ALL RIGHTS RESERVED.
\ Users of ForthCMP are given permission to use or distribute this
\ program, as long as no charge is made and the credit message is maintained.
100 MSDOS
\ I80186 \ FOR PC/AT
\ ALIGNDATA \ FOR PC/AT
INCLUDE VARS
INCLUDE DOS1
0 0 IN/OUT NEED HELP-ME
VARIABLE CHPOS \ Position in line
\ KEY -- FROM A FILE
32768 CONSTANT INBUFSZ
HCB INFILE \ File being read
10000 CONSTANT INBUFFER \ Buffer for input file
VARIABLE INBUFPTR \ Pointer to next character in buffer
VARIABLE INBUFEND \ End of buffer
128 CONSTANT SCRATCH_BUF
: KEY INBUFPTR @ INBUFEND @ = IF ( fetch block )
INFILE INBUFFER INBUFSZ FREAD ?DUP IF ( everything OK )
INBUFFER INBUFPTR !
INBUFFER + INBUFEND !
ELSE CHPOS OFF CONTROL Z EXIT
THEN
THEN
CHPOS @ 64 <> IF ( character is in line )
1 CHPOS +!
INBUFPTR @ C@ 127 AND 1 INBUFPTR +!
ELSE
13 ( cr ) CHPOS OFF
THEN ;
\ DIRECTORY SEARCHING STUFF
256 CONSTANT LINBUFSIZE \ Lines should not be longer than this
CREATE LINEBUF LINBUFSIZE ALLOT
CREATE MATCHBUF 128 ALLOT
CREATE UCMATCHBUF 128 ALLOT \ upcased version of above )
VARIABLE NEXTITEM \ must scan for new wildcard file name
HCB WILDFILE \ possibly wildcarded file name
VARIABLE INFILEP \ just a pointer
VARIABLE /PNTR \ location of last / or \
1 0 IN/OUT
: ADD.DEFAULT.EXTENSION ( handle -- )
2+ DUP >R 1+ ( ext string )
BEGIN COUNT DUP ASCII . = IF DROP BEGIN COUNT DUP 0=
IF R> DROP 2DROP EXIT THEN DUP ASCII \ = SWAP ASCII / = OR UNTIL 1 THEN
0= UNTIL
DUP 1- ASCII . C<- ( replace null with dot )
CNT" SCR" 0 DO COUNT 2 PICK C! SWAP 1+ SWAP LOOP
DROP ( extension address )
DUP 0 C<- ( delimit string )
R@ - 1- R> C! ( set length byte )
;
0 0 IN/OUT
: PARSE-COMMAND-LINE ( -- )
128 1+ TIB 127 CMOVE
128 C@ #TIB !
>IN OFF
NEXTITEM ON
BL WORD COUNT DUP 0= IF HELP-ME THEN ( NO ARGUMENTS )
MATCHBUF SWAP CMOVE ( MOVE IN MATCH STRING )
128 0 DO MATCHBUF I + C@ DUP ASCII a >= IF DUP ASCII z <=
IF 32 - THEN THEN
UCMATCHBUF I + C! LOOP ( fill uppercase buffer )
;
1 0 IN/OUT
: PUTN ( character -- , put in string of INFILE )
INFILEP @ C! 1 INFILEP +! ;
0 0 IN/OUT
: MAKE-FILENAME \ set up INFILE with path from WILDFILE and
\ file name from SCRATCH_BUF
INFILE 3 + INFILEP ! \ address of destination string
INFILEP @ /PNTR ! \ location of last slash
WILDFILE 2+ COUNT 0 ?DO COUNT DUP PUTN
DUP ASCII \ = SWAP ASCII / = OR IF INFILEP @ /PNTR ! THEN LOOP
DROP ( wildfile pointer )
/PNTR @ INFILEP ! \ get rid of characters after last \
SCRATCH_BUF 30 + \ remainder of filename
BEGIN COUNT DUP WHILE PUTN REPEAT 2DROP
INFILEP @ INFILE 3 + - INFILE 2+ C! \ length
0 PUTN \ zero delimit string
;
0 1 IN/OUT
: NEW-FILE? ( -- success )
BEGIN NEXTITEM @ IF ( must scan input stream )
BL WORD DUP C@ 0= IF DROP 0 EXIT THEN ( End of line )
WILDFILE NAME>HCB
WILDFILE ADD.DEFAULT.EXTENSION
WILDFILE HCB>N 0 firstf
NEXTITEM OFF
ELSE
nextf THEN
WHILE ( search failed )
NEXTITEM ON
REPEAT
MAKE-FILENAME
INFILE O_RD FOPEN IF CR
." OPEN FAILED FOR " INFILE .FNAME
NEW-FILE? EXIT THEN
INBUFEND @ INBUFPTR ! ( force first read )
-1 ( SUCCESS! ) ;
0 0 IN/OUT
: CLOSE-THE-FILE INFILE FCLOSE DROP ;
0 0 IN/OUT
: PRINT-SEARCHING ( --- )
CR ." Searching " INFILE .FNAME ;
0 0 IN/OUT
: HELLO
." Forth Search Program. Copyright (C) 1865 by Tom Almy" CR
;
0 0 IN/OUT
: HELP-ME
." Usage: FFIND string {filenames}" CR
0 0 BDOS
;
VARIABLE LINE#
VARIABLE ^LINE
1 0 IN/OUT
: PUT-LINE ( char -- ) ^LINE @ C! 1 ^LINE +! ;
0 0 IN/OUT
: CLEAR-LINE LINEBUF ^LINE ! ;
0 0 IN/OUT
: .LINE ( display matched line )
CR LINE# @ 16 /MOD 4 .R SPACE 3 .R SPACE
LINEBUF ^LINE @ LINEBUF - TYPE
BEGIN KEY DUP BL >= WHILE EMIT REPEAT DROP
CLEAR-LINE ;
0 0 IN/OUT
: SEARCHING PRINT-SEARCHING
LINE# OFF CLEAR-LINE
UCMATCHBUF COUNT
MATCHBUF COUNT ( first char on top of stack, bufferaddr under )
BEGIN KEY CASE
13 OF CLEAR-LINE 2DROP 2DROP 1 LINE# +!
UCMATCHBUF COUNT MATCHBUF COUNT ENDOF \ CR
26 OF 2DROP 2DROP EXIT ENDOF \ END OF FILE
0 OF 2DROP 2DROP EXIT ENDOF \ null is also eof
\ stack has ucbufaddr char bufaddr char key
OVER OF \ CHARACTER MATCHES
PUT-LINE NIP SWAP COUNT ROT COUNT
DUP 0= IF 2DROP 2DROP \ COMPLETE MATCH
.LINE
UCMATCHBUF COUNT MATCHBUF COUNT THEN
ENDOF
\ stack has ucbufaddr char bufaddr char key
3 PICK OF \ UPPERCASE CHARACTER MATCHES
ROT PUT-LINE DROP SWAP COUNT ROT COUNT
DUP 0= IF 2DROP 2DROP \ COMPLETE MATCH
.LINE
UCMATCHBUF COUNT MATCHBUF COUNT THEN
ENDOF
PUT-LINE 2DROP 2DROP \ NO MATCH
UCMATCHBUF COUNT MATCHBUF COUNT 0
ENDCASE
0 UNTIL \ REPEAT FOREVER
;
\ MAIN LOOP
: MAIN
HELLO
PARSE-COMMAND-LINE
BEGIN
NEW-FILE? WHILE
SEARCHING
CLOSE-THE-FILE
REPEAT ;
INCLUDE DOS2
INCLUDE FORTHLIB
NOMAP
END