Category : Pascal Source Code
Archive   : SOFTOOLS.ZIP
Filename : CHAPTER4.PAS

{chapter4.pas}

{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmith's Ltd.,

This software is derived from the book
"Software Tools in Pascal", by
Brian W. Kernighan and P. J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7

Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commercial gain and that this copyright notice remains
intact.
}

PROCEDURE SORT;
CONST
MAXCHARS=10000;
MAXLINES=300;
MERGEORDER=5;
TYPE
CHARPOS=1..MAXCHARS;
CHARBUF=ARRAY[1..MAXCHARS] OF CHARACTER;
POSBUF=ARRAY[1..MAXLINES] OF CHARPOS;
POS=0..MAXLINES;
FDBUF=ARRAY[1..MERGEORDER]OF FILEDESC;
VAR
LINEBUF:CHARBUF;
LINEPOS:POSBUF;
NLINES:POS;
INFILE:FDBUF;
OUTFILE:FILEDESC;
HIGH,LOW,LIM:INTEGER;
DONE:BOOLEAN;
NAME:XSTRING;
FUNCTION GTEXT(VAR LINEPOS:POSBUF;VAR NLINES:POS;
VAR LINEBUF:CHARBUF;INFILE:FILEDESC):BOOLEAN;
VAR
I,LEN,NEXTPOS:INTEGER;
TEMP:XSTRING;
DONE:BOOLEAN;
BEGIN
NLINES:=0;
NEXTPOS:=1;
REPEAT
DONE:=(GETLINE(TEMP,INFILE,MAXSTR)=FALSE);
IF(NOT DONE) THEN BEGIN
NLINES:=NLINES+1;
LINEPOS[NLINES]:=NEXTPOS;
LEN:=XLENGTH(TEMP);
FOR I:=1 TO LEN DO
LINEBUF[NEXTPOS+I-1]:=TEMP[I];
LINEBUF[NEXTPOS+LEN]:=ENDSTR;
NEXTPOS:=NEXTPOS+LEN+1
END
UNTIL (DONE) OR (NEXTPOS>= MAXCHARS-MAXSTR)
OR (NLINES>=MAXLINES);
GTEXT:=DONE
END;

PROCEDURE PTEXT(VAR LINEPOS:POSBUF;NLINES:INTEGER;
VAR LINEBUF:CHARBUF;OUTFILE:FILEDESC);
VAR
I,J:INTEGER;
BEGIN
FOR I:=1 TO NLINES DO BEGIN
J:=LINEPOS[I];
WHILE (LINEBUF[J]<>ENDSTR)DO BEGIN
PUTCF(LINEBUF[J],OUTFILE);
J:=J+1
END
END
END;



PROCEDURE EXCHANGE(VAR LP1,LP2:CHARPOS);
VAR
TEMP:CHARPOS;
BEGIN
TEMP:=LP1;
LP1:=LP2;
LP2:=TEMP
END;

