jp@lanl.ARPA (10/06/85)
{
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.
}
{ Rot -- Rotate a file 90 degrees clockwise }
program Rot;
%include swtools
const
maxWidth = 2000;
maxHeight = 130;
var
buffers: array [1..maxHeight] of array
[1..maxWidth] of Char;
i: Integer;
j: Integer;
maxReadWidth: Integer;
maxReadHeight: Integer;
begin
ToolInit;
i := 1;
j := 1;
maxReadWidth := 0;
while (GetC(buffers[i,j]) <> ENDFILE) do begin
if (buffers[i,j] = NEWLINE) then begin
maxReadWidth := Max(maxReadWidth,j);
for j := j to maxWidth do
buffers[i,j] := BLANK;
j := 1;
i := i + 1;
end
else
j := j + 1;
if (i > maxHeight) or (j > maxWidth) then begin
Message('input file too big');
leave
end
end;
maxReadHeight := i - 1;
for i := 1 to maxReadWidth do begin
for j := maxReadHeight downto 1 do
PutC (buffers[j,i]);
PutC (NEWLINE)
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.
}
{ SCCopy -- copy string s to cb[i] }
segment SCCopy;
%include swtools
%include defdef
%include defref
%include defproc
procedure SCCopy;
var
j: Integer;
begin
j := 1;
while (s[j] <> ENDSTR) do begin
cb[i] := s[j];
j := j + 1;
i := i + 1
end;
cb[i] := ENDSTR
end;
{
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.
}
{ SCopy (CMS) -- copy strings }
segment SCopy;
%include swtools
procedure SCopy;
begin
while(src[i] <> ENDSTR) do begin
dest[j] := src[i];
i := i + 1;
j := j + 1;
end;
dest[j] := ENDSTR;
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.
}
{ Screen -- line printer character test }
program Screen;
%include swtools
%include ioref
var i: Integer;
first: Integer;
begin
ToolInit;
WriteLn(openList[STDOUT].fileVar, ' C H A R A C T E R S E T');
PutC(NEWLINE);
WriteLn(openList[STDOUT].FileVar,
' 0 1 2 3 4 5 6 7 8 9 A B C D E F');
for i := 0 to 255 do begin
if i mod 16 = 0 then begin
PutC(NEWLINE);
PutC(NEWLINE);
first := i div 16;
if first >= 10 then
PutC(Chr(first + Ord(BIGA) - 10))
else
PutC(Chr(i div 16 + Ord(DIG0)));
PutC(DIG0);
PutC(BLANK);
PutC(BLANK);
end;
Write(openList[STDOUT].fileVar, ' ', Chr(i))
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.
}
{ SetBuf -- set Buffer and other Buffer handlers (new-free) }
segment SetBuf;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
const
MAXLINES = 10000;
type
BufType = { in-memory new/free buffer handler }
record
txt: StringPtr; { text of line }
mark: Boolean; { mark for line }
end;
ref OUTOFSPACE: Boolean;
static heapMark: @ Integer;
static { This is a PRIVATE buffer }
intBuff: array [0..MAXLINES] of BufType;
{ SetBuf -- (new-free) initialize line storage Buffer }
procedure SetBuf;
var
i: 0..MAXLINES;
begin
Mark(heapMark);
for i := 0 to MAXLINES do
intBuff[i].txt := nil;
curLn := 0;
lastLn := 0
end;
{ ClrBuf -- (new-free) release storage }
procedure ClrBuf;
var i: 0..MAXLINES;
begin
Release(heapMark)
end;
{ GetTxt -- (new-free) get text from line n into s }
procedure GetTxt;
begin
{ note: the null is already there }
if intBuff[n].txt = nil then
s[1] := ENDSTR
else
s := intBuff[n].txt@;
end;
{ PutTxt -- (new-free) put text from lin after curLn }
function PutTxt;
var
sSize: Integer;
begin
PutTxt := ERR;
if (lastLn < MAXLINES) then begin
lastLn := lastLn + 1;
sSize := StrLength(lin) + 1;
if intBuff[lastLn].txt = nil then
New(intBuff[lastLn].txt, sSize)
else if (sSize > MaxLength(intBuff[lastLn].txt@)) then begin
Dispose(intBuff[lastLn].txt);
New(intBuff[lastLn].txt, sSize)
end;
{ Check for New failing }
if OUTOFSPACE then begin
intBuff[lastLn].txt := nil; { insurance }
lastLn := lastLn - 1; { insurance }
OUTOFSPACE := false;
Message('out of space, write out and edit again');
return { error }
end;
WriteStr(intBuff[lastLn].txt@, lin:sSize);
PutMark(lastLn, false);
BlkMove(lastLn, lastLn, curLn);
curLn := curLn + 1;
PutTxt := OK
end
end;
{ GetMark -- get mark from nth line }
function GetMark;
begin
GetMark := intBuff[n].mark
end;
{ PutMark -- put mark m on nth line }
procedure PutMark;
begin
intBuff[n].mark := m
end;
{ BlkMove -- move block of lines n1..n2 to after n3 }
procedure BlkMove;
begin
if (n3 < n1-1) then begin
Reverse (n3+1,n1-1);
Reverse (n1,n2);
Reverse (n3+1,n2)
end
else if (n3 > n2) then begin
Reverse(n1,n2);
Reverse(n2+1,n3);
Reverse(n1,n3)
end
end;
{ Reverse -- reverse intBuff[n1]...intBuff[n2] }
procedure Reverse;
var temp: BufType;
begin
while (n1 < n2) do begin
temp := intBuff[n1];
intBuff[n1] := intBuff[n2];
intBuff[n2] := temp;
n1 := n1 + 1;
n2 := n2 - 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.
}
{ SkipBl -- skip blanks and tabs s[i] ... }
segment SkipBl;
%include swtools
%include editcons
%include edittype
%include editproc
procedure SkipBl;
begin
while (s[i] = BLANK) or (s[i] = TAB) do
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.
}
{ SortDriv -- Driver and Quick sort }
program Sort;
%include SWTOOLS
%include ioref
const
inCoreSize = 500;
MERGEORDER = 5;
type
LineType = -> StringType;
fdBufType = array [1..MERGEORDER] of FileDesc;
var
notEof: Boolean;
inBuf: array [1..inCoreSize] of LineType;
inFile: fdBufType;
i: Integer;
temp: StringType;
depth: Integer;
maxDepth: Integer;
procedure GName (n: Integer; var name: StringType);
var
junk: Integer;
temp: String(30);
begin
WriteStr(temp, 'STEMP',n:1,' TEMP A');
name := temp;
end; {GName}
procedure GOpen (var inFile: fdBufType; f1, f2: Integer);
var
name: StringType;
i: 1..MERGEORDER;
begin
for i := 1 to f2-f1+1 do begin
GName (f1+i-1, name);
inFile[i] := MustOpen(name, IOREAD);
end; {for}
end; {GOpen}
procedure GRemove (var inFile: fdBufType; f1, f2: Integer);
var
name: StringType;
i: 1..MERGEORDER;
begin
for i := 1 to f2-f1+1 do begin
FClose (inFile[i]);
GName (f1+i-1, name);
Remove (name);
end; {for}
end; {GRemove}
function MakeFile (n: Integer): FileDesc;
var
name: StringType;
temp: FileDesc;
begin
GName (n, name);
temp := FCreate (name, IOWRITE);
if temp = IOERROR then
Error('Could not create temporary file' || Str(name));
MakeFile := temp;
end; {MakeFile}
procedure PText (nLines: Integer; outFile: FileDesc);
var
i: Integer;
begin
for i := 1 to nLines do begin
PutStr(inBuf[i]@, outFile);
end; {for}
end; {PText}
function GText (var nLines: Integer; inFile: FileDesc): Boolean;
var
temp: StringType;
done: Boolean;
begin
nLines := 1;
done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
while (not done) do begin
nLines := nLines + 1;
if nLines > inCoreSize then leave;
done := (GetLine(inBuf[nLines]@, inFile, MAXSTR) = false);
end; {while}
nLines := nLines - 1;
GText := done;
end; {GText}
procedure QSort(l,r: integer);
var i,j: integer;
temp, hold: LineType;
begin
if l >= r then return;
depth := depth + 1;
maxDepth := Max (maxDepth, depth);
i := l;
j := r;
temp := inBuf[(i+j) div 2];
repeat
while inBuf[i]@ < temp@ do
i := i+1;
while temp@ < inBuf[j]@ do
j := j-1;
if i <= j then begin
hold := inBuf[i];
inBuf[i] := inBuf[j];
inBuf[j] := hold;
i := i+1;
j := j-1
end
until i > j;
{ if left smaller do: }
if (j - l) < (r - i) then begin
QSort(l,j); {left side first}
QSort(i,r);
end
else begin
QSort(i,r); {right side first}
QSort(l,j);
end; {if}
depth := depth - 1;
end {QSort} ;
{ Merge -- Merge infile[1] .. infile[nf] into outfile }
procedure Merge(var inFile: fdBufType; nf: Integer; outFile: FileDesc);
var
i,j: Integer;
lbp: Integer;
temp: LineType;
fromArray: array [1..MERGEORDER] of Integer;
procedure ReHeap (nf: Integer);
var
i,j,k: Integer;
temp: LineType;
begin
i := 1;
j := 2 * i;
while (j <= nf) do begin
if (j < nf) then { find smaller child }
if inBuf[j]@ > inBuf[j+1]@ then
j := j + 1;
if inBuf[i]@ <= inBuf[j]@ then
i := nf { proper position found, terminate loop }
else begin
k := fromArray[i];
fromArray[i] := fromArray[j];
fromArray[j] := k;
temp := inBuf[i];
inBuf[i] := inBuf[j];
inBuf[j] := temp;
end; {if}
i := j;
j := 2 * i;
end; {while}
end; {while}
procedure PermSort(l,r: Integer);
var
i,j,k: Integer;
temp: LineType;
begin
for i := 1 to r do
fromArray[i] := i;
for i := r downto 2 do
for j := 1 to i-1 do
if inBuf[j]@ > inBuf[j + 1]@ then begin
k := fromArray[j];
fromArray[j] := fromArray[j + 1];
fromArray[j + 1] := k;
temp := inBuf[j];
inBuf[j] := inBuf[j + 1];
inBuf[j + 1] := temp;
end; {if}
end; {PermSort}
begin
j := 1;
for i := 1 to nf do { get one line from each file }
if GetLine(inBuf[j]@, inFile[i], MAXSTR) then
j := j + 1;
nf := j - 1;
PermSort (1, nf); { make initial heap }
while (nf > 0) do begin
PutStr(inBuf[1]@, outFile);
if not
(GetLine(inBuf[1]@, inFile[fromArray[1]], MAXSTR))
then begin
temp := inBuf[1];
inBuf[1] := inBuf[nf];
inBuf[nf] := temp;
fromArray[1] := fromArray[nf];
nf := nf - 1;
end; {if}
ReHeap(nf);
end; {while}
end; {Merge}
var
done: Boolean;
nLines: Integer;
highMark: Integer;
lowMark: Integer;
lim: Integer;
outFile: FileDesc;
name: StringType;
begin
ToolInit;
highMark := 0;
for i := 1 to inCoreSize do
New(inBuf[i]);
repeat { initial formation of runs }
done := GText (nLines, STDIN);
depth := 0;
maxDepth := 0;
QSort(1, nLines);
highMark := highMark + 1;
outFile := MakeFile(highMark);
PText (nLines, outFile);
FClose (outFile);
until (done);
lowMark := 1;
while (lowMark < highMark) do begin { merge runs }
lim := Min(lowMark + MERGEORDER - 1, highMark);
GOpen (inFile, lowMark, lim);
highMark := highMark + 1;
outFile := MakeFile(highMark);
Merge(inFile, lim-lowMark+1, outFile);
FClose (outFile);
GRemove (inFile, lowMark, lim);
lowMark := lowMark + MERGEORDER;
end; {while}
GName (highMark, name); { final cleanup }
outFile := FOpen (name, IOREAD);
FCopy (outFile, STDOUT);
FClose (outFile);
Remove (name);
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.
}
{ SortDriv -- Driver and Quick sort }
program SortDriv;
%include SWTOOLS
%include ioref
const
inCoreSize = 500;
type
LineType = StringPtr;
var
notEof: Boolean;
inBuf: array [1..inCoreSize] of LineType;
i: Integer;
temp: StringType;
procedure PText (nLines: Integer; outFile: FileDesc);
var
i: Integer;
begin
for i := 1 to nLines do
PutStr (inBuf[i]@, outFile);
end; {PText}
function GText (var nLines: Integer; inFile: FileDesc): Boolean;
var
i: Integer;
temp: StringType;
begin
nLines := 0;
done := (GetLine(temp, inFile, MAXSTR) = false);
while (not done) and (nLines < inCoreSize) do begin
nLines := nLines + 1;
inBuf[nLines]@ := Str(temp);
done := (GetLine(temp, inFile, MAXSTR) = false);
end; {while}
end; {GText}
procedure QSort(l,r: integer);
var i,j: integer;
temp, hold: LineType;
begin
i := l;
j := r;
temp := inBuf[(i+j) div 2];
repeat
while inBuf[i]@ < temp@ do
i := i+1;
while temp@ < inBuf[j]@ do
j := j-1;
if i <= j then begin
hold := inBuf[i];
inBuf[i] := inBuf[j];
inBuf[j] := hold;
i := i+1;
j := j-1
end
until i > j;
if l < j then
QSort(l,j);
if i < r then
QSort(i,r)
end {QSort} ;
var
done: Boolean;
nLines: Integer;
high: Integer;
outFile: FileDesc;
begin
ToolInit;
high := 0;
for i := 1 to inCoreSize do
New(inBuf[i], SizeOf(StringType));
repeat { initial formation of runs }
done := GText (nLines, STDIN);
QSort(1, nLines);
high := high + 1;
outFile := MakeFile(high);
PText (nLines, outFile);
Close (outFile);
until (done);
low := 1;
while (low < high) do begin { merge runs }
lim := Min(low + MERGEORDER - 1, high);
GOpen (inFile, low, lim);
high := high + 1;
outFile := MakeFile(high);
Merge(inFile, lim-low+1, outFile);
Close (outFile);
GRemove (inFile, low, lim);
low := low + MERGEORDER;
end; {while}
GName (high, name) { final cleanup }
outFile := FOpen (name, IOREAD);
FCopy (outFile, STDOUT);
Close (outFile);
Remove (name);
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.
}
{ StClose -- insert closure entry at pat[j] }
segment STClose;
%include swtools
%include patdef
procedure StClose;
var
jp, jt: Integer;
junk: Boolean;
begin
for jp := j-1 downto lastJ do begin
jt := jp + CLOSIZE;
junk := AddStr(pat[jp], pat, jt, MAXPAT)
end;
j := j + CLOSIZE;
pat[lastJ] := CLOSURE { where original pattern began }
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.
}
{ StrIndex -- find position of character c in string s }
segment StrIndex;
%include swtools
function StrIndex;
var
i: Integer;
begin
i := 1;
while (s[i] <> c) and (s[i] <> ENDSTR) do
i := i + 1;
if (s[i] = ENDSTR) then
StrIndex := 0
else
StrIndex := 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.
}
{ StrLength -- determine length of swtools string }
segment StrLength;
%include swtools
function StrLength;
var
i: Integer;
begin
i := LBound(s);
while (s[i] <> ENDSTR) and (i < MAXSTR) do
i := i + 1;
StrLength := i - LBound(s)
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.
}
{ SubLine -- substitute sub for pat in lin and print }
segment SubLine;
%include swtools
%include patdef
%include subdef
%include matchdef
procedure SubLine;
var
i, lastm, m: Integer;
junk: Boolean;
begin
lastm := 0;
i := 1;
while (lin[i] <> ENDSTR) do begin
m := AMatch(lin, i, pat, 1);
if (m > 0) and (lastm <> m) then begin
{ replace substituted text }
PutSub(lin, i, m, sub);
lastm := m
end;
if (m = 0) or (m = i) then begin
{ no match or null match }
PutC(lin[i]);
i := i + 1
end
else { skip matched text }
i := m
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.
}
{ SubSt -- substitute "sub" for occurrences of pattern }
segment SubSt;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include matchdef
%include subdef
function SubSt;
var
new, old: StringType;
j, k, lastm, line, m: Integer;
stat: STCode;
done, subbed, junk: Boolean;
begin
if (glob) then
stat := OK
else
stat := ERR;
done := (line1 <= 0);
line := line1;
while (not done) and (line <= line2) do begin
j := 1;
subbed := false;
GetTxt(line, old);
lastm := 0;
k := 1;
while (old[k] <> ENDSTR) do begin
if (gFlag) or (not subbed) then
m := AMatch(old, k, pat, 1)
else
m := 0;
if (m > 0) and (lastm <> m) then begin
{ replace matched text }
subbed := true;
CatSub(old, k, m, sub, new, j, MAXSTR);
lastm := m
end;
if (m = 0) or (m = k) then begin
{ no match or null match }
junk := AddStr(old[k], new, j, MAXSTR);
k := k + 1
end
else
{ skip matched text }
k := m
end;
if (subbed) then begin
if (not AddStr(ENDSTR, new, j, MAXSTR)) then begin
stat := ERR;
done := true
end
else begin
stat := LnDelete(line, line, stat);
stat := PutTxt(new);
line2 := line2 + curLn - line;
line := curLn;
if (stat = ERR) then
done := true
else
stat := OK
end
end;
line := line + 1
end;
SubSt := stat
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.
}
{ SW[edit] -- main routine for text editor }
program SW;
%include swtools
%include editcons
%include edittype
%include editproc
var
curSave, i: Integer;
status: STCode;
more: Boolean;
argIndex: Integer;
def line1: Integer; { first line number }
def line2: Integer; { second line number }
def nLines: Integer; { # lines in buffer }
def curLn: Integer; { current line: value of dot }
def lastLn: Integer; { last line: value of $ }
def pat: StringType; { pattern }
def lin: StringType; { input line }
def saveFile: StringType; { file name }
value
line1 := 0;
line2 := 0;
nLines := 0;
begin
ToolInit;
SetBuf;
pat[1] := ENDSTR;
saveFile[1] := ENDSTR;
i := 1;
for argIndex := 1 to Nargs do
if GetArg(argIndex, lin, MAXSTR) then begin
SCopy (lin, 1, saveFile, i);
i := StrLength(saveFile) + 2;
saveFile[i-1] := BLANK
end;
i := 1;
if saveFile[1] <> ENDSTR then
if (not GetFid(saveFile, i, saveFile)) then
saveFile[1] := ENDSTR;
if saveFile[1] <> ENDSTR then
if (DoRead(0, saveFile) = ERR) then
Message('Cannot open input file');
if (OptIsOn(promptFlag)) then begin
PutC(COLON);
PutC(NEWLINE)
end;
more := GetLine(lin, STDIN, MAXSTR);
while (more) do begin
i := 1;
curSave := curLn;
if (GetList(lin, i, Status) = OK) then begin
if (CKGlob(lin, i, status) = OK) then
status := DoGlob(lin, i, curSave, status)
else if (status <> ERR) then
status := DoCmd(lin, i, false, status)
{ else error - do nothing }
end;
if (status = ERR) then begin
Message('eh?');
curLn := Min(curSave, lastLn)
end
else if (status = ENDDATA) then
more := false;
{ else ok }
if (more) then begin
if OptIsOn(promptFlag) then begin
PutC(COLON);
PutC(NEWLINE)
end;
more := GetLine(lin, STDIN, MAXSTR)
end
end;
ClrBuf
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.
}
{ Change -- change "from" into "to" on each line }
program swch;
%include swtools
%include patdef
%include matchdef
%include subdef
var
lin, pat, sub, arg: StringType;
begin
ToolInit;
if (not GetArg(1, arg, MAXSTR)) then
Error('usage: change from <to>');
if (not GetPat(arg, pat)) then
Error('change: illegal "from" pattern');
if (not GetArg(2, arg, MAXSTR)) then
arg[1] := ENDSTR;
if (not GetSub(arg, sub)) then
Error('change: illegal "to" string');
while (GetLine(lin, STDIN, MAXSTR)) do
SubLine(lin, pat, sub)
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.
}
{ Translit -- map characters }
program SWTr;
%include swtools
%include patdef
var
arg, fromSet, toSet: StringType;
c: CharType;
i, lastTo: 0..MAXSTR;
allBut, squash: Boolean;
{ XIndex -- conditionally invert value from strindex }
function XIndex (var inSet: StringType; c: CharType;
allBut: Boolean; lastTo: Integer): Integer;
begin
if (c = ENDFILE) then
XIndex := 0
else if (not allBut) then
XIndex := StrIndex(inSet,c)
else if (StrIndex(inSet,c) > 0) then
XIndex := 0
else
XIndex := lastTo + 1
end;
begin
ToolInit;
if (not GetArg(1, arg, MAXSTR)) then
Error('usage: translit from to');
allBut := (arg[1] = NEGATE);
if allBut then
i := 2
else
i := 1;
if (not MakeSet(arg, i, fromSet, MaxStr)) then
Error('translit: "from" set too large');
if (not GetArg(2,arg, MAXSTR)) then
toSet[1] := ENDSTR
else if (not MakeSet(arg, 1, toSet, MAXSTR)) then
Error('translit: "to" set too large')
else if (StrLength(fromSet) < StrLength(toSet)) then
Error('Translit: "from" shorter than "to"');
lastTo := StrLength(toSet);
squash := (StrLength(fromSet) > lastTo) or (allBut);
repeat
i := XIndex(fromSet, GetC(c), allBut, lastTo);
if (squash) and (i >= lastTo) and (lastTo > 0) then begin
PutC(toSet[lastTo]);
repeat
i := XIndex(fromSet, GetC(c), allBut, lastTo)
until (i < lastTo)
end;
if (c <> ENDFILE) then begin
if (i > 0) and (lastTo > 0) then { translate }
PutC(toSet[i])
else if (i = 0) then { copy }
PutC(c)
{ else delete (don't print) }
end
until (c = ENDFILE)
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.
}
{ Term -- Evaluate term of arithmetic expression }
segment Term;
%include swtools
%include macdefs
%include macproc
function Term;
var
v: Integer;
t: CharType;
begin
v := Factor(s, i);
t := GNBChar(s, i);
while (t in [STAR, SLASH, PERCENT]) do begin
i := i + 1;
case t of
STAR:
v := v * Factor(s, i);
SLASH:
v := v div Factor(s, i);
PERCENT:
v := v mod Factor(s, i)
end {case};
t := GNBChar(s, i)
end {while};
Term := v
end { Term };
{
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.
}
{ ToolInit -- (CMS) standard program prologue }
segment ToolInit;
%include swtools
%include iodef
def openList: array [FileDesc] of IOBlock;
def cmdLin: StringType;
def cmdArgs: 0..MAXARG;
def cmdIdx: array [1..MAXARG] of 1..MAXSTR;
def termInput: Boolean;
ref ERRORIO: Boolean;
value
termInput := false;
procedure ToolInit;
var
t: 1..MAXSTR;
i: FileDesc;
idx: 1..MAXSTR;
delim: CharType;
PARMSTRING: String(MAXSTR);
fileName: StringType;
cmdLength: 0..MAXSTR;
redirIn: Boolean;
j: 1..MAXSTR;
dummy: StringType;
okay: Boolean;
tempArgs: 0..MAXARG;
XFileName: String(MAXSTR);
k: 0..MAXSTR;
nextChar: 1..MAXSTR;
begin
TermIn(input);
TermOut(output);
for i := STDIN to MAXOPEN do
openList[i].mode := IOAVAIL;
openList[STDERR].mode := IOWRITE;
TermOut(openList[STDERR].fileVar);
PARMSTRING := PARMS;
if (Length(PARMSTRING) >= 1) and (PARMSTRING[1] = STAR) then begin
WriteLn('Input Command Parameters:');
ReadLn(PARMSTRING);
PARMSTRING := PARMSTRING || SubStr(PARMS, 2, Length(PARMS)-1)
end;
for idx := 1 to Length(PARMSTRING) do
cmdLin[idx] := PARMSTRING[idx];
cmdLin[Length(PARMSTRING) + 1] := NEWLINE;
cmdLin[Length(PARMSTRING) + 2] := ENDSTR;
idx := 1;
cmdArgs := 0;
while ((cmdLin[idx] <> ENDSTR) and
(cmdLin[idx] <> NEWLINE)) do begin
while (cmdLin[idx] = BLANK) do
idx := idx + 1;
if (cmdLin[idx] <> NEWLINE) then begin
delim := BLANK;
cmdArgs := cmdArgs + 1;
if (cmdLin[idx] = SQUOTE) or
(cmdLin[idx] = DQUOTE) then begin
cmdIdx[cmdArgs] := idx + 1;
delim := cmdLin[idx];
idx := idx + 1
end
else
cmdIdx[cmdArgs] := idx;
while ((cmdLin[idx] <> NEWLINE) and
(cmdLin[idx] <> delim)) do
idx := idx + 1;
cmdLin[idx] := ENDSTR;
idx := idx + 1;
end
end;
j := 1;
tempArgs := cmdArgs;
while (j <= cmdArgs) do begin
okay := GetArg(j, dummy, MAXSTR);
j := j + 1;
if (dummy[1] = LESS) or (dummy[1] = GREATER) then begin
if dummy[1] = LESS then
redirIn := true
else
redirIn := false;
SCopy(dummy, 2, fileName, 1);
nextChar := StrLength(fileName) + 1;
tempArgs := tempArgs - 1;
k := j;
while (k <= cmdArgs) do begin
okay := GetArg(k, dummy, MAXSTR);
k := k + 1;
if okay and (dummy[1] <> LESS) and
(dummy[1]<> GREATER) then begin
tempArgs := tempArgs - 1;
fileName[nextChar] := BLANK;
nextChar := nextChar + 1;
SCopy(dummy, 1, fileName, nextChar);
nextChar := StrLength(fileName) + 1;
j := j + 1;
end
else
k := cmdArgs + 1;
end;
t := 1;
okay := GetFid(fileName, t, fileName);
if not okay then
Error('Bad redirection file name');
CvtSTS(fileName, XFileName);
if redirIn then begin
openList[STDIN].mode := IOREAD;
Reset(openList[STDIN].fileVar, 'NAME=' ||
XFileName);
termInput := false;
if ERRORIO then begin
openList[STDIN].mode := IOAVAIL;
Error('Cannot open STDIN file');
ERRORIO := false
end
end
else begin
openList[STDOUT].mode := IOWRITE;
Remove(fileName);
ReWrite(openList[STDOUT].fileVar,
'LRECL=1000,NAME=' || XFileName);
if ERRORIO then begin
openList[STDOUT].mode := IOAVAIL;
ERRORIO := false
end
end
end
end;
cmdArgs := tempArgs;
if openList[STDIN].mode = IOAVAIL then begin
TermIn(openList[STDIN].fileVar);
openList[STDIN].mode := IOREAD;
termInput := true;
end;
if openList[STDOUT].mode = IOAVAIL then begin
TermOut(openList[STDOUT].fileVar);
openList[STDOUT].mode := IOWRITE;
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.
}
{ Unique -- strip adjacent duplicate lines in a file }
program Unique;
%include swtools
var
buffer: array [0..1] of StringType;
bufNum: 0..1;
sameRecCount: Integer;
counts: Boolean;
lastRec: StringType;
begin
ToolInit;
buffer[1,1] := ENDSTR;
buffer[0,1] := NEWLINE; { just so's they're different }
lastRec := buffer[1];
counts := NArgs > 0;
bufNum := 0;
sameRecCount := 0;
while(GetLine(buffer[bufNum], STDIN, MAXSTR)) do begin
if (not Equal(buffer[0], buffer[1])) then begin
if counts and (sameRecCount <> 0) then begin
PutDec(sameRecCount, 6);
PutC(BLANK)
end;
if sameRecCount <> 0 then
PutStr(lastRec, STDOUT);
lastRec := buffer[bufNum];
sameRecCount := 1
end
else
sameRecCount := sameRecCount + 1;
bufNum := (1 - bufNum)
end;
if sameRecCount <> 0 then begin
if counts then begin
PutDec(sameRecCount, 6);
PutC(BLANK)
end;
PutStr(lastRec, STDOUT)
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.
}
{ UnRotate -- Unrotate lines rotated by first half of KWIC }
Program UnRotate;
%include swtools
const
MAXOUT = 80;
MIDDLE = 40;
FOLD = DOLLAR;
var
inBuf, outBuf: StringType;
tempFile2: FileDesc;
i, j, f: Integer;
begin
ToolInit;
tempFile2 := STDIN;
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;
{
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.
}
{ Wc -- Word Counting program }
program Wc;
%include SWTOOLS
var
buffer: StringType;
numChars: Integer;
numWords: Integer;
numLines: Integer;
i: Integer;
lineLength: Integer;
inWord: Boolean;
begin
ToolInit;
numChars := 0;
numWords := 0;
numLines := 0;
while (GetLine(buffer, STDIN, MAXSTR)) do begin
inWord := false;
numLines := numLines + 1;
lineLength := StrLength (buffer);
numChars := numChars + lineLength;
for i := 1 to lineLength do
if (buffer[i] = BLANK) then
inWord := false
else if (not inWord) then begin
inWord := true;
numWords := numWords + 1;
end; {if}
end; {while}
PutDec(numChars, 7);
PutDec(numWords, 7);
PutDec(numLines, 7);
end; {Wc}