Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!utcs!mnetor!seismo!cmcl2!rna!rocky2!reintom
From: reintom@rocky2.UUCP
Newsgroups: net.sources
Subject: Software Tools in Pascal for Turbo Pascal (part 2/2)
Message-ID: <223@rocky2.UUCP>
Date: Wed, 16-Jul-86 01:01:42 EDT
Article-I.D.: rocky2.223
Posted: Wed Jul 16 01:01:42 1986
Date-Received: Fri, 18-Jul-86 01:02:09 EDT
Organization: Rockefeller Univ., N.Y.C. 10021
Lines: 1596

#! /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