home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
ucsdappleii
/
parser.text
< prev
next >
Wrap
Text File
|
1986-04-07
|
15KB
|
472 lines
(*>>>>>>>>>>>>PARSER>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*)
(*$S+*)
(*$I-*)
(*$R-*)
(*$V-*)
UNIT parser; INTRINSIC CODE 23 DATA 24;
INTERFACE
USES kermglob,
kermutil;
FUNCTION parse: statustype;
IMPLEMENTATION
VAR first_sym, last_sym : vocab;
PROCEDURE isolate_word ( var line, word : string; var wlen : integer );
var line_len : integer;
begin
word := ''; wlen := 0; linelen := length( line );
if linelen > 0
then begin
delete( line, 1, scan( linelen, <> ' ', line[1] ) );
linelen := length( line );
if linelen > 0
then begin
wlen := scan( linelen, = ' ', line[1] );
word := copy( line, 1, wlen );
delete( line, 1, wlen );
end;
end;
end; { isolate_word }
FUNCTION get_fn( var line, fn: string; namelen : integer ) : boolean;
checks the length of the filename requested for 'send'.
Or checks the prefix volume name for files to be received.
var i, l: integer;
begin
get_fn := true;
isolate_word( line, fn, l );
if (l > namelen) or (l < 1) then get_fn := false
{ max filename length, incl. volumename = 23 }
{ max volumename length, incl. ':' = 8 }
else begin
if (fn[l] = ':') and (namelen=23) then get_fn := false;
if (fn[l] <> ':') and (namelen=8) then get_fn := false;
{ legality of volume and filename will be tested }
{ when the file is actually opened. ( see unit "sender" ) }
end;
end; (* get_fn *)
FUNCTION get_num( var line: string; var n: integer ): boolean;
var
numstr: string;
i, numstr_len : integer;
begin
get_num := true; n := 0;
isolate_word( line, numstr, numstr_len );
if (numstr_len < 6) and (numstr_len > 0) then
begin
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 { while }
end; { if }
if n = 0 then get_num := false;
end; { get_num }
FUNCTION nextch(var ch: char): boolean;
var s: string;
ch_len : integer;
begin
isolate_word( line, s, ch_len );
if ch_len <= 1 then begin
if ch_len = 1 then ch := s[1]
else ch := cr;
nextch := true;
end
else nextch := false;
end; (* nextch *)
FUNCTION get_sym(var word: vocab): statustype;
var i: vocab;
s: string;
stat: statustype;
done: boolean;
matches, slen : integer;
begin
isolate_word( line, s, slen );
if slen = 0 then getsym := ateol
else
begin
stat := null;
done := false;
i := first_sym;
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 = last_sym ) 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 *)
FUNCTION parse(*: statustype*);
type states = (start, fin, get_filename, get_set_parm, get_parity, get_on_off,
get_esc_char, get_show_parm, get_help_show, get_help_parm,
exitstate, get_baud, get_wordlen, get_stopbit, get_xon_char,
get_xoff_char, get_xoffwait, get_nofeed, get_timeout, get_maxpak,
get_eoln_char, get_maxtry, get_prefix, get_dir);
var status: statustype;
word: vocab;
state: states;
procedure case_start;
begin
expected := [consym, exitsym, helpsym, phelpsym, quitsym, recsym,
sendsym, setsym, showsym, pshowsym, dirsym, pdirsym];
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, recsym, exitsym, quitsym: state := fin;
helpsym : begin
state := get_help_parm;
pr_out:= false
end;
phelpsym : begin
state := get_help_parm;
pr_out:= true
end;
dirsym : begin
state := get_dir;
pr_out := false;
end;
pdirsym : begin
state := get_dir;
pr_out := true;
end;
sendsym : state := getfilename;
setsym : state := get_set_parm;
showsym : begin
state := get_show_parm;
pr_out:= false
end;
pshowsym : begin
state := get_show_parm;
pr_out:= true
end;
end (* case *)
end; (* case_start *)
procedure case_fin;
begin
expected := [];
status := getsym(verb);
if status = ateol then
begin
parse := null;
exit(parse)
end (* if status *)
else
status := unconfirmed
end; (* case_fin *)
procedure case_getfilename;
begin
expected := [];
if getfn(line,xfilename,23) then
begin
status := null;
state := fin
end (* if *)
else
status := fnexpected
end; (* case_getfilename *)
procedure case_gtprefixname;
begin
expected := [];
if getfn(line,newprefix_vol,8) then
begin
status := null;
state := fin
end
else
status := pnexpected
end; (* case_gtprefixname *)
procedure case_getsetparm;
begin
expected := [paritysym, localsym, ibmsym, escsym, prefixsym,
wordlensym, stopbsym, delsym, debugsym, filewarnsym,
baudsym, xonsym, xoffsym, xoffwaitsym, nofeedsym,
timeoutsym, eolnsym, maxtrysym, emulatesym, maxpsym,
textfsym, rejectsym];
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;
prefixsym: state := get_prefix;
escsym: state := get_esc_char;
baudsym: state := get_baud;
wordlensym: state := get_wordlen;
stopbsym: state := get_stopbit;
xonsym: state := get_xon_char;
xoffsym: state := get_xoff_char;
eolnsym: state := get_eoln_char;
xoffwaitsym: state := get_xoffwait;
timeoutsym: state := get_timeout;
maxtrysym: state := get_maxtry;
maxpsym: state := get_maxpak;
nofeedsym, filewarnsym, debugsym, delsym, textfsym,
ibmsym, localsym, rejectsym, emulatesym:
state := get_on_off;
end (* case *)
end; (* case_getsetparm *)
procedure case_getparity;
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_getparity *)
procedure case_getnum( var newnum : integer );
begin
expected := [];
if get_num( line, newnum ) then
begin
status := null; state := fin
end
else status := num_expected
end; (* case_getnum *)
procedure case_getonoff;
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; (* case_ getonoff *)
procedure case_getchar( var newchar : char );
begin
if nextch(newchar) then
state := fin
else
status := ch_expected;
end; (* case_getchar *)
procedure case_gtshowparm;
begin
expected := [allsym, paritysym, localsym, ibmsym, prefixsym,
wordlensym, stopbsym, escsym, delsym, debugsym,
filewarnsym, baudsym, xonsym, xoffsym, xoffwaitsym,
nofeedsym, timeoutsym, eolnsym, emulatesym, maxpsym,
maxtrysym, textfsym, rejectsym];
status := getsym(noun);
if status = ateol then
status := parm_expected
else if (status <> unrec) and (status <> ambiguous) then
state := fin
end; (* case_gtshowparm *)
procedure case_gethelpshow;
begin
expected := [paritysym, localsym, ibmsym, escsym, delsym,
wordlensym, stopbsym, debugsym, filewarnsym,
baudsym, xonsym, xoffsym, xoffwaitsym, emulatesym,
nofeedsym, timeoutsym, eolnsym, prefixsym, maxpsym,
maxtrysym, textfsym, rejectsym];
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_gethelpshow *)
procedure case_gthelpparm;
begin
expected := [consym, exitsym, helpsym, phelpsym, quitsym, recsym,
sendsym, setsym, showsym, pshowsym, dirsym, pdirsym];
status := getsym(noun);
if status = ateol then
begin
parse := null;
exit(parse)
end;
if (status <> unrec) and (status <> ambiguous) then
case noun of
consym, sendsym, recsym,
showsym, pshowsym, helpsym,
phelpsym, exitsym, quitsym,
dirsym, pdirsym : state := fin;
setsym : state := get_help_show;
end (* case *)
end; (* case_gthelpparm *)
begin (* parse *)
state := start;
parse := null;
noun := nullsym;
verb := nullsym;
adj := nullsym;
uppercase ( line );
repeat
case state of
start : case_start;
fin : case_fin;
get_filename : case_getfilename;
get_prefix : case_gtprefixname;
get_set_parm : case_getsetparm;
get_parity : case_getparity;
get_baud : case_getnum( newbaud );
get_wordlen : case_getnum( newdbit );
get_stopbit : case_getnum( newstopbit );
get_xoffwait : case_getnum( newxoffwait);
get_timeout : case_getnum( newtimeout );
get_maxtry : case_getnum( newmaxtry );
get_maxpak : case_getnum( newmaxpack );
get_dir : case_getnum( vol_num );
get_on_off : case_getonoff;
get_esc_char : case_getchar( newescchar );
get_xon_char : case_getchar( newxonchar );
get_xoff_char : case_getchar( newxoffchar);
get_eoln_char : case_getchar( newxeol_char );
get_show_parm : case_gtshowparm;
get_help_show : case_gethelpshow;
get_help_parm : case_gthelpparm;
end; { case }
until (status <> null);
parse := status
end; (* parse *)
BEGIN { initialization }
vocablist[allsym] := 'ALL';
vocablist[baudsym] := 'BAUD';
vocablist[consym] := 'CONNECT';
vocablist[debugsym] := 'DEBUG';
vocablist[delsym] := 'DELKEY';
vocablist[dirsym] := 'DIRECTORY';
vocablist[emulatesym] := 'EMULATE';
vocablist[eolnsym] := 'END-OF-LINE';
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[maxpsym] := 'MAXPACK';
vocablist[maxtrysym] := 'MAXTRY';
vocablist[nofeedsym] := 'NOFEED';
vocablist[nonesym] := 'NONE';
vocablist[oddsym] := 'ODD';
vocablist[offsym] := 'OFF';
vocablist[onsym] := 'ON';
vocablist[paritysym] := 'PARITY';
vocablist[pdirsym] := 'PDIRECTORY';
vocablist[phelpsym] := 'PHELP';
vocablist[prefixsym] := 'PREFIX';
vocablist[pshowsym] := 'PSHOW';
vocablist[quitsym] := 'QUIT';
vocablist[recsym] := 'RECEIVE';
vocablist[rejectsym] := 'REJECT';
vocablist[sendsym] := 'SEND';
vocablist[setsym] := 'SET';
vocablist[showsym] := 'SHOW';
vocablist[spacesym] := 'SPACE';
vocablist[stopbsym] := 'STOPBIT';
vocablist[textfsym] := 'TEXTFILE';
vocablist[timeoutsym] := 'TIMEOUT';
vocablist[wordlensym] := 'WORD-LENGTH';
vocablist[xoffsym] := 'XOFF-CHAR';
vocablist[xoffwaitsym] := 'XOFF-WAIT-COUNT';
vocablist[xonsym] := 'XON-CHAR';
first_sym := allsym;
last_sym := xonsym;
END. (* end of unit parser *)