Software Tools in Pascal for Turbo Pascal (part 2/2)
reintom at rocky2.UUCP
reintom at rocky2.UUCP
Wed Jul 16 15:01:42 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:
# chapter7.pas
# chapter8.pas
# fprims.pas
# initcmd.pas
# shell.pas
# This archive created: Tue Jul 15 11:45:47 1986
export PATH; PATH=/bin:$PATH
if test -f 'chapter7.pas'
then
echo shar: will not over-write existing file "'chapter7.pas'"
else
cat << \SHAR_EOF > 'chapter7.pas'
{chapter7.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 FORMAT;
CONST
CMD=PERIOD;
PAGENUM=SHARP;
PAGEWIDTH=60;
PAGELEN=66;
HUGE=10000;
TYPE
CMDTYPE=(BP,BR,CE,FI,FO,HE,IND,LS,NF,PL,
RM,SP,TI,UL,UNKNOWN);
VAR
CURPAGE,NEWPAGE,LINENO:INTEGER;
PLVAL,M1VAL,M2VAL,M3VAL,M4VAL:INTEGER;
BOTTOM:INTEGER;
HEADER,FOOTER:XSTRING;
FILL:BOOLEAN;
LSVAL,SPVAL,INVAL,RMVAL,TIVAL,CEVAL,ULVAL:INTEGER;
OUTP,OUTW,OUTWDS:INTEGER;
OUTBUF:XSTRING;
DIR:0..1;
INBUF:XSTRING;
PROCEDURE SKIPBL(VAR S:XSTRING;VAR I:INTEGER);
BEGIN
WHILE(S[I]=BLANK) OR(S[I]=TAB)DO
I:=I+1
END;
FUNCTION GETVAL(VAR BUF:XSTRING;VAR ARGTYPE:INTEGER):INTEGER;
VAR
I:INTEGER;
BEGIN
I:=1;
WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
I:=I+1;
SKIPBL(BUF,I);
ARGTYPE:=BUF[I];
IF(ARGTYPE=PLUS) OR (ARGTYPE=MINUS) THEN
I:=I+1;
GETVAL:=CTOI(BUF,I)
END;
PROCEDURE SETPARAM(VAR PARAM:INTEGER;VAL,ARGTYPE,DEFVAL,MINVAL,MAXVAL:
INTEGER);
BEGIN
IF(ARGTYPE=NEWLINE)THEN
PARAM:=DEFVAL
ELSE IF (ARGTYPE=PLUS)THEN
PARAM:=PARAM+VAL
ELSE IF(ARGTYPE=MINUS) THEN
PARAM:=PARAM-VAL
ELSE PARAM:=VAL;
PARAM:=MIN(PARAM,MAXVAL);
PARAM:=MAX(PARAM,MINVAL)
END;
PROCEDURE SKIP(N:INTEGER);
VAR I:INTEGER;
BEGIN
FOR I:=1 TO N DO
PUTC(NEWLINE)
END;
PROCEDURE PUTTL(VAR BUF:XSTRING;PAGENO:INTEGER);
VAR I:INTEGER;
BEGIN
FOR I:=1 TO XLENGTH(BUF) DO
IF(BUF[I]=PAGENUM) THEN
PUTDEC(PAGENO,1)
ELSE
PUTC(BUF[I])
END;
PROCEDURE PUTFOOT;
BEGIN
SKIP(M3VAL);
IF(M4VAL>0) THEN BEGIN
PUTTL(FOOTER,CURPAGE);
SKIP(M4VAL-1)
END
END;
PROCEDURE PUTHEAD;
BEGIN
CURPAGE:=NEWPAGE;
NEWPAGE:=NEWPAGE+1;
IF(M1VAL>0)THEN BEGIN
SKIP(M1VAL-1);
PUTTL(HEADER,CURPAGE)
END;
SKIP(M2VAL);
LINENO:=M1VAL+M2VAL+1
END;
PROCEDURE PUT(VAR BUF:XSTRING);
VAR
I:INTEGER;
BEGIN
IF(LINENO<=0) OR(LINENO>BOTTOM) THEN
PUTHEAD;
FOR I:=1 TO INVAL+TIVAL DO
PUTC(BLANK);
TIVAL:=0;
PUTSTR(BUF,STDOUT);
SKIP(MIN(LSVAL-1,BOTTOM-LINENO));
LINENO:=LINENO+LSVAL;
IF(LINENO>BOTTOM)THEN PUTFOOT
END;
PROCEDURE BREAK;
BEGIN
IF(OUTP>0) THEN BEGIN
OUTBUF[OUTP]:=NEWLINE;
OUTBUF[OUTP+1]:=ENDSTR;
PUT(OUTBUF)
END;
OUTP:=0;
OUTW:=0;
OUTWDS:=0
END;
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;
PROCEDURE LEADBL(VAR BUF:XSTRING);
VAR I,J:INTEGER;
BEGIN
BREAK;
I:=1;
WHILE(BUF[I]=BLANK) DO
I:=I+1;
IF(BUF[I]<>NEWLINE) THEN
TIVAL:=TIVAL+I-1;
FOR J:=I TO XLENGTH(BUF)+1 DO
BUF[J-I+1]:=BUF[J]
END;
PROCEDURE GETTL(VAR BUF,TTL:XSTRING);
VAR
I:INTEGER;
BEGIN
I:=1;
WHILE(NOT(BUF[I]IN[BLANK,TAB,NEWLINE]))DO
I:=I+1;
SKIPBL(BUF,I);
IF(BUF[I]=SQUOTE) OR(BUF[I]=DQUOTE)THEN
I:=I+1;
SCOPY(BUF,I,TTL,1)
END;
PROCEDURE SPACE(N:INTEGER);
BEGIN
BREAK;
IF (LINENO<=BOTTOM) THEN BEGIN
IF(LINENO<=0)THEN
PUTHEAD;
SKIP(MIN(N,BOTTOM+1-LINENO));
LINENO:=LINENO+N;
IF(LINENO>BOTTOM) THEN
PUTFOOT
END
END;
PROCEDURE PAGE;
BEGIN
BREAK;
IF(LINENO>0) AND (LINENO<=BOTTOM) THEN BEGIN
SKIP(BOTTOM+1-LINENO);putfoot
END;
LINENO:=0
END;
FUNCTION WIDTH(VAR BUF:XSTRING):INTEGER;
VAR
I,W:INTEGER;
BEGIN
W:=0;
I:=1;
WHILE(BUF[I]<>ENDSTR) DO BEGIN
IF (BUF[I] = BACKSPACE) THEN
W:=W-1
ELSE IF (BUF[I]<>NEWLINE) THEN
W:=W+1;I:=I+1
END;
WIDTH:=W
END;
PROCEDURE SPREAD(VAR BUF:XSTRING;
OUTP,NEXTRA,OUTWDS:INTEGER);
VAR
I,J,NB,NHOLES:INTEGER;
BEGIN
IF(NEXTRA>0) AND (OUTWDS>1) THEN BEGIN
DIR:=1-DIR;
NHOLES:=OUTWDS-1;
I:=OUTP-1;
J:=MIN(MAXSTR-2,I+NEXTRA);
WHILE(I<J) DO BEGIN
BUF[J]:=BUF[I];
IF(BUF[I]=BLANK) THEN BEGIN
IF(DIR=0) THEN
NB:=(NEXTRA-1) DIV NHOLES +1
ELSE NB:=NEXTRA DIV NHOLES;
NEXTRA:=NEXTRA - NB;
NHOLES:=NHOLES-1;
WHILE(NB>0) DO BEGIN
J:=J-1;
BUF[J]:=BLANK;
NB:=NB-1
END
END;
I:=I-1;
J:=J-1
END
END
END;
PROCEDURE PUTWORD(VAR WORDBUF:XSTRING);
VAR
LAST,LLVAL,NEXTRA,W:INTEGER;
BEGIN
W:=WIDTH(WORDBUF);
LAST:=XLENGTH(WORDBUF)+OUTP+1;
LLVAL:=RMVAL-TIVAL-INVAL;
IF(OUTP>0)
AND ((OUTW+W>LLVAL) OR (LAST >=MAXSTR)) THEN BEGIN
LAST:=LAST-OUTP;
NEXTRA:=LLVAL-OUTW+1;
IF(NEXTRA >0) AND(OUTWDS>1) THEN BEGIN
SPREAD(OUTBUF,OUTP,NEXTRA,OUTWDS);
OUTP:=OUTP+NEXTRA
END;
BREAK
END;
SCOPY(WORDBUF,1,OUTBUF,OUTP+1);
OUTP:=LAST;
OUTBUF[OUTP]:=BLANK;
OUTW:=OUTW+W+1;
OUTWDS:=OUTWDS+1
END;
PROCEDURE CENTER(VAR BUF:XSTRING);
BEGIN
TIVAL:=MAX((RMVAL+TIVAL-WIDTH(BUF)) DIV 2,0)
END;
PROCEDURE UNDERLN (VAR BUF:XSTRING;SIZE:INTEGER);
VAR
I,J:INTEGER;
TBUF:XSTRING;
BEGIN
J:=1;
I:=1;
WHILE(BUF[I]<>NEWLINE) AND (J<SIZE-1)DO BEGIN
IF(ISALPHANUM(BUF[I])) THEN BEGIN
TBUF[J]:=UNDERLINE;
TBUF[J+1]:=BACKSPACE;
J:=J+2
END;
TBUF[J]:=BUF[I];
J:=J+1;
I:=I+1
END;
TBUF[J]:=NEWLINE;
TBUF[J+1]:=ENDSTR;
SCOPY(TBUF,1,BUF,1)
END;
PROCEDURE TEXT(VAR INBUF:XSTRING);
VAR
WORDBUF:XSTRING;
I:INTEGER;
BEGIN
IF(INBUF[1]=BLANK) OR (INBUF[1]=NEWLINE) THEN
LEADBL(INBUF);
IF(ULVAL>0) THEN BEGIN
UNDERLN(INBUF,MAXSTR);
ULVAL:=ULVAL-1
END;
IF(CEVAL>0)THEN BEGIN
CENTER(INBUF);
PUT(INBUF);
CEVAL:=CEVAL-1
END
ELSE IF (INBUF[1]=NEWLINE)THEN
PUT(INBUF)
ELSE IF(NOT FILL) THEN
PUT(INBUF)
ELSE BEGIN
I:=1;
REPEAT
I:=GETWORD(INBUF,I,WORDBUF);
IF(I>0)THEN
PUTWORD(WORDBUF)
UNTIL(I=0)
END
END;
PROCEDURE INITFMT;
BEGIN
FILL:=TRUE;
DIR:=0;
INVAL:=0;
RMVAL:=PAGEWIDTH;
TIVAL:=0;
LSVAL:=1;
SPVAL:=0;
CEVAL:=0;
ULVAL:=0;
LINENO:=0;
CURPAGE:=0;
NEWPAGE:=1;
PLVAL:=PAGELEN;
M1VAL:=3;M2VAL:=2;M3VAL:=2;M4VAL:=3;
BOTTOM:=PLVAL-M3VAL-M4VAL;
HEADER[1]:=NEWLINE;
HEADER[2]:=ENDSTR;
FOOTER[1]:=NEWLINE;
FOOTER[2]:=ENDSTR;
OUTP:=0;
OUTW:=0;
OUTWDS:=0
END;
FUNCTION GETCMD(VAR BUF:XSTRING):CMDTYPE;
VAR
CMD:PACKED ARRAY[1..2] OF CHAR;
BEGIN
CMD[1]:=CHR(BUF[2]);
CMD[2]:=CHR(BUF[3]);
IF(CMD='fi')THEN GETCMD:=FI
ELSE IF (CMD='nf')THEN GETCMD:=NF
ELSE IF (CMD='br')THEN GETCMD:=BR
ELSE IF (CMD='ls')THEN GETCMD:=LS
ELSE IF (CMD='bp')THEN GETCMD:=BP
ELSE IF (CMD='sp')THEN GETCMD:=SP
ELSE IF (CMD='in')THEN GETCMD:=IND
ELSE IF (CMD='rm')THEN GETCMD:=RM
ELSE IF (CMD='ce')THEN GETCMD:=CE
ELSE IF (CMD='ti')THEN GETCMD:=TI
ELSE IF (CMD='ul')THEN GETCMD:=UL
ELSE IF (CMD='he') THEN GETCMD:=HE
ELSE IF (CMD='fo') THEN GETCMD:=FO
ELSE IF (CMD='pl') THEN GETCMD:=PL
ELSE GETCMD:=UNKNOWN
END;
PROCEDURE COMMAND(VAR BUF:XSTRING);
VAR CMD:CMDTYPE;
ARGTYPE,SPVAL,VAL:INTEGER;
BEGIN
CMD:=GETCMD(BUF);
IF(CMD<>UNKNOWN)THEN
VAL:=GETVAL(BUF,ARGTYPE);
CASE CMD OF
FI:BEGIN
BREAK;
FILL:=TRUE END;
NF:BEGIN BREAK;
FILL:=FALSE END;
BR:BREAK;
LS:SETPARAM(LSVAL,VAL,ARGTYPE,1,1,HUGE);
CE:BEGIN BREAK;
SETPARAM(CEVAL,VAL,ARGTYPE,1,0,HUGE) END;
UL:SETPARAM(ULVAL,VAL,ARGTYPE,1,0,HUGE);
HE:GETTL(BUF,HEADER);
FO:GETTL(BUF,FOOTER);
BP:BEGIN PAGE;
SETPARAM(CURPAGE,VAL,ARGTYPE,CURPAGE+1,-HUGE,HUGE);
NEWPAGE:=CURPAGE END;
SP:BEGIN
SETPARAM(SPVAL,VAL,ARGTYPE,1,0,HUGE);
space(spval)
END;
IND:SETPARAM(INVAL,VAL,ARGTYPE,0,0,RMVAL-1);
RM:SETPARAM(INVAL,VAL,ARGTYPE,PAGEWIDTH,
INVAL+TIVAL+1,HUGE);
TI:BEGIN BREAK;
SETPARAM(TIVAL,VAL,ARGTYPE,0,-HUGE,RMVAL) END;
PL:BEGIN
SETPARAM(PLVAL,VAL,ARGTYPE,PAGELEN,
M1VAL+M2VAL+M3VAL+M4VAL+1,HUGE);
BOTTOM:=PLVAL-M3VAL-M4VAL END;
UNKNOWN:
END
END;
BEGIN
INITFMT;
WHILE(GETLINE(INBUF,STDIN,MAXSTR))DO
IF(INBUF[1]=CMD) THEN
COMMAND(INBUF)
ELSE
TEXT(INBUF);
PAGE
END;
SHAR_EOF
if test 8627 -ne "`wc -c < 'chapter7.pas'`"
then
echo shar: error transmitting "'chapter7.pas'" '(should have been 8627 characters)'
fi
fi # end of overwriting check
if test -f 'chapter8.pas'
then
echo shar: will not over-write existing file "'chapter8.pas'"
else
cat << \SHAR_EOF > 'chapter8.pas'
{chapter8.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 MACRO;
CONST
BUFSIZE=1000;
MAXCHARS=500;
MAXPOS=500;
CALLSIZE=MAXPOS;
ARGSIZE=MAXPOS;
EVALSIZE=MAXCHARS;
MAXDEF=MAXSTR;
MAXTOK=MAXSTR;
HASHSIZE=53;
ARGFLAG=DOLLAR;
TYPE
CHARPOS=1..MAXCHARS;
CHARBUF=ARRAY[1..MAXCHARS]OF CHARACTER;
POSBUF=ARRAY[1..MAXPOS]OF CHARPOS;
POS=0..MAXPOS;
STTYPE=(DEFTYPE,MACTYPE,IFTYPE,SUBTYPE,
EXPRTYPE,LENTYPE,CHQTYPE);
NDPTR=^NDBLOCK;
NDBLOCK=RECORD
NAME:CHARPOS;
DEFN:CHARPOS;
KIND:STTYPE;
NEXTPTR:NDPTR
END;
VAR
BUF:ARRAY[1..BUFSIZE]OF CHARACTER;
BP:0..BUFSIZE;
HASHTAB:ARRAY[1..HASHSIZE]OF NDPTR;
NDTABLE:CHARBUF;
NEXTTAB:CHARPOS;
CALLSTK:POSBUF;
CP:POS;
TYPESTK:ARRAY[1..CALLSIZE]OF STTYPE;
PLEV:ARRAY[1..CALLSIZE]OF INTEGER;
ARGSTK:POSBUF;
AP:POS;
EVALSTK:CHARBUF;
EP:CHARPOS;
(*BUILTINS*)
DEFNAME:XSTRING;
EXPRNAME:XSTRING;
SUBNAME,IFNAME,LENNAME,CHQNAME:XSTRING;
NULL:XSTRING;
LQUOTE,RQUOTE:CHARACTER;
DEFN,TOKEN:XSTRING;
TOKTYPE:STTYPE;
T:CHARACTER;
NLPAR:INTEGER;
PROCEDURE PUTCHR(C:CHARACTER);
BEGIN
IF(CP<=0) THEN
PUTC(C)
ELSE BEGIN
IF(EP>EVALSIZE)THEN
ERROR('MACRO:EVALUATION STACK OVERFLOW');
EVALSTK[EP]:=C;
EP:=EP+1
END
END;
PROCEDURE PUTTOK(VAR S:XSTRING);
VAR
I:INTEGER;
BEGIN
I:=1;
WHILE(S[I]<>ENDSTR) DO BEGIN
PUTCHR(S[I]);
I:=I+1
END
END;
FUNCTION PUSH(EP:INTEGER;VAR ARGSTK:POSBUF;AP:INTEGER):INTEGER;
BEGIN
IF(AP>ARGSIZE)THEN
ERROR('MACRO:ARGUMENT STACK OVERFLOW');
ARGSTK[AP]:=EP;
PUSH:=AP+1
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;
PROCEDURE PUTBACK(C:CHARACTER);
BEGIN
IF(BP>=BUFSIZE)THEN
WRITELN('TOO MANY CHARACTERS PUSHED BACK');
BP:=BP+1;
BUF[BP]:=C
END;
FUNCTION GETPBC(VAR C:CHARACTER):CHARACTER;
BEGIN
IF(BP>0)THEN
C:=BUF[BP]
ELSE BEGIN
BP:=1;
BUF[BP]:=GETC(C)
END;
IF(C<>ENDFILE)THEN
BP:=BP-1;
GETPBC:=C
END;
FUNCTION GETTOK(VAR TOKEN:XSTRING;TOKSIZE:INTEGER):
CHARACTER;
VAR I:INTEGER;
DONE:BOOLEAN;
BEGIN
I:=1;
DONE:=FALSE;
WHILE(NOT DONE) AND (I<TOKSIZE) DO
IF(ISALPHANUM(GETPBC(TOKEN[I]))) THEN
I:=I+1
ELSE
DONE:=TRUE;
IF(I>=TOKSIZE)THEN
WRITELN('DEFINE:TOKEN TOO LONG');
IF(I>1) THEN BEGIN (*SOME ALPHA WAS SEEN*)
PUTBACK(TOKEN[I]);
I:=I-1
END;
(*ELSE SINGLE NON-ALPHANUMERIC*)
TOKEN[I+1]:=ENDSTR;
GETTOK:=TOKEN[1]
END;
PROCEDURE PBSTR (VAR S:XSTRING);
VAR I:INTEGER;
BEGIN
FOR I:=XLENGTH(S) DOWNTO 1 DO
PUTBACK(S[I])
END;
FUNCTION HASH(VAR NAME:XSTRING):INTEGER;
VAR
I,H:INTEGER;
BEGIN
H:=0;
FOR I:=1 TO XLENGTH(NAME) DO
H:=(3*H+NAME[I]) MOD HASHSIZE;
HASH:=H+1
END;
FUNCTION HASHFIND(VAR NAME:XSTRING):NDPTR;
VAR
P:NDPTR;
TEMPNAME:XSTRING;
FOUND:BOOLEAN;
BEGIN
FOUND:=FALSE;
P:=HASHTAB[HASH(NAME)];
WHILE (NOT FOUND) AND (P<>NIL) DO BEGIN
CSCOPY(NDTABLE,P^.NAME,TEMPNAME);
IF(EQUAL(NAME,TEMPNAME)) THEN
FOUND:=TRUE
ELSE
P:=P^.NEXTPTR
END;
HASHFIND:=P
END;
PROCEDURE INITHASH;
VAR I:1..HASHSIZE;
BEGIN
NEXTTAB:=1;
FOR I:=1 TO HASHSIZE DO
HASHTAB[I]:=NIL
END;
FUNCTION LOOKUP(VAR NAME,DEFN:XSTRING; VAR T:STTYPE)
:BOOLEAN;
VAR P:NDPTR;
BEGIN
P:=HASHFIND(NAME);
IF(P=NIL)THEN
LOOKUP:=FALSE
ELSE BEGIN
LOOKUP:=TRUE;
CSCOPY(NDTABLE,P^.DEFN,DEFN);
T:=P^.KIND
END
END;
PROCEDURE INSTALL(VAR NAME,DEFN:XSTRING;T:STTYPE);
VAR
H,DLEN,NLEN:INTEGER;
P:NDPTR;
BEGIN
NLEN:=XLENGTH(NAME)+1;
DLEN:=XLENGTH(DEFN)+1;
IF(NEXTTAB + NLEN +DLEN > MAXCHARS) THEN BEGIN
PUTSTR(NAME,STDERR);
ERROR(':TOO MANY DEFINITIONS')
END
ELSE BEGIN
H:=HASH(NAME);
NEW(P);
P^.NEXTPTR:=HASHTAB[H];
HASHTAB[H]:=P;
P^.NAME:=NEXTTAB;
SCCOPY(NAME,NDTABLE,NEXTTAB);
NEXTTAB:=NEXTTAB+NLEN;
P^.DEFN:=NEXTTAB;
SCCOPY(DEFN,NDTABLE,NEXTTAB);
NEXTTAB:=NEXTTAB+DLEN;
P^.KIND:=T
END
END;
PROCEDURE DODEF(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
TEMP1,TEMP2 : XSTRING;
BEGIN
IF(J-I>2) THEN BEGIN
CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
INSTALL(TEMP1,TEMP2,MACTYPE)
END
END;
PROCEDURE DOIF(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
TEMP1,TEMP2,TEMP3:XSTRING;
BEGIN
IF(J-I>=4) THEN BEGIN
CSCOPY(EVALSTK,ARGSTK[I+2],TEMP1);
CSCOPY(EVALSTK,ARGSTK[I+3],TEMP2);
IF(EQUAL(TEMP1,TEMP2))THEN
CSCOPY(EVALSTK,ARGSTK[I+4],TEMP3)
ELSE IF (J-I>=5) THEN
CSCOPY(EVALSTK,ARGSTK[I+5],TEMP3)
ELSE
TEMP3[I]:=ENDSTR;
PBSTR(TEMP3)
END
END;
PROCEDURE PBNUM(N:INTEGER);
VAR
TEMP:XSTRING;
JUNK:INTEGER;
BEGIN
JUNK:=ITOC(N,TEMP,1);
PBSTR(TEMP)
END;
FUNCTION EXPR(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
PROCEDURE DOEXPR(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
JUNK:INTEGER;
TEMP:XSTRING;
BEGIN
CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
JUNK:=1;
PBNUM(EXPR(TEMP,JUNK))
END;
FUNCTION EXPR;
VAR
V:INTEGER;
T:CHARACTER;
FUNCTION GNBCHAR(VAR S:XSTRING;VAR I:INTEGER):CHARACTER;
BEGIN
WHILE(S[I]IN[BLANK,TAB,NEWLINE])DO
I:=I+1;
GNBCHAR:=S[I]
END;
FUNCTION TERM(VAR S:XSTRING;VAR I:INTEGER):INTEGER;
VAR
V:INTEGER;
T:CHARACTER;
FUNCTION FACTOR (VAR S:XSTRING;VAR I:INTEGER):
INTEGER;
BEGIN
IF(GNBCHAR(S,I)=LPAREN) THEN BEGIN
I:=I+1;
FACTOR:=EXPR(S,I);
IF(GNBCHAR(S,I)=RPAREN) THEN
I:=I+1
ELSE
WRITELN('MACRO:MISSING PAREN IN EXPR')
END
ELSE
FACTOR:=CTOI(S,I)
END;(*FACTOR*)
BEGIN(*TERM*)
V:=FACTOR(S,I);
T:=GNBCHAR(S,I);
WHILE(T IN [STAR,SLASH,PERCENT]) DO BEGIN
I:=I+1;
CASE T OF
STAR:V:=V*FACTOR(S,I);
SLASH:
V:=V DIV FACTOR(S,I);
PERCENT:
V:=V MOD FACTOR(S,I)
END;
T:=GNBCHAR(S,I)
END;
TERM:=V
END;(*TERM*)
BEGIN(*EXPR*)
V:=TERM(S,I);
T:=GNBCHAR(S,I);
WHILE(T IN [PLUS,MINUS])DO BEGIN
I:=I+1;
IF(T IN [PLUS]) THEN
V:=V+TERM(S,I)
ELSE(*MINUS*)
V:=V-TERM(S,I);
T:=GNBCHAR(S,I)
END;
EXPR:=V
END;
PROCEDURE DOLEN(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
TEMP:XSTRING;
BEGIN
IF(J-I>1)THEN BEGIN
CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
PBNUM(XLENGTH(TEMP))
END
ELSE
PBNUM(0)
END;
PROCEDURE DOSUB(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
AP,FC,K,NC:INTEGER;
TEMP1,TEMP2:XSTRING;
BEGIN
IF(J-I>=3) THEN BEGIN
IF(J-I<4) THEN
NC:=MAXTOK
ELSE BEGIN
CSCOPY(EVALSTK,ARGSTK[I+4],TEMP1);
K:=1;
NC:=EXPR(TEMP1,K)
END;
CSCOPY(EVALSTK,ARGSTK[I+3],TEMP1);
AP:=ARGSTK[I+2];
K:=1;
FC:=AP+EXPR(TEMP1,K)-1;
CSCOPY(EVALSTK,AP,TEMP2);
IF(FC>=AP) AND (FC<AP+XLENGTH(TEMP2)) THEN BEGIN
CSCOPY(EVALSTK,FC,TEMP1);
FOR K:=FC+MIN(NC,XLENGTH(TEMP1))-1 DOWNTO FC DO
PUTBACK(EVALSTK[K])
END
END
END;
PROCEDURE DOCHQ(VAR ARGSTK:POSBUF;I,J:INTEGER);
VAR
TEMP:XSTRING;
N:INTEGER;
BEGIN
CSCOPY(EVALSTK,ARGSTK[I+2],TEMP);
N:=XLENGTH(TEMP);
IF(N<=0)THEN BEGIN
LQUOTE:=ORD(LESS);
RQUOTE:=ORD(GREATER)
END
ELSE IF (N=1) THEN BEGIN
LQUOTE:=TEMP[1];
RQUOTE:=LQUOTE
END
ELSE BEGIN
LQUOTE:=TEMP[1];
RQUOTE:=TEMP[2]
END
END;
PROCEDURE EVAL(VAR ARGSTK:POSBUF;TD:STTYPE;
I,J:INTEGER);
VAR
ARGNO,K,T:INTEGER;
TEMP:XSTRING;
BEGIN
T:=ARGSTK[I];
IF(TD=DEFTYPE)THEN
DODEF(ARGSTK,I,J)
ELSE IF (TD=EXPRTYPE)THEN
DOEXPR(ARGSTK,I,J)
ELSE IF (TD=SUBTYPE) THEN
DOSUB(ARGSTK,I,J)
ELSE IF (TD=IFTYPE) THEN
DOIF(ARGSTK,I,J)
ELSE IF (TD=LENTYPE) THEN
DOLEN(ARGSTK,I,J)
ELSE IF (TD=CHQTYPE) THEN
DOCHQ(ARGSTK,I,J)
ELSE BEGIN
K:=T;
WHILE(EVALSTK[K]<>ENDSTR) DO
K:=K+1;
K:=K-1;
WHILE(K>T) DO BEGIN
IF(EVALSTK[K-1] <> ARGFLAG) THEN
PUTBACK(EVALSTK[K])
ELSE BEGIN
ARGNO:=ORD(EVALSTK[K])-ORD('0');
IF(ARGNO>=0) AND (ARGNO <J-I)THEN BEGIN
CSCOPY(EVALSTK,ARGSTK[I+ARGNO+1],TEMP);
PBSTR(TEMP)
END;
K:=K-1
END;
K:=K-1
END;
IF(K=T)THEN
PUTBACK(EVALSTK[K])
END
END;
PROCEDURE INITMACRO;
BEGIN
NULL[1]:=ENDSTR;
DEFNAME[1]:=ORD('d');
DEFNAME[2]:=ORD('e');
DEFNAME[3]:=ORD('f');
DEFNAME[4]:=ORD('i');
DEFNAME[5]:=ORD('n');
DEFNAME[6]:=ORD('e');
DEFNAME[7]:=ENDSTR;
SUBNAME[1]:=ORD('s');
SUBNAME[2]:=ORD('u');
SUBNAME[3]:=ORD('b');
SUBNAME[4]:=ORD('s');
SUBNAME[5]:=ORD('t');
SUBNAME[6]:=ORD('r');
SUBNAME[7]:=ENDSTR;
EXPRNAME[1]:=ORD('e');
EXPRNAME[2]:=ORD('x');
EXPRNAME[3]:=ORD('p');
EXPRNAME[4]:=ORD('r');
EXPRNAME[5]:=ENDSTR;
IFNAME[1]:=ORD('i');
IFNAME[2]:=ORD('f');
IFNAME[3]:=ORD('e');
IFNAME[4]:=ORD('l');
IFNAME[5]:=ORD('s');
IFNAME[6]:=ORD('e');
IFNAME[7]:=ENDSTR;
LENNAME[1]:=ORD('l');
LENNAME[2]:=ORD('e');
LENNAME[3]:=ORD('n');
LENNAME[4]:=ENDSTR;
CHQNAME[1]:=ORD('c');
CHQNAME[2]:=ORD('h');
CHQNAME[3]:=ORD('a');
CHQNAME[4]:=ORD('n');
CHQNAME[5]:=ORD('g');
CHQNAME[6]:=ORD('e');
CHQNAME[7]:=ORD('q');
CHQNAME[8]:=ENDSTR;
BP:=0;
INITHASH;
LQUOTE:=ORD('`');
RQUOTE:=ORD('''')
END;
BEGIN
INITMACRO;
INSTALL(DEFNAME,NULL,DEFTYPE);
INSTALL(EXPRNAME,NULL,EXPRTYPE);
INSTALL(SUBNAME,NULL,SUBTYPE);
INSTALL(IFNAME,NULL,IFTYPE);
INSTALL(LENNAME,NULL,LENTYPE);
INSTALL(CHQNAME,NULL,CHQTYPE);
CP:=0;AP:=1;EP:=1;
WHILE(GETTOK(TOKEN,MAXTOK)<>ENDFILE)DO
IF(ISLETTER(TOKEN[1]))THEN BEGIN
IF(NOT LOOKUP(TOKEN,DEFN,TOKTYPE))THEN
PUTTOK(TOKEN)
ELSE BEGIN
CP:=CP+1;
IF(CP>CALLSIZE)THEN
ERROR('MACRO:CALL STACK OVERFLOW');
CALLSTK[CP]:=AP;
TYPESTK[CP]:=TOKTYPE;
AP:=PUSH(EP,ARGSTK,AP);
PUTTOK(DEFN);
PUTCHR(ENDSTR);
AP:=PUSH(EP,ARGSTK,AP);
PUTTOK(TOKEN);
PUTCHR(ENDSTR);
AP:=PUSH(EP,ARGSTK,AP);
T:=GETTOK(TOKEN,MAXTOK);
PBSTR(TOKEN);
IF(T<>LPAREN)THEN BEGIN
PUTBACK(RPAREN);
PUTBACK(LPAREN)
END;
PLEV[CP]:=0
END
END
ELSE IF(TOKEN[1]=LQUOTE) THEN BEGIN
NLPAR:=1;
REPEAT
T:=GETTOK(TOKEN,MAXTOK);
IF(T=RQUOTE)THEN
NLPAR:=NLPAR-1
ELSE IF (T=LQUOTE)THEN
NLPAR:=NLPAR+1
ELSE IF (T=ENDFILE) THEN
ERROR('MACRO:MISSING RIGHT QUOTE');
IF(NLPAR>0) THEN
PUTTOK(TOKEN)
UNTIL(NLPAR=0)
END
ELSE IF (CP=0)THEN
PUTTOK(TOKEN)
ELSE IF (TOKEN[1]=LPAREN) THEN BEGIN
IF(PLEV[CP]>0)THEN
PUTTOK(TOKEN);
PLEV[CP]:=PLEV[CP]+1
END
ELSE IF (TOKEN[1]=RPAREN)THEN BEGIN
PLEV[CP]:=PLEV[CP]-1;
IF(PLEV[CP]>0)THEN
PUTTOK(TOKEN)
ELSE BEGIN
PUTCHR(ENDSTR);
EVAL(ARGSTK,TYPESTK[CP],CALLSTK[CP],AP-1);
AP:=CALLSTK[CP];
EP:=ARGSTK[AP];
CP:=CP-1
END
END
ELSE IF (TOKEN[1]=COMMA) AND (PLEV[CP]=1)THEN BEGIN
PUTCHR(ENDSTR);
AP:=PUSH(EP,ARGSTK,AP)
END
ELSE
PUTTOK(TOKEN);
IF(CP<>0)THEN
ERROR('MACRO:UNEXPECTED END OF INPUT')
END;
SHAR_EOF
if test 12030 -ne "`wc -c < 'chapter8.pas'`"
then
echo shar: error transmitting "'chapter8.pas'" '(should have been 12030 characters)'
fi
fi # end of overwriting check
if test -f 'fprims.pas'
then
echo shar: will not over-write existing file "'fprims.pas'"
else
cat << \SHAR_EOF > 'fprims.pas'
{fprims.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
MAXPAT=MAXSTR;
CLOSIZE=1;
CLOSURE=STAR;
BOL=PERCENT;
EOL=DOLLAR;
ANY=QUESTION;
CCL=LBRACK;
CCLEND=RBRACK;
NEGATE=CARET;
NCCL=EXCLAM;
LITCHAR=67;
FUNCTION MAKEPAT (VAR ARG:XSTRING; START:INTEGER;
DELIM:CHARACTER; VAR PAT:XSTRING):INTEGER;FORWARD;
FUNCTION AMATCH(VAR LIN:XSTRING;OFFSET:INTEGER;
VAR PAT:XSTRING; J:INTEGER):INTEGER;FORWARD;
FUNCTION MATCH(VAR LIN,PAT:XSTRING):BOOLEAN;FORWARD;
FUNCTION MAKEPAT;
VAR
I,J,LASTJ,LJ:INTEGER;
DONE,JUNK:BOOLEAN;
FUNCTION GETCCL(VAR ARG:XSTRING; VAR I:INTEGER;
VAR PAT:XSTRING; VAR J:INTEGER):BOOLEAN;
VAR
JSTART:INTEGER;
JUNK:BOOLEAN;
PROCEDURE DODASH(DELIM:CHARACTER; VAR SRC:XSTRING;
VAR I:INTEGER; VAR DEST:XSTRING;
VAR J:INTEGER; MAXSET:INTEGER);
CONST ESCAPE=ATSIGN;
VAR K:INTEGER;
JUNK:BOOLEAN;
FUNCTION ESC(VAR S:XSTRING; VAR I:INTEGER):CHARACTER;
BEGIN
IF(S[I]<>ESCAPE) THEN
ESC:=S[I]
ELSE IF (S[I+1]=ENDSTR) THEN
ESC:=ESCAPE
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;
BEGIN
WHILE(SRC[I]<>DELIM) AND (SRC[I]<>ENDSTR) DO BEGIN
IF(SRC[I]=ESCAPE)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;
BEGIN
I:=I+1;
IF(ARG[I]=NEGATE) THEN BEGIN
JUNK:=ADDSTR(NCCL,PAT,J,MAXPAT);
I:=I+1
END
ELSE
JUNK:=ADDSTR(CCL,PAT,J,MAXPAT);
JSTART:=J;
JUNK:=ADDSTR(0,PAT,J,MAXPAT);
DODASH(CCLEND,ARG,I,PAT,J,MAXPAT);
PAT[JSTART]:=J-JSTART-1;
GETCCL:=(ARG[I]=CCLEND)
END;
PROCEDURE STCLOSE(VAR PAT:XSTRING;VAR J:INTEGER;
LASTJ:INTEGER);
VAR
JP,JT:INTEGER;
JUNK:BOOLEAN;
BEGIN
FOR JP:=J-1 DOWNTO LASTJ DO BEGIN
JT:=JP+CLOSIZE;
JUNK:=ADDSTR(PAT[JP],PAT,JT,MAXPAT)
END;
J:=J+CLOSIZE;
PAT[LASTJ]:=CLOSURE
END;
BEGIN
J:=1;
I:=START;
LASTJ:=1;
DONE:=FALSE;
WHILE(NOT DONE) AND (ARG[I]<>DELIM)
AND (ARG[I]<>ENDSTR) DO BEGIN
LJ:=J;
IF(ARG[I]=ANY) THEN
JUNK:=ADDSTR(ANY,PAT,J,MAXPAT)
ELSE IF (ARG[I]=BOL) AND (I=START) THEN
JUNK:=ADDSTR(BOL,PAT,J,MAXPAT)
ELSE IF (ARG[I]=EOL) AND (ARG[I+1]=DELIM) THEN
JUNK:=ADDSTR(EOL,PAT,J,MAXPAT)
ELSE IF (ARG[I]=CCL) THEN
DONE:=(GETCCL(ARG,I,PAT,J)=FALSE)
ELSE IF (ARG[I]=CLOSURE) AND (I>START) THEN BEGIN
LJ:=LASTJ;
IF(PAT[LJ] IN [BOL,EOL,CLOSURE]) THEN
DONE:=TRUE
ELSE
STCLOSE(PAT,J,LASTJ)
END
ELSE BEGIN
JUNK:=ADDSTR(LITCHAR,PAT,J,MAXPAT);
JUNK:=ADDSTR(ESC(ARG,I),PAT,J,MAXPAT)
END;
LASTJ:=LJ;
IF(NOT DONE) THEN
I:=I+1
END;
IF(DONE) OR (ARG[I]<>DELIM) THEN
MAKEPAT:=0
ELSE IF (NOT ADDSTR(ENDSTR,PAT,J,MAXPAT)) THEN
MAKEPAT:=0
ELSE
MAKEPAT:=I
END;
FUNCTION AMATCH;
VAR I,K:INTEGER;
DONE:BOOLEAN;
FUNCTION OMATCH(VAR LIN:XSTRING; VAR I:INTEGER;
VAR PAT:XSTRING; J:INTEGER):BOOLEAN;
VAR
ADVANCE:-1..1;
FUNCTION LOCATE (C:CHARACTER; VAR PAT: XSTRING;
OFFSET:INTEGER):BOOLEAN;
VAR
I:INTEGER;
BEGIN
LOCATE:=FALSE;
I:=OFFSET+PAT[OFFSET];
WHILE(I>OFFSET) DO
IF(C=PAT[I]) THEN BEGIN
LOCATE :=TRUE;
I:=OFFSET
END
ELSE
I:=I-1
END;BEGIN
ADVANCE:=-1;
IF(LIN[I]=ENDSTR) THEN
OMATCH:=FALSE
ELSE IF (NOT( PAT[J] IN
[LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
ERROR('IN OMATCH:CAN''T HAPPEN')
ELSE
CASE PAT[J] OF
LITCHAR:
IF (LIN[I]=PAT[J+1]) THEN
ADVANCE:=1;
BOL:
IF (I=1) THEN
ADVANCE:=0;
ANY:
IF (LIN[I]<>NEWLINE) THEN
ADVANCE:=1;
EOL:
IF(LIN[I]=NEWLINE) THEN
ADVANCE:=0;
CCL:
IF(LOCATE(LIN[I],PAT,J+1)) THEN
ADVANCE:=1;
NCCL:
IF(LIN[I]<>NEWLINE)
AND (NOT LOCATE (LIN[I],PAT,J+1)) THEN
ADVANCE:=1
END;
IF(ADVANCE>=0) THEN BEGIN
I:=I+ADVANCE;
OMATCH:=TRUE
END
ELSE
OMATCH:=FALSE
END;
FUNCTION PATSIZE(VAR PAT:XSTRING;N:INTEGER):INTEGER;
BEGIN
IF(NOT (PAT[N] IN
[LITCHAR,BOL,EOL,ANY,CCL,NCCL,CLOSURE])) THEN
ERROR('IN PATSIZE:CAN''T HAPPEN')
ELSE
CASE PAT[N] OF
LITCHAR:PATSIZE:=2;
BOL,EOL,ANY:PATSIZE:=1;
CCL,NCCL:PATSIZE:=PAT[N+1]+2;
CLOSURE:PATSIZE:=CLOSIZE
END
END;
BEGIN
DONE:=FALSE;
WHILE(NOT DONE) AND (PAT[J]<>ENDSTR) DO
IF(PAT[J]=CLOSURE) THEN BEGIN
J:=J+PATSIZE(PAT,J);
I:=OFFSET;
WHILE(NOT DONE) AND (LIN[I]<>ENDSTR) DO
IF (NOT OMATCH(LIN,I,PAT,J)) THEN
DONE:=TRUE;
DONE:=FALSE;
WHILE (NOT DONE) AND (I>=OFFSET) DO BEGIN
K:=AMATCH(LIN,I,PAT,J+PATSIZE(PAT,J));
IF(K>0) THEN
DONE:=TRUE
ELSE
I:=I-1
END;
OFFSET:=K;
DONE:=TRUE
END
ELSE IF (NOT OMATCH(LIN,OFFSET,PAT,J))
THEN BEGIN
OFFSET :=0;
DONE:=TRUE
END
ELSE
J:=J+PATSIZE(PAT,J);
AMATCH:=OFFSET
END;
FUNCTION MATCH;
VAR
I,POS:INTEGER;
BEGIN
POS:=0;
I:=1;
WHILE(LIN[I]<>ENDSTR) AND (POS=0) DO BEGIN
POS:=AMATCH(LIN,I,PAT,1);
I:=I+1
END;
MATCH:=(POS>0)
END;
SHAR_EOF
if test 6206 -ne "`wc -c < 'fprims.pas'`"
then
echo shar: error transmitting "'fprims.pas'" '(should have been 6206 characters)'
fi
fi # end of overwriting check
if test -f 'initcmd.pas'
then
echo shar: will not over-write existing file "'initcmd.pas'"
else
cat << \SHAR_EOF > 'initcmd.pas'
{initcmd.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 INITCMD;
VAR
FD:FILEDESC;
FNAME:XSTRING;
FT:FILTYP;
IDX:1..MAXSTR;
I,JSKIP:INTEGER;
JUNK:BOOLEAN;
BEGIN
CMDFIL[STDIN]:=STDIO;
CMDFIL[STDOUT]:=STDIO;
CMDFIL[STDERR]:=STDIO;
FOR FD:=SUCC(STDERR) TO MAXOPEN DO
CMDFIL[FD]:=CLOSED;
WRITELN;
write('$ ');
FOR FT:= FIL1 TO FIL4 DO
CMDOPEN[FT]:=FALSE;
KBDN:=0;
if (not getline(cmdlin,STDIN,MAXSTR)) then error('NO CMDLINE');
CMDARGS:=0;
JSKIP:=0;
IDX:=1;
WHILE ((CMDLIN[IDX]<>ENDSTR)
AND(CMDLIN[IDX]<>NEWLINE)) DO BEGIN
WHILE((CMDLIN[IDX]=BLANK)AND(JSKIP MOD 2 <>1))DO
IDX:=IDX+1;
IF(CMDLIN[IDX]<>NEWLINE) THEN BEGIN
CMDARGS:=CMDARGS+1;
CMDIDX[CMDARGS]:=IDX-JSKIP;
WHILE((CMDLIN[IDX]<>NEWLINE)AND
((CMDLIN[IDX]<>BLANK)OR(JSKIP MOD 2 <>0)))DO BEGIN
IF (CMDLIN[IDX]=DQUOTE)THEN BEGIN
JSKIP:=JSKIP+1;
IDX:=IDX+1
END
ELSE BEGIN
CMDLIN[IDX-JSKIP]:=CMDLIN[IDX];
IDX:=IDX+1
END
END;
CMDLIN[IDX-JSKIP]:=ENDSTR;
IDX:=IDX+1;
IF (CMDLIN[CMDIDX[CMDARGS]]=LESS) THEN BEGIN
XCLOSE(STDIN);
CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
FD:=MUSTOPEN(FNAME,IOREAD);
CMDARGS:=CMDARGS-1;
END
ELSE IF (CMDLIN[CMDIDX[CMDARGS]]=GREATER) THEN BEGIN
XCLOSE(STDOUT);
CMDIDX[CMDARGS]:=CMDIDX[CMDARGS]+1;
JUNK:=GETARG(CMDARGS,FNAME,MAXSTR);
FD:=MUSTCREATE(FNAME,IOWRITE);
CMDARGS:=CMDARGS-1;
END
END
END;
END;
SHAR_EOF
if test 2249 -ne "`wc -c < 'initcmd.pas'`"
then
echo shar: error transmitting "'initcmd.pas'" '(should have been 2249 characters)'
fi
fi # end of overwriting check
if test -f 'shell.pas'
then
echo shar: will not over-write existing file "'shell.pas'"
else
cat << \SHAR_EOF > 'shell.pas'
{SHELL.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.
}
PROGRAM TOOLS;
{$I TOOLU.PAS}
{$I INITCMD.PAS}
{$I CHAPTER1.PAS}
{$I CHAPTER2.PAS}
{$I CHAPTER3.PAS}
{$I CHAPTER4.PAS}
{$I CHAPTER5.PAS}
{$I CHAPTER6.PAS}
{$I CHAPTER7.PAS}
{$I CHAPTER8.PAS}
VAR
STR,STR1:STRING80;
COMMAND:XSTRING;
DONE:BOOLEAN;
I:INTEGER;
BEGIN {SHELL}
DONE:=FALSE;
WHILE NOT DONE
DO
BEGIN
INITCMD;
IF GETARG(1,COMMAND,MAXSTR)
THEN
BEGIN
STR:='';
STR1:='X';
FOR I:=1 TO XLENGTH(COMMAND)
DO
BEGIN
if COMMAND[I]in[97..122]
then
str1[1]:=chr(command[i]-32)
ELSE STR1[1]:=chr(COMMAND[I]);
STR:=CONCAT(STR,STR1)
END;
if str = 'COPY' then copy
else if str = 'LINECOUNT' then linecount
else if str = 'WORDCOUNT' then wordcount
else if str = 'DETAB' then detab
else if str = 'ENTAB' then entab
else if str = 'OVERSTRIKE' then overstrike
else if str = 'COMPRESS' then compress
else if str = 'EXPAND' then expand
else if str = 'ECHO' then echo
else if str = 'TRANSLIT' then translit
else if str = 'COMPARE' then compare
else if str = 'INCLUDE' then include
else if str = 'CONCAT' then concat
else if str = 'PRINT' then print
else if str = 'MAKECOPY' then makecopy
else if str = 'ARCHIVE' then archive
else if str = 'SORT' then sort
else if str = 'UNIQUE' then unique
else if str = 'KWIC' then kwic
else if str = 'ROTATE' then writeln('ROTATE not directly supported.')
else if str = 'UNROTATE' then unrotate
else if str = 'FIND' then find
else if str = 'CHANGE' then change
else if str = 'EDIT' then edit
else if str = 'FORMAT' then format
else if str = 'DEFINE' then macro
else if str = 'MACRO' then macro
else if str = 'QUIT' then halt
ELSE
BEGIN
WRITELN('?');
DONE:=FALSE
END
END;
endcmd;
END;
END.
SHAR_EOF
if test 2654 -ne "`wc -c < 'shell.pas'`"
then
echo shar: error transmitting "'shell.pas'" '(should have been 2654 characters)'
fi
fi # end of overwriting check
# End of shell archive
exit 0
More information about the Comp.sources.unix
mailing list