Software Tools in Pascal for Turbo Pascal (part 1/3)
Tom Reingold
reintom at rocky2.UUCP
Fri Sep 19 15:15:18 AEST 1986
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# README.V30
# chapter1.pas
# chapter2.pas
# chapter3.pas
# chapter4.pas
# This archive created: Thu Sep 18 14:16:10 1986
export PATH; PATH=/bin:$PATH
if test -f 'README.V30'
then
echo shar: will not over-write existing file "'README.V30'"
else
cat << \SHAR_EOF > 'README.V30'
{readme.v30}
TURBTOOL.LBR DOCUMENTATION
This library contains the source from the book
"Software Tools in Pascal" by B.W. Kernighan and
P.J. Plauger, Addison-Wesley. It has been adapted
for Turbo Pascal.
How to Implement:
Compile SHELL.PAS with the CMD option
Execute SHELL
Accepts redirection, but not pipes.
Bill McGee, 613-828-9130
Notes: The version using TURBO is fast enough to make
this a useful set of tools for file manipulation.
------Further Modifications------
The primitives in this version are basically the UCSD Pascal versions
presented in the book, with modifications for Turbo Pascal.
This version has been modified for use under Turbo Pascal v. 3.0
under CP/M-86. There are no system dependent statements in the code
to the best of my knowledge, so it should work under MS-DOS as well.
The original version (typed in by Bill McGee) was set up for CP/M-80 and
used the CHAIN capability of Turbo Pascal. I have eliminated that
feature in favor of using INCLUDE files. There is not enough memory
available in a CP/M-80 system for this version, but one could modify
the include file list to eliminate unwanted features or to make more
than one version, (e.g. break out EDIT, FORMAT, and DEFINE).
There was really only one change required to the McGee's original to get
it to work with version 3.0. A readln(TRM) had to be added in the
subroutine GETKBD. The change to CP/M-86 required replacing all calls
to the procedure BDOS(0,0) with HALT. This change works with the CP/M-80
version of Turbo Pascal v. 3.0 as well. Thus, as anyone can see, all of
the hard work was done by Bill.
(Adaption to version 3.0 of Turbo Pascal by Jim Potter, (505) 662-5804.)
Please note that this is copyright software. The following notice has
been included with each file and should not be removed.
+-------------------------------------------------------------------------+
| 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. |
+-------------------------------------------------------------------------+
SHAR_EOF
if test 3049 -ne "`wc -c < 'README.V30'`"
then
echo shar: error transmitting "'README.V30'" '(should have been 3049 characters)'
fi
fi # end of overwriting check
if test -f 'chapter1.pas'
then
echo shar: will not over-write existing file "'chapter1.pas'"
else
cat << \SHAR_EOF > 'chapter1.pas'
{chapter1.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 COPY;
VAR C:CHARACTER;
BEGIN
WHILE(GETC(C)<>ENDFILE)DO
PUTC(C)
END;
PROCEDURE CHARCOUNT;
VAR
NC:INTEGER;
C:CHARACTER;
BEGIN
NC:=0;
WHILE (GETC(C)<>ENDFILE)DO
NC:=NC+1;
PUTDEC(NC,1);
PUTC(NEWLINE)
END;
PROCEDURE LINECOUNT;
VAR
N1:INTEGER;
C:CHARACTER;
BEGIN
N1:=0;
WHILE(GETC(C)<>ENDFILE)DO
IF(C=NEWLINE)THEN
N1:=N1+1;
PUTDEC(N1,1);
PUTC(NEWLINE)
END;
PROCEDURE WORDCOUNT;
VAR
NW:INTEGER;
C:CHARACTER;
INWORD:BOOLEAN;
BEGIN
NW:=0;
INWORD:=FALSE;
WHILE(GETC(C)<>ENDFILE)DO
IF(C=BLANK)OR(C=NEWLINE)OR(C=TAB) THEN
INWORD:=FALSE
ELSE IF (NOT INWORD)THEN BEGIN
INWORD:=TRUE;
NW:=NW+1
END;
PUTDEC(NW,1);
PUTC(NEWLINE)
END;
PROCEDURE DETAB;
CONST
MAXLINE=1000;
TYPE
TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
VAR
C:CHARACTER;
COL:INTEGER;
TABSTOPS:TABTYPE;
FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE)
:BOOLEAN;
BEGIN
IF(COL>MAXLINE)THEN
TABPOS:=TRUE
ELSE
TABPOS:=TABSTOPS[COL]
END;
PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
CONST
TABSPACE=4;
VAR
I:INTEGER;
BEGIN
FOR I:=1 TO MAXLINE DO
TABSTOPS[I]:=(I MOD TABSPACE = 1)
END;
BEGIN
SETTABS(TABSTOPS);
COL:=1;
WHILE(GETC(C)<>ENDFILE)DO
IF(C=TAB)THEN
REPEAT
PUTC(BLANK);
COL:=COL+1
UNTIL(TABPOS(COL,TABSTOPS))
ELSE IF(C=NEWLINE)THEN BEGIN
PUTC(NEWLINE);
COL:=1
END
ELSE BEGIN
PUTC(C);
COL:=COL+1
END
END;
SHAR_EOF
if test 2054 -ne "`wc -c < 'chapter1.pas'`"
then
echo shar: error transmitting "'chapter1.pas'" '(should have been 2054 characters)'
fi
fi # end of overwriting check
if test -f 'chapter2.pas'
then
echo shar: will not over-write existing file "'chapter2.pas'"
else
cat << \SHAR_EOF > 'chapter2.pas'
{chapter2.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 TRANSLIT;FORWARD;
PROCEDURE ENTAB;FORWARD;
PROCEDURE EXPAND;FORWARD;
PROCEDURE ECHO;FORWARD;
PROCEDURE COMPRESS;FORWARD;
PROCEDURE OVERSTRIKE;FORWARD;
PROCEDURE OVERSTRIKE;
CONST
SKIP=BLANK;
NOSKIP=PLUS;
VAR
C:CHARACTER;
COL,NEWCOL,I:INTEGER;
BEGIN
COL:=1;
REPEAT
NEWCOL:=COL;
WHILE(GETC(C)=BACKSPACE) DO
NEWCOL:=MAX(NEWCOL-1,1);
IF (NEWCOL<COL) THEN BEGIN
PUTC(NEWLINE);
PUTC(NOSKIP);
FOR I:=1 TO NEWCOL-1 DO
PUTC(BLANK);
COL:=NEWCOL
END
ELSE IF (COL=1) AND (C<>ENDFILE) THEN
PUTC(SKIP);
IF(C<>ENDFILE)THEN BEGIN
PUTC(C);
IF (C=NEWLINE) THEN
COL:=1
ELSE
COL:=COL+1
END
UNTIL (C=ENDFILE)
END;
PROCEDURE COMPRESS;
CONST
WARNING=CARET;
VAR
C,LASTC:CHARACTER;
N:INTEGER;
PROCEDURE PUTREP(N:INTEGER;C:CHARACTER);CONST
MAXREP=26;
THRESH=4;
BEGIN
WHILE(N>=THRESH)OR((C=WARNING)AND(N>0))DO BEGIN
PUTC(WARNING);
PUTC(MIN(N,MAXREP)-1+ORD('A'));
PUTC(C);
N:=N-MAXREP
END;
FOR N:=N DOWNTO 1 DO
PUTC(C)
END;
BEGIN(*COMPRESS*)
N:=1;
LASTC:=GETC(LASTC);
WHILE(LASTC<>ENDFILE) DO BEGIN
IF(GETC(C)=ENDFILE)THEN BEGIN
IF(N>1) OR(LASTC=WARNING) THEN
PUTREP(N,LASTC)
ELSE
PUTC(LASTC)
END
ELSE IF (C=LASTC) THEN
N:=N+1
ELSE IF (N>1) OR (LASTC=WARNING) THEN BEGIN
PUTREP(N,LASTC);
N:=1
END
ELSE
PUTC(LASTC);
LASTC:=C
END
END;
PROCEDURE EXPAND;
CONST
WARNING=CARET;
VAR
C:CHARACTER;
N:INTEGER;
BEGIN
WHILE(GETC(C)<>ENDFILE) DO
IF (C<>WARNING)THEN
PUTC(C)
ELSE IF(ISUPPER(GETC(C))) THEN BEGIN
N:=C-ORD('A')+1;
IF(GETC(C)<>ENDFILE)THEN
FOR N:=N DOWNTO 1 DO
PUTC(C)
ELSE BEGIN
PUTC(WARNING);
PUTC(N-1+ORD('A'))
END
END
ELSE BEGIN
PUTC(WARNING);
IF(C<>ENDFILE) THEN
PUTC(C)
END
END;
PROCEDURE ECHO;
VAR
I,J:INTEGER;
ARGSTR:XSTRING;
BEGIN
I:=2;
WHILE(GETARG(I,ARGSTR,MAXSTR))DO BEGIN
IF(I>1) THEN PUTC(BLANK);
FOR J:=1 TO XLENGTH(ARGSTR) DO
PUTC(ARGSTR[J]);
I:=I+1
END;
IF(I>1)THEN PUTC(NEWLINE)
END;
PROCEDURE ENTAB;
CONST
MAXLINE=1000;
TYPE
TABTYPE=ARRAY[1..MAXLINE] OF BOOLEAN;
VAR
C:CHARACTER;
COL,NEWCOL:INTEGER;
TABSTOPS:TABTYPE;
FUNCTION TABPOS(COL:INTEGER;VAR TABSTOPS:TABTYPE):BOOLEAN;
BEGIN
IF(COL>MAXLINE)THEN
TABPOS:=TRUE
ELSE
TABPOS:=TABSTOPS[COL]
END;
PROCEDURE SETTABS(VAR TABSTOPS:TABTYPE);
CONST
TABSPACE=4;
VAR
I:INTEGER;
BEGIN
FOR I:=1 TO MAXLINE DO
TABSTOPS[I]:=(I MOD TABSPACE = 1)
END;
BEGIN
SETTABS(TABSTOPS);
COL:=1;
REPEAT
NEWCOL:=COL;
WHILE(GETC(C)=BLANK) DO BEGIN
NEWCOL:=NEWCOL+1;
IF(TABPOS(NEWCOL,TABSTOPS))THEN BEGIN
PUTC(TAB);
COL:=NEWCOL;
END
END;
WHILE (COL<NEWCOL) DO BEGIN
PUTC(BLANK);
COL:=COL+1
END;
IF(C<>ENDFILE) THEN BEGIN
PUTC(C);
IF(C=NEWLINE) THEN
COL:=1
ELSE
COL:=COL+1
END
UNTIL(C=ENDFILE)
END;
PROCEDURE TRANSLIT;
CONST
NEGATE=CARET;
VAR
ARG,FROMSET,TOSET:XSTRING;
C:CHARACTER;
I,LASTTO:0..MAXSTR;
ALLBUT,SQUASH:BOOLEAN;
FUNCTION XINDEX(VAR INSET:XSTRING;C:CHARACTER;
ALLBUT:BOOLEAN;LASTTO:INTEGER):INTEGER;
BEGIN
IF(C=ENDFILE)THEN XINDEX:=0
ELSE IF (NOT ALLBUT) THEN
XINDEX:=INDEX(INSET,C)
ELSE IF(INDEX(INSET,C)>0)THEN
XINDEX:=0
ELSE
XINDEX:=LASTTO+1
END;
FUNCTION MAKESET(VAR INSET:XSTRING;K:INTEGER;
VAR OUTSET:XSTRING;MAXSET:INTEGER):BOOLEAN;
VAR J:INTEGER;
PROCEDURE DODASH(DELIM:CHARACTER;VAR SRC:XSTRING;
VAR I:INTEGER;VAR DEST:XSTRING;
VAR J:INTEGER;MAXSET:INTEGER);
VAR
K:INTEGER;
JUNK:BOOLEAN;
BEGIN
WHILE (SRC[I]<>DELIM)AND(SRC[I]<>ENDSTR)DO BEGIN
IF(SRC[I]=ATSIGN)THEN
JUNK:=ADDSTR(ESC(SRC,I),DEST,J,MAXSET)
ELSE IF (SRC[I]<>DASH) THEN
JUNK:=ADDSTR(SRC[I],DEST,J,MAXSET)
ELSE IF (J<=1)OR(SRC[I+1]=ENDSTR)THEN
JUNK:=ADDSTR(DASH,DEST,J,MAXSET)
ELSE IF (ISALPHANUM(SRC[I-1]))
AND (ISALPHANUM(SRC[I+1]))
AND (SRC[I-1]<=SRC[I+1]) THEN BEGIN
FOR K:=SRC[I-1]+1 TO SRC[I+1] DO
JUNK:=ADDSTR(K,DEST,J,MAXSET);
I:=I+1
END
ELSE
JUNK:=ADDSTR(DASH,DEST,J,MAXSET);
I:=I+1
END
END;(*DODASH*)
BEGIN(*MAKESET*)
J:=1;
DODASH(ENDSTR,INSET,K,OUTSET,J,MAXSET);
MAKESET:=ADDSTR(ENDSTR,OUTSET,J,MAXSET)
END;(*MAKESET*)
BEGIN(*TRANSLIT*)
IF (NOT GETARG(2,ARG,MAXSTR))THEN
ERROR('USAGE:TRANSLIT FROM TO');
ALLBUT:=(ARG[1]=NEGATE);
IF(ALLBUT)THEN
I:=2
ELSE
I:=1;
IF (NOT MAKESET(ARG,I,FROMSET,MAXSTR)) THEN
ERROR('TRANSLIT:"FROM"SET TOO LARGE');
IF(NOT GETARG(3,ARG,MAXSTR))THEN
TOSET[1]:=ENDSTR
ELSE IF (NOT MAKESET(ARG,1,TOSET,MAXSTR)) THEN
ERROR('TRANSLIT:"TO"SET TOO LARGE')
ELSE IF (XLENGTH(FROMSET)<XLENGTH(TOSET))THEN
ERROR('TRANSLIT:"FROM"SHORTER THAN "TO');
LASTTO:=XLENGTH(TOSET);
SQUASH:=(XLENGTH(FROMSET)>LASTTO) OR (ALLBUT);
REPEAT
I:=XINDEX(FROMSET,GETC(C),ALLBUT,LASTTO);
IF (SQUASH) AND(I>=LASTTO) AND (LASTTO>0) THEN BEGIN
PUTC(TOSET[LASTTO]);
REPEAT
I:=XINDEX(FROMSET,GETC(C),ALLBUT,LASTTO)
UNTIL (I<LASTTO)
END;
IF(C<>ENDFILE) THEN BEGIN
IF(I>0)AND(LASTTO>0) THEN
PUTC(TOSET[I])
ELSE IF (I=0)THEN
PUTC(C)
(*ELSE DELETE*)
END
UNTIL(C=ENDFILE)
END;
SHAR_EOF
if test 6124 -ne "`wc -c < 'chapter2.pas'`"
then
echo shar: error transmitting "'chapter2.pas'" '(should have been 6124 characters)'
fi
fi # end of overwriting check
if test -f 'chapter3.pas'
then
echo shar: will not over-write existing file "'chapter3.pas'"
else
cat << \SHAR_EOF > 'chapter3.pas'
{chapter3.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 COMPARE;FORWARD;
PROCEDURE INCLUDE;FORWARD;
PROCEDURE CONCAT;FORWARD;
PROCEDURE MAKECOPY;
VAR
INNAME,OUTNAME:XSTRING;
FIN,FOUT:FILEDESC;
BEGIN
IF(NOT GETARG(2,INNAME,MAXSTR))
OR (NOT GETARG(3,OUTNAME,MAXSTR))THEN
ERROR('USAGE:MAKECOPY OLD NEW');
FIN:=MUSTOPEN(INNAME,IOREAD);
FOUT:=MUSTCREATE(OUTNAME,IOWRITE);
FCOPY(FIN,FOUT);
XCLOSE(FIN);
XCLOSE(FOUT)
END;
PROCEDURE PRINT;
VAR
NAME:XSTRING;
NULL:XSTRING;
I:INTEGER;
FIN:FILEDESC;
JUNK:BOOLEAN;
PROCEDURE FPRINT(VAR NAME:XSTRING;FIN:FILEDESC);
CONST
MARGIN1=2;
MARGIN2=2;
BOTTOM=64;
PAGELEN=66;
VAR
LINE:XSTRING;
LINENO,PAGENO:INTEGER;
PROCEDURE SKIP(N:INTEGER);
VAR
I:INTEGER;
BEGIN
FOR I:=1 TO N DO
PUTC(NEWLINE)
END;
PROCEDURE HEAD(VAR NAME:XSTRING;PAGENO:INTEGER);
VAR
PAGE:XSTRING;
BEGIN
PAGE[1]:=ORD(' ');
PAGE[2]:=ORD('P');
PAGE[3]:=ORD('a');
PAGE[4]:=ORD('g');
PAGE[5]:=ORD('e');
PAGE[6]:=ORD(' ');
PAGE[7]:=ENDSTR;
PUTSTR(NAME,STDOUT);
PUTSTR(PAGE,STDOUT);
PUTDEC(PAGENO,1);
PUTC(NEWLINE)
END;
BEGIN(*FPRINT*)
PAGENO:=1;
SKIP(MARGIN1);
HEAD(NAME,PAGENO);
SKIP(MARGIN2);
LINENO:=MARGIN1+MARGIN2+1;
WHILE(GETLINE(LINE,FIN,MAXSTR))DO BEGIN
IF(LINENO=0)THEN BEGIN
SKIP(MARGIN1);;
PAGENO:=PAGENO+1;
HEAD(NAME,PAGENO);
SKIP(MARGIN2);
LINENO:=MARGIN1+MARGIN2+1
END;
PUTSTR(LINE,STDOUT);
LINENO:=LINENO+1;
IF(LINENO>=BOTTOM)THEN BEGIN
SKIP(PAGELEN-LINENO);
LINENO:=0
END
END;
IF(LINENO>0)THEN
SKIP(PAGELEN-LINENO)
END;
BEGIN(*PRINT*)
NULL[1]:=ENDSTR;
IF(NARGS=1)THEN
FPRINT(NULL,STDIN)
ELSE
FOR I:=2 TO NARGS DO BEGIN
JUNK:=GETARG(I,NAME,MAXSTR);
FIN:=MUSTOPEN(NAME,IOREAD);
FPRINT(NAME,FIN);
XCLOSE(FIN)
END
END;
PROCEDURE COMPARE;
VAR
LINE1,LINE2:XSTRING;
ARG1,ARG2:XSTRING;
LINENO:INTEGER;
INFILE1,INFILE2:FILEDESC;
F1,F2:BOOLEAN;
PROCEDURE DIFFMSG (N:INTEGER; VAR LINE1,LINE2:XSTRING);
BEGIN
PUTDEC(N,1);
PUTC(COLON);
PUTC(NEWLINE);
PUTSTR(LINE1,STDOUT);
PUTSTR(LINE2,STDOUT)
END;
BEGIN(*COMPARE*)
IF (NOT GETARG(2,ARG1,MAXSTR))
OR (NOT GETARG(3,ARG2,MAXSTR)) THEN
ERROR('USAGE:COMPARE FILE1 FILE2');
INFILE1:=MUSTOPEN(ARG1,IOREAD);
INFILE2:=MUSTOPEN(ARG2,IOREAD);
LINENO:=0;
REPEAT
LINENO:=LINENO+1;
F1:=GETLINE(LINE1,INFILE1,MAXSTR);
F2:=GETLINE(LINE2,INFILE2,MAXSTR);
IF (F1 AND F2) THEN
IF (NOT EQUAL(LINE1,LINE2)) THEN
DIFFMSG(LINENO,LINE1,LINE2)
UNTIL (F1=FALSE) OR (F2=FALSE);
IF(F2 AND NOT F1) THEN
WRITELN('COMPARE:END OF FILE ON FILE 1')
ELSE IF (F1 AND NOT F2) THEN
WRITELN('COMPARE:END OF FILE ON FILE2')
END;
PROCEDURE INCLUDE;
VAR
INCL:XSTRING;
PROCEDURE FINCLUDE(F:FILEDESC);
VAR
LINE,STR:XSTRING;
LOC,I:INTEGER;
F1:FILEDESC;
FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;
VAR OUT:XSTRING):INTEGER;
VAR
J:INTEGER;
BEGIN
WHILE(S[I] IN [BLANK,TAB,NEWLINE]) DO
I:=I+1;
J:=1;
WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
OUT[J]:=S[I];
I:=I+1;
J:=J+1
END;
OUT[J]:=ENDSTR;
IF(S[I]=ENDSTR) THEN
GETWORD:=0
ELSE
GETWORD:=I
END;
BEGIN
WHILE (GETLINE(LINE,F,MAXSTR))DO BEGIN
LOC:=GETWORD(LINE,1,STR);
IF (NOT EQUAL(STR,INCL)) THEN
PUTSTR(LINE,STDOUT)
ELSE BEGIN
LOC:=GETWORD(LINE,LOC,STR);
STR[XLENGTH(STR)]:=ENDSTR;
FOR I:= 1 TO XLENGTH(STR)DO
STR[I]:=STR[I+1];
F1:=MUSTOPEN(STR,IOREAD);
FINCLUDE(F1);
XCLOSE(F1)
END
END
END;
BEGIN
INCL[1]:=ORD('#');
INCL[2]:=ORD('i');
INCL[3]:=ORD('n');
INCL[4]:=ORD('c');
INCL[5]:=ORD('l');
INCL[6]:=ORD('u');
INCL[7]:=ORD('d');
INCL[8]:=ORD('e');
INCL[9]:=ENDSTR;
FINCLUDE(STDIN)
END;
PROCEDURE CONCAT;
VAR
I:INTEGER;
JUNK:BOOLEAN;
FD:FILEDESC;
S:XSTRING;
BEGIN
FOR I:=2 TO NARGS DO BEGIN
JUNK:=GETARG(I,S,MAXSTR);
FD:=MUSTOPEN(S,IOREAD);
FCOPY(FD,STDOUT);
XCLOSE(FD)
END
END;
PROCEDURE ARCHIVE;
CONST
MAXFILES=10;
VAR
ANAME:XSTRING;
CMD:XSTRING;
FNAME:ARRAY[1..MAXFILES]OF XSTRING;
FSTAT:ARRAY[1..MAXFILES] OF BOOLEAN;
NFILES:INTEGER;
ERRCOUNT:INTEGER;
ARCHTEMP:XSTRING;
ARCHHDR:XSTRING;
FUNCTION GETWORD(VAR S:XSTRING;I:INTEGER;VAR OUT:XSTRING):INTEGER;
VAR
J:INTEGER;
BEGIN
WHILE (S[I] IN [BLANK,TAB,NEWLINE]) DO
I:=I+1;
J:=1;
WHILE(NOT (S[I] IN [ENDSTR,BLANK,TAB,NEWLINE])) DO BEGIN
OUT[J]:=S[I];
I:=I+1;
J:=J+1
END;
OUT[J]:=ENDSTR;
IF(S[I]=ENDSTR) THEN
GETWORD:=0
ELSE
GETWORD:=I
END;
FUNCTION GETHDR(FD:FILEDESC;VAR BUF,NAME:XSTRING;
VAR SIZE:INTEGER):BOOLEAN;
VAR
TEMP:XSTRING;
I:INTEGER;
BEGIN
IF(GETLINE(BUF,FD,MAXSTR)=FALSE)THEN
GETHDR:=FALSE
ELSE BEGIN
I:=GETWORD(BUF,1,TEMP);
IF(NOT EQUAL(TEMP,ARCHHDR))THEN
ERROR('ARCHIVE NOT IN PROPER FORMAT');
I:=GETWORD(BUF,I,NAME);
SIZE:=CTOI(BUF,I);
GETHDR:=TRUE
END
END;
FUNCTION FILEARG (VAR NAME:XSTRING):BOOLEAN;
VAR
I:INTEGER;
FOUND:BOOLEAN;
BEGIN
IF(NFILES<=0)THEN
FILEARG:=TRUE
ELSE BEGIN
FOUND:=FALSE;
I:=1;
WHILE(NOT FOUND) AND (I<=NFILES)DO BEGIN
IF(EQUAL(NAME,FNAME[I])) THEN BEGIN
FSTAT[I]:=TRUE;
FOUND:=TRUE
END;
I:=I+1
END;
FILEARG:=FOUND
END
END;
PROCEDURE FSKIP(FD:FILEDESC;N:INTEGER);
VAR
C:CHARACTER;
I:INTEGER;
BEGIN
FOR I:=1 TO N DO
IF(GETCF(C,FD)=ENDFILE)THEN
ERROR('ARCHIVE:END OF FILE IN FSKIP')
END;
PROCEDURE FMOVE(VAR NAME1,NAME2:XSTRING);
VAR
FD1,FD2:FILEDESC;
BEGIN
FD1:=MUSTOPEN(NAME1,IOREAD);
FD2:=MUSTCREATE(NAME2,IOWRITE);
FCOPY(FD1,FD2);
XCLOSE(FD1);
XCLOSE(FD2)
END;
PROCEDURE ACOPY(FDI,FDO:FILEDESC;N:INTEGER);
VAR
C:CHARACTER;
I:INTEGER;
BEGIN
FOR I:=1 TO N DO
IF (GETCF(C,FDI)=ENDFILE)THEN
ERROR('ARCHIVE: END OF FILE IN ACOPY')
ELSE
PUTCF(C,FDO)
END;
PROCEDURE NOTFOUND;
VAR
I:INTEGER;
BEGIN
FOR I := 1 TO NFILES DO
IF(FSTAT[I]=FALSE)THEN BEGIN
PUTSTR(FNAME[I],STDERR);
WRITELN(':NOT IN ARCHIVE');
ERRCOUNT:=ERRCOUNT + 1
END
END;
PROCEDURE ADDFILE(VAR NAME:XSTRING;FD:FILEDESC);
VAR
HEAD:XSTRING;
NFD:FILEDESC;
PROCEDURE MAKEHDR(VAR NAME,HEAD:XSTRING);
VAR
I:INTEGER;
FUNCTION FSIZE(VAR NAME:XSTRING):INTEGER;
VAR
C:CHARACTER;
FD:FILEDESC;
N:INTEGER;
BEGIN
N:=0;
FD:=MUSTOPEN(NAME,IOREAD);
WHILE(GETCF(C,FD)<>ENDFILE)DO
N:=N+1;
XCLOSE(FD);
FSIZE:=N
END;
BEGIN
SCOPY(ARCHHDR,1,HEAD,1);
I:=XLENGTH(HEAD)+1;
HEAD[I]:=BLANK;
SCOPY(NAME,1,HEAD,I+1);
I:=XLENGTH(HEAD)+1;
HEAD[I]:=BLANK;
I:=ITOC(FSIZE(NAME),HEAD,I+1);
HEAD[I]:=NEWLINE;
HEAD[I+1]:=ENDSTR
END;
BEGIN
NFD:=OPEN(NAME,IOREAD);
IF(NFD=IOERROR)THEN BEGIN
PUTSTR(NAME,STDERR);
WRITELN(':CAN''T ADD');
ERRCOUNT:=ERRCOUNT+1
END;
IF(ERRCOUNT=0)THEN BEGIN
MAKEHDR(NAME,HEAD);
PUTSTR(HEAD,FD);
FCOPY(NFD,FD);
XCLOSE(NFD)
END
END;
PROCEDURE REPLACE(AFD,TFD:FILEDESC;CMD:INTEGER);
VAR
PINLINE,UNAME:XSTRING;
SIZE:INTEGER;
BEGIN
WHILE(GETHDR(AFD,PINLINE,UNAME,SIZE))DO
IF(FILEARG(UNAME))THEN BEGIN
IF(CMD=ORD('U'))THEN
ADDFILE(UNAME,TFD);
FSKIP(AFD,SIZE)
END
ELSE BEGIN
PUTSTR(PINLINE,TFD);
ACOPY(AFD,TFD,SIZE)
END
END;
PROCEDURE HELP;
BEGIN
ERROR('USAGE:ARCHIVE -[CDPTUX] ARCHNAME [FILES...]')
END;
PROCEDURE GETFNS;
VAR
I,J:INTEGER;
JUNK:BOOLEAN;
BEGIN
ERRCOUNT:=0;
NFILES:=NARGS-3;
IF(NFILES>MAXFILES)THEN
ERROR('ARCHIVE:TO MANY FILE NAMES');
FOR I:=1 TO NFILES DO
JUNK:=GETARG(I+3,FNAME[I],MAXSTR);
FOR I:=1 TO NFILES DO
FSTAT[I]:=FALSE;
FOR I:=1 TO NFILES-1 DO
FOR J:=I+1 TO NFILES DO
IF(EQUAL(FNAME[I],FNAME[J]))THEN BEGIN
PUTSTR(FNAME[I],STDERR);
ERROR(':DUPLICATE FILENAME')
END
END;
PROCEDURE UPDATE(VAR ANAME:XSTRING;CMD:CHARACTER);
VAR
I:INTEGER;
AFD,TFD:FILEDESC;
BEGIN
TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
IF(CMD=ORD('u')) THEN BEGIN
AFD:=MUSTOPEN(ANAME,IOREAD);
REPLACE(AFD,TFD,ORD('u'));(*UPDATE EXISTING*)
XCLOSE(AFD)
END;
FOR I:=1 TO NFILES DO
IF(FSTAT[I]=FALSE)THEN BEGIN
ADDFILE(FNAME[I],TFD);
FSTAT[I]:=TRUE
END;
XCLOSE(TFD);
IF(ERRCOUNT=0)THEN
FMOVE(ARCHTEMP,ANAME)
ELSE
WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
REMOVE (ARCHTEMP)
END;
PROCEDURE TABLE(VAR ANAME:XSTRING);
VAR
HEAD,NAME:XSTRING;
SIZE:INTEGER;
AFD:FILEDESC;
PROCEDURE TPRINT(VAR BUF:XSTRING);
VAR
I:INTEGER;
TEMP:XSTRING;
BEGIN
I:=GETWORD(BUF,1,TEMP);
I:=GETWORD(BUF,I,TEMP);
PUTSTR(TEMP,STDOUT);
PUTC(BLANK);
I:=GETWORD(BUF,I,TEMP);(*SIZE*)
PUTSTR(TEMP,STDOUT);
PUTC(NEWLINE)
END;
BEGIN
AFD:=MUSTOPEN(ANAME,IOREAD);
WHILE(GETHDR(AFD,HEAD,NAME,SIZE))DO BEGIN
IF(FILEARG(NAME))THEN
TPRINT(HEAD);
FSKIP(AFD,SIZE)
END;
NOTFOUND
END;
PROCEDURE EXTRACT (VAR ANAME:XSTRING;CMD:CHARACTER);
VAR
ENAME,PINLINE:XSTRING;
AFD,EFD:FILEDESC;
SIZE : INTEGER;
BEGIN
AFD:=MUSTOPEN(ANAME,IOREAD);
IF (CMD=ORD('p')) THEN
EFD:=STDOUT
ELSE
EFD:=IOERROR;
WHILE (GETHDR(AFD,PINLINE,ENAME,SIZE)) DO
IF (NOT FILEARG(ENAME))THEN
FSKIP(AFD,SIZE)
ELSE
BEGIN
IF (EFD<> STDOUT) THEN
EFD:=CREATE(ENAME,IOWRITE);
IF(EFD=IOERROR) THEN BEGIN
PUTSTR(ENAME,STDERR);
WRITELN(': CANT''T CREATE');
ERRCOUNT:=ERRCOUNT+1;
FSKIP(AFD,SIZE)
END
ELSE BEGIN
ACOPY(AFD,EFD,SIZE);
IF(EFD<>STDOUT)THEN
XCLOSE(EFD)
END
END;
NOTFOUND
END;
PROCEDURE DELETE(VAR ANAME:XSTRING);
VAR
AFD,TFD:FILEDESC;
BEGIN
IF(NFILES<=0)THEN(*PROTECT INNOCENT*)
ERROR('ARCHIVE:-D REQUIRES EXPLICIT FILE NAMES');
AFD:=MUSTOPEN(ANAME,IOREAD);
TFD:=MUSTCREATE(ARCHTEMP,IOWRITE);
REPLACE(AFD,TFD,ORD('d'));
NOTFOUND;
XCLOSE(AFD);
XCLOSE(TFD);
IF(ERRCOUNT=0)THEN
FMOVE(ARCHTEMP,ANAME)
ELSE
WRITELN('FATAL ERRORS - ARCHIVE NOT ALTERED');
REMOVE(ARCHTEMP)
END;
PROCEDURE INITARCH;
BEGIN
ARCHTEMP[1]:=ORD('A');
ARCHTEMP[2]:=ORD('R');
ARCHTEMP[3]:=ORD('T');
ARCHTEMP[4]:=ORD('E');
ARCHTEMP[5]:=ORD('M');
ARCHTEMP[6]:=ORD('P');
ARCHTEMP[7]:=ENDSTR;
ARCHHDR[1]:=ORD('-');
ARCHHDR[2]:=ORD('H');
ARCHHDR[3]:=ORD('-');
ARCHHDR[4]:=ENDSTR;
END;
BEGIN
INITARCH;
IF (NOT GETARG(2,CMD,MAXSTR))
OR(NOT GETARG(3,ANAME,MAXSTR)) THEN
HELP;
GETFNS;
IF(XLENGTH(CMD)<>2) OR(CMD[1]<>ORD('-')) THEN
HELP
ELSE IF (CMD[2]=ORD('c'))OR(CMD[2]=ORD('u'))THEN
UPDATE(ANAME,CMD[2])
ELSE IF (CMD[2]=ORD('t'))THEN
TABLE(ANAME)
ELSE IF (CMD[2]=ORD('x'))OR(CMD[2]=ORD('p'))THEN
EXTRACT(ANAME,CMD[2])
ELSE IF (CMD[2]=ORD('d'))THEN
DELETE(ANAME)
ELSE
HELP
END;
SHAR_EOF
if test 11306 -ne "`wc -c < 'chapter3.pas'`"
then
echo shar: error transmitting "'chapter3.pas'" '(should have been 11306 characters)'
fi
fi # end of overwriting check
if test -f 'chapter4.pas'
then
echo shar: will not over-write existing file "'chapter4.pas'"
else
cat << \SHAR_EOF > '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]<LINEBUF[J]) THEN
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<HI) THEN BEGIN
I:=LO;
J:=HI;
PIVLINE:=LINEPOS[J];
REPEAT
WHILE (I<J)
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<J) THEN
(*OUT OF ORDER PAIR*)
EXCHANGE(LINEPOS[I],LINEPOS[J])
UNTIL (I>=J);
EXCHANGE(LINEPOS[I],LINEPOS[HI]);
IF(I-LO<HI-I) THEN BEGIN
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<NF) THEN
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<HIGH) DO BEGIN
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;
SHAR_EOF
if test 7602 -ne "`wc -c < 'chapter4.pas'`"
then
echo shar: error transmitting "'chapter4.pas'" '(should have been 7602 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
More information about the Comp.sources.unix
mailing list