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