jp@lanl.ARPA (10/06/85)
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Grep -- Globally look for Regular Expressions and Print }
program Grep;
%include swtools
%include patdef
%include matchdef
var
arg, lin, pat: StringType;
returnCode: Integer;
begin
ToolInit;
returnCode := 4;
if (not GetArg(1, arg, MAXSTR)) then
Error('Usage: Grep pattern');
if (not GetPat(arg, pat)) then
Error('Grep: illegal pattern');
while (GetLine(lin, STDIN, MAXSTR)) do
if (Match(lin, pat)) then begin
returnCode := 0;
PutStr(lin, STDOUT)
end;
ProgExit(returnCode)
end.
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Hash -- compute hash function of a name }
segment Hash;
%include swtools
%include defdef
%include defref
%include defproc
function Hash;
var
i, h: Integer;
begin
h := 0;
for i := 1 to StrLength(name) do
h := (3 * h + Ord(name[i])) mod HASHSIZE;
Hash := h + 1
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ HashFind -- find name in hash table }
segment HashFind;
%include swtools
%include defdef
%include defref
%include defproc
function HashFind;
var
p: NDPtr;
tempName: StringType;
found: Boolean;
begin
found := false;
p := hashTab[Hash(name)];
while (not found) and (p <> nil) do begin
CSCopy(NDTable, p->.name, tempName);
if (Equal(name, tempName)) then
found := true
else
p := p->.nextPtr
end;
HashFind := p
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Includ -- replace include file by contents }
Program Includ;
%include swtools
var incl: StringType;
{ FInclude -- include file desc f }
procedure FInclude(f: FileDesc);
var
line,strg: StringType;
loc, i: Integer;
f1: FileDesc;
begin
while(GetLine(line,f,MAXSTR)) do begin
loc := GetWord(line,1,strg);
if (not Equal(strg,incl)) then
PutStr(line,STDOUT)
else begin
if GetFid(line, loc, strg) then begin
f1 := MustOpen(strg,IOREAD);
FInclude(f1);
FClose(f1);
end
else
Error('Bad file name');
end
end
end;
begin
ToolInit;
CvtSST('#include', incl);
FInclude(STDIN)
end.
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ InitHash -- initialize hash table to nil }
segment InitHash;
%include swtools
%include defdef
%include defref
%include defproc
procedure InitHash;
var
i: 1..HASHSIZE;
begin
nextTab := 1; { first free slot in table }
for i := 1 to HASHSIZE do
hashTab[i] := nil
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ InitMacro -- initialize variables for macro }
segment InitMacro;
%include swtools
%include macdefs
%include macproc
procedure InitMacro;
begin
null[1] := ENDSTR;
CvtSST('define', defName);
CvtSST('substr', subName);
CvtSST('expr', exprName);
CvtSST('ifelse', ifName);
CvtSST('len', lenName);
CvtSST('changeq', chqName);
bp := 0; { push back buffer pointer }
traceing := false;
if NArgs > 0 then traceing := true;
InitHash;
lQuote := GRAVE;
rQuote := ACUTE;
end {InitMacro};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Install -- add name, definition and type to table }
segment Install;
%include swtools
%include defdef
%include defref
%include defproc
procedure Install;
var
h, dlen, nlen: Integer;
p: NDPtr;
begin
nlen := StrLength(name) + 1; { 1 for ENDSTR }
dlen := StrLength(defn) + 1;
if (nextTab + nlen + dlen > MAXCHARS) then begin
PutStr(name, STDERR);
Error(': too many definitions')
end
else begin
h := Hash(name);
new(p);
p->.nextPtr := hashTab[h];
hashTab[h] := p;
p->.name := nextTab;
SCCopy(name, ndTable, nextTab);
nextTab := nextTab + nlen;
p->.defn := nextTab;
SCCopy(defn, ndTable, nextTab);
nextTab := nextTab + dlen;
p->.kind := t
end
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ IsAlphaNum -- true if c is letter or digit }
segment IsAlphaNum;
%include swtools
function IsAlphaNum;
begin
IsAlphaNum := ((c >= LETA) and (c <= LETI)) or
((c >= LETJ) and (c <= LETR)) or
((c >= LETS) and (c <= LETZ)) or
((c >= BIGA) and (c <= BIGI)) or
((c >= BIGJ) and (c <= BIGR)) or
((c >= BIGS) and (c <= BIGZ)) or
((c >= DIG0) and (c <= DIG9))
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ IsDigit -- true if c is a digit }
segment IsDigit;
%include swtools
function IsDigit;
begin
IsDigit := c in [DIG0..DIG9];
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ IsLetter -- true if c is a letter of either case }
segment IsLetter;
%include swtools
%include chardef
function IsLetter;
begin
IsLetter := ChLetter in CharClass(c)
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ IToC -- convert integer n to char string in s[i] ... }
segment IToC;
%include swtools
function IToC;
begin
if (n < 0) then begin
s[i] := MINUS;
IToC := IToC(-n, s, i+1);
end
else begin
if (n >= 10) then
i := IToC(n div 10, s, i);
s[i] := Chr(n mod 10 + Ord(DIG0));
s[i+1] := ENDSTR;
IToC := i + 1;
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Kopy -- move line1 thru line2 after line3 }
segment Kopy;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function Kopy;
var
i: Integer;
curSave, lastSave: Integer;
tempLine: StringType;
begin
if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
Kopy := ERR
else begin
curSave := curLn;
lastSave := lastLn;
curLn := lastLn;
for i := line1 to line2 do begin
GetTxt(i, tempLine);
if PutTxt(tempLine) = ERR then begin
curLn := curSave;
lastLn := lastSave;
Kopy := ERR;
return
end
end; {if}
BlkMove(lastSave+1, lastSave+1+line2-line1, line3);
if (line3 > line1) then
curLn := line3
else
curLn := line3 + (line2 - line1 + 1);
Kopy := OK
end
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Kwic -- make Keyword in Context index }
program Kwic;
%include swtools
%include cms
const
FOLD = DOLLAR;
var
buf: StringType;
tempFile1: FileDesc;
tempFile2: FileDesc;
fileName: StringType;
RCode: Integer;
{ Rotate -- output rotated lines }
procedure Rotate (var buf: StringType; n: Integer);
var
i: Integer;
begin
i := n;
while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin
PutCF(buf[i], tempFile1);
i := i + 1
end;
PutCF(FOLD, tempFile1);
for i := 1 to n - 1 do
PutCF(buf[i], tempFile1);
PutCF(NEWLINE, tempFile1)
end;
{ PutRot -- create lines with keyword at front }
procedure PutRot(var buf: StringType);
var
i: Integer;
begin
i := 1;
while (buf[i] <> NEWLINE) and (buf[i] <> ENDSTR) do begin
if (IsAlphaNum(buf[i])) then begin
Rotate(buf, i); { token starts at "i" }
repeat
i := i + 1
until (not IsAlphaNum(buf[i]))
end;
i := i + 1
end
end;
/* temporarily commented out until CMS cmd works
{ UnRotate -- Unrotate lines rotated by first half of KWIC }
procedure UnRotate;
const
MAXOUT = 80;
MIDDLE = 40;
var
inBuf, outBuf: StringType;
i, j, f: Integer;
begin
while (GetLine(inBuf, tempFile2, MAXSTR)) do begin
for i := 1 to MAXOUT -1 do
outBuf[i] := BLANK;
f := StrIndex(inBuf, FOLD);
j := MIDDLE - 1;
for i := StrLength(inBuf)-1 downto f+1 do begin
outBuf[j] := inBuf[i];
j := j - 1;
if (j <= 0) then
j := MAXOUT - 1
end;
j := MIDDLE + 3;
for i := 1 to f-1 do begin
outBuf[j] := inBuf[i];
j := j mod (MAXOUT - 1) + 1
end;
for j := 1 to MAXOUT - 1 do
if (outBuf[j] <> BLANK) then
i := j;
outBuf[i+1] := ENDSTR;
PutStr(outBuf, STDOUT);
PutC(NEWLINE)
end
end;
*/
{ Main program for Kwic }
begin
ToolInit;
/* Cannot get CMS to call sort properly
CvtSST('KWIC1 TEMP A', fileName);
tempFile1 := FOpen(fileName, IOWRITE);
if tempFile1 = IOERROR then
Error('Cannot open first KWIC temporary');
*/
/* */
tempFile1 := STDOUT;
/* */
while (GetLine(buf, STDIN, MAXSTR)) do
PutRot(buf);
/*
Cms('EXEC OSSORT KWIC1 TEMP A KWIC2 TEMP A 1 10', RCode);
if RCode <> 0 then
Error('KWIC: BNRSORT failed');
CvtSST('KWIC2 TEMP A', fileName);
tempFile2 := FOpen(fileName, IOREAD);
if tempFile2 = IOERROR then
Error('KWIC: cannot open sorted rotated file');
UnRotate
*/
end.
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ LnDelete -- delete lines n1 thru n2 }
segment LnDelete;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function LnDelete;
begin
if (n1 <= 0) then
status := ERR
else begin
BlkMove(n1, n2, lastLn);
lastLn := lastLn - (n2 - n1 + 1);
curLn := PrevLn(n1);
status := OK
end;
LnDelete := status
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Locate -- look for c in character class at pat[offset] }
segment Locate;
%include swtools
%include matchdef
function Locate;
var
i: Integer;
begin
{ size of class is at pat[offset], characters follow }
Locate := false;
i := offset + Ord(pat[offset]); { last position }
while (i > offset) do
if (c = pat[i]) then begin
locate := true;
i := offset { force loop termination }
end
else
i := i - 1
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Lookup -- locate name, get defn and type from table }
segment Lookup;
%include swtools
%include defdef
%include defref
%include defproc
function Lookup;
var
p: ndPtr;
begin
p := HashFind(name);
if (p = nil) then
Lookup := false
else begin
Lookup := true;
CSCopy(NDTable, p->.defn, defn);
t := p->.kind
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Macro -- expand macros with arguments }
program Macro;
%include swtools
%include macdefs
%include macproc
begin
ToolInit;
InitMacro;
Install(defName, null, DEFTYPE);
Install(exprName, null, EXPRTYPE);
Install(subName, null, SUBTYPE);
Install(ifName, null, IFTYPE);
Install(lenName, null, LENTYPE);
Install(chqName, null, CHQTYPE);
cp := 0;
ap := 1;
ep := 1;
while (GetTok(token, MAXTOK) <> ENDFILE) do
if (IsLetter(token[1])) then begin
if (not Lookup(token, defn, tokType)) then
PutTok(token)
else begin
cp := cp + 1;
if (cp > CALLSIZE) then
Error('Macro: call stack overflow');
callStk[cp] := ap;
typeStk[cp] := tokType;
ap := Push(ep, argStk, ap);
PutTok(defn); { push definition }
PutChr(ENDSTR);
ap := Push(ep, argStk, ap);
PutTok(token); { stack name }
PutChr(ENDSTR);
ap := Push(ep, argStk, ap);
t := GetTok(token, MAXTOK); { peek at next }
PBStr(token);
if (t <> LPAREN) then begin { add () }
PutBack(RPAREN);
PutBack(LPAREN);
end;
pLev[cp] := 0
end
end
else if (token[1] = lQuote) then begin { strip quotes }
nlPar := 1;
repeat
t := GetTok(token, MAXTOK);
if (t = rQuote) then
nlPar := nlPar - 1
else if (t = lQuote) then
nlPar := nlPar + 1
else if (t = ENDFILE) then
Error('Macro: missing right quote');
if nlPar > 0 then
PutTok(token)
until (nlPar = 0)
end
else if (cp = 0) then { not in macro at all }
PutTok(token)
else if (token[1] = LPAREN) then begin
if (pLev[cp] > 0) then
PutTok(token);
pLev[cp] := pLev[cp] + 1
end {then}
else if (token[1] = RPAREN) then begin
pLev[cp] := pLev[cp] - 1;
if (pLev[cp] > 0) then
PutTok(token)
else begin { end of argument list }
PutChr(ENDSTR);
Eval(argStk, typeStk[cp], callStk[cp], ap - 1);
ap := callStk[cp]; { pop eval stack }
ep := argStk[ap];
cp := cp - 1
end
end
else if (token[1] = COMMA) and (pLev[cp] = 1) then begin
PutChr(ENDSTR); { new argument }
ap := Push(ep, argStk, ap)
end {then}
else
PutTok(token); { just stack it }
if (cp <> 0) then
Error('Macro: unexpected end of input')
end.
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ MakePat -- make pattern from arg[i], terminate at delim }
segment MakePat;
%include swtools
%include patdef
%include metadef
function MakePat;
var
i,j, lastJ, lj: Integer;
k: Integer;
done, junk: Boolean;
begin
j := 1; { pat index}
i := start; { arg index}
metaStackPointer := 0;
metaIndex := 1;
done := false;
k := start;
while (arg[k] <> delim) and ((k + 2) <= MAXSTR) do
if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
arg[k] := delim;
arg[k+1] := NEWLINE;
arg[k+2] := ENDSTR;
end
else
k := k + 1;
while (not done) and (arg[i] <> delim) and
(arg[i] <> ENDSTR) do begin
lj := j;
if (arg[i] = ANY) then
junk := AddStr(ANY, pat, j, MAXPAT)
else if (arg[i] = BOL) and (i = start) then
junk := AddStr(BOL, pat, j, MAXPAT)
else if (arg[i] = BOM) then begin
junk := AddStr(BOM, pat, j, MAXPAT);
metaStackPointer := metaStackPointer + 1;
metaIndex := metaIndex + 1;
if (metaStackPointer > 9) or
(metaIndex > 9) then
done := true
end
else if (arg[i] = EOM) and (metaStackPointer > 0) then begin
junk := AddStr(EOM, pat, j, MAXPAT);
metaStackPointer := metaStackPointer - 1;
if (metaStackPointer < 0) then
done := true
end
else if (arg[i] = EOL) and (arg[i+1] = delim) then
junk := AddStr(EOL, pat, j, MAXPAT)
else if (arg[i] = CCL) then
done := (GetCCL(arg, i, pat, j) = false)
else if (arg[i] = CLOSURE) and (i > start) then begin
lj := lastJ;
if (pat[lj] in [BOL, EOL, CLOSURE]) then
done := true { force loop termination }
else
STClose(pat, j, lastJ)
end
else begin
junk := AddStr(LITCHAR, pat, j, MAXPAT);
junk := AddStr(Esc(arg,i), pat, j, MAXPAT)
end;
lastJ := lj;
if (not done) then
i := i + 1;
end;
if (done) or (arg[i] <> delim) or (metaStackPointer <> 0) then
MakePat := 0
else if (not AddStr(ENDSTR, pat, j, MAXPAT)) then
MakePat := 0 { no room}
else
MakePat := i;
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ MakeSet -- make set from inset(k) in outset }
segment MakeSet;
%include swtools
%include patdef
function MakeSet;
var
j: Integer;
begin
j := 1;
DoDash(ENDSTR, inSet, k, outSet, j, maxSet);
makeSet := AddStr(ENDSTR, outSet, j, maxSet)
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ MakeSub -- make substitution string from arg into sub }
segment MakeSub;
%include swtools
%include patdef
%include subdef
%include metadef
value
nullMetaTable := MetaTableType(
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0),
MetaElementType(0,0));
function MakeSub;
var
k: Integer;
i, j: Integer;
l: Integer;
junk: Boolean;
begin
j := 1;
i := from;
k := from;
while (arg[k] <> delim) and (k <= (MAXSTR - 2)) do
if (arg[k] = NEWLINE) or (arg[k] = ENDSTR) then begin
arg[k] := delim;
arg[k+1] := NEWLINE;
arg[k+2] := ENDSTR;
end
else
k := k + 1;
while (arg[i] <> delim) and (arg[i] <> ENDSTR) do begin
if (arg[i] = AMPER) then begin
junk := AddStr(DITTO, sub, j, MAXPAT);
{ &n handler for meta brackets }
if (arg[i+1] in [DIG0..DIG9]) then begin
i := i + 1;
junk := AddStr(Chr(Ord(arg[i]) - Ord(DIG0)),
sub, j, MAXPAT)
end
end
else
junk := AddStr(Esc(arg,i), sub, j, MAXPAT);
i := i + 1
end;
if (arg[i] <> delim) then { missing delim }
MakeSub := 0
else if (not AddStr(ENDSTR, sub, j, MAXPAT)) then
MakeSub := 0
else
MakeSub := i
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Match -- find match anywhere on line + support fcns }
segment Match;
%include swtools
%include patdef
%include matchdef
function Match;
var
i, pos: Integer;
begin
pos := 0;
i := 1;
while (lin[i] <> ENDSTR) and (pos = 0) do begin
pos := AMatch(lin, i, pat, 1);
i := i + 1;
end;
Match := (pos > 0)
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Message -- print a PASCALVS string on STDERR }
segment Message;
%include swtools
procedure Message;
var
i: 1..MAXSTR;
begin
for i := 1 to Length(s) do
PutCF(s[i], STDERR);
PutCF(NEWLINE,STDERR);
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Move -- move line1 thru line2 after line3 }
segment Move;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function Move;
begin
if (line1 <= 0) or ((line3 >= line1) and (line3 < line2)) then
Move := ERR
else begin
BlkMove(line1, line2, line3);
if (line3 > line1) then
curLn := line3
else
curLn := line3 + (line2 - line1 + 1);
Move := OK
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ MPutStr -- put meta'd string out on file }
segment MPutStr;
%include swtools
%include ioref
procedure MPutStr;
var
i: Integer;
j: integer;
len: Integer;
outString: StringType;
begin
i := 1;
j := 1;
len := StrLength(str);
while i <= len do begin
if str[i] = DOLLAR then begin
i := i + 1;
if (str[i] = BIGN) or (str[i] = LETN) then begin
if j = 1 then WriteLn(openList[fd].fileVar,' ')
else WriteLn(openList[fd].fileVar,
outString:j-1);
j := 1
end
else if (str[i] = BIGE) or (str[i] = LETE) then
return
else
i := i - 1
end else
if str[i] = NEWLINE then begin
if j = 1 then WriteLn(openList[fd].fileVar,' ')
else WriteLn(openList[fd].fileVar, outString:j-1);
j := 1;
end {then}
else begin
outString[j] := str[i];
j := j + 1;
end; {if}
i := i + 1
end; {while}
if j <> 1 then write(openList[fd].fileVar, outString:j-1);
end; {MPutStr}
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ MustOpen -- same as FOpen except for no allowance of failure }
segment MustOpen;
{ mustopen -- open file or die }
%include swtools
function MustOpen;
var
fd: FileDesc;
begin
fd := FOpen(fname, fMode);
if (fd = IOERROR) then begin
PutStr(fname, STDERR);
Error(': can''t open file')
end;
MustOpen := fd
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Nargs (CMS) -- return number of arguments }
segment Nargs;
%include swtools
%include ioref
function NArgs;
begin
NArgs := cmdArgs
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ NextLn/PrevLn -- get next/previous line number }
segment NextLn;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function NextLn;
begin
if (n >= lastLn) then
nextLn := 0
else
nextLn := n + 1
end;
function PrevLn;
begin
if (n <= 0) then
PrevLn := lastLn
else
PrevLn := n - 1
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ OMatch -- match one pattern element at pat[j] }
segment OMatch;
%include swtools
%include matchdef
%include patdef
%include metadef
function OMatch;
var
advance: -1..1;
mIndex: Integer;
begin
advance := -1;
if (lin[i] = ENDSTR) then
OMatch := false
else
case pat[j] of
LITCHAR:
if (lin[i] = pat[j+1]) then
advance := 1;
BOM:
if (metaStackPointer <= 9) and
(metaIndex <= 9) then begin
metaStack[metaStackPointer] := metaIndex;
metaTable[metaIndex].first := i;
metaIndex := metaIndex + 1;
metaStackPointer := metaStackPointer + 1;
advance := 0
end
else
Error('OMatch/meta: can''t happen');
EOM:
if (metaStackPointer >= 1) then begin
metaStackPointer := metaStackPointer - 1;
mIndex := metaStack[metaStackPointer];
metaTable[mIndex].last := i;
advance := 0
end
else
Error('OMatch/meta/EOM can''t happen');
BOL:
if (i = 1) then
advance := 0;
ANY:
if (lin[i] <> NEWLINE) then
advance := 1;
EOL:
if (lin[i] = NEWLINE) then
advance := 0;
CCL:
if (Locate(lin[i], pat, j+1)) then
advance := 1;
NCCL:
if (lin[i] <> NEWLINE) and
(not Locate(lin[i], pat, j+1)) then
advance := 1
otherwise
Error('in omatch: can''t happen')
end;
if (advance >= 0) then begin
i := i + advance;
OMatch := true
end
else
OMatch := false
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ OnError -- intercept pascalvs run-time errors }
segment OnError;
def ERRORIO: Boolean;
def ATTENTION: Boolean;
def OUTOFSPACE: Boolean;
value
ERRORIO := false;
ATTENTION := false;
OUTOFSPACE := false;
%include onerror
procedure OnError;
var
statementNumber: String(10);
procName: String(10);
errorNo: String(10);
begin
if (FERROR in [41..53,75..78]) then begin
ERRORIO := true;
FACTION := [];
end
else if FERROR = 30 then begin
ATTENTION := true;
FACTION := [];
end
else if (FERROR = 64) and (not OUTOFSPACE) then begin
OUTOFSPACE := true;
FACTION := []
end
else if FERROR = 36 then begin
FACTION := [XUMSG,XTRACE,XHALT];
WriteStr(statementNumber, FSTMTNO:5);
WriteStr(procName, FPROCNAME:8);
WriteStr(errorNo, FERROR:5);
FRETMSG := 'SWTOOLS ASSERT FAILURE: RID=' || PROCNAME||
'; S#=' || statementNumber ||
'; EID' || errorNo || ';';
end
else begin
FACTION := [XUMSG,XTRACE];
WriteStr(statementNumber, FSTMTNO:5);
WriteStr(procName, FPROCNAME:8);
WriteStr(errorNo, FERROR: 5);
FRETMSG := '***SWTOOLS error: RID=' || procName
|| '; S#=' || statementNumber ||
'; EID=' || errorNo || ';';
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ OptPat -- get optional pattern from lin[i], increment i }
segment OptPat;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include patdef
function OptPat;
begin
if (lin[i] = ENDSTR) then
i := 0
else if (lin[i + 1] = ENDSTR) then
i := 0
else if (lin[I + 1] = lin[i]) then { leave existing pattern alone }
i := i + 1
else
i := MakePat(lin, i+1, lin[i], pat);
if (pat[1] = ENDSTR) then
i := 0;
if (i = 0) then begin
pat[1] := ENDSTR;
OptPat := ERR
end
else
OptPat := OK
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PatScan -- find next occurance of pattern after line n }
segment PatScan;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include matchdef
function PatScan;
var
done: Boolean;
line: StringType;
begin
n := curLn;
PatScan := ERR;
done := false;
repeat
if (way = SCAN) then
n := NextLn(n)
else
n := PrevLn(n);
GetTxt(n, line);
if (Match(line, pat)) then begin
PatScan := OK;
done := true
end
until (n = curLn) or (done)
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PatSize -- returns size of pattern entry at pat[n] }
segment PatSize;
%include swtools
%include patdef
%include matchdef
%include metadef
function PatSize;
begin
case pat[n] of
LITCHAR:
PatSize := 2;
BOL, EOL, ANY, BOM, EOM:
PatSize := 1;
CCL, NCCL:
PatSize := Ord(pat[n+1]) + 2;
CLOSURE:
PatSize := CLOSIZE
otherwise
Error('in PatSize: Can''t happen');
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PBNum -- Convert number to string, push back on input }
segment PBNum;
%include swtools
%include macdefs
%include macproc
procedure PBNum;
var
temp: StringType;
junk: Integer;
begin
junk := IToC(n, temp, 1);
PBStr(temp)
end {PBNum};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PBStr -- push string back onto input }
segment PBStr;
%include swtools
%include defdef
%include defproc
procedure PBStr;
var
i: Integer;
begin
for i := StrLength(s) downto 1 do
PutBack(s[i])
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ ProgExit -- Returns a return code and quits }
segment ProgExit;
%include swtools
procedure ProgExit;
begin
RetCode(returnCode);
HALT
end; {ProgExit}
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Push -- push ep onto argStk, return new position ap }
segment Push;
%include swtools
%include macdefs
%include macproc
function Push;
begin
if (ap > ARGSIZE) then
Error('Macro: argument stack overflow');
argStk[ap] := ep;
Push := ap + 1
end {Push};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutBack -- push character back onto input }
segment PutBack;
%include swtools
%include defdef
%include defref
%include defproc
procedure PutBack;
begin
if (bp >= BUFSIZE) then
Error('Too many characters pushed back');
bp := bp + 1;
buf[bp] := c
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutC -- print character to STDOUT }
segment PutC;
%include swtools
procedure PutC;
begin
PutCF(c, STDOUT)
end;
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutCF -- put string out on file }
segment PutCF;
%include swtools
%include ioref
procedure PutCF;
begin
if openList[fd].mode = IOAVAIL then
Error('putcf on unopen file');
if c = NEWLINE then
writeln(openList[fd].fileVar)
else
write(openList[fd].fileVar, c)
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutChr -- put single char on output or eval stack }
segment PutChr;
%include swtools
%include macdefs
%include macproc
procedure PutChr;
begin
if (cp <= 0) then
PutC(c)
else begin
if (ep > EVALSIZE) then
Error('Macro: evaluation stack overflow');
evalStk[ep] := c;
ep := ep + 1
end {if}
end {PutChr};
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutDec -- put decimal integer n in field width >= w }
segment PutDec;
%include swtools
procedure PutDec;
var
i, nd: Integer;
s: StringType;
begin
nd := itoc(n, s, 1);
for i := nd to w do
PutC(BLANK);
for i := 1 to nd-1 do
PutC(s[i])
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutStr -- put string out on file }
segment PutStr;
%include swtools
%include ioref
procedure PutStr;
var
i: Integer;
j: integer;
len: Integer;
outString: StringType;
begin
i := 1;
j := 1;
len := StrLength(str);
while i <= len do begin
if str[i] = NEWLINE then begin
if j = 1 then WriteLn(openList[fd].fileVar)
else WriteLn(openList[fd].fileVar, outString:j-1);
j := 1;
end {then}
else begin
outString[j] := str[i];
j := j + 1;
end; {if}
i := i + 1
end; {while}
if j <> 1 then write(openList[fd].fileVar, outString:j-1);
end; {PutStr}
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutSub -- output substitution text }
segment PutSub;
%include swtools
%include subdef
procedure PutSub;
var
i, j: Integer;
junk: Boolean;
begin
i := 1;
while (sub[i] <> ENDSTR) do begin
if (sub[i] = DITTO) then
for j := s1 to s2-1 do
PutC(lin[j])
else
PutC(sub[i]);
i := i + 1
end
end;
{
Copyright (c) 1981
By: Bell Telephone Laboratories, Inc. and
Whitesmiths, Ltd.,
This software is derived from the book
"Software Tools In Pascal", by
Brian W. Kernighan and P.J. Plauger
Addison-Wesley, 1981
ISBN 0-201-10342-7
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ PutTok -- put token on output or evaluation stack }
segment PutTok;
%include swtools
%include macdefs
%include macproc
procedure PutTok;
var
i: Integer;
begin
i := 1;
while s[i] <> ENDSTR do begin
PutChr(s[i]);
i := i + 1
end {while};
end {PutTok};
{
Copyright (c) 1982
By: Chris Lewis
Right is hereby granted to freely distribute or duplicate this
software, providing distribution or duplication is not for profit
or other commerical gain and that this copyright notice remains
intact.
}
{ Remove -- remove a file - very tricky }
segment Remove;
%include swtools
%include cms
procedure Remove;
var
cmsString: String(MAXSTR);
returnCode: Integer;
i: 1..MAXSTR;
begin
cmsString := 'ERASE ';
for i := 1 TO StrLength(name) do
if name[i] in [NEWLINE, PERIOD] then
cmsString := cmsString || Str(' ')
else
cmsString := cmsString || Str(name[i]);
Cms(cmsString, returnCode);
end;