Software Tools in Pascal 4/8
jp at lanl.ARPA
jp at lanl.ARPA
Sun Oct 6 14:59:50 AEST 1985
{
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.
}
{ Echo -- echo arguments }
program Echo;
%include swtools
var
lin: StringType;
i: Integer;
junk: Boolean;
begin
ToolInit;
for i := 1 to Nargs do begin
junk := GetArg(i, lin, MAXSTR);
PutStr(lin, STDOUT);
if i < Nargs then PutCF(BLANK, STDOUT)
end;
PutCF(NEWLINE, STDOUT)
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.
}
{ Equal -- test two strings for equality }
segment Equal;
%include swtools
function Equal;{str1, str2: StringType): Boolean}
var
i: Integer;
begin
i := 1;
while (str1[i] = str2[i]) and (str1[i] <> ENDSTR) do
i := i + 1;
Equal := (str1[i] = str2[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.
}
segment Error;
%include swtools
procedure Error;
var
i: 1..MAXSTR;
begin
for i := 1 to Length(s) do
PutCF(s[i], STDERR);
PutCF(NEWLINE,STDERR);
RetCode(1000);
HALT;
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.
}
{ Esc -- map s(i) into escaped characters, increment i }
segment Esc;
%include swtools
function Esc;
begin
if (s[i] <> ESCAPE) then
Esc := s[i]
else if (s[i+1] = ENDSTR) then { @ not special at end }
Esc := ESCAPE
else begin
i := i + 1;
if (s[i] = LETN) or (s[i] = BIGN) then
Esc := NEWLINE
else if (s[i] = TAB) then
Esc := TAB
else
Esc := s[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.
}
{ Eval -- expand args i..j: do built-in or push back defn }
segment Eval;
%include swtools
%include macdefs
%include macproc
procedure Eval;
var
argNo, k, t: Integer;
temp: StringType;
l,m,n: Integer;
begin
t := argStk[i];
if traceing then begin
MPutStr('Traceing -$E', STDOUT);
case td of
DEFTYPE:
MPutStr('define($N$E', STDOUT);
EXPRTYPE:
MPutStr('expr($N$E', STDOUT);
SUBTYPE:
MPutStr('substr($N$E', STDOUT);
IFTYPE:
MPutStr('ifelse($N$E', STDOUT);
LENTYPE:
MPutStr('len($N$E', STDOUT);
CHQTYPE:
MPutStr('changeq($N$E', STDOUT)
otherwise
MPutStr('macro expansion:$N$E', STDOUT);
end {case};
for l := i + 2 to j do begin
CsCopy(evalStk, argStk[l], temp);
PutStr(temp, STDOUT);
PutCF(NEWLINE, STDOUT)
end {for};
MPutStr('<<<<<<$N$E', STDOUT);
end {if};
if (td = DEFTYPE) then
DoDef(argStk, i, j)
else if (td = EXPRTYPE) then
DoExpr(argStk, i, j)
else if (td = SUBTYPE) then
DoSub(argStk, i, j)
else if (td = IFTYPE) then
DoIf(argStk, i, j)
else if (td = LENTYPE) then
DoLen(argStk, i, j)
else if (td = CHQTYPE) then
DoChq(argStk, i, j)
else begin
k := t;
while (evalStk[k] <> ENDSTR) do
k := k + 1;
k := k - 1; { last character of data }
while (k > t) do begin
if (evalStk[k-1] <> ARGFLAG) then
PutBack(evalStk[k])
else begin
argNo := Ord(evalStk[k]) - Ord(DIG0);
if (argNo >= 0) and (argNo < j-1) then begin
CsCopy(evalStk, argStk[i+argNo+1], temp);
PBStr(temp)
end {if};
k := k - 1 { skip over $ }
end {if};
k := k - 1
end {while};
if (k = t) then { do last character }
PutBack(evalStk[k])
end {if}
end {Eval};
{
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.
}
{ Expand -- Expand a file by a specified factor }
program Expand;
%include swtools
const maxWidth = 2000;
var
arguments: StringType;
outBuffer: array [1..maxWidth] of Char;
inPtr: Integer;
anchor: Integer;
i: Integer;
factor: Integer;
index: Integer;
j: Integer;
begin
ToolInit;
index := 1;
if GetArg(1, arguments, MAXSTR) then begin
factor := CToI(arguments, index);
if factor = 0 then
Error('Argument to Expand should be numeric, > 0');
end
else
factor := 1;
while true do begin
inPtr := 1;
{ read an input line, expanding on the fly }
while (GetC(outBuffer[inPtr]) <> ENDFILE) do begin
if outBuffer[inPtr] = NEWLINE then leave;
anchor := inPtr;
for j := 1 to factor - 1 do begin
inPtr := inPtr + 1;
outBuffer[inPtr] := outBuffer[anchor];
end; {for}
inPtr := inPtr + 1;
end; {while}
if outBuffer[inPtr] = ENDFILE then leave;
{ output expanded array twice }
for j := 1 to factor do
for i := 1 to inPtr do
PutC(outBuffer[i]);
end; {while}
end. {Expand}
{
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.
}
{ Expr -- Recursive expression evaluation }
segment Expr;
%include swtools
%include macdefs
%include macproc
function Expr;
var
v: Integer;
t: CharType;
begin
v := Term(s, i);
t := GNBChar(s, i);
while (t in [PLUS, MINUS]) do begin
i := i + 1;
if (t = PLUS) then
v := v + Term(s, i)
else
v := v - Term(s, i);
t := GNBChar(s, i)
end {while};
Expr := v
end {Expr};
{
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.
}
{ Factor -- Evaluate factor of arithmetic expression }
segment Factor;
%include swtools
%include macdefs
%include macproc
function Factor;
begin
if (GNBChar(s, i) = LPAREN) then begin
i := i + 1;
Factor := Expr(s, i);
if (GNBChar(s, i) = RPAREN) then
i := i + 1
else
Message('Macro: missing paren in expr')
end {then}
else
Factor := CToI(s, i)
end {Factor};
{
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.
}
{ FClose -- close a file }
segment FClose;
%include swtools
%include ioref
procedure FClose;
begin
if (fd > STDERR) and (fd <= MAXOPEN) and
(openList[fd].mode <> IOAVAIL) then begin
Close(openList[fd].fileVar);
openList[fd].mode := IOAVAIL;
ERRORIO := false;
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.
}
{ FCopy -- Copy file fin to file fout }
segment FCopy;
%include SWTOOLS
%include IODEF
procedure FCopy;
var
temp: StringType;
begin
while (GetLine(temp, fin, MAXSTR)) do
PutStr(temp, fout);
end; {FCopy}
{
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.
}
{ FCreate -- create a file (temporary version) }
segment FCreate;
%include swtools
function FCreate;
begin
FCreate := FOpen(name, mode)
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.
}
{ FDAlloc - find a free file descriptor }
segment FDAlloc;
%include swtools
%include ioref
function FDAlloc;
var
fd: FileDesc;
done: Boolean;
begin
done := false;
fd := Succ(STDERR);
repeat
done := (openList[fd].mode = IOAVAIL) or (fd = MAXOPEN);
if (not done) then
fd := Succ(fd)
until (done);
if openList[fd].mode = IOAVAIL then
FDAlloc := fd
else
FDAlloc := IOERROR
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.
}
{ FOpen -- open a file }
segment FOpen;
%include swtools
%include cms
%include ioref
function FOpen;
var
returnCode: Integer;
cmsString: String(MAXSTR);
sName: String(MAXSTR);
f: FileDesc;
i: 1..MAXSTR;
fixedName: StringType;
begin
if mode = IOREAD then begin
cmsString := 'STATE ';
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);
if returnCode <> 0 then begin
FOpen := IOERROR;
return
end;
end;
i := 1;
if (not GetFid(Name, i, fixedName)) then
Error('Bad file name');
CvtSTS(fixedName, sName);
f := FDAlloc;
if f = IOERROR then
Error('Out of file descriptors')
else begin
openList[f].mode := mode;
if mode = IOREAD then
Reset(openList[f].fileVar, 'name=' || sName)
else begin
Remove(fixedName);
ReWrite(openList[f].fileVar, 'name=' || sName);
end;
if ERRORIO then begin
openList[f].mode := IOAVAIL;
f := IOERROR;
ERRORIO := false;
end
end;
FOpen := f
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.
}
{ GetArg (CMS) -- get n-th command line parameter }
segment GetArg;
%include swtools
%include ioref
function GetArg;
begin
if ((n < 1) or (cmdArgs < n)) then
GetArg := false
else begin
SCopy(cmdLin,cmdIdx[n], str, 1);
GetArg := true
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.
}
{ GetCCL -- expand char class at arg[i] into pat[j }
segment GetCCL;
%include swtools
%include patdef
function GetCCL;
var
jStart: Integer;
junk: Boolean;
begin
i := i + 1; {skip over CCL}
if (arg[i] = NEGATE) then begin
junk := AddStr(NCCL, pat, j, MAXPAT);
i := i + 1
end
else
junk := AddStr(CCL, pat, j, MAXPAT);
jStart := j;
junk := AddStr(ENDSTR, pat, j, MAXPAT); {make room for count}
DoDash(CCLEND, arg, i, pat, j, MAXPAT);
{ putting an integer into a char only works if the number is les
than 255}
pat[jStart] := Chr(j - jStart - 1);
GetCCL := (arg[i] = CCLEND)
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.
}
{ GetCF -- get character from file }
segment GetCF;
%include swtools
%include ioref
function GetCF;
begin
if Eof(openList[fd].fileVar) then begin
c := ENDFILE;
GetCF := ENDFILE
end
else if Eoln(openList[fd].fileVar) then begin
GetCF := NEWLINE;
c := NEWLINE;
ReadLn(openList[fd].fileVar);
end
else begin
Read(openList[fd].fileVar,c);
GetCF := c;
end
end;
function GetC;
begin
c := GetCF(c, STDIN);
GetC := 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.
}
{ GetDef -- get name and definition }
segment GetDef;
%include swtools
%include defdef
%include defref
%include defproc
procedure GetDef;
var
i, nlPar: Integer;
c: CharType;
begin
token[1] := ENDSTR; { in case of bad input }
defn[1] := ENDSTR;
if (GetPBC(c) <> LPAREN) then
Message('define: missing left paren')
else if (not IsLetter(GetTok(token, tokSize))) then
Message('define: non-alphanumeric name')
else if (GetPBC(c) <> COMMA) then
Message('define: missing comma in define')
else begin { got '(name,' so far }
while (GetPBC(c) = BLANK) do
; { skip leading blanks }
PutBack(c); { went one too far }
nlPar := 0;
i := 1;
while (nlPar >= 0) do begin
defn[i] := GetPBC(c);
if (i >= defSize) then
Error('define: definition too long')
else if (c = ENDFILE) then
Error('define: missing right paren')
else if (c = LPAREN) then
nlPar := nlPar + 1
else if (c = RPAREN) then
nlPar := nlPar - 1;
{ else normal char in defn[i] }
i := i + 1
end;
defn[i-1] := ENDSTR
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.
}
{ GetFid -- convert a string into a file name }
segment GetFid;
%include swtools
%include ioref
function GetFid;
var
nameIndex: 1..MAXSTR;
temp: StringType;
fMode: StringType;
fType: StringType;
i: 0..MAXSTR;
j: 0..MAXSTR;
begin
SCopy(line, idx, temp, 1);
for nameIndex := 1 to StrLength(temp) do
if (not (line[nameIndex] in
[DOLLAR, LETA..LETZ, BIGA..BIGZ, DIG0..DIG9, BLANK])) then
temp[nameIndex] := BLANK;
i := GetWord(temp, 1, fileName);
if i = 0 then begin
GetFid := false;
return;
end;
j := GetWord(temp, i, fType);
if j = 0 then begin
CvtSST('TEMP', fType);
CvtSST('*', fMode);
end
else begin
j := GetWord(temp, j, fMode);
if j = 0 then
CvtSST('*', fMode);
end;
i := StrLength(fileName);
fileName[i+1] := PERIOD;
SCopy(fType, 1, fileName, i + 2);
i := StrLength(fileName);
fileName[i+1] := PERIOD;
SCopy(fMode, 1, fileName, i + 2);
getFid := true;
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.
}
{ GetFn -- get file name from lin[i] .... }
segment GetFn;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function GetFn;
var
k: Integer;
stat: STCode;
begin
stat := ERR;
if (lin[i+1] = BLANK) then begin
Scopy(lin, i+2, fil, 1);
if fil[StrLength(fil)] = NEWLINE then
fil[StrLength(fil)] := ENDSTR;
stat := OK
end
else if (lin[i+1] = NEWLINE) and (saveFile[1] <> ENDSTR) then begin
Scopy(saveFile, 1, fil, 1);
stat := OK
end;
if (stat = OK) and (saveFile[1] = ENDSTR) then
Scopy(fil, 1, saveFile, 1); { save if no old one }
k := 1;
if stat = Ok then
if (not GetFid(saveFile, k, saveFile)) then
stat := ERR;
GetFn := 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.
}
{ GetLine-- put string out on file }
segment GetLine;
%include swtools
%include ioref
ref termInput: Boolean;
function GetKeyBoard(var str: StringType; maxSize: Integer): Boolean;
forward;
function GetLine;
var
i: Integer;
begin
if (fd < STDIN) or (fd > MAXOPEN) or
(openList[fd].mode <> IOREAD) then
Error('Getline with unopen or bad fd')
else if (fd = STDIN) and (termInput) then
GetLine := GetKeyBoard(str, maxSize)
else begin
i := 1;
GetLine := false;
if Eof(openList[fd].fileVar) then begin
str[1] := NEWLINE;
str[2] := ENDSTR;
return;
end;
Readln(openList[fd].fileVar, str);
i := maxSize;
while (i > 0) do begin
if (str[i] <> BLANK) then leave;
i := i - 1
end;
str[i+1] := NEWLINE;
str[i+2] := ENDSTR;
GetLine := true
end
end;
function GetKeyBoard;
var
i: Integer;
begin
ReadLn(openList[STDIN].fileVar, str);
if Eof(openList[STDIN].fileVar) then begin
TermIn(openList[STDIN].fileVar);
i := 0
end
else begin
i := maxSize;
while (i > 0) do begin
if str[i] <> BLANK then leave;
i := i - 1
end
end;
str[i + 1] := NEWLINE;
str[i + 2] := ENDSTR;
if (str[1] = ATSIGN) and (str[2] = NEWLINE) then
GetKeyBoard := false
else
GetKeyBoard := true
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.
}
{ GetList -- Get list of line numbers at lin[i], increment i }
segment GetList;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function GetList;
var
num: Integer;
done: Boolean;
begin
line2 := 0;
nLines := 0;
done := (GetOne(lin, i, num, status) <> OK);
if done and (lin[i] = COMMA) then begin
done := false;
num := 1
end; {if}
while (not done) do begin
line1 := line2;
line2 := num;
nLines := nLines + 1;
if (lin[i] = SEMICOL) then
curLn := num;
if (lin[i] = COMMA) or (lin[i] = SEMICOL) then begin
i := i + 1;
done := (GetOne(lin, i, num, status) <> OK);
if done then begin
num := lastLn;
done := false
end {if}
end
else
done := true
end;
nLines := Min(nLines, 2);
if (nLines = 0) then
line2 := curLn;
if (nLines <= 1) then
line1 := line2;
if (status <> ERR) then
status := OK;
GetList := 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.
}
{ GetNum -- get single line number component }
segment GetNum;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
function GetNum;
begin
status := OK;
SkipBl(lin, i);
if (IsDigit(lin[i])) then begin
num := CToI(lin, i);
i := i - 1 { move back, to be advanced at end }
end
else if (lin[i] = PLUS) or (lin[i] = MINUS) then begin
num := curLn;
i := i - 1; {don't eat the plus or minus sign}
end
else if (lin[i] = CURLINE) then
num := curLn
else if (lin[i] = LASTLINE) then
num := lastLn
else if (lin[i] = SCAN) or (lin[i] = BACKSCAN) then begin
if (OptPat(lin,i) = ERR) then { build pattern }
status := ERR
else
status := PatScan(lin[i], num)
end
else
status := ENDDATA;
if (status = OK) then
i := i + 1; { advance to next character }
GetNum := 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.
}
{ GetOne -- get one line number expression }
segment GetOne;
%include swtools
%include editcons
%include edittype
%include editref
%include editproc
function GetOne;
var
iStart, mul, pNum: Integer;
begin
iStart := i;
num := 0;
if (GetNum(lin, i, num, status) = OK) then { 1st term }
repeat { + or - terms }
SkipBl(lin, i);
if (lin[i] <> PLUS) and (lin[i] <> MINUS) then
status := ENDDATA
else begin
if (lin[i] = PLUS) then
mul := 1
else
mul := -1;
i := i + 1;
if (GetNum(lin, i, pNum, status) = OK) then
num := num + mul * pNum;
if (status = ENDDATA) then
status := ERR
end
until (status <> OK);
if (num < 0) or (num > lastLn) then
status := ERR;
if (status <> ERR) then begin
if (i <= iStart) then
status := ENDDATA
else
status := OK
end;
GetOne := 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.
}
{ GetPat -- get pattern from lin, increment i }
segment GetPat;
%include swtools
%include patdef
function GetPat;
begin
GetPat := (MakePat(arg, 1, ENDSTR, pat) > 0)
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.
}
{ GetPBC -- get a (possibly pushed back) character }
segment GetPBC;
%include swtools
%include defdef
%include defref
%include defproc
function GetPBC;
begin
if (bp > 0) then
c := buf[bp]
else begin
bp := 1;
buf[bp] := GetC(c);
end;
if (c <> ENDFILE) then
bp := bp - 1;
GetPBC := 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.
}
{ GetRHS -- get right hand side of "s" command }
segment GetRHS;
%include swtools
%include editcons
%include edittype
%include editproc
%include editref
%include subdef
function GetRHS;
begin
GetRHS := OK;
if (lin[i] = ENDSTR) then
GetRHS := ERR
else if (lin[i+1] = ENDSTR) then
GetRHS := ERR
else begin
i := MakeSub(lin, i+1, lin[i], sub);
if (i = 0) then
GetRHS := ERR
else if (lin[i+1] = LETG) then begin
i := i + 1;
gFlag := true
end
else
gFlag := false
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.
}
{ GetSub -- Get substitution pattern and support fcns }
segment GetSub;
%include swtools
%include patdef
%include subdef
{ GetSub -- Get substitution pattern and support fcns }
function GetSub;
begin
GetSub := (MakeSub(arg, 1, ENDSTR, sub) > 0)
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.
}
{ GetTok -- get token for define }
segment GetTok;
%include swtools
%include defdef
%include defref
%include defproc
function GetTok;
var
i: Integer;
done: Boolean;
junk: CharType;
begin
i := 1;
done := false;
while (not done) and (i < tokSize) do begin
token[i] := GetPBC(junk);
if (IsAlphaNum(token[i])) then
i := i + 1
else
done := true
end;
if (i >= tokSize) then
Error('define: token too long');
if (i > 1) then begin { some alpha was seen }
PutBack(token[i]);
i := i - 1
end;
{ else single non-alphanumeric }
token[i+1] := ENDSTR;
GetTok := token[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.
}
{ getword -- get word form s(i) into out }
segment GetWord;
%include swtools
function GetWord;
var
j: Integer;
begin
while (s[i] in [BLANK,TAB,NEWLINE]) do
i := i + 1;
j := 1;
while (not (s[i] in [ENDSTR,BLANK,TAB,NEWLINE])) do begin
out[j] := s[i];
i := i + 1;
j := j + 1
end;
out[j] := ENDSTR;
if (j = 1) then
GetWord := 0
else
GetWord := 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.
}
{ GNBChar -- Get next non-blank character }
segment GNBChar;
%include swtools
%include macdefs
%include macproc
function GNBChar;
begin
while (s[i] in [BLANK, TAB, NEWLINE]) do
i := i + 1;
GNBChar := s[i]
end {GNBChar};
More information about the Comp.sources.unix
mailing list