var
s : pckstr;
i,j, firstchar, lastchar : integer;
ch : char;
procedure findfirstchar( s : pckstr; var firstchar : integer);
begin
firstchar := 1;
while (firstchar < s.length) and (s.body[firstchar] <= blank) do
firstchar := firstchar + 1
end;
procedure findlastchar( s : pckstr; var lastchar : integer );
begin
lastchar := s.length;
while (lastchar > 1) and (s.body[lastchar] <= blank) do
lastchar := lastchar - 1
end;
begin
if smooth then
begin
findfirstchar( arg.source, firstchar);
findlastchar( arg.source, lastchar);
j := 0;
for i := firstchar to lastchar do
begin
ch := arg.source.body[i];
if ch < blank then ch := blank;
if ch in ['a'..'z'] then ch := chr(ord(ch) - ord(blank));
j := j + 1;
s.body[j] := ch
end;
if (j = 1) and (s.body[1] = blank) then
s.length := 0
else
s.length := j
end
else
s := arg.source;
argliteral := s
end;
[GLOBAL] FUNCTION pckstrisgeneralization( s : pckstr ) : boolean;
label
routineexit;
var
flag : boolean;
begin
flag := false;
if s = '[N]' then
begin
flag := true;
goto routineexit
end;
if s = '[C]' then
begin
flag := true;
goto routineexit
end;
if s = '[Y]' then
begin
flag := true;
goto routineexit
end;
if s = '[T]' then
begin
flag := true;
goto routineexit
end;
if s = '[Q]' then
begin
flag := true;
goto routineexit
end;
routineexit : pckstrisgeneralization := flag
end;
[GLOBAL] FUNCTION argisgeneralization( arg : argument ) : boolean;
begin
argisgeneralization := arg.isgeneralization
end;
[GLOBAL] FUNCTION textualmatch( arg1, arg2 : argument) : boolean;
begin
textualmatch := false;
if (arg1.source = '[T]') and (textpckstr in arg2.class) then
textualmatch := true
else
if (arg2.source = '[T]') and (textpckstr in arg1.class) then
textualmatch := true
end;
[GLOBAL] FUNCTION compareargs( leftarg, rightarg : argument ) : comparisons;
label
routineexit;
var
lefts, rights : pckstr;
equalpckstrs : boolean;
comp : comparisons;
procedure greaterorlessthancompare;
begin
if lefts < rights then
comp := lessthan
else
comp := greaterthan
end;
procedure checktexindex;
begin
if (leftarg.texindex = indexofunknowntexcommand) or
(rightarg.texindex = indexofunknowntexcommand) then
comp := equal
else
if leftarg.texindex = rightarg.texindex then
comp := equal
else
greaterorlessthancompare
end;
begin
if textualmatch( leftarg, rightarg) then
begin
comp := equal;
goto routineexit
end;
if (leftarg.class = [nulltype]) or (rightarg.class = [nulltype]) then
begin
comp := equal;
goto routineexit
end;
lefts := argliteral(leftarg, TRUE);
rights := argliteral(rightarg, TRUE);
equalpckstrs := (lefts = rights);
comp := notvalid;
if leftarg.class * rightarg.class <> [] then
begin
if equalpckstrs then
comp := equal
else
if (leftarg.isgeneralization) or (rightarg.isgeneralization) then
checktexindex
else
greaterorlessthancompare
end
else
greaterorlessthancompare;
routineexit : compareargs := comp
end;
[GLOBAL] FUNCTION argtexindex( arg : argument ) : integer;
begin
argtexindex := arg.texindex
end;
[GLOBAL] FUNCTION argclass( arg : argument ) : setofargtype;
begin
argclass := arg.class
end;
[GLOBAL] PROCEDURE initarg( var arg : argument; classification : setofargtype;
lit : pckstr; index : integer; general : boolean );
begin
arg.source := lit;
arg.class := classification;
arg.texindex := index;
arg.isgeneralization := general
end;
[GLOBAL] PROCEDURE reassignargclass( var arg : argument; newclass : setofargtype);
begin
arg.class := newclass
end;
[GLOBAL] PROCEDURE reassignargtexindex( var arg : argument; newindex:integer);
begin
arg.texindex := newindex
end;
[GLOBAL] PROCEDURE reassignarggeneralization( var arg : argument;general:boolean);
begin
arg.isgeneralization := general
end;
[GLOBAL] PROCEDURE appendchartoarg( ch : char; var arg : argument );
begin
if arg.source.length = maxchars then
warningmessage('appendchartoarg','argument too long')
else
begin
arg.source.length := arg.source.length + 1;
arg.source.body[arg.source.length] := ch
end
end;
[GLOBAL] PROCEDURE extractintegerfromargument( arg : argument; var successful : boolean;
var int : integer;
var signed : boolean );
var
s : pckstr;
begin
s := argliteral( arg, TRUE);
readv( s, int, error := continue );
if statusv <> 0 then
successful := false
else
begin
successful := true;
signed := (s.body[1] = '+') or (s.body[1] = '-')
end
end;
