Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume2/tools/part7

Internet Message Format | 1986-11-30 | 26.8 KB

Subject: Software Tools in Pascal (Part 6 of 6)
From: ihnp4!mnetor!clewis (Chris Lewis)
Newsgroups: mod.sources
Approved: [e-mail]

Mod.sources:  Volume 2, Issue 12
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)

#!/bin/sh
echo 'Start of pack.out, part 06 of 06:'
echo 'x - addstr.pascal'
sed 's/^X//' > addstr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ AddStr -- put c in outSet[j] if it fits, increment j }
Xsegment AddStr;
X%include swtools
Xfunction Addstr;
Xbegin
X    if (j > maxSet) then
X        AddStr := false
X    else begin
X        outSet[j] := c;
X        j := j + 1;
X        AddStr := true
X    end
Xend;
/
echo 'x - cvtsst.pascal'
sed 's/^X//' > cvtsst.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CvtSST -- assign pascalvs string to StringType }
Xsegment CvtSST;
X%include swtools
Xprocedure CvtSST;
Xvar
X    i: 1..MAXSTR;
Xbegin
X    for i := 1 to Length(src) do
X        dest[i] := src[i];
X    dest[Length(src) + 1] := ENDSTR;
Xend;
/
echo 'x - cvtsts.pascal'
sed 's/^X//' > cvtsts.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ CvtStS -- convert swtools StringType to Pascalvs String }
Xsegment cvtsts;
X%include swtools
Xprocedure cvtsts;
Xbegin
X    WriteStr(dest, src:StrLength(src));
Xend;
/
echo 'x - doexpr.pascal'
sed 's/^X//' > doexpr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ DoExpr -- Evaluate arithmetic expression }
Xsegment DoExpr;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoExpr;
Xvar
X    temp: StringType;
X    junk: Integer;
Xbegin
X    CsCopy(evalStk, argStk[i+2], temp);
X    junk := 1;
X    PBNum(Expr(temp, junk))
Xend {DoExpr};
/
echo 'x - echo.pascal'
sed 's/^X//' > echo.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Echo -- echo arguments }
Xprogram Echo;
X%include swtools
Xvar
X    lin: StringType;
X    i: Integer;
X    junk: Boolean;
Xbegin
X    ToolInit;
X    for i := 1 to Nargs do begin
X        junk := GetArg(i, lin, MAXSTR);
X        PutStr(lin, STDOUT);
X        if i < Nargs then PutCF(BLANK, STDOUT)
X    end;
X    PutCF(NEWLINE, STDOUT)
Xend.
/
echo 'x - equal.pascal'
sed 's/^X//' > equal.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Equal -- test two strings for equality }
Xsegment Equal;
X%include swtools
Xfunction Equal;{str1, str2: StringType): Boolean}
Xvar
X    i: Integer;
Xbegin
X    i := 1;
X    while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
X        i := i + 1;
X    Equal := (str1[i] = str2[i])
Xend;
/
echo 'x - error.pascal'
sed 's/^X//' > error.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
Xsegment Error;
X%include swtools
Xprocedure Error;
Xvar
X    i: 1..MAXSTR;
Xbegin
X    for i := 1 to Length(s) do
X         PutCF(s[i], STDERR);
X    PutCF(NEWLINE,STDERR);
X    RetCode(1000);
X    HALT;
Xend;
/
echo 'x - fclose.pascal'
sed 's/^X//' > fclose.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ FClose -- close a file }
Xsegment FClose;
X%include swtools
X%include ioref
Xprocedure FClose;
Xbegin
X    if (fd > STDERR) and (fd <= MAXOPEN) and
X      (openList[fd].mode <> IOAVAIL) then begin
X        Close(openList[fd].fileVar);
X        openList[fd].mode := IOAVAIL;
X        ERRORIO := false;
X    end;
Xend;
/
echo 'x - fcopy.pascal'
sed 's/^X//' > fcopy.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ FCopy -- Copy file fin to file fout }
Xsegment FCopy;
X%include SWTOOLS
X%include IODEF
Xprocedure FCopy;
Xvar
X    temp: StringType;
Xbegin
X    while (GetLine(temp, fin, MAXSTR)) do
X        PutStr(temp, fout);
Xend; {FCopy}
/
echo 'x - fcreate.pascal'
sed 's/^X//' > fcreate.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ FCreate -- create a file (temporary version) }
Xsegment FCreate;
X%include swtools
Xfunction FCreate;
Xbegin
X    FCreate := FOpen(name, mode)
Xend;
/
echo 'x - fdalloc.pascal'
sed 's/^X//' > fdalloc.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ FDAlloc - find a free file descriptor }
Xsegment FDAlloc;
X%include swtools
X%include ioref
Xfunction FDAlloc;
Xvar
X    fd: FileDesc;
X    done: Boolean;
Xbegin
X    done := false;
X    fd := Succ(STDERR);
X    repeat
X        done := (openList[fd].mode = IOAVAIL) or (fd = MAXOPEN);
X        if (not done) then
X            fd := Succ(fd)
X    until (done);
X    if openList[fd].mode = IOAVAIL then
X        FDAlloc := fd
X    else
X        FDAlloc := IOERROR
Xend;
/
echo 'x - getarg.pascal'
sed 's/^X//' > getarg.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetArg (CMS) -- get n-th command line parameter }
Xsegment GetArg;
X%include swtools
X%include ioref
Xfunction GetArg;
Xbegin
X    if ((n < 1) or (cmdArgs < n)) then
X        GetArg := false
X    else begin
X        SCopy(cmdLin,cmdIdx[n], str, 1);
X        GetArg := true
X    end
Xend;
/
echo 'x - getcf.pascal'
sed 's/^X//' > getcf.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetCF -- get character from file }
Xsegment GetCF;
X%include swtools
X%include ioref
Xfunction GetCF;
Xbegin
X    if Eof(openList[fd].fileVar) then begin
X        c := ENDFILE;
X        GetCF := ENDFILE
X    end
X    else if Eoln(openList[fd].fileVar) then begin
X        GetCF := NEWLINE;
X        c := NEWLINE;
X        ReadLn(openList[fd].fileVar);
X    end
X    else begin
X        Read(openList[fd].fileVar,c);
X        GetCF := c;
X    end
Xend;
Xfunction GetC;
Xbegin
X    c := GetCF(c, STDIN);
X    GetC := c;
Xend;
/
echo 'x - getsub.pascal'
sed 's/^X//' > getsub.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GetSub -- Get substitution pattern and support fcns }
Xsegment GetSub;
X%include swtools
X%include patdef
X%include subdef
X{ GetSub -- Get substitution  pattern and support fcns }
Xfunction GetSub;
Xbegin
X    GetSub := (MakeSub(arg, 1, ENDSTR, sub) > 0)
Xend;
/
echo 'x - gnbchar.pascal'
sed 's/^X//' > gnbchar.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ GNBChar -- Get next non-blank character }
Xsegment GNBChar;
X%include swtools
X%include macdefs
X%include macproc
Xfunction GNBChar;
Xbegin
X    while (s[i] in [BLANK, TAB, NEWLINE]) do
X        i := i + 1;
X    GNBChar := s[i]
Xend {GNBChar};
/
echo 'x - hash.pascal'
sed 's/^X//' > hash.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Hash -- compute hash function of a name }
Xsegment Hash;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction Hash;
Xvar
X    i, h: Integer;
Xbegin
X    h := 0;
X    for i := 1 to StrLength(name) do
X        h := (3 * h + Ord(name[i])) mod HASHSIZE;
X    Hash := h + 1
Xend;
/
echo 'x - inithash.pascal'
sed 's/^X//' > inithash.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ InitHash -- initialize hash table to nil }
Xsegment InitHash;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure InitHash;
Xvar
X    i: 1..HASHSIZE;
Xbegin
X    nextTab := 1;   { first free slot in table }
X    for i := 1 to HASHSIZE do
X        hashTab[i] := nil
Xend;
/
echo 'x - isalphan.pascal'
sed 's/^X//' > isalphan.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ IsAlphaNum -- true if c is letter or digit }
Xsegment IsAlphaNum;
X%include swtools
Xfunction IsAlphaNum;
Xbegin
X    IsAlphaNum := ((c >= LETA) and (c <= LETI)) or
X                  ((c >= LETJ) and (c <= LETR)) or
X                  ((c >= LETS) and (c <= LETZ)) or
X                  ((c >= BIGA) and (c <= BIGI)) or
X                  ((c >= BIGJ) and (c <= BIGR)) or
X                  ((c >= BIGS) and (c <= BIGZ)) or
X                  ((c >= DIG0) and (c <= DIG9))
Xend;
/
echo 'x - isdigit.pascal'
sed 's/^X//' > isdigit.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ IsDigit -- true if c is a digit }
Xsegment IsDigit;
X%include swtools
Xfunction IsDigit;
Xbegin
X    IsDigit := c in [DIG0..DIG9];
Xend;
/
echo 'x - isletter.pascal'
sed 's/^X//' > isletter.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ IsLetter -- true if c is a letter of either case }
Xsegment IsLetter;
X%include swtools
X%include chardef
Xfunction IsLetter;
Xbegin
X    IsLetter := ChLetter in CharClass(c)
Xend;
/
echo 'x - itoc.pascal'
sed 's/^X//' > itoc.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ IToC -- convert integer n to char string in s[i] ... }
Xsegment IToC;
X%include swtools
Xfunction IToC;
Xbegin
X    if (n < 0) then begin
X        s[i] := MINUS;
X        IToC := IToC(-n, s, i+1);
X    end
X    else begin
X        if (n >= 10) then
X            i := IToC(n div 10, s, i);
X        s[i] := Chr(n mod 10 + Ord(DIG0));
X        s[i+1] := ENDSTR;
X        IToC := i + 1;
X    end
Xend;
/
echo 'x - makeset.pascal'
sed 's/^X//' > makeset.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ MakeSet -- make set from inset(k) in outset }
Xsegment MakeSet;
X%include swtools
X%include patdef
Xfunction MakeSet;
Xvar
X    j: Integer;
Xbegin
X    j := 1;
X    DoDash(ENDSTR, inSet, k, outSet, j, maxSet);
X    makeSet := AddStr(ENDSTR, outSet, j, maxSet)
Xend;
/
echo 'x - message.pascal'
sed 's/^X//' > message.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Message -- print a PASCALVS string on STDERR }
Xsegment Message;
X%include swtools
Xprocedure Message;
Xvar
X    i: 1..MAXSTR;
Xbegin
X    for i := 1 to Length(s) do
X         PutCF(s[i], STDERR);
X    PutCF(NEWLINE,STDERR);
Xend;
/
echo 'x - mustopen.pascal'
sed 's/^X//' > mustopen.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ MustOpen -- same as FOpen except for no allowance of failure }
Xsegment MustOpen;
X{ mustopen -- open file or die }
X%include swtools
Xfunction MustOpen;
Xvar
X    fd: FileDesc;
Xbegin
X    fd := FOpen(fname, fMode);
X    if (fd = IOERROR) then begin
X        PutStr(fname, STDERR);
X        Error(': can''t open file')
X    end;
X    MustOpen := fd
Xend;
/
echo 'x - nargs.pascal'
sed 's/^X//' > nargs.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Nargs (CMS) -- return number of arguments }
Xsegment Nargs;
X%include swtools
X%include ioref
Xfunction NArgs;
Xbegin
X    NArgs := cmdArgs
Xend;
/
echo 'x - pbnum.pascal'
sed 's/^X//' > pbnum.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PBNum -- Convert number to string, push back on input }
Xsegment PBNum;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PBNum;
Xvar
X    temp: StringType;
X    junk: Integer;
Xbegin
X    junk := IToC(n, temp, 1);
X    PBStr(temp)
Xend {PBNum};
/
echo 'x - pbstr.pascal'
sed 's/^X//' > pbstr.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PBStr -- push string back onto input }
Xsegment PBStr;
X%include swtools
X%include defdef
X%include defproc
Xprocedure PBStr;
Xvar
X    i: Integer;
Xbegin
X    for i := StrLength(s) downto 1 do
X        PutBack(s[i])
Xend;
/
echo 'x - progexit.pascal'
sed 's/^X//' > progexit.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ ProgExit -- Returns a return code and quits }
Xsegment ProgExit;
X%include swtools
Xprocedure ProgExit;
Xbegin
X    RetCode(returnCode);
X    HALT
Xend; {ProgExit}
/
echo 'x - push.pascal'
sed 's/^X//' > push.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Push -- push ep onto argStk, return new position ap }
Xsegment Push;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Push;
Xbegin
X    if (ap > ARGSIZE) then
X        Error('Macro: argument stack overflow');
X    argStk[ap] := ep;
X    Push := ap + 1
Xend {Push};
/
echo 'x - putback.pascal'
sed 's/^X//' > putback.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutBack -- push character back onto input }
Xsegment PutBack;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure PutBack;
Xbegin
X    if (bp >= BUFSIZE) then
X        Error('Too many characters pushed back');
X    bp := bp + 1;
X    buf[bp] := c
Xend;
/
echo 'x - putc.pascal'
sed 's/^X//' > putc.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutC -- print character to STDOUT }
Xsegment PutC;
X%include swtools
Xprocedure PutC;
Xbegin
X    PutCF(c, STDOUT)
Xend;
/
echo 'x - putcf.pascal'
sed 's/^X//' > putcf.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutCF -- put string out on file }
Xsegment PutCF;
X%include swtools
X%include ioref
Xprocedure PutCF;
Xbegin
X    if openList[fd].mode = IOAVAIL then
X        Error('putcf on unopen file');
X    if c = NEWLINE then
X        writeln(openList[fd].fileVar)
X    else
X        write(openList[fd].fileVar, c)
Xend;
/
echo 'x - putdec.pascal'
sed 's/^X//' > putdec.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutDec -- put decimal integer n in field width >= w }
Xsegment PutDec;
X%include swtools
Xprocedure PutDec;
Xvar
X    i, nd: Integer;
X    s: StringType;
Xbegin
X    nd := itoc(n, s, 1);
X    for i := nd to w do
X        PutC(BLANK);
X    for i := 1 to nd-1 do
X        PutC(s[i])
Xend;
/
echo 'x - puttok.pascal'
sed 's/^X//' > puttok.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ PutTok -- put token on output or evaluation stack }
Xsegment PutTok;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PutTok;
Xvar
X    i: Integer;
Xbegin
X    i := 1;
X    while s[i] <> ENDSTR do begin
X        PutChr(s[i]);
X        i := i + 1
X    end {while};
Xend {PutTok};
/
echo 'x - remove.pascal'
sed 's/^X//' > remove.pascal << '/'
X{
X    Copyright (c) 1982
X    By:    Chris Lewis
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ Remove -- remove a file - very tricky }
Xsegment Remove;
X%include swtools
X%include cms
Xprocedure Remove;
Xvar
X    cmsString: String(MAXSTR);
X    returnCode: Integer;
X    i: 1..MAXSTR;
Xbegin
X    cmsString := 'ERASE ';
X    for i := 1 TO StrLength(name) do
X        if name[i] in [NEWLINE, PERIOD] then
X            cmsString := cmsString || Str(' ')
X        else
X            cmsString := cmsString || Str(name[i]);
X    Cms(cmsString, returnCode);
Xend;
/
echo 'x - scopy.pascal'
sed 's/^X//' > scopy.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ SCopy (CMS) -- copy strings }
Xsegment SCopy;
X%include swtools
Xprocedure SCopy;
Xbegin
X    while(src[i] <> ENDSTR) do begin
X        dest[j] := src[i];
X        i := i + 1;
X        j := j + 1;
X    end;
X    dest[j] := ENDSTR;
Xend;
/
echo 'x - skipbl.pascal'
sed 's/^X//' > skipbl.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ SkipBl -- skip blanks and tabs s[i] ... }
Xsegment SkipBl;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
Xprocedure SkipBl;
Xbegin
X    while (s[i] = BLANK) or (s[i] = TAB) do
X        i := i + 1
Xend;
/
echo 'x - strlengt.pascal'
sed 's/^X//' > strlengt.pascal << '/'
X{
X    Copyright (c) 1981
X    By:    Bell Telephone Laboratories, Inc. and
X        Whitesmiths, Ltd.,
X
X    This software is derived from the book
X        "Software Tools In Pascal", by
X        Brian W. Kernighan and P.J. Plauger
X        Addison-Wesley, 1981
X        ISBN 0-201-10342-7
X
X    Right is hereby granted to freely distribute or duplicate this
X    software, providing distribution or duplication is not for profit
X    or other commerical gain and that this copyright notice remains
X    intact.
X}
X{ StrLength -- determine length of swtools string }
Xsegment StrLength;
X%include swtools
Xfunction StrLength;
Xvar
X    i: Integer;
Xbegin
X    i := LBound(s);
X    while (s[i] <> ENDSTR) and (i < MAXSTR) do
X        i := i + 1;
X    StrLength := i - LBound(s)
Xend;
/
echo 'x - swprin1.exec'
sed 's/^X//' > swprin1.exec << '/'
X&TRACE OFF
XEXEC TIMEFOR SWTOOLS LDATE C &1 &2 &3 PRINT &1 &2 &3
/
echo 'x - swtpc.exec'
sed 's/^X//' > swtpc.exec << '/'
X&CONTROL ERROR
XSTATE &1 PASCAL *
X&IF &RETCODE NE 0 &EXIT
XEXEC PASCALVS &1 (LIB(SWTOOLS) NOPRINT NOGOS NOCHECK NODEBUG &2 &3 &4 &5 &6
X&IF &RETCODE > 4 &EXIT &RETCODE
XTXTLIB DEL SWTOOLS &1
XTXTLIB ADD SWTOOLS &1
/
echo 'Part 06 of pack.out complete.'
exit