Software Tools in Pascal (Part 6 of 6)
sources-request at genrad.UUCP
sources-request at genrad.UUCP
Sun Jul 14 22:43:14 AEST 1985
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
More information about the Mod.sources
mailing list