reintom@rocky2.UUCP (07/20/86)
#! /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:
# toolu.pas
# This archive created: Sun Jul 20 12:05:14 1986
export PATH; PATH=/bin:$PATH
if test -f 'toolu.pas'
then
echo shar: will not over-write existing file "'toolu.pas'"
else
cat << \SHAR_EOF > 'toolu.pas'
{toolu.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.
}
CONST
IOERROR=0;
STDIN=1;
STDOUT=2;
STDERR=3;
(*IO RELEATED STUFF*)
MAXOPEN=7;
IOREAD=0;
IOWRITE=1;
MAXCMD=20;
ENDFILE=255;
BLANK=32;
ENDSTR=0;
MAXSTR=100;
BACKSPACE=8;
TAB=9;
NEWLINE=10;
EXCLAM=33;
DQUOTE=34;
SHARP=35;
DOLLAR=36;
PERCENT=37;
AMPER=38;
SQUOTE=39;
ACUTE=SQUOTE;
LPAREN=40;
RPAREN=41;
STAR=42;
PLUS=43;
COMMA=44;
MINUS=45;
DASH=MINUS;
PERIOD=46;
SLASH=47;
COLON=58;
SEMICOL=59;
LESS=60;
EQUALS=61;
GREATER=62;
QUESTION=63;
ATSIGN=64;
ESCAPE=ATSIGN;
LBRACK=91;
BACKSLASH=92;
RBRACK=93;
CARET=94;
GRAVE=96;
UNDERLINE=95;
TILDE=126;
LBRACE=123;
BAR=124;
RBRACE=125;
TYPE
CHARACTER=0..255;
XSTRING=ARRAY[1..MAXSTR]OF CHARACTER;
STRING80=string[80];
FILEDESC=IOERROR..MAXOPEN;
FILTYP=(CLOSED,STDIO,FIL1,FIL2,FIL3,FIL4);
VAR
KBDN,KBDNEXT:INTEGER;
KBDLINE:XSTRING;
CMDARGS:0..MAXCMD;
CMDIDX:ARRAY[1..MAXCMD] OF 1..MAXSTR;
CMDLIN:XSTRING;
CMDLINE:STRING80;
CMDFIL:ARRAY[STDIN..MAXOPEN]OF FILTYP;
CMDOPEN:ARRAY[FILTYP]OF BOOLEAN;
FILE1,FILE2,FILE3,FILE4:TEXT;
FUNCTION GETKBD(VAR C:CHARACTER):CHARACTER;FORWARD;
FUNCTION FGETCF(VAR FIL:TEXT):CHARACTER;FORWARD;
FUNCTION GETCF(VAR C:CHARACTER;FD:FILEDESC):CHARACTER;FORWARD;
FUNCTION GETC(VAR C:CHARACTER):CHARACTER;FORWARD;
PROCEDURE FPUTCF(C:CHARACTER;VAR FIL:TEXT);FORWARD;
PROCEDURE PUTCF(C:CHARACTER;FD:FILEDESC);FORWARD;
PROCEDURE PUTC(C:CHARACTER);FORWARD;
PROCEDURE PUTDEC(N,W:INTEGER);FORWARD;
FUNCTION ITOC(N:INTEGER;VAR S:XSTRING;I:INTEGER):INTEGER;FORWARD;
FUNCTION GETARG(N:INTEGER;VAR S:XSTRING;
MAXSIZE:INTEGER):BOOLEAN;FORWARD;
PROCEDURE SCOPY(VAR SRC:XSTRING;I:INTEGER;VAR DEST:XSTRING;J:INTEGER);FORWARD;
PROCEDURE ENDCMD;FORWARD;
PROCEDURE XCLOSE(FD:FILEDESC);FORWARD;
FUNCTION MUSTCREATE(VAR NAME:XSTRING;MODE:INTEGER):
FILEDESC;FORWARD;
FUNCTION CREATE(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
FUNCTION XLENGTH(VAR S:XSTRING):INTEGER;FORWARD;
PROCEDURE STRNAME(VAR STR:STRING80;VAR XSTR:XSTRING);FORWARD;
PROCEDURE ERROR(STR:STRING80);FORWARD;
FUNCTION MAX(X,Y:INTEGER):INTEGER;FORWARD;
PROCEDURE REMOVE(NAME:XSTRING);FORWARD;
FUNCTION GETLINE(VAR STR:XSTRING;FD:FILEDESC;
SIZE:INTEGER):BOOLEAN;FORWARD;
FUNCTION OPEN(VAR NAME:XSTRING;MODE:INTEGER):
FILEDESC;FORWARD;
FUNCTION FDALLOC:FILEDESC;FORWARD;
FUNCTION FTALLOC:FILTYP;FORWARD;
FUNCTION NARGS:INTEGER;FORWARD;
FUNCTION ADDSTR(C:CHARACTER;VAR OUTSET:XSTRING;
VAR J:INTEGER;MAXSET:INTEGER):BOOLEAN;FORWARD;
PROCEDURE PUTSTR(STR:XSTRING;FD:FILEDESC);FORWARD;
FUNCTION MUSTOPEN(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
FUNCTION MIN(X,Y:INTEGER):INTEGER;FORWARD;
FUNCTION ISUPPER(C:CHARACTER):BOOLEAN;FORWARD;
FUNCTION EQUAL(VAR STR1,STR2:XSTRING):BOOLEAN;FORWARD;
FUNCTION INDEX(VAR S:XSTRING;C:CHARACTER):INTEGER;FORWARD;
FUNCTION ISALPHANUM(C:CHARACTER):BOOLEAN;FORWARD;
FUNCTION ESC(VAR S:XSTRING;VAR I:INTEGER):
CHARACTER;FORWARD;
PROCEDURE FCOPY(FIN,FOUT:FILEDESC);FORWARD;
FUNCTION CTOI(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
FUNCTION ISDIGIT(C:CHARACTER):BOOLEAN;FORWARD;
FUNCTION ISLOWER(C:CHARACTER):BOOLEAN;FORWARD;
FUNCTION ISLETTER(C:CHARACTER):BOOLEAN;FORWARD;
FUNCTION ISDIGIT;
BEGIN
ISDIGIT:=C IN [ORD('0')..ORD('9')]
END;
FUNCTION ISLOWER;
BEGIN
ISLOWER:=C IN [97..122]
END;
FUNCTION ISLETTER;
BEGIN
ISLETTER:=C IN [65..90]+[97..122]
END;
FUNCTION CTOI;
VAR N,SIGN:INTEGER;
BEGIN
WHILE (S[I]=BLANK) OR (S[I]=TAB)DO
I:=I+1;
IF(S[I]=MINUS) THEN
SIGN:=-1
ELSE
SIGN:=1;
IF(S[I]=PLUS)OR(S[I]=MINUS)THEN
I:=I+1;
N:=0;
WHILE(ISDIGIT(S[I])) DO BEGIN
N:=10*N+S[I]-ORD('0');
I:=I+1
END;
CTOI:=SIGN*N
END;
PROCEDURE FCOPY;
VAR
C:CHARACTER;
BEGIN
WHILE(GETCF(C,FIN)<>ENDFILE) DO
PUTCF(C,FOUT)
END;
FUNCTION INDEX;
VAR I:INTEGER;
BEGIN
I:=1;
WHILE(S[I]<>C) AND (S[I]<>ENDSTR)DO
I:=I+1;
IF (S[I]=ENDSTR) THEN
INDEX:=0
ELSE
INDEX:=I
END;
FUNCTION ESC;
BEGIN
IF(S[I]<>ATSIGN) THEN
ESC:=S[I]
ELSE IF(S[I+1]=ENDSTR) THEN (*@ NOT SPECIAL AT END*)
ESC:=ATSIGN
ELSE BEGIN
I:=I+1;
IF(S[I]=ORD('N'))THEN ESC:=NEWLINE
ELSE IF (S[I]=ORD('T')) THEN
ESC:=TAB
ELSE
ESC:=S[I]
END
END;
FUNCTION ISALPHANUM;
BEGIN
ISALPHANUM:=C IN
[ORD('A')..ORD('Z'),ORD('0')..ORD('9'),
97..122]
END;
FUNCTION MAX;
BEGIN
IF(X>Y)THEN
MAX:=X
ELSE
MAX:=Y
END;
FUNCTION MIN;
BEGIN
IF X<Y THEN
MIN:=X
ELSE
MIN:=Y
END;
FUNCTION ISUPPER;
BEGIN
ISUPPER:=C IN [ORD('A')..ORD('Z')]
END;
FUNCTION XLENGTH;
VAR
N:INTEGER;
BEGIN
N:=1;
WHILE(S[N]<>ENDSTR)DO
N:=N+1;
XLENGTH:=N-1
END;
FUNCTION GETARG;
BEGIN
IF((N<1)OR(CMDARGS<N))THEN
GETARG:=FALSE
ELSE BEGIN
SCOPY(CMDLIN,CMDIDX[N],S,1);
GETARG:=TRUE
END
END;(*GETARG*)
PROCEDURE SCOPY;
BEGIN
WHILE(SRC[I]<>ENDSTR)DO BEGIN
DEST[J]:=SRC[I];
I:=I+1;
J:=J+1
END;
DEST[J]:=ENDSTR;
END;
(*$I-*)
FUNCTION CREATE;
VAR
FD:FILEDESC;
SNM:STRING80;
BEGIN
FD:=FDALLOC;
IF(FD<>IOERROR)THEN BEGIN
STRNAME(SNM,NAME);
CASE (CMDFIL[FD])OF
FIL1:
begin assign(FILE1,SNM);rewrite(FILE1) end;
FIL2:begin assign(FILE2,SNM);rewrite(FILE2) end;
FIL3:begin assign(FILE3,SNM);rewrite(FILE3) end;
FIL4:begin assign(FILE4,SNM);rewrite(FILE4) end
END;
IF(IORESULT<>0)THEN BEGIN
XCLOSE(FD);
FD:=IOERROR
END
END;
CREATE:=FD;
END;
(*$I+*)
PROCEDURE STRNAME;
VAR I:INTEGER;
BEGIN
STR:='.PAS';
I:=1;
WHILE(XSTR[I]<>ENDSTR)DO BEGIN
INSERT('X',STR,I);
STR[I]:=CHR(XSTR[I]);
I:=I+1
END
END;
PROCEDURE ERROR;
BEGIN
WRITELN(STR);
HALT
END;
FUNCTION MUSTCREATE;
VAR
FD:FILEDESC;
BEGIN
FD:=CREATE(NAME,MODE);
IF(FD=IOERROR)THEN BEGIN
PUTSTR(NAME,STDERR);
ERROR(' :CAN''T CREATE FILE')
END;
MUSTCREATE:=FD
END;
FUNCTION NARGS;
BEGIN
NARGS:=CMDARGS
END;
PROCEDURE REMOVE;
VAR
FD:FILEDESC;
BEGIN
FD:=OPEN(NAME,IOREAD);
IF(FD=IOERROR)THEN
WRITELN('CAN''T REMOVE FILE')
ELSE BEGIN
CASE (CMDFIL[FD]) OF
FIL1:CLOSE(FILE1);
FIL2:CLOSE(FILE2);
FIL3:CLOSE(FILE3);
FIL4:CLOSE(FILE4);
END
END;
CMDFIL[FD]:=CLOSED
END;
FUNCTION GETLINE;
VAR I,ii:INTEGER;
DONE:BOOLEAN;
CH:CHARACTER;
BEGIN
I:=0;
REPEAT
DONE:=TRUE;
CH:=GETCF(CH,FD);
IF(CH=ENDFILE) THEN
I:=0
ELSE IF (CH=NEWLINE) THEN BEGIN
I:=I+1;
STR[I]:=NEWLINE
END
ELSE IF (SIZE-2<=I) THEN BEGIN
WRITELN('LINE TOO LONG');
I:=I+1;
STR[I]:=NEWLINE
END
ELSE BEGIN
DONE:=FALSE;
I:=I+1;
STR[I]:=CH;
END
UNTIL(DONE);
STR[I+1]:=ENDSTR;
GETLINE:=(0<I)
END;(*GETLINE*)
(*$I-*)
FUNCTION OPEN;
VAR FD:FILEDESC;
SNM:STRING80;
BEGIN
FD:=FDALLOC;
IF(FD<>IOERROR) THEN BEGIN
STRNAME(SNM,NAME);
CASE (CMDFIL[FD]) OF
FIL1:begin assign(FILE1,SNM);RESET(FILE1) end;
FIL2:begin assign(FILE2,SNM);RESET(FILE2) end;
FIL3:begin assign(FILE3,SNM);RESET(FILE3) end;
FIL4:begin assign(FILE4,SNM);RESET(FILE4) end
END;
IF(IORESULT<>0) THEN BEGIN
XCLOSE(FD);
FD:=IOERROR
END
END;
OPEN:=FD
END;
(*$I+*)
FUNCTION FTALLOC;
VAR DONE:BOOLEAN;
FT:FILTYP;
BEGIN
FT:=FIL1;
REPEAT
DONE:=(NOT CMDOPEN[FT] OR (FT=FIL4));
IF(NOT DONE) THEN
FT:=SUCC(FT)
UNTIL (DONE);
IF(CMDOPEN[FT]) THEN
FTALLOC:=CLOSED
ELSE
FTALLOC:=FT
END;
FUNCTION FDALLOC;
VAR DONE:BOOLEAN;
FD:FILEDESC;
BEGIN
FD:=STDIN;
DONE:=FALSE;
WHILE(NOT DONE) DO
IF((CMDFIL[FD]=CLOSED) OR (FD=MAXOPEN))THEN
DONE:=TRUE
ELSE FD:=SUCC(FD);
IF(CMDFIL[FD]<>CLOSED) THEN
FDALLOC:=IOERROR
ELSE BEGIN
CMDFIL[FD]:=FTALLOC;
IF(CMDFIL[FD]=CLOSED) THEN
FDALLOC:=IOERROR
ELSE BEGIN
CMDOPEN[CMDFIL[FD]]:=TRUE;
FDALLOC:=FD
END
END
END;(*FDALLOC*)
PROCEDURE ENDCMD;
VAR FD:FILEDESC;
BEGIN
FOR FD:=STDIN TO MAXOPEN DO
XCLOSE(FD)
END;
PROCEDURE XCLOSE;
BEGIN
CASE (CMDFIL[FD])OF
CLOSED,STDIO:;
FIL1:CLOSE(FILE1);
FIL2:CLOSE(FILE2);
FIL3:CLOSE(FILE3);
FIL4:CLOSE(FILE4)
END;
CMDOPEN[CMDFIL[FD]]:=FALSE;
CMDFIL[FD]:=CLOSED
END;
FUNCTION ADDSTR;
BEGIN
IF(J>MAXSET)THEN
ADDSTR:=FALSE
ELSE BEGIN
OUTSET[J]:=C;
J:=J+1;
ADDSTR:=TRUE
END
END;
PROCEDURE PUTSTR;
VAR I:INTEGER;
BEGIN
I:=1;
WHILE(STR[I]<>ENDSTR) DO BEGIN
PUTCF(STR[I],FD);
I:=I+1
END
END;
FUNCTION MUSTOPEN;
VAR FD:FILEDESC;
BEGIN
FD:=OPEN(NAME,MODE);
IF(FD=IOERROR)THEN BEGIN
PUTSTR(NAME,STDERR);
WRITELN(': CAN''T OPEN FILE')
END;
MUSTOPEN:=FD
END;
FUNCTION GETKBD;
VAR
DONE:BOOLEAN;
i:integer;
ch:char;
BEGIN
IF (KBDN<=0)
THEN
BEGIN
KBDNEXT:=1;
DONE:=FALSE;
if (kbdn=-2)
then
begin
readln;
kbdn:=0
end
else if (kbdn<0)
then
done:=true;
WHILE(NOT DONE)
DO
BEGIN
kbdn:=kbdn+1;
DONE:=TRUE;
if (eof(TRM))
then
kbdn:=-1
else if eoln(TRM)
then
begin
kbdline[kbdn]:=NEWLINE;
readln(TRM);
end
else if (MAXSTR-1<=kbdn)
then
begin
writeln('Line too long');
kbdline[kbdn]:=newline
end
ELSE
begin
read(TRM,ch);
kbdline[kbdn]:=ord(ch);
if (ord(ch)in [0..7,9..12,14..31])
then
write('^',chr(ord(ch)+64))
else if (kbdline[kbdn]<>BACKSPACE)
then
{do nothing}
ELSE
begin
write(ch,' ',ch);
if (1<kbdn)
then
begin
kbdn:=kbdn-2;
if kbdline[kbdn+1]in[0..31]
then
write(ch,' ',ch)
end
ELSE
kbdn:=kbdn-1
end;
done:=false
end;
END
END;
reset(TRM);
IF(KBDN<=0)
THEN
C:=ENDFILE
ELSE
BEGIN
C:=KBDLINE[KBDNEXT];
KBDNEXT:=KBDNEXT+1;
if (c=NEWLINE)
then
begin
reset(TRM);
kbdn:=-2;
end
ELSE
KBDN:=KBDN-1
END;
GETKBD:=C
END;
FUNCTION FGETCF;
VAR CH:CHAR;
BEGIN
IF(EOF(FIL))THEN
FGETCF:=ENDFILE
ELSE IF(EOLN(FIL)) THEN BEGIN
READLN(FIL);
FGETCF:=NEWLINE
END
ELSE BEGIN
READ(FIL,CH);
FGETCF:=ORD(CH);
END;
END;
FUNCTION GETCF;
BEGIN
CASE(CMDFIL[FD])OF
STDIO:C:=GETKBD(C);
FIL1:C:=FGETCF(FILE1);
FIL2:C:=FGETCF(FILE2);
FIL3:C:=FGETCF(FILE3);
FIL4:C:=FGETCF(FILE4);
END;
GETCF:=C
END;
FUNCTION GETC;
BEGIN
GETC:=GETCF(C,STDIN)
END;
PROCEDURE FPUTCF;
BEGIN
IF(C=NEWLINE)THEN
WRITELN(FIL)
ELSE
WRITE(FIL,CHR(C))
END;
PROCEDURE PUTCF;
BEGIN
CASE (CMDFIL[FD]) OF
STDIO:FPUTCF(C,CON);
FIL1:FPUTCF(C,FILE1);
FIL2:FPUTCF(C,FILE2);
FIL3:FPUTCF(C,FILE3);
FIL4:FPUTCF(C,FILE4)
END
END;
PROCEDURE PUTC;
BEGIN
PUTCF(C,STDOUT);
END;
FUNCTION ITOC;
BEGIN
IF(N<0)THEN BEGIN
S[I]:=ORD('-');
ITOC:=ITOC(-N,S,I+1);
END
ELSE BEGIN
IF (N>=10)THEN
I:=ITOC(N DIV 10,S, I);
S[I]:=N MOD 10 + ORD('0');
S[I+1]:=ENDSTR;
ITOC:=I+1;
END
END;
PROCEDURE PUTDEC;
VAR I,ND:INTEGER;
S:XSTRING;
BEGIN
ND:=ITOC(N,S,1);
FOR I:=ND TO W DO
PUTC(BLANK);
FOR I:=1 TO ND-1 DO
PUTC(S[I])
END;
FUNCTION EQUAL;
VAR
I:INTEGER;
BEGIN
I:=1;
WHILE(STR1[I]=STR2[I])AND(STR1[I]<>ENDSTR) DO
I:=I+1;
EQUAL:=(STR1[I]=STR2[I])
END;
SHAR_EOF
if test 12173 -ne "`wc -c < 'toolu.pas'`"
then
echo shar: error transmitting "'toolu.pas'" '(should have been 12173 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0