(*>>>>>>>>>>>>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 *)