home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ucsdibmpc.tar.gz
/
ucsdibmpc.tar
/
parser.text
< prev
next >
Wrap
Text File
|
1984-05-23
|
10KB
|
355 lines
(*$S+*)
unit parser;
INTERFACE
uses {$U kermglob.code} kermglob;
function parse: statustype;
procedure initvocab;
IMPLEMENTATION
uses
{$U kermutil.code} kermutil;
procedure eatspaces(var s: string255);
var done: boolean;
i: integer;
begin
done := (length(s) = 0);
while not done do
begin
if s[1] = ' ' then
begin
i := length(s) - 1;
s := copy(s,2,i);
done := length(s) = 0
end (* if *)
else
done := true
end (* while *)
end; (* eatspaces *)
procedure isolate_word(var line, s: string255);
var i: integer;
done: boolean;
begin
done := false;
i := 1;
s := copy(' ',0,0);
while (i <= length(line)) and not done do
begin
if line[i] = ' ' then
done := true
else
s := concat(s,copy(line,i,1));
i := i + 1;
end; (* while *)
line := copy(line,i,length(line)-i+1);
end; (* isolate_word *)
function get_fn(var line, fn: string255): boolean;
var i, l: integer;
begin
get_fn := true;
isolate_word(line, fn);
l := length(fn);
(* Watch out, the set below had an ASCII null (0) in quotes as its 5th *)
(* member, between '_' and '/'. The null character has been deleted to *)
(* allow tape and network distribution of this program. *)
if (l > 15) or (l < 1) then
get_fn := false
else
for i := 1 to l do
if not (fn[i] in ['0'..'9','A'..'Z', '-', '_', '', '/', '.']) then
get_fn := false
end; (* get_fn *)
function get_num( var line: string255; var n: integer ): boolean;
var
numstr: string255;
i, l: integer;
begin
get_num := true;
isolate_word( line, numstr );
l := length(numstr);
if (l>5) or (l<1) then begin
n := 0;
get_num := false
end
else begin
n := 0; i := 1;
numstr := concat( numstr, ' ' );
while (numstr[i] in ['0'..'9']) do begin
if n<(maxint div 10) then
n := n*10 + ord( numstr[i] ) - ord( '0' );
i := i + 1
end
end
end; { get_num }
function nextch(var ch: char): boolean;
var s: string255;
begin
isolate_word(line,s);
if length(s) <> 1 then
nextch := false
else
begin
ch := s[1];
nextch := true
end (* else *)
end; (* nextch *)
function parse(*: statustype*);
type states = (start, fin, get_filename, get_set_parm, get_parity, get_on_off,
get_char, get_show_parm, get_help_show, get_help_parm,
exitstate, get_baud);
var status: statustype;
word: vocab;
state: states;
function get_sym(var word: vocab): statustype;
var i: vocab;
s: string255;
stat: statustype;
done: boolean;
matches: integer;
begin
eat_spaces(line);
if length(line) = 0 then
getsym := ateol
else
begin
stat := null;
done := false;
isolate_word(line,s);
i := allsym;
matches := 0;
repeat
if (pos(s,vocablist[i]) = 1) and (i in expected) then
begin
matches := matches + 1;
word := i
end
else if (s[1] < vocablist[i,1]) then
done := true;
if (i = spacesym) then
done := true
else
i := succ(i)
until (matches > 1) or done;
if matches > 1 then
stat := ambiguous
else if (matches = 0) then
stat := unrec;
getsym := stat
end (* else *)
end; (* getsym *)
begin
state := start;
parse := null;
noun := nullsym;
verb := nullsym;
adj := nullsym;
uppercase(line);
repeat
case state of
start:
begin
expected := [consym, exitsym, helpsym, quitsym, recsym, sendsym,
setsym, showsym];
status := getsym(verb);
if status = ateol then
begin
parse := null;
exit(parse)
end (* if *)
else if (status <> unrec) and (status <> ambiguous) then
case verb of
consym: state := fin;
exitsym, quitsym: state := fin;
helpsym: state := get_help_parm;
recsym: state := fin;
sendsym: state := getfilename;
setsym: state := get_set_parm;
showsym: state := get_show_parm;
end (* case *)
end; (* case start *)
fin:
begin
expected := [];
status := getsym(verb);
if status = ateol then
begin
parse := null;
exit(parse)
end (* if status *)
else
status := unconfirmed
end; (* case fin *)
getfilename:
begin
expected := [];
if getfn(line,xfilename) then
begin
status := null;
state := fin
end (* if *)
else
status := fnexpected
end; (* case get file name *)
get_set_parm:
begin
expected := [paritysym, localsym, ibmsym, emulatesym, escsym,
debugsym, filewarnsym, baudsym];
status := getsym(noun);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
case noun of
paritysym: state := get_parity;
localsym: state := get_on_off;
ibmsym: state := get_on_off;
emulatesym: state := get_on_off;
escsym: state := getchar;
debugsym: state := get_on_off;
filewarnsym: state := get_on_off;
baudsym: state := get_baud
end (* case *)
end; (* case get_set_parm *)
get_parity:
begin
expected := [marksym, spacesym, nonesym, evensym, oddsym];
status := getsym(adj);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
state := fin
end; (* case get_parity *)
get_baud:
begin
expected := [];
if get_num( line, newbaud ) then begin
status := null; state := fin
end
else begin
newbaud := 0;
status := parm_expected
end
end; (* case get_baud *)
get_on_off:
begin
expected := [onsym, offsym];
status := getsym(adj);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
state := fin
end; (* get_on_off *)
get_char:
if nextch(newescchar) then
state := fin
else
status := ch_expected;
get_show_parm:
begin
expected := [allsym, paritysym, localsym, ibmsym, escsym,
debugsym, filewarnsym, baudsym];
status := getsym(noun);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
state := fin
end; (* case get_show_parm *)
get_help_show:
begin
expected := [paritysym, localsym, ibmsym, escsym,
debugsym, filewarnsym, baudsym, emulatesym];
status := getsym(adj);
if (status = at_eol) then
begin
status := null;
state := fin
end
else if (status <> unrec) and (status <> ambiguous) then
state := fin
end; (* case get_help_show *)
get_help_parm:
begin
expected := [consym, exitsym, helpsym, quitsym, recsym,
sendsym, setsym, showsym];
status := getsym(noun);
if status = ateol then
begin
parse := null;
exit(parse)
end;
if (status <> unrec) and (status <> ambiguous) then
case noun of
consym: state := fin;
sendsym: state := fin;
recsym: state := fin;
setsym: state := get_help_show;
showsym: state := fin;
helpsym: state := fin;
exitsym, quitsym: state := fin;
end (* case *)
end; (* case get_help_show *)
end (* case *)
until (status <> null);
parse := status
end; (* parse *)
procedure initvocab;
var i: integer;
begin
vocablist[allsym] := 'ALL';
vocablist[baudsym] := 'BAUD';
vocablist[consym] := 'CONNECT';
vocablist[debugsym] := 'DEBUG';
vocablist[emulatesym] := 'EMULATE';
vocablist[escsym] := 'ESCAPE';
vocablist[evensym] := 'EVEN';
vocablist[exitsym] := 'EXIT';
vocablist[filewarnsym] := 'FILE-WARNING';
vocablist[helpsym] := 'HELP';
vocablist[ibmsym] := 'IBM';
vocablist[localsym] := 'LOCAL-ECHO';
vocablist[marksym] := 'MARK';
vocablist[nonesym] := 'NONE';
vocablist[oddsym] := 'ODD';
vocablist[offsym] := 'OFF';
vocablist[onsym] := 'ON';
vocablist[paritysym] := 'PARITY';
vocablist[quitsym] := 'QUIT';
vocablist[recsym] := 'RECEIVE';
vocablist[sendsym] := 'SEND';
vocablist[setsym] := 'SET';
vocablist[showsym] := 'SHOW';
vocablist[spacesym] := 'SPACE';
end; (* initvocab *)
end. (* end of unit *)