Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!cmcl2!rna!rocky2!reintom
From: reintom@rocky2.UUCP (Tom Reingold)
Newsgroups: net.sources
Subject: Software Tools in Pascal for Turbo Pascal (part 3/3)
Message-ID: <259@rocky2.UUCP>
Date: Fri, 19-Sep-86 01:15:47 EDT
Article-I.D.: rocky2.259
Posted: Fri Sep 19 01:15:47 1986
Date-Received: Sat, 20-Sep-86 02:46:14 EDT
Organization: Rockefeller Univ., N.Y.C. 10021
Lines: 1834

#! /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:
#	chapter8.pas
#	fprims.pas
#	initcmd.pas
#	shell.pas
#	toolu.pas
# This archive created: Thu Sep 18 14:28:01 1986
export PATH; PATH=/bin:$PATH
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
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