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