home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ucsdpecan.zip
/
parser.text
< prev
next >
Wrap
Text File
|
1990-08-05
|
14KB
|
429 lines
(*$S+*)
unit parser;
INTERFACE
uses {$U kermglob.code} kermglob;
{Change log:
13 May 89, V1.1: Fixed several bugs in parsing of HELP commands RTC
13 May 89, V1.1: Added parsing for COMMENT command
30 Apr 89, V1.1: Added parsing for SET INTERFACE command RTC
26 Apr 89, V1.1: minor cleanups RTC
16 Apr 89, V1.1: Added BYE & FINISH command parsing RTC
14 Apr 89, V1.1: Added parsing for GET, PUT & SHOW VERSION commands RTC
13 Apr 89, V1.1: Added Version message RTC
14 Aug 88: Added parsing for LOG, CLOSE, and SET SYSTEM commands RTC
02 Jul 88: Added -NAMES, -TYPE, TAKE command parsing RTC
}
function parse: statustype;
procedure initvocab;
procedure par_version;
IMPLEMENTATION
uses
{$U kermutil.code} kermutil;
const
my_version = ' Parser Unit V1.1, 13 May 89';
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);
if (l < 1) 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_f_type, get_char, get_show_parm,
get_help_show, get_int_type, get_naming, get_help_parm,
exitstate, get_baud, get_line, get_log_parm, get_help_log);
var status: statustype;
word: vocab;
state: states;
function get_a_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
get_a_sym := 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 = versionsym) 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;
get_a_sym := stat
end (* else *)
end; (* get_a_sym *)
begin
state := start;
parse := null;
noun := nullsym;
verb := nullsym;
adj := nullsym;
uppercase(line);
repeat
case state of
start:
begin
expected := [comsym, consym, exitsym, helpsym, quitsym,
logsym, closesym, getsym, putsym, byesym, finsym,
recsym, sendsym, setsym, showsym, takesym];
status := get_a_sym(verb);
if status = ateol then
begin
parse := null;
exit(parse)
end (* if *)
else if (status <> unrec) and (status <> ambiguous) then
case verb of
comsym: state := get_line;
consym, exitsym, quitsym,
byesym, finsym, recsym: state := fin;
getsym, putsym,
sendsym, takesym: state := getfilename;
helpsym: state := get_help_parm;
logsym, closesym: state := get_log_param;
setsym: state := get_set_parm;
showsym: state := get_show_parm;
end (* case *)
end; (* case start *)
fin:
begin
expected := [];
status := get_a_sym(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, filenamsym, filetypesym,
intsym, filewarnsym, baudsym, systemsym];
status := get_a_sym(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;
filenamsym : state := get_naming;
filetypesym : state := get_f_type;
filewarnsym: state := get_on_off;
intsym: state := get_int_type;
baudsym: state := get_baud;
systemsym: state := get_line
end (* case *)
end; (* case get_set_parm *)
get_log_parm:
begin
expected := [debugsym];
status := get_a_sym(adj);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
if verb = logsym
then state := getfilename
else state := fin
end; (* case get_log_parm *)
get_line:
begin
eat_spaces(line);
parse := null;
exit(parse)
end; {case get_line}
get_parity, get_naming, get_int_type, get_on_off, get_f_type:
begin
case state of
get_parity: expected := [marksym, spacesym,
nonesym, evensym, oddsym];
get_naming: expected := [convsym, litsym];
get_int_type: expected := [kermitsym, ucsdsym];
get_on_off: expected := [onsym, offsym];
get_f_type: expected := [binsym, textsym];
end {case state};
status := get_a_sym(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_char:
if nextch(newescchar) then
state := fin
else
status := ch_expected;
get_show_parm:
begin
expected := [allsym, paritysym, localsym, ibmsym,
emulatesym, escsym, debugsym,
filenamsym, filetypesym, filewarnsym,
baudsym, systemsym, versionsym];
status := get_a_sym(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, get_help_log:
begin
case noun of
logsym, closesym:
expected := [debugsym];
setsym:
expected := [paritysym, localsym, ibmsym, escsym,
intsym, debugsym, filenamsym, filetypesym,
filewarnsym, baudsym, emulatesym, systemsym];
showsym:
expected := [paritysym, localsym, ibmsym, escsym,
debugsym, filenamsym, filetypesym,
filewarnsym, baudsym, emulatesym, systemsym,
allsym, versionsym];
end {case noun};
status := get_a_sym(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,
comsym, getsym, putsym, byesym, finsym, takesym,
logsym, closesym, sendsym, setsym, showsym];
status := get_a_sym(noun);
if status = ateol then
begin
parse := null;
exit(parse)
end;
if (status <> unrec) and (status <> ambiguous) then
case noun of
consym, comsym, getsym, putsym,
sendsym, finsym, byesym, takesym,
recsym: state := fin;
closesym, logsym: state := get_help_log;
showsym, setsym: state := get_help_show;
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[binsym] := 'BINARY';
vocablist[byesym] := 'BYE';
vocablist[closesym] := 'CLOSE';
vocablist[comsym] := 'COMMENT';
vocablist[consym] := 'CONNECT';
vocablist[convsym] := 'CONVERTED';
vocablist[debugsym] := 'DEBUG';
vocablist[emulatesym] := 'EMULATE';
vocablist[escsym] := 'ESCAPE';
vocablist[evensym] := 'EVEN';
vocablist[exitsym] := 'EXIT';
vocablist[filenamsym] := 'FILE-NAMES';
vocablist[filetypesym] := 'FILE-TYPE';
vocablist[filewarnsym] := 'FILE-WARNING';
vocablist[finsym] := 'FINISH';
vocablist[getsym] := 'GET';
vocablist[helpsym] := 'HELP';
vocablist[ibmsym] := 'IBM';
vocablist[intsym] := 'INTERFACE';
vocablist[kermitsym] := 'KERMIT';
vocablist[litsym] := 'LITERAL';
vocablist[localsym] := 'LOCAL-ECHO';
vocablist[logsym] := 'LOG';
vocablist[marksym] := 'MARK';
vocablist[nonesym] := 'NONE';
vocablist[oddsym] := 'ODD';
vocablist[offsym] := 'OFF';
vocablist[onsym] := 'ON';
vocablist[paritysym] := 'PARITY';
vocablist[putsym] := 'PUT';
vocablist[quitsym] := 'QUIT';
vocablist[recsym] := 'RECEIVE';
vocablist[sendsym] := 'SEND';
vocablist[setsym] := 'SET';
vocablist[showsym] := 'SHOW';
vocablist[spacesym] := 'SPACE';
vocablist[systemsym] := 'SYSTEM-ID';
vocablist[takesym] := 'TAKE';
vocablist[textsym] := 'TEXT';
vocablist[ucsdsym] := 'UCSD';
vocablist[versionsym] := 'VERSION';
end; (* initvocab *)
procedure par_version;
begin
writeln(my_version)
end {par_version};
end. (* end of unit *)