FUNCTION CMP (I,J:CHARPOS;VAR LINEBUF:CHARBUF)
:INTEGER;
BEGIN
WHILE(LINEBUF[I]=LINEBUF[J])
AND (LINEBUF[I]<>ENDSTR) DO BEGIN
I:=I+1;
J:=J+1
END;
IF(LINEBUF[I]=LINEBUF[J]) THEN
CMP:=0
ELSE IF (LINEBUF[I]=ENDSTR) THEN
CMP:=-1
ELSE IF (LINEBUF[J]=ENDSTR) THEN
CMP:=+1
ELSE IF (LINEBUF[I] CMP:=-1
ELSE
CMP:=+1
END;(*CMP*)


PROCEDURE QUICK(VAR LINEPOS:POSBUF; NLINE:POS;
VAR LINEBUF:CHARBUF);
PROCEDURE RQUICK(LO,HI:INTEGER);
VAR
I,J:INTEGER;
PIVLINE:CHARPOS;
BEGIN
IF (LO I:=LO;
J:=HI;
PIVLINE:=LINEPOS[J];
REPEAT
WHILE (I AND (CMP(LINEPOS[I],PIVLINE,LINEBUF)<=0) DO
I:=I+1;
WHILE (J>I)
AND (CMP(LINEPOS[J],PIVLINE,LINEBUF)>=0) DO
J:=J-1;
IF(I (*OUT OF ORDER PAIR*)
EXCHANGE(LINEPOS[I],LINEPOS[J])
UNTIL (I>=J);
EXCHANGE(LINEPOS[I],LINEPOS[HI]);
IF(I-LO RQUICK(LO,I-1);
RQUICK(I+1,HI)
END
ELSE BEGIN
RQUICK(I+1,HI);
RQUICK(LO,I-1)
END
END
END;(*RQUICK*)

BEGIN(*QUICK*)
RQUICK(1,NLINES)
END;


PROCEDURE GNAME(N:INTEGER;VAR NAME:XSTRING);
VAR
JUNK:INTEGER;
BEGIN
NAME[1]:=ORD('S');
NAME[2]:=ORD('T');
NAME[3]:=ORD('E');
NAME[4]:=ORD('M');
NAME[5]:=ORD('P');
NAME[6]:=ENDSTR;
JUNK:=ITOC(N,NAME,XLENGTH(NAME)+1)
END;

PROCEDURE GOPEN(VAR INFILE:FDBUF;F1,F2:INTEGER);
VAR
NAME:XSTRING;
I:1..MERGEORDER;
BEGIN
FOR I:=1 TO F2-F1+1 DO BEGIN
GNAME(F1+I-1,NAME);
INFILE[I]:=MUSTOPEN(NAME,IOREAD)
END
END;

PROCEDURE GREMOVE(VAR INFILE:FDBUF;F1,F2:INTEGER);
VAR
NAME:XSTRING;
I:1..MERGEORDER;
BEGIN
FOR I:= 1 TO F2-F1+1 DO BEGIN
XCLOSE(INFILE[I]);
GNAME(F1+I-1,NAME);
REMOVE(NAME)
END
END;


FUNCTION MAKEFILE(N:INTEGER):FILEDESC;
VAR
NAME:XSTRING;
BEGIN
GNAME(N,NAME);

MAKEFILE:=MUSTCREATE(NAME,IOWRITE)
END;

PROCEDURE MERGE(VAR INFILE:FDBUF; NF:INTEGER;
OUTFILE:FILEDESC);

VAR
I,J:INTEGER;
LBP:CHARPOS;
TEMP:XSTRING;

PROCEDURE REHEAP(VAR LINEPOS:POSBUF;NF:POS;
VAR LINEBUF:CHARBUF);
VAR
I,J:INTEGER;
BEGIN
I:=1;
J:=2*I;
WHILE(J<=NF)DO BEGIN
IF(J IF(CMP(LINEPOS[J],LINEPOS[J+1],LINEBUF)>0)THEN
J:=J+1;
IF(CMP(LINEPOS[I],LINEPOS[J],LINEBUF)<=0)THEN
I:=NF
ELSE
EXCHANGE(LINEPOS[I],LINEPOS[J]);(*PERCOLATE*)
I:=J;
J:=2*I
END
END;

PROCEDURE SCCOPY(VAR S:XSTRING; VAR CB:CHARBUF;
I:CHARPOS);
VAR J:INTEGER;
BEGIN
J:=1;
WHILE(S[J]<>ENDSTR)DO BEGIN
CB[I]:=S[J];
J:=J+1;
I:=I+1
END;
CB[I]:=ENDSTR
END;

PROCEDURE CSCOPY(VAR CB:CHARBUF;I:CHARPOS;
VAR S:XSTRING);
VAR J:INTEGER;
BEGIN
J:=1;
WHILE(CB[I]<>ENDSTR)DO BEGIN
S[J]:=CB[I];
I:=I+1;
J:=J+1
END;
S[J]:=ENDSTR
END;

BEGIN(*MERGE*)
J:=0;
FOR I:=1 TO NF DO
IF(GETLINE(TEMP,INFILE[I],MAXSTR)) THEN BEGIN
LBP:=(I-1)*MAXSTR+1;
SCCOPY(TEMP,LINEBUF,LBP);
LINEPOS[I]:=LBP;
J:=J+1
END;
NF:=J;
QUICK(LINEPOS,NF,LINEBUF);
WHILE (NF>0) DO BEGIN
LBP:=LINEPOS[1];
CSCOPY(LINEBUF,LBP,TEMP);
PUTSTR(TEMP,OUTFILE);
I:=LBP DIV MAXSTR +1;
IF (GETLINE(TEMP,INFILE[I],MAXSTR))THEN
SCCOPY(TEMP,LINEBUF,LBP)
ELSE BEGIN
LINEPOS[1]:=LINEPOS[NF];
NF:=NF-1
END;
REHEAP(LINEPOS,NF,LINEBUF)
END
END;


BEGIN
HIGH:=0;
REPEAT (*INITIAL FORMTION OF RUNS*)
DONE:=GTEXT(LINEPOS,NLINES,LINEBUF,STDIN);
QUICK(LINEPOS,NLINES,LINEBUF);
HIGH:=HIGH+1;
OUTFILE:=MAKEFILE(HIGH);
PTEXT(LINEPOS,NLINES,LINEBUF,OUTFILE);
XCLOSE(OUTFILE)
UNTIL (DONE);
LOW:=1;
WHILE (LOW LIM:=MIN(LOW+MERGEORDER-1,HIGH);
GOPEN(INFILE,LOW,LIM);
HIGH:=HIGH+1;
OUTFILE:=MAKEFILE(HIGH);
MERGE(INFILE,LIM-LOW+1,OUTFILE);
XCLOSE(OUTFILE);
GREMOVE(INFILE,LOW,LIM);
LOW:=LOW+MERGEORDER
END;
GNAME(HIGH,NAME);
OUTFILE:=OPEN(NAME,IOREAD);
FCOPY(OUTFILE,STDOUT);
XCLOSE(OUTFILE);
REMOVE(NAME)
END;

PROCEDURE UNIQUE;
VAR
BUF:ARRAY[0..1] OF XSTRING;
CUR:0..1;
BEGIN
CUR:=1;
BUF[1-CUR][1]:=ENDSTR;
WHILE (GETLINE(BUF[CUR],STDIN,MAXSTR))DO
IF (NOT EQUAL (BUF[CUR],BUF[1-CUR])) THEN BEGIN
PUTSTR(BUF[CUR],STDOUT);
CUR:=1-CUR
END
END;

PROCEDURE KWIC;
CONST
FOLD=DOLLAR;
VAR
BUF:XSTRING;

PROCEDURE PUTROT(VAR BUF:XSTRING);
VAR I:INTEGER;

PROCEDURE ROTATE(VAR BUF:XSTRING;N:INTEGER);
VAR I:INTEGER;
BEGIN
I:=N;
WHILE (BUF[I]<>NEWLINE) AND (BUF[I]<>ENDSTR) DO BEGIN
PUTC(BUF[I]);
I:=I+1
END;
PUTC(FOLD);
FOR I:=1 TO N-1 DO
PUTC(BUF[I]);
PUTC(NEWLINE)
END;(*ROTATE*)

BEGIN(*PUTROT*)
I:=1;
WHILE(BUF[I]<>NEWLINE) AND (BUF[I]<>ENDSTR) DO BEGIN
IF (ISALPHANUM(BUF[I])) THEN BEGIN
ROTATE(BUF,I);(*TOKEN STATRS AT "I"*)
REPEAT
I:=I+1
UNTIL (NOT ISALPHANUM(BUF[I]))
END;
I:=I+1
END

END;(*PUTROT*)

BEGIN(*KWIC*)
WHILE(GETLINE(BUF,STDIN,MAXSTR))DO
PUTROT(BUF)
END;

PROCEDURE UNROTATE;
CONST
MAXOUT=80;
MIDDLE=40;
FOLD=DOLLAR;
VAR
INBUF,OUTBUF:XSTRING;
I,J,F:INTEGER;
BEGIN
WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO BEGIN
FOR I:=1 TO MAXOUT-1 DO
OUTBUF[I]:=BLANK;
F:=INDEX(INBUF,FOLD);
J:=MIDDLE-1;
FOR I:=XLENGTH(INBUF)-1 DOWNTO F+1 DO BEGIN
OUTBUF[J]:=INBUF[I];
J:=J-1;
IF(J<=0)THEN
J:=MAXOUT-1
END;
J:=MIDDLE+1;
FOR I:=1 TO F-1 DO BEGIN
OUTBUF[J]:=INBUF[I];
J:=J MOD (MAXOUT-1) +1
END;
FOR J:=1 TO MAXOUT-1 DO
IF(OUTBUF[J]<>BLANK) THEN
I:=J;
OUTBUF[I+1]:=ENDSTR;
PUTSTR(OUTBUF,STDOUT);
PUTC(NEWLINE)
END
END;