Software Tools in Pascal (Part 5 of 6)
sources-request at genrad.UUCP
sources-request at genrad.UUCP
Sat Jul 13 22:37:41 AEST 1985
Mod.sources: Volume 2, Issue 11
Submitted by: ihnp4!mnetor!clewis (Chris Lewis)
#!/bin/sh
echo 'Start of pack.out, part 05 of 06:'
echo 'x - append.pascal'
sed 's/^X//' > append.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{ Append -- append lines after "line" }
Xsegment Append;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Append;
Xvar
X inLine: StringType;
X stat: STCode;
X done: Boolean;
Xbegin
X if (glob) then
X stat := ERR
X else begin
X curLn := line;
X stat := OK;
X done := false;
X while (not done) and (stat = OK) do
X if (not GetLine(inLine, STDIN, MAXSTR)) then
X stat := ENDDATA
X else if (inLine[1] = PERIOD) and
X (inLine[2] = NEWLINE) then
X done := true
X else if (PutTxt(inLine) = ERR) then
X stat := ERR
X end;
X Append := stat
Xend;
/
echo 'x - catsub.pascal'
sed 's/^X//' > catsub.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{ CatSub -- add replacement text to end of new }
Xsegment CatSub;
X%include swtools
X%include subdef
X%include metadef
Xprocedure CatSub;
Xvar
X i,j: Integer;
X junk: Boolean;
X l: Integer;
Xbegin
X i := 1;
X while (sub[i] <> ENDSTR) do begin
X if (sub[i] = DITTO) then begin
X l := Ord(sub[i+1]);
X if (l in [0..9]) then begin
X for j := metaTable[l].first to metaTable[l].last -1 do
X junk := AddStr(lin[j], new, k, maxNew);
X i := i + 1
X end
X else
X for j := s1 to s2-1 do
X junk := AddStr(lin[j], new, k, maxNew)
X end
X else
X junk := AddStr(sub[i], new, k, maxNew);
X i := i + 1
X end
Xend;
/
echo 'x - ckp.pascal'
sed 's/^X//' > ckp.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{ CkP -- check for "p" after command }
Xsegment CkP;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction CkP;
Xbegin
X SkipBl(lin, i);
X if (lin[i] = PCMD) then begin
X i := i + 1;
X pFlag := true
X end
X else
X pFlag := false;
X if (lin[i] = NEWLINE) then
X status := OK
X else
X status := ERR;
X CkP := status
Xend;
/
echo 'x - cscopy.pascal'
sed 's/^X//' > cscopy.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{ CSCopy -- copy cb[i]... to string s }
Xsegment CSCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure CSCopy;
Xvar
X j: Integer;
Xbegin
X j := 1;
X while (cb[i] <> ENDSTR) do begin
X s[j] := cb[i];
X i := i + 1;
X j := j + 1
X end;
X s[j] := ENDSTR
Xend;
/
echo 'x - ctoi.pascal'
sed 's/^X//' > ctoi.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{ CToI -- convert string at s[i] to integer, increment i }
Xsegment ctoi;
X%include swtools
Xfunction CToI;
Xvar
X n, sign: Integer;
Xbegin
X while (s[i] = BLANK) or (s[i] = TAB) do
X i := i + 1;
X if (s[i] = MINUS) then
X sign := -1
X else
X sign := 1;
X if (s[i] = MINUS) or (s[i] = PLUS) then
X i := i + 1;
X n := 0;
X while(IsDigit(s[i])) do begin
X n := 10 * n + Ord(s[i]) - Ord(DIG0);
X i := i + 1;
X end;
X CToI := sign * n;
Xend;
/
echo 'x - dochq.pascal'
sed 's/^X//' > dochq.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{ DoChq -- Change quote characters }
Xsegment DoChq;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoChq;
Xvar
X temp: StringType;
X n: Integer;
Xbegin
X CsCopy(evalStk, argStk[i+2], temp);
X n := StrLength(temp);
X if (n <= 0) then begin
X lQuote := GRAVE;
X rQuote := ACUTE;
X end {elseif}
X else if (n = 1) then begin
X lQuote := temp[1];
X rQuote := lQuote
X end {elseif}
X else begin
X lQuote := temp[1];
X rQuote := temp[2]
X end {if}
Xend {DoCkq};
/
echo 'x - dodef.pascal'
sed 's/^X//' > dodef.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{ DoDef -- install definition in table }
Xsegment DoDef;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoDef;
Xvar
X temp1, temp2: StringType;
Xbegin
X if (j - i > 2) then begin
X CsCopy(evalStk, argStk[i+2], temp1);
X CsCopy(evalStk, argStk[i+3], temp2);
X Install(temp1, temp2, MACTYPE)
X end {if};
Xend {DoDef};
/
echo 'x - doglob.pascal'
sed 's/^X//' > doglob.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{ DoGlob -- do command at lin[i] on all marked lines }
Xsegment DoGlob;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoGlob;
Xvar
X count, iStart, n: Integer;
Xbegin
X status := OK;
X count := 0;
X n := line1;
X iStart := i;
X repeat
X if (GetMark(n)) then begin
X PutMark(n, false);
X curLn := n;
X curSave := curLn;
X i := iStart;
X if (GetList(lin, i, status) = OK) then
X if (DoCmd(lin, i, true, status) = OK) then
X count := 0;
X end
X else begin
X n := NextLn(n);
X count := count + 1
X end
X until (count > lastLn) or (status <> OK);
X DoGlob := status
Xend;
/
echo 'x - doif.pascal'
sed 's/^X//' > doif.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{ DoIf -- Select one of two arguments }
Xsegment DoIf;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoIf;
Xvar
X temp1, temp2, temp3: StringType;
Xbegin
X if (j - i >= 4) then begin
X CsCopy(evalStk, argStk[i+2], temp1);
X CsCopy(evalStk, argStk[i+3], temp2);
X if (Equal(temp1, temp2)) then
X CsCopy(evalStk, argStk[i+4], temp3)
X else if (j - i >= 5) then
X CsCopy(evalStk, argStk[i+5], temp3)
X else
X temp3[1] := ENDSTR;
X PBStr(temp3)
X end {if}
Xend {DoIf};
/
echo 'x - dolen.pascal'
sed 's/^X//' > dolen.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{ DoLen -- Return length of argument }
Xsegment DoLen;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure DoLen;
Xvar
X temp: StringType;
Xbegin
X if (j - i > 1) then begin
X CsCopy(evalStk, argStk[i+2], temp);
X PBNum(StrLength(temp))
X end {then}
X else
X PBNum(0)
Xend {DoLen};
/
echo 'x - dolprint.pascal'
sed 's/^X//' > dolprint.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{ DoLPrint -- print lines n1 thru n2 unambiguously }
Xsegment DoLPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include chardef
Xfunction DoLPrint;
Xvar
X lp: Integer;
X i: Integer;
X line: StringType;
Xbegin
X if (n1 < 0) then
X DoLPrint := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X if OptIsOn(numFlag) then begin
X PutDec(i, 5);
X PutC(BLANK)
X end;
X for lp := 1 to StrLength(line) do begin
X if CharClass(line[lp]) <> [] then
X PutC(line[lp])
X else if line[lp] = NEWLINE then
X PutC(NEWLINE)
X else begin
X PutC(BACKSLASH);
X PutDec(Ord(line[lp]), 3)
X end
X end
X end;
X curLn := n2;
X DoLPrint := OK
X end
Xend;
/
echo 'x - doprint.pascal'
sed 's/^X//' > doprint.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{ DoPrint -- print lines n1 thru n2 }
Xsegment DoPrint;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoPrint;
Xvar
X i: Integer;
X line: StringType;
Xbegin
X if (n1 < 0) then
X DoPrint := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X if OptIsOn(numFlag) then begin
X PutDec(i, 5);
X PutC(BLANK)
X end;
X PutStr(line, STDOUT)
X end;
X curLn := n2;
X DoPrint := OK
X end
Xend;
/
echo 'x - dowrite.pascal'
sed 's/^X//' > dowrite.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{ DoWrite -- write lines n1..n2 into file }
Xsegment DoWrite;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction DoWrite;
Xvar
X i: Integer;
X fd: FileDesc;
X line: StringType;
Xbegin
X fd := FCreate(fil, IOWRITE);
X if (fd = IOERROR) then
X DoWrite := ERR
X else begin
X for i := n1 to n2 do begin
X GetTxt(i, line);
X PutStr(line,fd)
X end;
X FClose(fd);
X PutDec(n2-n1+1, 1);
X PutC(NEWLINE);
X DoWrite := OK
X end
Xend;
/
echo 'x - esc.pascal'
sed 's/^X//' > esc.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{ Esc -- map s(i) into escaped characters, increment i }
Xsegment Esc;
X%include swtools
Xfunction Esc;
Xbegin
X if (s[i] <> ESCAPE) then
X Esc := s[i]
X else if (s[i+1] = ENDSTR) then { @ not special at end }
X Esc := ESCAPE
X else begin
X i := i + 1;
X if (s[i] = LETN) or (s[i] = BIGN) then
X Esc := NEWLINE
X else if (s[i] = TAB) then
X Esc := TAB
X else
X Esc := s[i]
X end
Xend;
/
echo 'x - expr.pascal'
sed 's/^X//' > expr.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{ Expr -- Recursive expression evaluation }
Xsegment Expr;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Expr;
Xvar
X v: Integer;
X t: CharType;
Xbegin
X v := Term(s, i);
X t := GNBChar(s, i);
X while (t in [PLUS, MINUS]) do begin
X i := i + 1;
X if (t = PLUS) then
X v := v + Term(s, i)
X else
X v := v - Term(s, i);
X t := GNBChar(s, i)
X end {while};
X Expr := v
Xend {Expr};
/
echo 'x - factor.pascal'
sed 's/^X//' > factor.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{ Factor -- Evaluate factor of arithmetic expression }
Xsegment Factor;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Factor;
Xbegin
X if (GNBChar(s, i) = LPAREN) then begin
X i := i + 1;
X Factor := Expr(s, i);
X if (GNBChar(s, i) = RPAREN) then
X i := i + 1
X else
X Message('Macro: missing paren in expr')
X end {then}
X else
X Factor := CToI(s, i)
Xend {Factor};
/
echo 'x - getccl.pascal'
sed 's/^X//' > getccl.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{ GetCCL -- expand char class at arg[i] into pat[j }
Xsegment GetCCL;
X%include swtools
X%include patdef
Xfunction GetCCL;
Xvar
X jStart: Integer;
X junk: Boolean;
Xbegin
X i := i + 1; {skip over CCL}
X if (arg[i] = NEGATE) then begin
X junk := AddStr(NCCL, pat, j, MAXPAT);
X i := i + 1
X end
X else
X junk := AddStr(CCL, pat, j, MAXPAT);
X jStart := j;
X junk := AddStr(ENDSTR, pat, j, MAXPAT); {make room for count}
X DoDash(CCLEND, arg, i, pat, j, MAXPAT);
X { putting an integer into a char only works if the number is les
X than 255}
X pat[jStart] := Chr(j - jStart - 1);
X GetCCL := (arg[i] = CCLEND)
Xend;
/
echo 'x - getpbc.pascal'
sed 's/^X//' > getpbc.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{ GetPBC -- get a (possibly pushed back) character }
Xsegment GetPBC;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetPBC;
Xbegin
X if (bp > 0) then
X c := buf[bp]
X else begin
X bp := 1;
X buf[bp] := GetC(c);
X end;
X if (c <> ENDFILE) then
X bp := bp - 1;
X GetPBC := c
Xend;
/
echo 'x - getrhs.pascal'
sed 's/^X//' > getrhs.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{ GetRHS -- get right hand side of "s" command }
Xsegment GetRHS;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include subdef
Xfunction GetRHS;
Xbegin
X GetRHS := OK;
X if (lin[i] = ENDSTR) then
X GetRHS := ERR
X else if (lin[i+1] = ENDSTR) then
X GetRHS := ERR
X else begin
X i := MakeSub(lin, i+1, lin[i], sub);
X if (i = 0) then
X GetRHS := ERR
X else if (lin[i+1] = LETG) then begin
X i := i + 1;
X gFlag := true
X end
X else
X gFlag := false
X end
Xend;
/
echo 'x - gettok.pascal'
sed 's/^X//' > gettok.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{ GetTok -- get token for define }
Xsegment GetTok;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction GetTok;
Xvar
X i: Integer;
X done: Boolean;
X junk: CharType;
Xbegin
X i := 1;
X done := false;
X while (not done) and (i < tokSize) do begin
X token[i] := GetPBC(junk);
X if (IsAlphaNum(token[i])) then
X i := i + 1
X else
X done := true
X end;
X if (i >= tokSize) then
X Error('define: token too long');
X if (i > 1) then begin { some alpha was seen }
X PutBack(token[i]);
X i := i - 1
X end;
X { else single non-alphanumeric }
X token[i+1] := ENDSTR;
X GetTok := token[1]
Xend;
/
echo 'x - getword.pascal'
sed 's/^X//' > getword.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{ getword -- get word form s(i) into out }
Xsegment GetWord;
X%include swtools
Xfunction GetWord;
Xvar
X j: Integer;
Xbegin
X while (s[i] in [BLANK,TAB,NEWLINE]) do
X i := i + 1;
X j := 1;
X while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin
X out[j] := s[i];
X i := i + 1;
X j := j + 1
X end;
X out[j] := ENDSTR;
X if (j = 1) then
X GetWord := 0
X else
X GetWord := i
Xend;
/
echo 'x - grep.pascal'
sed 's/^X//' > grep.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{ Grep -- Globally look for Regular Expressions and Print }
Xprogram Grep;
X%include swtools
X%include patdef
X%include matchdef
Xvar
X arg, lin, pat: StringType;
X returnCode: Integer;
Xbegin
X ToolInit;
X returnCode := 4;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('Usage: Grep pattern');
X if (not GetPat(arg, pat)) then
X Error('Grep: illegal pattern');
X while (GetLine(lin, STDIN, MAXSTR)) do
X if (Match(lin, pat)) then begin
X returnCode := 0;
X PutStr(lin, STDOUT)
X end;
X ProgExit(returnCode)
Xend.
/
echo 'x - includ.pascal'
sed 's/^X//' > includ.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{ Includ -- replace include file by contents }
XProgram Includ;
X%include swtools
Xvar incl: StringType;
X{ FInclude -- include file desc f }
Xprocedure FInclude(f: FileDesc);
Xvar
X line,strg: StringType;
X loc, i: Integer;
X f1: FileDesc;
Xbegin
X while(GetLine(line,f,MAXSTR)) do begin
X loc := GetWord(line,1,strg);
X if (not Equal(strg,incl)) then
X PutStr(line,STDOUT)
X else begin
X if GetFid(line, loc, strg) then begin
X f1 := MustOpen(strg,IOREAD);
X FInclude(f1);
X FClose(f1);
X end
X else
X Error('Bad file name');
X end
X end
Xend;
Xbegin
X ToolInit;
X CvtSST('#include', incl);
X FInclude(STDIN)
Xend.
/
echo 'x - initmacr.pascal'
sed 's/^X//' > initmacr.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{ InitMacro -- initialize variables for macro }
Xsegment InitMacro;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure InitMacro;
Xbegin
X null[1] := ENDSTR;
X CvtSST('define', defName);
X CvtSST('substr', subName);
X CvtSST('expr', exprName);
X CvtSST('ifelse', ifName);
X CvtSST('len', lenName);
X CvtSST('changeq', chqName);
X bp := 0; { push back buffer pointer }
X traceing := false;
X if NArgs > 0 then traceing := true;
X InitHash;
X lQuote := GRAVE;
X rQuote := ACUTE;
Xend {InitMacro};
/
echo 'x - kwic.exec'
sed 's/^X//' > kwic.exec << '/'
X&CONTROL OFF
X&IF &1 EQ ? &GOTO -EXPLAIN
XSTATE &1 &2 *
X&IF &RETCODE NE 0 &GOTO -NOFILE
XKWIC < &1 &2 > KWIC TEMP1 A
X&IF &RETCODE NE 0 &GOTO -DIED
XBNRSORT KWIC TEMP1 KWIC TEMP2 AP 1 20
X&IF &RETCODE NE 0 &GOTO -DIED
XUNROTATE < KWIC TEMP2 > &1 KWIC A
X&IF &RETCODE NE 0 &GOTO -DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&EXIT 0
X-NOFILE
X&TYPE FILE &1 &2 DOES NOT EXIST
X&EXIT 4
X-DIED
XERASE KWIC TEMP1
XERASE KWIC TEMP2
X&TYPE ONE OF THE KWIC PASSES DIED
X&EXIT 8
X-EXPLAIN
X&BEGTYPE
X KWIC INNAME INTYPE
X
X Kwic is an EXEC that produces a "Keyword in Context" Index.
X Kwic takes the file specified by inFile inType and creates
X the index in a file called "inFile KWIC"
X
X The first "inName inFile" encountered in your search path is
X used. "inFile KWIC" is created on your A disk.
X
X It is recommended that you never "KWIC" a "KWIC" file.
X&END
/
echo 'x - lndelete.pascal'
sed 's/^X//' > lndelete.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{ LnDelete -- delete lines n1 thru n2 }
Xsegment LnDelete;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction LnDelete;
Xbegin
X if (n1 <= 0) then
X status := ERR
X else begin
X BlkMove(n1, n2, lastLn);
X lastLn := lastLn - (n2 - n1 + 1);
X curLn := PrevLn(n1);
X status := OK
X end;
X LnDelete := status
Xend;
/
echo 'x - locate.pascal'
sed 's/^X//' > locate.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{ Locate -- look for c in character class at pat[offset] }
Xsegment Locate;
X%include swtools
X%include matchdef
Xfunction Locate;
Xvar
X i: Integer;
Xbegin
X { size of class is at pat[offset], characters follow }
X Locate := false;
X i := offset + Ord(pat[offset]); { last position }
X while (i > offset) do
X if (c = pat[i]) then begin
X locate := true;
X i := offset { force loop termination }
X end
X else
X i := i - 1
Xend;
/
echo 'x - lookup.pascal'
sed 's/^X//' > lookup.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{ Lookup -- locate name, get defn and type from table }
Xsegment Lookup;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xfunction Lookup;
Xvar
X p: ndPtr;
Xbegin
X p := HashFind(name);
X if (p = nil) then
X Lookup := false
X else begin
X Lookup := true;
X CSCopy(NDTable, p->.defn, defn);
X t := p->.kind
X end
Xend;
/
echo 'x - match.pascal'
sed 's/^X//' > match.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{ Match -- find match anywhere on line + support fcns }
Xsegment Match;
X%include swtools
X%include patdef
X%include matchdef
Xfunction Match;
Xvar
X i, pos: Integer;
Xbegin
X pos := 0;
X i := 1;
X while (lin[i] <> ENDSTR) and (pos = 0) do begin
X pos := AMatch(lin, i, pat, 1);
X i := i + 1;
X end;
X Match := (pos > 0)
Xend;
/
echo 'x - move.pascal'
sed 's/^X//' > move.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{ Move -- move line1 thru line2 after line3 }
Xsegment Move;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction Move;
Xbegin
X if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
X Move := ERR
X else begin
X BlkMove(line1, line2, line3);
X if (line3 > line1) then
X curLn := line3
X else
X curLn := line3 + (line2 - line1 + 1);
X Move := OK
X end
Xend;
/
echo 'x - nextln.pascal'
sed 's/^X//' > nextln.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{ NextLn/PrevLn -- get next/previous line number }
Xsegment NextLn;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
Xfunction NextLn;
Xbegin
X if (n >= lastLn) then
X nextLn := 0
X else
X nextLn := n + 1
Xend;
Xfunction PrevLn;
Xbegin
X if (n <= 0) then
X PrevLn := lastLn
X else
X PrevLn := n - 1
Xend;
/
echo 'x - optpat.pascal'
sed 's/^X//' > optpat.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{ OptPat -- get optional pattern from lin[i], increment i }
Xsegment OptPat;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include patdef
Xfunction OptPat;
Xbegin
X if (lin[i] = ENDSTR) then
X i := 0
X else if (lin[i + 1] = ENDSTR) then
X i := 0
X else if (lin[I + 1] = lin[i]) then { leave existing pattern alone }
X i := i + 1
X else
X i := MakePat(lin, i+1, lin[i], pat);
X if (pat[1] = ENDSTR) then
X i := 0;
X if (i = 0) then begin
X pat[1] := ENDSTR;
X OptPat := ERR
X end
X else
X OptPat := OK
Xend;
/
echo 'x - patscan.pascal'
sed 's/^X//' > patscan.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{ PatScan -- find next occurance of pattern after line n }
Xsegment PatScan;
X%include swtools
X%include editcons
X%include edittype
X%include editproc
X%include editref
X%include matchdef
Xfunction PatScan;
Xvar
X done: Boolean;
X line: StringType;
Xbegin
X n := curLn;
X PatScan := ERR;
X done := false;
X repeat
X if (way = SCAN) then
X n := NextLn(n)
X else
X n := PrevLn(n);
X GetTxt(n, line);
X if (Match(line, pat)) then begin
X PatScan := OK;
X done := true
X end
X until (n = curLn) or (done)
Xend;
/
echo 'x - patsize.pascal'
sed 's/^X//' > patsize.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{ PatSize -- returns size of pattern entry at pat[n] }
Xsegment PatSize;
X%include swtools
X%include patdef
X%include matchdef
X%include metadef
Xfunction PatSize;
Xbegin
X case pat[n] of
X LITCHAR:
X PatSize := 2;
X BOL, EOL, ANY, BOM, EOM:
X PatSize := 1;
X CCL, NCCL:
X PatSize := Ord(pat[n+1]) + 2;
X CLOSURE:
X PatSize := CLOSIZE
X otherwise
X Error('in PatSize: Can''t happen');
X end
Xend;
/
echo 'x - putchr.pascal'
sed 's/^X//' > putchr.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{ PutChr -- put single char on output or eval stack }
Xsegment PutChr;
X%include swtools
X%include macdefs
X%include macproc
Xprocedure PutChr;
Xbegin
X if (cp <= 0) then
X PutC(c)
X else begin
X if (ep > EVALSIZE) then
X Error('Macro: evaluation stack overflow');
X evalStk[ep] := c;
X ep := ep + 1
X end {if}
Xend {PutChr};
/
echo 'x - putstr.pascal'
sed 's/^X//' > putstr.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{ PutStr -- put string out on file }
Xsegment PutStr;
X%include swtools
X%include ioref
Xprocedure PutStr;
Xvar
X i: Integer;
X j: integer;
X len: Integer;
X outString: StringType;
Xbegin
X i := 1;
X j := 1;
X len := StrLength(str);
X while i <= len do begin
X if str[i] = NEWLINE then begin
X if j = 1 then WriteLn(openList[fd].fileVar)
X else WriteLn(openList[fd].fileVar, outString:j-1);
X j := 1;
X end {then}
X else begin
X outString[j] := str[i];
X j := j + 1;
X end; {if}
X i := i + 1
X end; {while}
X if j <> 1 then write(openList[fd].fileVar, outString:j-1);
Xend; {PutStr}
/
echo 'x - putsub.pascal'
sed 's/^X//' > putsub.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{ PutSub -- output substitution text }
Xsegment PutSub;
X%include swtools
X%include subdef
Xprocedure PutSub;
Xvar
X i, j: Integer;
X junk: Boolean;
Xbegin
X i := 1;
X while (sub[i] <> ENDSTR) do begin
X if (sub[i] = DITTO) then
X for j := s1 to s2-1 do
X PutC(lin[j])
X else
X PutC(sub[i]);
X i := i + 1
X end
Xend;
/
echo 'x - sccopy.pascal'
sed 's/^X//' > sccopy.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{ SCCopy -- copy string s to cb[i] }
Xsegment SCCopy;
X%include swtools
X%include defdef
X%include defref
X%include defproc
Xprocedure SCCopy;
Xvar
X j: Integer;
Xbegin
X j := 1;
X while (s[j] <> ENDSTR) do begin
X cb[i] := s[j];
X j := j + 1;
X i := i + 1
X end;
X cb[i] := ENDSTR
Xend;
/
echo 'x - screen.pascal'
sed 's/^X//' > screen.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{ Screen -- line printer character test }
Xprogram Screen;
X%include swtools
X%include ioref
Xvar i: Integer;
X first: Integer;
Xbegin
XToolInit;
XWriteLn(openList[STDOUT].fileVar, ' C H A R A C T E R S E T');
XPutC(NEWLINE);
XWriteLn(openList[STDOUT].FileVar,
X ' 0 1 2 3 4 5 6 7 8 9 A B C D E F');
Xfor i := 0 to 255 do begin
X if i mod 16 = 0 then begin
X PutC(NEWLINE);
X PutC(NEWLINE);
X first := i div 16;
X if first >= 10 then
X PutC(Chr(first + Ord(BIGA) - 10))
X else
X PutC(Chr(i div 16 + Ord(DIG0)));
X PutC(DIG0);
X PutC(BLANK);
X PutC(BLANK);
X end;
X Write(openList[STDOUT].fileVar, ' ', Chr(i))
Xend
Xend.
/
echo 'x - stclose.pascal'
sed 's/^X//' > stclose.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{ StClose -- insert closure entry at pat[j] }
Xsegment STClose;
X%include swtools
X%include patdef
Xprocedure StClose;
Xvar
X jp, jt: Integer;
X junk: Boolean;
Xbegin
X for jp := j-1 downto lastJ do begin
X jt := jp + CLOSIZE;
X junk := AddStr(pat[jp], pat, jt, MAXPAT)
X end;
X j := j + CLOSIZE;
X pat[lastJ] := CLOSURE { where original pattern began }
Xend;
/
echo 'x - strindex.pascal'
sed 's/^X//' > strindex.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{ StrIndex -- find position of character c in string s }
Xsegment StrIndex;
X%include swtools
Xfunction StrIndex;
Xvar
X i: Integer;
Xbegin
X i := 1;
X while (s[i] <> c) and (s[i] <> ENDSTR) do
X i := i + 1;
X if (s[i] = ENDSTR) then
X StrIndex := 0
X else
X StrIndex := i
Xend;
/
echo 'x - subline.pascal'
sed 's/^X//' > subline.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{ SubLine -- substitute sub for pat in lin and print }
Xsegment SubLine;
X%include swtools
X%include patdef
X%include subdef
X%include matchdef
Xprocedure SubLine;
Xvar
X i, lastm, m: Integer;
X junk: Boolean;
Xbegin
X lastm := 0;
X i := 1;
X while (lin[i] <> ENDSTR) do begin
X m := AMatch(lin, i, pat, 1);
X if (m > 0) and (lastm <> m) then begin
X { replace substituted text }
X PutSub(lin, i, m, sub);
X lastm := m
X end;
X if (m = 0) or (m = i) then begin
X { no match or null match }
X PutC(lin[i]);
X i := i + 1
X end
X else { skip matched text }
X i := m
X end
Xend;
/
echo 'x - swch.pascal'
sed 's/^X//' > swch.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{ Change -- change "from" into "to" on each line }
Xprogram swch;
X%include swtools
X%include patdef
X%include matchdef
X%include subdef
Xvar
X lin, pat, sub, arg: StringType;
Xbegin
X ToolInit;
X if (not GetArg(1, arg, MAXSTR)) then
X Error('usage: change from <to>');
X if (not GetPat(arg, pat)) then
X Error('change: illegal "from" pattern');
X if (not GetArg(2, arg, MAXSTR)) then
X arg[1] := ENDSTR;
X if (not GetSub(arg, sub)) then
X Error('change: illegal "to" string');
X while (GetLine(lin, STDIN, MAXSTR)) do
X SubLine(lin, pat, sub)
Xend;
/
echo 'x - swprint.exec'
sed 's/^X//' > swprint.exec << '/'
X&TRACE OFF
XCP SPOOL PRT CONT HOLD FORM LW1T
XERASE CMS EXEC A
XEXECUTIL WRITE CMS EXEC A (&TRACE OFF)
XLISTFILE * PASCAL C (APPEND
XEXEC CMS EXEC SWPRIN1
XERASE CMS EXEC A
XERASE SWTOOLS LDATE C
XEXECUTIL WRITE SWTOOLS LDATE C (JUNK)
XERASE CMS EXEC
XCP SPOOL PRT CLOSE
/
echo 'x - term.pascal'
sed 's/^X//' > term.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{ Term -- Evaluate term of arithmetic expression }
Xsegment Term;
X%include swtools
X%include macdefs
X%include macproc
Xfunction Term;
Xvar
X v: Integer;
X t: CharType;
Xbegin
X v := Factor(s, i);
X t := GNBChar(s, i);
X while (t in [STAR, SLASH, PERCENT]) do begin
X i := i + 1;
X case t of
X STAR:
X v := v * Factor(s, i);
X SLASH:
X v := v div Factor(s, i);
X PERCENT:
X v := v mod Factor(s, i)
X end {case};
X t := GNBChar(s, i)
X end {while};
X Term := v
Xend { Term };
/
echo 'x - wc.pascal'
sed 's/^X//' > wc.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{ Wc -- Word Counting program }
Xprogram Wc;
X%include SWTOOLS
Xvar
X buffer: StringType;
X numChars: Integer;
X numWords: Integer;
X numLines: Integer;
X i: Integer;
X lineLength: Integer;
X inWord: Boolean;
Xbegin
X ToolInit;
X numChars := 0;
X numWords := 0;
X numLines := 0;
X while (GetLine(buffer, STDIN, MAXSTR)) do begin
X inWord := false;
X numLines := numLines + 1;
X lineLength := StrLength (buffer);
X numChars := numChars + lineLength;
X for i := 1 to lineLength do
X if (buffer[i] = BLANK) then
X inWord := false
X else if (not inWord) then begin
X inWord := true;
X numWords := numWords + 1;
X end; {if}
X end; {while}
X PutDec(numChars, 7);
X PutDec(numWords, 7);
X PutDec(numLines, 7);
Xend; {Wc}
/
echo 'Part 05 of pack.out complete.'
exit
More information about the Mod.sources
mailing list